CPRS29_DEA_SETUP.KIDs

KIDS Distribution saved on Apr 02, 2013@11:40:08
DEA SETUP BUILD
**KIDS**:CPRS29 DEA 1.0^XU*8.0*580^OR*3.0*218^PSD*3.0*76^

**INSTALL NAME**
CPRS29 DEA 1.0
"BLD",8470,0)
CPRS29 DEA 1.0^^1^3130402^y
"BLD",8470,6.3)
29
"BLD",8470,10,0)
^9.63^3^3
"BLD",8470,10,1,0)
XU*8.0*580^1
"BLD",8470,10,2,0)
OR*3.0*218^1
"BLD",8470,10,3,0)
PSD*3.0*76^1
"BLD",8470,10,"B","OR*3.0*218",2)

"BLD",8470,10,"B","PSD*3.0*76",3)

"BLD",8470,10,"B","XU*8.0*580",1)

"BLD",8470,"KRN",0)
^9.67PA^779.2^20
"BLD",8470,"KRN",.4,0)
.4
"BLD",8470,"KRN",.401,0)
.401
"BLD",8470,"KRN",.402,0)
.402
"BLD",8470,"KRN",.403,0)
.403
"BLD",8470,"KRN",.5,0)
.5
"BLD",8470,"KRN",.84,0)
.84
"BLD",8470,"KRN",3.6,0)
3.6
"BLD",8470,"KRN",3.8,0)
3.8
"BLD",8470,"KRN",9.2,0)
9.2
"BLD",8470,"KRN",9.8,0)
9.8
"BLD",8470,"KRN",19,0)
19
"BLD",8470,"KRN",19.1,0)
19.1
"BLD",8470,"KRN",101,0)
101
"BLD",8470,"KRN",409.61,0)
409.61
"BLD",8470,"KRN",771,0)
771
"BLD",8470,"KRN",779.2,0)
779.2
"BLD",8470,"KRN",870,0)
870
"BLD",8470,"KRN",8989.51,0)
8989.51
"BLD",8470,"KRN",8989.52,0)
8989.52
"BLD",8470,"KRN",8994,0)
8994
"BLD",8470,"KRN","B",.4,.4)

"BLD",8470,"KRN","B",.401,.401)

"BLD",8470,"KRN","B",.402,.402)

"BLD",8470,"KRN","B",.403,.403)

"BLD",8470,"KRN","B",.5,.5)

"BLD",8470,"KRN","B",.84,.84)

"BLD",8470,"KRN","B",3.6,3.6)

"BLD",8470,"KRN","B",3.8,3.8)

"BLD",8470,"KRN","B",9.2,9.2)

"BLD",8470,"KRN","B",9.8,9.8)

"BLD",8470,"KRN","B",19,19)

"BLD",8470,"KRN","B",19.1,19.1)

"BLD",8470,"KRN","B",101,101)

"BLD",8470,"KRN","B",409.61,409.61)

"BLD",8470,"KRN","B",771,771)

"BLD",8470,"KRN","B",779.2,779.2)

"BLD",8470,"KRN","B",870,870)

"BLD",8470,"KRN","B",8989.51,8989.51)

"BLD",8470,"KRN","B",8989.52,8989.52)

"BLD",8470,"KRN","B",8994,8994)

"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"VER")
8.0^22.0
**INSTALL NAME**
XU*8.0*580
"BLD",1393,0)
XU*8.0*580^KERNEL^0^3130328^y
"BLD",1393,1,0)
^^4^4^3120516^^^
"BLD",1393,1,1,0)
 
"BLD",1393,1,2,0)
Please refer to the Description in the FORUM Patch Module for details.
"BLD",1393,1,3,0)

"BLD",1393,1,4,0)

"BLD",1393,4,0)
^9.64PA^19^5
"BLD",1393,4,4,0)
4
"BLD",1393,4,4,2,0)
^9.641^4^1
"BLD",1393,4,4,2,4,0)
INSTITUTION  (File-top level)
"BLD",1393,4,4,2,4,1,0)
^9.6411^52.1^1
"BLD",1393,4,4,2,4,1,52.1,0)
FACILITY DEA EXPIRATION DATE
"BLD",1393,4,4,222)
y^y^p^^^^n^^n
"BLD",1393,4,4,224)

"BLD",1393,4,19,0)
19
"BLD",1393,4,19,2,0)
^9.641^19^1
"BLD",1393,4,19,2,19,0)
OPTION  (File-top level)
"BLD",1393,4,19,2,19,1,0)
^9.6411^69.3^4
"BLD",1393,4,19,2,19,1,69,0)
DIS(0)
"BLD",1393,4,19,2,19,1,69.1,0)
DIS(1)
"BLD",1393,4,19,2,19,1,69.2,0)
DIS(2)
"BLD",1393,4,19,2,19,1,69.3,0)
DIS(3)
"BLD",1393,4,19,222)
y^y^p^^^^n^^n
"BLD",1393,4,19,224)

"BLD",1393,4,200,0)
200
"BLD",1393,4,200,2,0)
^9.641^200^1
"BLD",1393,4,200,2,200,0)
NEW PERSON  (File-top level)
"BLD",1393,4,200,2,200,1,0)
^9.6411^53.3^10
"BLD",1393,4,200,2,200,1,53.11,0)
Detox/Maintenance ID Number
"BLD",1393,4,200,2,200,1,53.2,0)
DEA#
"BLD",1393,4,200,2,200,1,53.3,0)
VA#
"BLD",1393,4,200,2,200,1,55.1,0)
Schedule II Narcotic
"BLD",1393,4,200,2,200,1,55.2,0)
Schedule II Non-narcotic
"BLD",1393,4,200,2,200,1,55.3,0)
Schedule III Narcotic
"BLD",1393,4,200,2,200,1,55.4,0)
Schedule III Non-narcotic
"BLD",1393,4,200,2,200,1,55.5,0)
Schedule IV
"BLD",1393,4,200,2,200,1,55.6,0)
Schedule V
"BLD",1393,4,200,2,200,1,501.2,0)
SUBJECT ALTERNATIVE NAME
"BLD",1393,4,200,222)
y^y^p^^^^n^^n
"BLD",1393,4,200,224)

"BLD",1393,4,8991.6,0)
8991.6
"BLD",1393,4,8991.6,222)
y^y^f^^^^n
"BLD",1393,4,8991.7,0)
8991.7
"BLD",1393,4,8991.7,222)
y^y^f^^^^n
"BLD",1393,4,"APDD",4,4)

"BLD",1393,4,"APDD",4,4,52.1)

"BLD",1393,4,"APDD",19,19)

"BLD",1393,4,"APDD",19,19,69)

"BLD",1393,4,"APDD",19,19,69.1)

"BLD",1393,4,"APDD",19,19,69.2)

"BLD",1393,4,"APDD",19,19,69.3)

"BLD",1393,4,"APDD",200,200)

"BLD",1393,4,"APDD",200,200,53.11)

"BLD",1393,4,"APDD",200,200,53.2)

"BLD",1393,4,"APDD",200,200,53.3)

"BLD",1393,4,"APDD",200,200,55.1)

"BLD",1393,4,"APDD",200,200,55.2)

"BLD",1393,4,"APDD",200,200,55.3)

"BLD",1393,4,"APDD",200,200,55.4)

"BLD",1393,4,"APDD",200,200,55.5)

"BLD",1393,4,"APDD",200,200,55.6)

"BLD",1393,4,"APDD",200,200,501.2)

"BLD",1393,4,"B",4,4)

"BLD",1393,4,"B",19,19)

"BLD",1393,4,"B",200,200)

"BLD",1393,4,"B",8991.6,8991.6)

"BLD",1393,4,"B",8991.7,8991.7)

"BLD",1393,6)
29^
"BLD",1393,6.3)
46
"BLD",1393,"ABPKG")
n
"BLD",1393,"INI")
PRE^XU8P580
"BLD",1393,"INIT")
POST^XU8P580
"BLD",1393,"KRN",0)
^9.67PA^9002226^21
"BLD",1393,"KRN",.4,0)
.4
"BLD",1393,"KRN",.4,"NM",0)
^9.68A^10^10
"BLD",1393,"KRN",.4,"NM",1,0)
XU EPCS XDATE PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",2,0)
XU EPCS PSDRPH PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",3,0)
XU EPCS SET PARMS PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",4,0)
XU EPCS PRIVS PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",5,0)
XU EPCS LOGICAL ACCESS PRINT    FILE #8991.6^8991.6^0
"BLD",1393,"KRN",.4,"NM",6,0)
XU EPCS PSDRPH KEY PRINT    FILE #8991.7^8991.7^0
"BLD",1393,"KRN",.4,"NM",7,0)
XU EPCS XDATE 30 PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",8,0)
XU EPCS DISUSER XDATE PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",9,0)
XU EPCS DISUSER PRIVS PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM",10,0)
XU EPCS DISUSER XDATE2 PRINT    FILE #200^200^0
"BLD",1393,"KRN",.4,"NM","B","XU EPCS DISUSER PRIVS PRINT    FILE #200",9)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS DISUSER XDATE PRINT    FILE #200",8)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS DISUSER XDATE2 PRINT    FILE #200",10)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS LOGICAL ACCESS PRINT    FILE #8991.6",5)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS PRIVS PRINT    FILE #200",4)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS PSDRPH KEY PRINT    FILE #8991.7",6)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS PSDRPH PRINT    FILE #200",2)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS SET PARMS PRINT    FILE #200",3)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS XDATE 30 PRINT    FILE #200",7)

"BLD",1393,"KRN",.4,"NM","B","XU EPCS XDATE PRINT    FILE #200",1)

"BLD",1393,"KRN",.401,0)
.401
"BLD",1393,"KRN",.401,"NM",0)
^9.68A^6^6
"BLD",1393,"KRN",.401,"NM",1,0)
XU EPCS PSDRPH SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM",2,0)
XU EPCS SET PARMS SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM",3,0)
XU EPCS DIV SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM",4,0)
XU EPCS DISUSER SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM",5,0)
XU EPCS ACTIVE USER SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM",6,0)
XU EPCS DISUSER2 SORT    FILE #200^200^0
"BLD",1393,"KRN",.401,"NM","B","XU EPCS ACTIVE USER SORT    FILE #200",5)

"BLD",1393,"KRN",.401,"NM","B","XU EPCS DISUSER SORT    FILE #200",4)

"BLD",1393,"KRN",.401,"NM","B","XU EPCS DISUSER2 SORT    FILE #200",6)

"BLD",1393,"KRN",.401,"NM","B","XU EPCS DIV SORT    FILE #200",3)

"BLD",1393,"KRN",.401,"NM","B","XU EPCS PSDRPH SORT    FILE #200",1)

"BLD",1393,"KRN",.401,"NM","B","XU EPCS SET PARMS SORT    FILE #200",2)

"BLD",1393,"KRN",.402,0)
.402
"BLD",1393,"KRN",.403,0)
.403
"BLD",1393,"KRN",.5,0)
.5
"BLD",1393,"KRN",.84,0)
.84
"BLD",1393,"KRN",3.6,0)
3.6
"BLD",1393,"KRN",3.6,"NM",0)
^9.68A^1^1
"BLD",1393,"KRN",3.6,"NM",1,0)
XUSSPKI SAN^^0
"BLD",1393,"KRN",3.6,"NM","B","XUSSPKI SAN",1)

"BLD",1393,"KRN",3.8,0)
3.8
"BLD",1393,"KRN",3.8,"NM",0)
^9.68A^^0
"BLD",1393,"KRN",9.2,0)
9.2
"BLD",1393,"KRN",9.2,"NM",0)
^9.68A^^
"BLD",1393,"KRN",9.8,0)
9.8
"BLD",1393,"KRN",9.8,"NM",0)
^9.68A^6^6
"BLD",1393,"KRN",9.8,"NM",1,0)
XUSER^^0^B47045111
"BLD",1393,"KRN",9.8,"NM",2,0)
XUEPCSED^^0^B2888160
"BLD",1393,"KRN",9.8,"NM",3,0)
XUSER2^^0^B15407315
"BLD",1393,"KRN",9.8,"NM",4,0)
XUEPCSRT^^0^B22030133
"BLD",1393,"KRN",9.8,"NM",5,0)
XUSC1C^^0^B8383983
"BLD",1393,"KRN",9.8,"NM",6,0)
XU8P580^^0^B7617911
"BLD",1393,"KRN",9.8,"NM","B","XU8P580",6)

"BLD",1393,"KRN",9.8,"NM","B","XUEPCSED",2)

"BLD",1393,"KRN",9.8,"NM","B","XUEPCSRT",4)

"BLD",1393,"KRN",9.8,"NM","B","XUSC1C",5)

"BLD",1393,"KRN",9.8,"NM","B","XUSER",1)

"BLD",1393,"KRN",9.8,"NM","B","XUSER2",3)

"BLD",1393,"KRN",19,0)
19
"BLD",1393,"KRN",19,"NM",0)
^9.68A^17^16
"BLD",1393,"KRN",19,"NM",1,0)
XU EPCS EDIT DATA^^0
"BLD",1393,"KRN",19,"NM",2,0)
XU EPCS EXP DATE^^0
"BLD",1393,"KRN",19,"NM",3,0)
XU EPCS PSDRPH^^0
"BLD",1393,"KRN",19,"NM",4,0)
XU EPCS SET PARMS^^0
"BLD",1393,"KRN",19,"NM",6,0)
XUSSPKI UPN SET^^0
"BLD",1393,"KRN",19,"NM",7,0)
XU EPCS PRIVS^^0
"BLD",1393,"KRN",19,"NM",8,0)
XU EPCS LOGICAL ACCESS^^0
"BLD",1393,"KRN",19,"NM",9,0)
XU EPCS PSDRPH KEY^^0
"BLD",1393,"KRN",19,"NM",10,0)
XU EPCS PSDRPH AUDIT^^0
"BLD",1393,"KRN",19,"NM",11,0)
XU EPCS EDIT DEA# AND XDATE^^0
"BLD",1393,"KRN",19,"NM",12,0)
XU EPCS XDATE EXPIRES^^0
"BLD",1393,"KRN",19,"NM",13,0)
XU EPCS UTILITY FUNCTIONS^^0
"BLD",1393,"KRN",19,"NM",14,0)
XU EPCS PRINT EDIT AUDIT^^0
"BLD",1393,"KRN",19,"NM",15,0)
XU EPCS DISUSER EXP DATE^^0
"BLD",1393,"KRN",19,"NM",16,0)
XU EPCS DISUSER PRIVS^^0
"BLD",1393,"KRN",19,"NM",17,0)
XU EPCS DISUSER XDATE EXPIRES^^0
"BLD",1393,"KRN",19,"NM","B","XU EPCS DISUSER EXP DATE",15)

"BLD",1393,"KRN",19,"NM","B","XU EPCS DISUSER PRIVS",16)

"BLD",1393,"KRN",19,"NM","B","XU EPCS DISUSER XDATE EXPIRES",17)

"BLD",1393,"KRN",19,"NM","B","XU EPCS EDIT DATA",1)

"BLD",1393,"KRN",19,"NM","B","XU EPCS EDIT DEA# AND XDATE",11)

"BLD",1393,"KRN",19,"NM","B","XU EPCS EXP DATE",2)

"BLD",1393,"KRN",19,"NM","B","XU EPCS LOGICAL ACCESS",8)

"BLD",1393,"KRN",19,"NM","B","XU EPCS PRINT EDIT AUDIT",14)

"BLD",1393,"KRN",19,"NM","B","XU EPCS PRIVS",7)

"BLD",1393,"KRN",19,"NM","B","XU EPCS PSDRPH",3)

"BLD",1393,"KRN",19,"NM","B","XU EPCS PSDRPH AUDIT",10)

"BLD",1393,"KRN",19,"NM","B","XU EPCS PSDRPH KEY",9)

"BLD",1393,"KRN",19,"NM","B","XU EPCS SET PARMS",4)

"BLD",1393,"KRN",19,"NM","B","XU EPCS UTILITY FUNCTIONS",13)

"BLD",1393,"KRN",19,"NM","B","XU EPCS XDATE EXPIRES",12)

"BLD",1393,"KRN",19,"NM","B","XUSSPKI UPN SET",6)

"BLD",1393,"KRN",19.1,0)
19.1
"BLD",1393,"KRN",19.1,"NM",0)
^9.68A^1^1
"BLD",1393,"KRN",19.1,"NM",1,0)
XUEPCSEDIT^^0
"BLD",1393,"KRN",19.1,"NM","B","XUEPCSEDIT",1)

"BLD",1393,"KRN",101,0)
101
"BLD",1393,"KRN",409.61,0)
409.61
"BLD",1393,"KRN",771,0)
771
"BLD",1393,"KRN",779.2,0)
779.2
"BLD",1393,"KRN",870,0)
870
"BLD",1393,"KRN",8989.51,0)
8989.51
"BLD",1393,"KRN",8989.51,"NM",0)
^9.68A^1^1
"BLD",1393,"KRN",8989.51,"NM",1,0)
XUEPCS REPORT DEVICE^^0
"BLD",1393,"KRN",8989.51,"NM","B","XUEPCS REPORT DEVICE",1)

"BLD",1393,"KRN",8989.52,0)
8989.52
"BLD",1393,"KRN",8989.52,"NM",0)
^9.68A^^
"BLD",1393,"KRN",8994,0)
8994
"BLD",1393,"KRN",8994,"NM",0)
^9.68A^4^4
"BLD",1393,"KRN",8994,"NM",1,0)
XU EPCS EDIT^^0
"BLD",1393,"KRN",8994,"NM",2,0)
XUS PKI SET UPN^^0
"BLD",1393,"KRN",8994,"NM",3,0)
XUS PKI GET UPN^^0
"BLD",1393,"KRN",8994,"NM",4,0)
XWB GET VARIABLE VALUE^^0
"BLD",1393,"KRN",8994,"NM","B","XU EPCS EDIT",1)

"BLD",1393,"KRN",8994,"NM","B","XUS PKI GET UPN",3)

"BLD",1393,"KRN",8994,"NM","B","XUS PKI SET UPN",2)

"BLD",1393,"KRN",8994,"NM","B","XWB GET VARIABLE VALUE",4)

"BLD",1393,"KRN","B",.4,.4)

"BLD",1393,"KRN","B",.401,.401)

"BLD",1393,"KRN","B",.402,.402)

"BLD",1393,"KRN","B",.403,.403)

"BLD",1393,"KRN","B",.5,.5)

"BLD",1393,"KRN","B",.84,.84)

"BLD",1393,"KRN","B",3.6,3.6)

"BLD",1393,"KRN","B",3.8,3.8)

"BLD",1393,"KRN","B",9.2,9.2)

"BLD",1393,"KRN","B",9.8,9.8)

"BLD",1393,"KRN","B",19,19)

"BLD",1393,"KRN","B",19.1,19.1)

"BLD",1393,"KRN","B",101,101)

"BLD",1393,"KRN","B",409.61,409.61)

"BLD",1393,"KRN","B",771,771)

"BLD",1393,"KRN","B",779.2,779.2)

"BLD",1393,"KRN","B",870,870)

"BLD",1393,"KRN","B",8989.51,8989.51)

"BLD",1393,"KRN","B",8989.52,8989.52)

"BLD",1393,"KRN","B",8994,8994)

"BLD",1393,"PRE")
XU8P580
"BLD",1393,"QDEF")
^^^^YES
"BLD",1393,"QUES",0)
^9.62^^
"BLD",1393,"REQB",0)
^9.611^1^1
"BLD",1393,"REQB",1,0)
XU*8.0*373^1
"BLD",1393,"REQB","B","XU*8.0*373",1)

"FIA",4)
INSTITUTION
"FIA",4,0)
^DIC(4,
"FIA",4,0,0)
4I
"FIA",4,0,1)
y^y^p^^^^n^^n
"FIA",4,0,10)

"FIA",4,0,11)

"FIA",4,0,"RLRO")

"FIA",4,0,"VR")
8.0^XU
"FIA",4,4)
1
"FIA",4,4,52.1)

"FIA",19)
OPTION
"FIA",19,0)
^DIC(19,
"FIA",19,0,0)
19I
"FIA",19,0,1)
y^y^p^^^^n^^n
"FIA",19,0,10)

"FIA",19,0,11)

"FIA",19,0,"RLRO")

"FIA",19,0,"VR")
8.0^XU
"FIA",19,19)
1
"FIA",19,19,69)

"FIA",19,19,69.1)

"FIA",19,19,69.2)

"FIA",19,19,69.3)

"FIA",200)
NEW PERSON
"FIA",200,0)
^VA(200,
"FIA",200,0,0)
200I
"FIA",200,0,1)
y^y^p^^^^n^^n
"FIA",200,0,10)

"FIA",200,0,11)

"FIA",200,0,"RLRO")

"FIA",200,0,"VR")
8.0^XU
"FIA",200,200)
1
"FIA",200,200,53.11)

"FIA",200,200,53.2)

"FIA",200,200,53.3)

"FIA",200,200,55.1)

"FIA",200,200,55.2)

"FIA",200,200,55.3)

"FIA",200,200,55.4)

"FIA",200,200,55.5)

"FIA",200,200,55.6)

"FIA",200,200,501.2)

"FIA",8991.6)
XUEPCS DATA
"FIA",8991.6,0)
^XTV(8991.6,
"FIA",8991.6,0,0)
8991.6P
"FIA",8991.6,0,1)
y^y^f^^^^n
"FIA",8991.6,0,10)

"FIA",8991.6,0,11)

"FIA",8991.6,0,"RLRO")

"FIA",8991.6,0,"VR")
8.0^XU
"FIA",8991.6,8991.6)
0
"FIA",8991.7)
XUEPCS PSDRPH AUDIT
"FIA",8991.7,0)
^XTV(8991.7,
"FIA",8991.7,0,0)
8991.7P
"FIA",8991.7,0,1)
y^y^f^^^^n
"FIA",8991.7,0,10)

"FIA",8991.7,0,11)

"FIA",8991.7,0,"RLRO")

"FIA",8991.7,0,"VR")
8.0^XU
"FIA",8991.7,8991.7)
0
"INI")
PRE^XU8P580
"INIT")
POST^XU8P580
"KRN",.4,200,-1)
0^1
"KRN",.4,200,0)
XU EPCS XDATE PRINT^3121213.1609^@^200^^@^3130307
"KRN",.4,200,"%D",0)
^.4001^3^3^3121213^^
"KRN",.4,200,"%D",1,0)
This is a print template for the DEA EPCS project. This prints
"KRN",.4,200,"%D",2,0)
name, DEA#, and DEA Expiration Date.
"KRN",.4,200,"%D",3,0)

"KRN",.4,200,"F",2)
.01;L37~53.2;L11~747.44~
"KRN",.4,200,"H")
NULL 'DEA EXPIRATION DATE'
"KRN",.4,202,-1)
0^2
"KRN",.4,202,0)
XU EPCS PSDRPH PRINT^3120926.1655^@^200^^@^3121213
"KRN",.4,202,"%D",0)
^.4001^2^2^3121213^^^^
"KRN",.4,202,"%D",1,0)
This print template is for the DEA ePCS project and prints name, duz, 
"KRN",.4,202,"%D",2,0)
security keys, and who assigned key.
"KRN",.4,202,"F",2)
.01;C1;L25~0;C27;L10;"DUZ"~51,1;C39;L23~51,2;C64;L12~
"KRN",.4,202,"H")
 PSDRPH KEY HOLDERS
"KRN",.4,203,-1)
0^3
"KRN",.4,203,0)
XU EPCS SET PARMS PRINT^3120926.1702^@^200^^@^3121213
"KRN",.4,203,"%D",0)
^.4001^2^2^3121213^^
"KRN",.4,203,"%D",1,0)
This is a print template for the DEA EPCS project. This prints user's 
"KRN",.4,203,"%D",2,0)
name, DUZ, GIVEN BY, and DATE GIVEN.
"KRN",.4,203,"F",2)
.01;C1;L25~0;C27;L10;"DUZ"~51,1;C39;L23~51,2;C64;L12~
"KRN",.4,203,"H")
 USERS RESPONSIBLE FOR SETTING PARAMETERS
"KRN",.4,204,-1)
0^4
"KRN",.4,204,0)
XU EPCS PRIVS PRINT^3120202.1215^@^200^^@^3130307
"KRN",.4,204,"%D",0)
^.4001^4^4^3121213^^^^
"KRN",.4,204,"%D",1,0)
This is a print template for the DEA EPCS project.  This prints user's 
"KRN",.4,204,"%D",2,0)
NAME, SCHEDULESs, VA#, DUZ and DEA#.
"KRN",.4,204,"%D",3,0)

"KRN",.4,204,"%D",4,0)

"KRN",.4,204,"F",1)
.01;L30~0;"DUZ"~53.2;L11~53.3;L11~"SCHEDULE II: ";C10~55.1;X;C30~"SCHEDULE II NON: ";C10~55.2;X;C30~"SCHEDULE III: ";C10~55.3;X;C30~
"KRN",.4,204,"F",2)
"SCHEDULE III NON: ";C10~55.4;X;C30~"SCHEDULE IV: ";C10~55.5;X;C30~"SCHEDULE V: ";C10~55.6;X;C30~
"KRN",.4,204,"H")
PRESCRIBERS WITH PRIVILEGES
"KRN",.4,207,-1)
0^5
"KRN",.4,207,0)
XU EPCS LOGICAL ACCESS PRINT^3130124.1612^@^8991.6^^@^3130124
"KRN",.4,207,"%D",0)
^.4001^3^3^3120223^^
"KRN",.4,207,"%D",1,0)
This print template is for the DEA ePCS project and print fields NAME, 
"KRN",.4,207,"%D",2,0)
EDITED BY, FIELD EDITED, ORIGINAL DATA, AND EDITED DATA out of file 
"KRN",.4,207,"%D",3,0)
#8991.6. 
"KRN",.4,207,"F",2)
.01;C1;L20;"NAME"~.02;C21;L20~.03~.04;"ORIGINAL DATA(INTERNAL)"~.05;"EDITED DATA(INTERNAL)"~
"KRN",.4,207,"H")
SETTING OR CHANGES TO DEA PRESCRIBING PRIVILEGES
"KRN",.4,209,-1)
0^6
"KRN",.4,209,0)
XU EPCS PSDRPH KEY PRINT^3130123.1431^@^8991.7^^@^3130123
"KRN",.4,209,"%D",0)
^.4001^2^2^3120918^^
"KRN",.4,209,"%D",1,0)
This option is for the DEA ePCS project and will print the allocation of the PSDRPH key.
"KRN",.4,209,"%D",2,0)

"KRN",.4,209,"F",2)
.01;C1L20~.02;C21;L20~.03;C42;L12~.04;C56~
"KRN",.4,209,"H")
PSDRPH KEY AUDIT LIST
"KRN",.4,210,-1)
0^7
"KRN",.4,210,0)
XU EPCS XDATE 30 PRINT^3130117.1533^@^200^^@^3130321
"KRN",.4,210,"%D",0)
^.4001^2^2^3121213^^^
"KRN",.4,210,"%D",1,0)
This is a print template for the DEA EPCS project. This option prints the Name, DEA# and DEA Expiration Date.
"KRN",.4,210,"%D",2,0)

"KRN",.4,210,"F",2)
.01;L37~53.2;L11~747.44~
"KRN",.4,210,"H")
EXPIRATION DATE EXPIRES IN 30 DAYS
"KRN",.4,214,-1)
0^8
"KRN",.4,214,0)
XU EPCS DISUSER XDATE PRINT^3130321.0801^@^200^^@^3130321
"KRN",.4,214,"%D",0)
3^.4001^3^3^3130117^^^^
"KRN",.4,214,"%D",1,0)
This is a print template for the DEA EPCS project. This prints
"KRN",.4,214,"%D",2,0)
name, DEA# and Termination Date.
"KRN",.4,214,"%D",3,0)

"KRN",.4,214,"F",2)
9.2;L11~.01;L33~53.2~
"KRN",.4,214,"H")
DISUSER & NULL 'DEA EXPIRATION DATE'
"KRN",.4,216,-1)
0^9
"KRN",.4,216,0)
XU EPCS DISUSER PRIVS PRINT^3121213.1601^@^200^^@^3130117
"KRN",.4,216,"%D",0)
3^.4001^3^3^3121213^^^^
"KRN",.4,216,"%D",1,0)
This is a print template for the DEA EPCS project.  This prints user's 
"KRN",.4,216,"%D",2,0)
NAME, SCHEDULESs, TERMINATION DATE, DUZ and DEA#.
"KRN",.4,216,"%D",3,0)

"KRN",.4,216,"F",1)
.01;L30~0;"DUZ"~53.2;L11~9.2;L11~"SCHEDULE II: ";C10~55.1;X;C30~"SCHEDULE II NON: ";C10~55.2;X;C30~"SCHEDULE III: ";C10~55.3;X;C30~
"KRN",.4,216,"F",2)
"SCHEDULE III NON: ";C10~55.4;X;C30~"SCHEDULE IV: ";C10~55.5;X;C30~"SCHEDULE V: ";C10~55.6;X;C30~
"KRN",.4,216,"H")
DISUSER PRESCRIBERS WITH PRIVILEGES
"KRN",.4,220,-1)
0^10
"KRN",.4,220,0)
XU EPCS DISUSER XDATE2 PRINT^3130117.1141^@^200^^@^3130307
"KRN",.4,220,"%D",0)
^.4001^3^3^3130117^^
"KRN",.4,220,"%D",1,0)
This is a print template for the DEA EPCS project. This prints
"KRN",.4,220,"%D",2,0)
name, DEA#, Termination Date and Expiration Date.
"KRN",.4,220,"%D",3,0)

"KRN",.4,220,"F",2)
9.2;L11~.01;L33~53.2;L10~747.44~
"KRN",.4,220,"H")
DISUSER EXPIRATION DATE EXPIRES IN 30 DAYS
"KRN",.401,142,-1)
0^3
"KRN",.401,142,0)
XU EPCS DIV SORT^3121213.1326^@^200^^@^3130307
"KRN",.401,142,2,0)
^.4014^2^2
"KRN",.401,142,2,1,0)
200.02^^DIVISION^".01^^^^^^4
"KRN",.401,142,2,1,1,0)
^.40141^1^1
"KRN",.401,142,2,1,1,1,0)
200^2
"KRN",.401,142,2,1,1,"B",200,1)

"KRN",.401,142,2,1,"CM")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,142,2,1,"F")
?z^@
"KRN",.401,142,2,1,"GET")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,142,2,1,"QCON")
I 1
"KRN",.401,142,2,1,"T")
z^
"KRN",.401,142,2,1,"TXT")
All DIVISION (includes nulls)
"KRN",.401,142,2,2,0)
200^.01^NAME^^^^^^^4
"KRN",.401,142,2,2,"GET")
S DISX(2)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,142,2,2,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,142,2,2,"QCON")
I DISX(2)'=""
"KRN",.401,142,2,2,"SER")
0^0
"KRN",.401,142,2,2,"TXT")
NAME not null
"KRN",.401,142,2,"B",200,2)

"KRN",.401,142,2,"B",200.02,1)

"KRN",.401,142,"%D",0)
^.4012^5^5^3121214^^^^
"KRN",.401,142,"%D",1,0)
This sort template is for the DEA EPCS project.  This supports the 
"KRN",.401,142,"%D",2,0)
report for Prescribers with Controlled Substance Privileges.  This 
"KRN",.401,142,"%D",3,0)
templates will sort on file #200, by divisions and by user. 
"KRN",.401,142,"%D",4,0)

"KRN",.401,142,"%D",5,0)

"KRN",.401,143,-1)
0^1
"KRN",.401,143,0)
XU EPCS PSDRPH SORT^3121213.1201^@^200^^@^3121213
"KRN",.401,143,2,0)
^.4014^3^3
"KRN",.401,143,2,1,0)
200.051^^KEY^@".01^^^^^^4
"KRN",.401,143,2,1,1,0)
^.40141^1^1
"KRN",.401,143,2,1,1,1,0)
200^51
"KRN",.401,143,2,1,1,"B",200,1)

"KRN",.401,143,2,1,"CM")
S Y(1)=$S($D(^VA(200,D0,51,D1,0)):^(0),1:"") S X=$P($G(^DIC(19.1,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,143,2,1,"F")
PSDRPGz^PSDRPH
"KRN",.401,143,2,1,"GET")
S Y(1)=$S($D(^VA(200,D0,51,D1,0)):^(0),1:"") S X=$P($G(^DIC(19.1,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,143,2,1,"IX")
^VA(200,"AB",^VA(200,^2
"KRN",.401,143,2,1,"PTRIX")
^DIC(19.1,"B",
"KRN",.401,143,2,1,"QCON")
I DISX(1)="PSDRPH"
"KRN",.401,143,2,1,"T")
PSDRPH^PSDRPH
"KRN",.401,143,2,1,"TXT")
KEY equals PSDRPH
"KRN",.401,143,2,2,0)
200.02^^DIVISION^".01^^^^^^4
"KRN",.401,143,2,2,1,0)
^.40141^1^1
"KRN",.401,143,2,2,1,1,0)
200^2
"KRN",.401,143,2,2,1,"B",200,1)

"KRN",.401,143,2,2,"CM")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(2)=X
"KRN",.401,143,2,2,"F")
?z^@
"KRN",.401,143,2,2,"GET")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(2)=X
"KRN",.401,143,2,2,"QCON")
I 1
"KRN",.401,143,2,2,"T")
z^
"KRN",.401,143,2,2,"TXT")
All DIVISION (includes nulls)
"KRN",.401,143,2,3,0)
200^.01^NAME^^^^^^^4
"KRN",.401,143,2,3,"GET")
S DISX(3)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,143,2,3,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,143,2,3,"QCON")
I DISX(3)'=""
"KRN",.401,143,2,3,"SER")
0^0
"KRN",.401,143,2,3,"TXT")
NAME not null
"KRN",.401,143,2,"B",200,3)

"KRN",.401,143,2,"B",200.02,2)

"KRN",.401,143,2,"B",200.051,1)

"KRN",.401,143,"%D",0)
^.4012^4^4^3130228^^^^
"KRN",.401,143,"%D",1,0)
This sort template is for the ePCS DEA project will sort by security key 
"KRN",.401,143,"%D",2,0)
'PSDRPH' and Division..  This sort template will be used for report to identify 
"KRN",.401,143,"%D",3,0)
individuals that hold this keys.
"KRN",.401,143,"%D",4,0)

"KRN",.401,144,-1)
0^2
"KRN",.401,144,0)
XU EPCS SET PARMS SORT^3120126.1631^@^200^^@^3121213
"KRN",.401,144,2,0)
^.4014^2^2
"KRN",.401,144,2,1,0)
200.051^^KEY^@".01^^^^^^4
"KRN",.401,144,2,1,1,0)
^.40141^1^1
"KRN",.401,144,2,1,1,1,0)
200^51
"KRN",.401,144,2,1,1,"B",200,1)

"KRN",.401,144,2,1,"CM")
S Y(1)=$S($D(^VA(200,D0,51,D1,0)):^(0),1:"") S X=$P($G(^DIC(19.1,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,144,2,1,"F")
XUEPCSEDISz^XUEPCSEDIT
"KRN",.401,144,2,1,"GET")
S Y(1)=$S($D(^VA(200,D0,51,D1,0)):^(0),1:"") S X=$P($G(^DIC(19.1,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,144,2,1,"IX")
^VA(200,"AB",^VA(200,^2
"KRN",.401,144,2,1,"PTRIX")
^DIC(19.1,"B",
"KRN",.401,144,2,1,"QCON")
I DISX(1)="XUEPCSEDIT"
"KRN",.401,144,2,1,"T")
XUEPCSEDIT^XUEPCSEDIT
"KRN",.401,144,2,1,"TXT")
KEY equals XUEPCSEDIT
"KRN",.401,144,2,2,0)
200^.01^NAME^^^^^^^4
"KRN",.401,144,2,2,"GET")
S DISX(2)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,144,2,2,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,144,2,2,"QCON")
I DISX(2)'=""
"KRN",.401,144,2,2,"SER")
0^0
"KRN",.401,144,2,2,"TXT")
NAME not null
"KRN",.401,144,2,"B",200,2)

"KRN",.401,144,2,"B",200.051,1)

"KRN",.401,144,"%D",0)
^.4012^3^3^3121213^^^^
"KRN",.401,144,"%D",1,0)
This sort template is for the ePCS DEA project will sort by security key 
"KRN",.401,144,"%D",2,0)
'XUEPCSEDIT'.  This sort template will be used for report to identify 
"KRN",.401,144,"%D",3,0)
individuals responsible for setting ePCS parameters.
"KRN",.401,148,-1)
0^5
"KRN",.401,148,0)
XU EPCS ACTIVE USER SORT^3130219.1654^@^200^^@^3130219
"KRN",.401,148,2,0)
^.4014^2^2
"KRN",.401,148,2,1,0)
200^^I $$ACTIVE^]@"^^^^^^4
"KRN",.401,148,2,1,"CM")
I $$ACTIVE I D0>0 S DISX(1)=X
"KRN",.401,148,2,1,"GET")
I $$ACTIVE I D0>0 S DISX(1)=X
"KRN",.401,148,2,1,"QCON")
I DISX(1)'=""
"KRN",.401,148,2,1,"TXT")
I $$ACTIVE not null
"KRN",.401,148,2,2,0)
200^.01^NAME^^^^^^^4
"KRN",.401,148,2,2,"GET")
S DISX(2)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,148,2,2,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,148,2,2,"QCON")
I DISX(2)'=""
"KRN",.401,148,2,2,"TXT")
NAME not null
"KRN",.401,148,2,"B",200,1)

"KRN",.401,148,2,"B",200,2)

"KRN",.401,148,"%D",0)
^.4012^3^3^3130228^^^^
"KRN",.401,148,"%D",1,0)
This sort template is for the DEA EPCS project. This 
"KRN",.401,148,"%D",2,0)
templates will sort on file #200, by ACTIVE users.
"KRN",.401,148,"%D",3,0)

"KRN",.401,150,-1)
0^4
"KRN",.401,150,0)
XU EPCS DISUSER SORT^3121214.1242^@^200^^@^3130321
"KRN",.401,150,2,0)
^.4014^2^2
"KRN",.401,150,2,1,0)
200^9.2^TERMINATION DATE^-^^^^^^1
"KRN",.401,150,2,1,"F")
?z^@
"KRN",.401,150,2,1,"GET")
S DISX(1)=$P($G(^VA(200,D0,0)),U,11)
"KRN",.401,150,2,1,"QCON")
I 1
"KRN",.401,150,2,1,"SER")
0.0000^0.0000
"KRN",.401,150,2,1,"T")
z^
"KRN",.401,150,2,1,"TXT")
All TERMINATION DATE (includes nulls)
"KRN",.401,150,2,2,0)
200^.01^NAME^^^^^^^4
"KRN",.401,150,2,2,"GET")
S DISX(2)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,150,2,2,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,150,2,2,"QCON")
I DISX(2)'=""
"KRN",.401,150,2,2,"SER")
0^0
"KRN",.401,150,2,2,"TXT")
NAME not null
"KRN",.401,150,2,"B",200,1)

"KRN",.401,150,2,"B",200,2)

"KRN",.401,150,"%D",0)
^.4012^2^2^3121214^^^^
"KRN",.401,150,"%D",1,0)
This sort template is for the DEA EPCS project. This sorts by termination date.
"KRN",.401,150,"%D",2,0)

"KRN",.401,151,-1)
0^6
"KRN",.401,151,0)
XU EPCS DISUSER2 SORT^3121214.1318^@^200^^@^3130117
"KRN",.401,151,2,0)
^.4014^3^3
"KRN",.401,151,2,1,0)
200.02^^DIVISION^".01^^^^^^4
"KRN",.401,151,2,1,1,0)
^.40141^1^1
"KRN",.401,151,2,1,1,1,0)
200^2
"KRN",.401,151,2,1,1,"B",200,1)

"KRN",.401,151,2,1,"CM")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,151,2,1,"F")
?z^@
"KRN",.401,151,2,1,"GET")
S Y(1)=$S($D(^VA(200,D0,2,D1,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(1),U,1),0)),U) I D1>0 S DISX(1)=X
"KRN",.401,151,2,1,"QCON")
I 1
"KRN",.401,151,2,1,"T")
z^
"KRN",.401,151,2,1,"TXT")
All DIVISION (includes nulls)
"KRN",.401,151,2,2,0)
200^9.2^TERMINATION DATE^-^^^^^^1
"KRN",.401,151,2,2,"F")
?z^@
"KRN",.401,151,2,2,"GET")
S DISX(2)=$P($G(^VA(200,D0,0)),U,11)
"KRN",.401,151,2,2,"QCON")
I 1
"KRN",.401,151,2,2,"SER")
0.0000^0.0000
"KRN",.401,151,2,2,"T")
z^
"KRN",.401,151,2,2,"TXT")
All TERMINATION DATE (includes nulls)
"KRN",.401,151,2,3,0)
200^.01^NAME^^^^^^^4
"KRN",.401,151,2,3,"GET")
S DISX(3)=$P($G(^VA(200,D0,0)),U)
"KRN",.401,151,2,3,"IX")
^VA(200,"B",^VA(200,^2
"KRN",.401,151,2,3,"QCON")
I DISX(3)'=""
"KRN",.401,151,2,3,"SER")
0^0
"KRN",.401,151,2,3,"TXT")
NAME not null
"KRN",.401,151,2,"B",200,2)

"KRN",.401,151,2,"B",200,3)

"KRN",.401,151,2,"B",200.02,1)

"KRN",.401,151,"%D",0)
^.4012^4^4^3121214^^^^
"KRN",.401,151,"%D",1,0)
This sort template is for the DEA EPCS project.  This template will sort 
"KRN",.401,151,"%D",2,0)
on file #200, by Division and Termination Date.
"KRN",.401,151,"%D",3,0)

"KRN",.401,151,"%D",4,0)

"KRN",3.6,69,-1)
0^1
"KRN",3.6,69,0)
XUSSPKI SAN^"Subject Alternative Name" field
"KRN",3.6,69,1,0)
^3.61A^5^5^3120110^^^^
"KRN",3.6,69,1,1,0)
The "Subject Alternative Name" field in New Person File (#200) has been 
"KRN",3.6,69,1,2,0)
changed or deleted for: |3| 
"KRN",3.6,69,1,3,0)
 
"KRN",3.6,69,1,4,0)
Before: |1|
"KRN",3.6,69,1,5,0)
 After: |2|    <-- if null, field was deleted!
"KRN",3.6,69,3,0)
^3.63^2^2^3120110^^^
"KRN",3.6,69,3,1,0)
This bulletin is sent when the "Subject Alternative Name" field has been 
"KRN",3.6,69,3,2,0)
changed or deleted. The bulletin is sent to users holding the PSDMGR key.
"KRN",3.6,69,4,0)
^3.64A^3^3
"KRN",3.6,69,4,1,0)
1
"KRN",3.6,69,4,1,1,0)
^3.65^1^1^3111221^^^^
"KRN",3.6,69,4,1,1,1,0)
This parameter is the old value before changed or deleted.
"KRN",3.6,69,4,2,0)
2
"KRN",3.6,69,4,2,1,0)
^3.65^1^1^3111221^^^^
"KRN",3.6,69,4,2,1,1,0)
This is the new value.  If null, value was deleted.
"KRN",3.6,69,4,3,0)
3
"KRN",3.6,69,4,3,1,0)
^3.65^1^1^3120110^^^^
"KRN",3.6,69,4,3,1,1,0)
This is the name of the user.
"KRN",19,1531,-1)
0^6
"KRN",19,1531,0)
XUSSPKI UPN SET^ePCS Set SAN from PIV Card^^B^^^^^^^^KERNEL^n
"KRN",19,1531,1,0)
^19.06^5^5^3120829^^^^
"KRN",19,1531,1,1,0)
This only needs to be run once for a user at a site.
"KRN",19,1531,1,2,0)
It sets the Subject Alternative Name (SAN) field in file #200
"KRN",19,1531,1,3,0)
from the PIV Smart Card.  This is used with the DEA e-sig to be
"KRN",19,1531,1,4,0)
sure the right certificate is selected from the PIV card.
"KRN",19,1531,1,5,0)

"KRN",19,1531,"RPC",0)
^19.05P^2^2
"KRN",19,1531,"RPC",1,0)
XUS PKI GET UPN
"KRN",19,1531,"RPC",2,0)
XUS PKI SET UPN
"KRN",19,1531,"U")
EPCS SET SAN FROM PIV CARD
"KRN",19,1567,-1)
0^1
"KRN",19,1567,0)
XU EPCS EDIT DATA^ ePCS Edit Prescriber Data^^B^^XUEPCSEDIT^^^^^^KERNEL
"KRN",19,1567,1,0)
^19.06^3^3^3121213^^^^
"KRN",19,1567,1,1,0)
This context option is given to those individuals who are permitted to
"KRN",19,1567,1,2,0)
edit the data related to e-prescribing of controlled substances.  They
"KRN",19,1567,1,3,0)
must hold the XUEPCSEDIT security key.
"KRN",19,1567,"RPC",0)
^19.05P^15^15
"KRN",19,1567,"RPC",1,0)
XU EPCS EDIT
"KRN",19,1567,"RPC",2,0)
XUS KEY CHECK
"KRN",19,1567,"RPC",3,0)
DDR DELETE ENTRY
"KRN",19,1567,"RPC",4,0)
DDR FILER
"KRN",19,1567,"RPC",5,0)
DDR FIND1
"KRN",19,1567,"RPC",6,0)
DDR FINDER
"KRN",19,1567,"RPC",7,0)
DDR GET DD HELP
"KRN",19,1567,"RPC",8,0)
DDR GETS ENTRY DATA
"KRN",19,1567,"RPC",9,0)
DDR KEY VALIDATOR
"KRN",19,1567,"RPC",10,0)
DDR LISTER
"KRN",19,1567,"RPC",11,0)
DDR LOCK/UNLOCK NODE
"KRN",19,1567,"RPC",12,0)
DDR VALIDATOR
"KRN",19,1567,"RPC",13,0)
XWB GET VARIABLE VALUE
"KRN",19,1567,"RPC",14,0)
XUS PKI SET UPN
"KRN",19,1567,"RPC",15,0)
XUS PKI GET UPN
"KRN",19,1567,"U")
 EPCS EDIT PRESCRIBER DATA
"KRN",19,1572,-1)
0^2
"KRN",19,1572,0)
XU EPCS EXP DATE^Print DEA Expiration Date Null^^P^^^^^^^^KERNEL
"KRN",19,1572,1,0)
^19.06^6^6^3130321^^^^
"KRN",19,1572,1,1,0)
This option is for the DEA ePCS project and will print all active users with a 
"KRN",19,1572,1,2,0)
DEA# and DEA Expiration Date is unpopulated.  This option prints the 
"KRN",19,1572,1,3,0)
Name, DEA# and DEA Expiration Date.
"KRN",19,1572,1,4,0)

"KRN",19,1572,1,5,0)

"KRN",19,1572,1,6,0)

"KRN",19,1572,60)
VA(200,
"KRN",19,1572,62)
0
"KRN",19,1572,63)
[XU EPCS XDATE PRINT]
"KRN",19,1572,64)
.01
"KRN",19,1572,65)

"KRN",19,1572,66)

"KRN",19,1572,69)
I $$VUSER1^XUEPCSRT(D0,1)
"KRN",19,1572,69.1)

"KRN",19,1572,69.2)

"KRN",19,1572,"U")
PRINT DEA EXPIRATION DATE NULL
"KRN",19,1578,-1)
0^3
"KRN",19,1578,0)
XU EPCS PSDRPH^Print PSDRPH Key Holders^^P^^^^^^^^KERNEL
"KRN",19,1578,1,0)
^19.06^6^6^3130228^^^^
"KRN",19,1578,1,1,0)
This option is for the DEA ePCS project and will print all active users holding 
"KRN",19,1578,1,2,0)
the PSDRPH key. This report will sort by division and within division it 
"KRN",19,1578,1,3,0)
sorts by name.  This report will print name, duz, person who assigned key
"KRN",19,1578,1,4,0)
and date assigned.
"KRN",19,1578,1,5,0)

"KRN",19,1578,1,6,0)

"KRN",19,1578,60)
VA(200,
"KRN",19,1578,62)
0
"KRN",19,1578,63)
[XU EPCS PSDRPH PRINT]
"KRN",19,1578,64)
[XU EPCS PSDRPH SORT]
"KRN",19,1578,69)
I $$ACTIVE^XUSER(D0)
"KRN",19,1578,"U")
PRINT PSDRPH KEY HOLDERS
"KRN",19,1580,-1)
0^4
"KRN",19,1580,0)
XU EPCS SET PARMS^Print Setting Parameters Privileges^^P^^^^^^^^KERNEL
"KRN",19,1580,1,0)
^19.06^5^5^3130228^^^^
"KRN",19,1580,1,1,0)
This option is for the DEA ePCS project and will print all active users holding 
"KRN",19,1580,1,2,0)
the XUEPCSEDIT key. This report will identify individuals responsible 
"KRN",19,1580,1,3,0)
for setting the parameters.
"KRN",19,1580,1,4,0)

"KRN",19,1580,1,5,0)

"KRN",19,1580,60)
VA(200,
"KRN",19,1580,62)
0
"KRN",19,1580,63)
[XU EPCS SET PARMS PRINT]
"KRN",19,1580,64)
[XU EPCS SET PARMS SORT]
"KRN",19,1580,69)
I $$ACTIVE^XUSER(D0)
"KRN",19,1580,"U")
PRINT SETTING PARAMETERS PRIVI
"KRN",19,1583,-1)
0^7
"KRN",19,1583,0)
XU EPCS PRIVS^Print Prescribers with Privileges^^P^^^^^^^^KERNEL
"KRN",19,1583,1,0)
^19.06^4^4^3130228^^^^
"KRN",19,1583,1,1,0)
This option is for the DEA ePCS project and will print all active users who
"KRN",19,1583,1,2,0)
have privileges to any of the SCHEDULEs II through V and who have a DEA# or 
"KRN",19,1583,1,3,0)
VA#.  This option prints the NAME, SCHEDULESs, VA#, DUZ and DEA#.
"KRN",19,1583,1,4,0)

"KRN",19,1583,60)
VA(200,
"KRN",19,1583,62)
0
"KRN",19,1583,63)
[XU EPCS PRIVS PRINT]
"KRN",19,1583,64)
[XU EPCS DIV SORT]
"KRN",19,1583,65)

"KRN",19,1583,66)

"KRN",19,1583,69)
I $$VUSER2^XUEPCSRT(D0,1)
"KRN",19,1583,69.1)

"KRN",19,1583,69.2)

"KRN",19,1583,69.3)

"KRN",19,1583,"U")
PRINT PRESCRIBERS WITH PRIVILE
"KRN",19,1590,-1)
0^8
"KRN",19,1590,0)
XU EPCS LOGICAL ACCESS^Task Changes to DEA Prescribing Privileges Report^^R^^^^^^^^KERNEL
"KRN",19,1590,1,0)
^19.06^7^7^3130314^^^^
"KRN",19,1590,1,1,0)
This option is for the DEA ePCS project and will print the setting or 
"KRN",19,1590,1,2,0)
change to DEA prescribing privileges related to issuance of controlled 
"KRN",19,1590,1,3,0)
substance prescription.  The report will only print data from the 
"KRN",19,1590,1,4,0)
previous day and with data that has been modified.  The data is retrieved 
"KRN",19,1590,1,5,0)
from file #8991.6.  This option should be scheduled to run on a daily basis.
"KRN",19,1590,1,6,0)

"KRN",19,1590,1,7,0)

"KRN",19,1590,25)
RPT1^XUEPCSRT
"KRN",19,1590,"U")
TASK CHANGES TO DEA PRESCRIBIN
"KRN",19,1593,-1)
0^9
"KRN",19,1593,0)
XU EPCS PSDRPH KEY^Allocate/De-Allocate of PSDRPH Key^^R^^^^^^^^KERNEL
"KRN",19,1593,1,0)
^19.06^3^3^3121213^^^^
"KRN",19,1593,1,1,0)
This option is for the DEA ePCS project and will allow users to allocate 
"KRN",19,1593,1,2,0)
or de-allocate the PSDRPH key.  
"KRN",19,1593,1,3,0)

"KRN",19,1593,25)
PSDKEY^XUEPCSRT
"KRN",19,1593,"U")
ALLOCATE/DE-ALLOCATE OF PSDRPH
"KRN",19,1594,-1)
0^10
"KRN",19,1594,0)
XU EPCS PSDRPH AUDIT^Task Allocation Audit of PSDRPH Key Report^^R^^^^^^^^KERNEL
"KRN",19,1594,1,0)
^19.06^3^3^3130314^^^^
"KRN",19,1594,1,1,0)
This option is for the DEA ePCS project and will print the allocation of 
"KRN",19,1594,1,2,0)
the PSDRPH key.  The report will only print data from the previous day and with data that has been modified.  The report prints data for the archive file #8991.7.  This option should be scheduled to run on a daily basis
"KRN",19,1594,1,3,0)

"KRN",19,1594,25)
RPT2^XUEPCSRT
"KRN",19,1594,"U")
TASK ALLOCATION AUDIT OF PSDRP
"KRN",19,1627,-1)
0^11
"KRN",19,1627,0)
XU EPCS EDIT DEA# AND XDATE^Edit Facility DEA# and Expiration Date^^E^^^^^^^^KERNEL
"KRN",19,1627,1,0)
^19.06^6^6^3121213^^^^
"KRN",19,1627,1,1,0)
This option is for the DEA ePCS project and will allow users to edit the 
"KRN",19,1627,1,2,0)
facility DEA# and Expiration Date in Institution file (#4).
"KRN",19,1627,1,3,0)

"KRN",19,1627,1,4,0)

"KRN",19,1627,1,5,0)

"KRN",19,1627,1,6,0)

"KRN",19,1627,30)
DIC(4,
"KRN",19,1627,31)
AEMQ
"KRN",19,1627,50)
DIC(4,
"KRN",19,1627,51)
52;52.1
"KRN",19,1627,"U")
EDIT FACILITY DEA# AND EXPIRAT
"KRN",19,1628,-1)
0^12
"KRN",19,1628,0)
XU EPCS XDATE EXPIRES^Print DEA Expiration Date Expires 30 days^^P^^^^^^^^KERNEL
"KRN",19,1628,1,0)
^19.06^6^6^3130321^^^^
"KRN",19,1628,1,1,0)
This option is for the DEA ePCS project and will print all active users with a 
"KRN",19,1628,1,2,0)
DEA# and where the DEA Expiration Date will expire within 30 days.  This 
"KRN",19,1628,1,3,0)
option prints the Name, DEA# and DEA Expiration Date.
"KRN",19,1628,1,4,0)

"KRN",19,1628,1,5,0)

"KRN",19,1628,1,6,0)

"KRN",19,1628,60)
VA(200,
"KRN",19,1628,62)
0
"KRN",19,1628,63)
[XU EPCS XDATE 30 PRINT]
"KRN",19,1628,64)
.01
"KRN",19,1628,69)
I $$XT30^XUEPCSRT(D0,1)
"KRN",19,1628,69.1)

"KRN",19,1628,69.2)

"KRN",19,1628,"U")
PRINT DEA EXPIRATION DATE EXPI
"KRN",19,1632,-1)
0^13
"KRN",19,1632,0)
XU EPCS UTILITY FUNCTIONS^ePCS DEA Utility Functions^^M^^^^^^^^KERNEL
"KRN",19,1632,1,0)
^19.06^4^4^3130123^^^^
"KRN",19,1632,1,1,0)
This option is for the DEA ePCS project.  This is the main menu to print all reports and utility functions.
"KRN",19,1632,1,2,0)

"KRN",19,1632,1,3,0)

"KRN",19,1632,1,4,0)

"KRN",19,1632,10,0)
^19.01IP^13^13
"KRN",19,1632,10,1,0)
1572^1^1
"KRN",19,1632,10,1,"^")
XU EPCS EXP DATE
"KRN",19,1632,10,2,0)
1578^7^7
"KRN",19,1632,10,2,"^")
XU EPCS PSDRPH
"KRN",19,1632,10,3,0)
1580^8^8
"KRN",19,1632,10,3,"^")
XU EPCS SET PARMS
"KRN",19,1632,10,4,0)
1583^5^5
"KRN",19,1632,10,4,"^")
XU EPCS PRIVS
"KRN",19,1632,10,5,0)
1590^10^10
"KRN",19,1632,10,5,"^")
XU EPCS LOGICAL ACCESS
"KRN",19,1632,10,6,0)
1593^12^12
"KRN",19,1632,10,6,"^")
XU EPCS PSDRPH KEY
"KRN",19,1632,10,7,0)
1594^11^11
"KRN",19,1632,10,7,"^")
XU EPCS PSDRPH AUDIT
"KRN",19,1632,10,8,0)
1628^3^3
"KRN",19,1632,10,8,"^")
XU EPCS XDATE EXPIRES
"KRN",19,1632,10,9,0)
1627^13^13
"KRN",19,1632,10,9,"^")
XU EPCS EDIT DEA# AND XDATE
"KRN",19,1632,10,10,0)
1648^9^9
"KRN",19,1632,10,10,"^")
XU EPCS PRINT EDIT AUDIT
"KRN",19,1632,10,11,0)
1652^2^2
"KRN",19,1632,10,11,"^")
XU EPCS DISUSER EXP DATE
"KRN",19,1632,10,12,0)
1653^6^6
"KRN",19,1632,10,12,"^")
XU EPCS DISUSER PRIVS
"KRN",19,1632,10,13,0)
1658^4^4
"KRN",19,1632,10,13,"^")
XU EPCS DISUSER XDATE EXPIRES
"KRN",19,1632,99)
62846,57956
"KRN",19,1632,99.1)
62909,46802
"KRN",19,1632,"U")
EPCS DEA UTILITY FUNCTIONS
"KRN",19,1648,-1)
0^14
"KRN",19,1648,0)
XU EPCS PRINT EDIT AUDIT^Print Audits for Prescriber Editing^^R^^^^^^^^KERNEL
"KRN",19,1648,1,0)
^19.06^3^3^3130228^^^^
"KRN",19,1648,1,1,0)
This option provides the ability to print information related to the 
"KRN",19,1648,1,2,0)
editing of prescriber information related to electronic Prescribing of 
"KRN",19,1648,1,3,0)
Controlled Substances.
"KRN",19,1648,25)
PRINT^XUEPCSED
"KRN",19,1648,"U")
PRINT AUDITS FOR PRESCRIBER ED
"KRN",19,1652,-1)
0^15
"KRN",19,1652,0)
XU EPCS DISUSER EXP DATE^Print DISUSER DEA Expiration Date Null ^^P^^^^^^^^KERNEL
"KRN",19,1652,1,0)
^19.06^4^4^3130321^^^^
"KRN",19,1652,1,1,0)
This option is for the DEA ePCS project and will print all DISUSER users with a 
"KRN",19,1652,1,2,0)
DEA# and DEA Expiration Date is unpopulated.  This option prints the 
"KRN",19,1652,1,3,0)
Name, DEA#, Terminatin Date and DEA Expiration Date.
"KRN",19,1652,1,4,0)

"KRN",19,1652,60)
VA(200,
"KRN",19,1652,62)
0
"KRN",19,1652,63)
[XU EPCS DISUSER XDATE PRINT]
"KRN",19,1652,64)
[XU EPCS DISUSER SORT]
"KRN",19,1652,69)
I $$VUSER1^XUEPCSRT(D0,0)
"KRN",19,1652,69.1)

"KRN",19,1652,69.2)

"KRN",19,1652,"U")
PRINT DISUSER DEA EXPIRATION D
"KRN",19,1653,-1)
0^16
"KRN",19,1653,0)
XU EPCS DISUSER PRIVS^Print DISUSER Prescribers with Privileges^^P^^^^^^^^KERNEL
"KRN",19,1653,1,0)
^19.06^5^5^3130228^^^^
"KRN",19,1653,1,1,0)
This option is for the DEA ePCS project and will print all DISUSER users who
"KRN",19,1653,1,2,0)
have privileges to any of the SCHEDULEs II through V and who have a DEA# or 
"KRN",19,1653,1,3,0)
VA#.  This option prints the NAME, SCHEDULESs, VA#, DUZ, TERMINATION DATE
"KRN",19,1653,1,4,0)
and DEA#.
"KRN",19,1653,1,5,0)

"KRN",19,1653,60)
VA(200,
"KRN",19,1653,62)
0
"KRN",19,1653,63)
[XU EPCS DISUSER PRIVS PRINT]
"KRN",19,1653,64)
[XU EPCS DISUSER2 SORT]
"KRN",19,1653,65)

"KRN",19,1653,69)
I $$VUSER2^XUEPCSRT(D0,0)
"KRN",19,1653,"U")
PRINT DISUSER PRESCRIBERS WITH
"KRN",19,1658,-1)
0^17
"KRN",19,1658,0)
XU EPCS DISUSER XDATE EXPIRES^Print DISUSER DEA Expiration Date Expires 30 days^^P^^^^^^^^KERNEL
"KRN",19,1658,1,0)
^19.06^4^4^3130228^^^^
"KRN",19,1658,1,1,0)
This option is for the DEA ePCS project and will print all DISUSER users with a 
"KRN",19,1658,1,2,0)
DEA# and where the DEA Expiration Date will expire within 30 days.  This 
"KRN",19,1658,1,3,0)
option prints the Name, DEA# and DEA Expiration Date.
"KRN",19,1658,1,4,0)

"KRN",19,1658,60)
VA(200,
"KRN",19,1658,62)
0
"KRN",19,1658,63)
[XU EPCS DISUSER XDATE2 PRINT]
"KRN",19,1658,64)
[XU EPCS DISUSER SORT]
"KRN",19,1658,69)
I $$XT30^XUEPCSRT(D0,0)
"KRN",19,1658,"U")
PRINT DISUSER DEA EXPIRATION D
"KRN",19.1,122,-1)
0^1
"KRN",19.1,122,0)
XUEPCSEDIT^ABLE TO EDIT ePCS PRESCRIBER^l
"KRN",19.1,122,1,0)
^19.11^5^5^3120530^^
"KRN",19.1,122,1,1,0)
This key is required for individuals who will enter data related to 
"KRN",19.1,122,1,2,0)
electronic prescribing of controlled substances for providers.  
"KRN",19.1,122,1,3,0)
 
"KRN",19.1,122,1,4,0)
The holder of this key may NOT also hold the ORES key (they are exclusive
"KRN",19.1,122,1,5,0)
keys and should not both be held by an individual at the same time).
"KRN",19.1,122,5,0)
^19.15P^1^1
"KRN",19.1,122,5,1,0)
ORES
"KRN",8989.51,313,-1)
0^1
"KRN",8989.51,313,0)
XUEPCS REPORT DEVICE^ePCS Device Definition for Reports^0^^Select device for ePCS reports
"KRN",8989.51,313,1)
P^3.5^Enter a device from the Device file for ePCS report output.
"KRN",8989.51,313,20,0)
^8989.512^3^3^3120828^^^^
"KRN",8989.51,313,20,1,0)
This is for the ePCS DEA project.  It will set the device for the report 
"KRN",8989.51,313,20,2,0)
output.
"KRN",8989.51,313,20,3,0)

"KRN",8989.51,313,30,0)
^8989.513I^1^1
"KRN",8989.51,313,30,1,0)
1^4.2
"KRN",8994,9,-1)
0^4
"KRN",8994,9,0)
XWB GET VARIABLE VALUE^VARVAL^XWBLIB^1^P
"KRN",8994,9,1,0)
^8994.01^3^3^3120627^^
"KRN",8994,9,1,1,0)
This RPC accepts the name of a variable which will be evaluated and its
"KRN",8994,9,1,2,0)
value returned to the server.  For example, this RPC may be called with
"KRN",8994,9,1,3,0)
a parameter like DUZ which will be returned as 123456.
"KRN",8994,237,-1)
0^3
"KRN",8994,237,0)
XUS PKI GET UPN^GETUPN^XUSER2^1^P^^^0
"KRN",8994,237,1,0)
^8994.01^2^2^3120925^^^^
"KRN",8994,237,1,1,0)
This RPC gets the SUBJECT ALTERNATIVE NAME field from the New Person (#200) file field 501.2.  It is used to check that the correct PIV card has been put into the reader.
"KRN",8994,237,1,2,0)

"KRN",8994,238,-1)
0^2
"KRN",8994,238,0)
XUS PKI SET UPN^SETUPN^XUSER2^1^R
"KRN",8994,238,1,0)
^8994.01^2^2^3120828^^^^
"KRN",8994,238,1,1,0)
This RPC is used to set the SUBJECT ALTERNATIVE NAME in the New Person #(200) file field 501.2. 
"KRN",8994,238,1,2,0)

"KRN",8994,238,2,0)
^8994.02A^1^1
"KRN",8994,238,2,1,0)
UPN^1^50^1^1
"KRN",8994,238,2,1,1,0)
^8994.021^2^2^3120828^^^^
"KRN",8994,238,2,1,1,1,0)
This is the SUBJECT ALTERNATIVE NAME from the PIV card.
"KRN",8994,238,2,1,1,2,0)

"KRN",8994,238,2,"B","UPN",1)

"KRN",8994,238,2,"PARAMSEQ",1,1)

"KRN",8994,241,-1)
0^1
"KRN",8994,241,0)
XU EPCS EDIT^ENTRY^XUEPCSED^1^R
"KRN",8994,241,1,0)
^8994.01^2^2^3120711^^^^
"KRN",8994,241,1,1,0)
This remote procedure stores information on editing changes in file 200
"KRN",8994,241,1,2,0)
related to the electronic prescribing of controlled substances.
"KRN",8994,241,2,0)
^8994.02A^1^1
"KRN",8994,241,2,1,0)
DATA^2^^1^1
"KRN",8994,241,2,"B","DATA",1)

"KRN",8994,241,2,"PARAMSEQ",1,1)

"MBREQ")
0
"ORD",2,3.6)
3.6;2;1;;BUL^XPDTA1;;BULE1^XPDIA1;;;BULDEL^XPDIA1
"ORD",2,3.6,0)
BULLETIN
"ORD",3,19.1)
19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"ORD",5,.4)
.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%)
"ORD",5,.4,0)
PRINT TEMPLATE
"ORD",6,.401)
.401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%)
"ORD",6,.401,0)
SORT TEMPLATE
"ORD",16,8994)
8994;16;1;;;;;;;RPCDEL^XPDIA1
"ORD",16,8994,0)
REMOTE PROCEDURE
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"ORD",20,8989.51)
8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
"ORD",20,8989.51,0)
PARAMETER DEFINITION
"PKG",3,-1)
1^1
"PKG",3,0)
KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^
"PKG",3,20,0)
^9.402P^^0
"PKG",3,22,0)
^9.49I^1^1
"PKG",3,22,1,0)
8.0^3090706^3090706^6
"PKG",3,22,1,"PAH",1,0)
580^3130328
"PKG",3,22,1,"PAH",1,1,0)
^^4^4^3130328
"PKG",3,22,1,"PAH",1,1,1,0)
 
"PKG",3,22,1,"PAH",1,1,2,0)
Please refer to the Description in the FORUM Patch Module for details.
"PKG",3,22,1,"PAH",1,1,3,0)

"PKG",3,22,1,"PAH",1,1,4,0)

"PRE")
XU8P580
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
YES
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
6
"RTN","XU8P580")
0^6^B7617911^n/a
"RTN","XU8P580",1,0)
XU8P580 ;O-OIFO/GMB-Delete OBJECT multiple from HELP FRAME file ;06/05/2012
"RTN","XU8P580",2,0)
 ;;8.0;KERNEL;**580**;Jul 10, 1995;Build 46
"RTN","XU8P580",3,0)
 ;
"RTN","XU8P580",4,0)
ENV ; Environmental Check
"RTN","XU8P580",5,0)
 D BMES^XPDUTL("Perform Environment Check...")
"RTN","XU8P580",6,0)
 D CHKSTOP
"RTN","XU8P580",7,0)
 D BMES^XPDUTL("Finished Environment Check.")
"RTN","XU8P580",8,0)
 Q
"RTN","XU8P580",9,0)
CHKSTOP ;
"RTN","XU8P580",10,0)
 ; Check XPDENV 0 = Loading; 1 = Installing
"RTN","XU8P580",11,0)
 Q:'XPDENV  ; Loading Distribution - No Check
"RTN","XU8P580",12,0)
 ;
"RTN","XU8P580",13,0)
 ;
"RTN","XU8P580",14,0)
INSCHK ; Do Checks During Install Only
"RTN","XU8P580",15,0)
 W $C(7)
"RTN","XU8P580",16,0)
 D MES^XPDUTL("** Although Queuing is allowed - it is HIGHLY recommended that ALL Users and")
"RTN","XU8P580",17,0)
 D MES^XPDUTL("VISTA Background jobs be STOPPED before installation of this patch. Failure")
"RTN","XU8P580",18,0)
 D MES^XPDUTL("to do so may result in 'source routine edited' error(s). Edits will be")
"RTN","XU8P580",19,0)
 D MES^XPDUTL("lost and record(s) may be left in an inconsistent state, for example,")
"RTN","XU8P580",20,0)
 D MES^XPDUTL("not all Cross-Referencing completed; which in turn may cause FUTURE")
"RTN","XU8P580",21,0)
 D MES^XPDUTL("VistA/FileMan Hard Errors or corrupted Data. **")
"RTN","XU8P580",22,0)
 ;
"RTN","XU8P580",23,0)
TMCHK ; Check to see if TaskMan is still running
"RTN","XU8P580",24,0)
 S X=$$TM^%ZTLOAD
"RTN","XU8P580",25,0)
 I X,'$D(^%ZTSCH("WAIT")) D
"RTN","XU8P580",26,0)
 . W $C(7)
"RTN","XU8P580",27,0)
 . D BMES^XPDUTL("* Warning TaskMan Has NOT Been Stopped or Placed in a WAIT State!")
"RTN","XU8P580",28,0)
 ;
"RTN","XU8P580",29,0)
LINH ; Check to see if Logons are Inhibited
"RTN","XU8P580",30,0)
 D GETENV^%ZOSV  ; $P(Y,"^",2) = Installing Volume
"RTN","XU8P580",31,0)
 Q:$G(^%ZIS(14.5,"LOGON",$P(Y,"^",2)))
"RTN","XU8P580",32,0)
 W $C(7)
"RTN","XU8P580",33,0)
 D BMES^XPDUTL("* Warning Logons are NOT Inhibited!")
"RTN","XU8P580",34,0)
 Q
"RTN","XU8P580",35,0)
 ;
"RTN","XU8P580",36,0)
PRE ;Pre-Init
"RTN","XU8P580",37,0)
 D BMES^XPDUTL("Beginning Pre-Installation...")
"RTN","XU8P580",38,0)
 D BMES^XPDUTL("  I am deleting the cross-reference ""SAN"" for field #501.2 file #200.")
"RTN","XU8P580",39,0)
 K ^VA(200,"SAN")
"RTN","XU8P580",40,0)
 D BMES^XPDUTL("Finished Pre-Installation.")
"RTN","XU8P580",41,0)
 Q
"RTN","XU8P580",42,0)
 ;
"RTN","XU8P580",43,0)
POST ; Post-Init
"RTN","XU8P580",44,0)
 D BMES^XPDUTL("Beginning Post-Installation...")
"RTN","XU8P580",45,0)
 D BMES^XPDUTL("  I am deleting the OBJECT (#9.201) multiple from the HELP FRAME (#9.2) file.")
"RTN","XU8P580",46,0)
 D BMES^XPDUTL("  I am re-indexing ""ASAN"" cross-reference for field #501.2 file #200. ")
"RTN","XU8P580",47,0)
 N DIU
"RTN","XU8P580",48,0)
 S DIU=9.201,DIU(0)="DS" D EN^DIU2
"RTN","XU8P580",49,0)
 D REINDEX
"RTN","XU8P580",50,0)
 D BMES^XPDUTL("Finished Post-Installation.")
"RTN","XU8P580",51,0)
 Q
"RTN","XU8P580",52,0)
 ;
"RTN","XU8P580",53,0)
REINDEX ;Re-index xfer "ASAN"
"RTN","XU8P580",54,0)
 N DIK,DA
"RTN","XU8P580",55,0)
 S DIK="^VA(200,"
"RTN","XU8P580",56,0)
 S DIK(1)="501.2^ASAN"
"RTN","XU8P580",57,0)
 D ENALL^DIK
"RTN","XU8P580",58,0)
 Q
"RTN","XU8P580",59,0)
 ;
"RTN","XU8P580",60,0)
 ;END
"RTN","XU8P580",61,0)
 
"RTN","XUEPCSED")
0^2^B2888160^n/a
"RTN","XUEPCSED",1,0)
XUEPCSED ;JLI/FO-OAKLAND-RPC to handle epcs data changes ;08/24/12  11:56
"RTN","XUEPCSED",2,0)
 ;;8.0;KERNEL;**580**;Jul 10, 1995;Build 46
"RTN","XUEPCSED",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","XUEPCSED",4,0)
 ;
"RTN","XUEPCSED",5,0)
ENTRY(RESULT,INPUT) ;.remoteprocedure
"RTN","XUEPCSED",6,0)
 NEW I,NOW
"RTN","XUEPCSED",7,0)
 SET NOW=$P($$HTE^XLFDT($H),":",1,2)
"RTN","XUEPCSED",8,0)
 FOR I=-1:0 SET I=$O(INPUT(I)) QUIT:I=""  DO RECORD(INPUT(I),NOW)
"RTN","XUEPCSED",9,0)
 SET RESULT=1
"RTN","XUEPCSED",10,0)
 QUIT
"RTN","XUEPCSED",11,0)
 ;
"RTN","XUEPCSED",12,0)
RECORD(LINE,NOW) ;
"RTN","XUEPCSED",13,0)
 N FDA,VALUE,IEN,MSG,I
"RTN","XUEPCSED",14,0)
 FOR I=1:1:5 SET VALUE=$P(LINE,U,I),FDA(8991.6,"+1,",(I/100))=VALUE
"RTN","XUEPCSED",15,0)
 SET FDA(8991.6,"+1,",.06)=NOW
"RTN","XUEPCSED",16,0)
 DO UPDATE^DIE("E","FDA","IEN","MSG")
"RTN","XUEPCSED",17,0)
 QUIT
"RTN","XUEPCSED",18,0)
 ;
"RTN","XUEPCSED",19,0)
PRINT ; print audit logs as indicated
"RTN","XUEPCSED",20,0)
 NEW DIR,I,VAL,X,Y,BY,DIC,FLDS,L
"RTN","XUEPCSED",21,0)
 SET DIR(0)="S^"
"RTN","XUEPCSED",22,0)
 FOR I=1:1:6 SET X=$T(SORTTYPE+I),DIR(0)=DIR(0)_$SELECT(I>1:";",1:"")_I_":"_$PIECE(X,";",3),VAL(I)=$PIECE(X,";",4)
"RTN","XUEPCSED",23,0)
 SET DIR("A")="SORT BY" DO ^DIR IF +$GET(Y)'>0 QUIT
"RTN","XUEPCSED",24,0)
 SET BY=VAL(+Y),FLDS=".06,.01,.02,.03,.04,.05",DIC=8991.6,L="" DO EN1^DIP
"RTN","XUEPCSED",25,0)
 QUIT
"RTN","XUEPCSED",26,0)
 ;
"RTN","XUEPCSED",27,0)
SORTTYPE ; specifies sort types for selection
"RTN","XUEPCSED",28,0)
 ;;Sort by Edited By then Date/time;.02,.06,.01
"RTN","XUEPCSED",29,0)
 ;;Sort by Edited By then User Edited;.02,.01,.06
"RTN","XUEPCSED",30,0)
 ;;Sort by Date/time then Edited By;.06,.02,.01
"RTN","XUEPCSED",31,0)
 ;;Sort by Date/time then User Edited;.06,.01,.02
"RTN","XUEPCSED",32,0)
 ;;Sort by User Edited then Edited By;.01,.02,.06
"RTN","XUEPCSED",33,0)
 ;;Sort by User Edited then Date;.01,.06,.02
"RTN","XUEPCSED",34,0)
 ;      .01        .02         .06
"RTN","XUEPCSED",35,0)
 ; User Edited, Edited by, Date/Time Edited
"RTN","XUEPCSRT")
0^4^B22030133^n/a
"RTN","XUEPCSRT",1,0)
XUEPCSRT ;FO-OAKAND/REM - EPCS Utilities and Reports; [5/7/02 5:53am] ;08/06/2012
"RTN","XUEPCSRT",2,0)
 ;;8.0;KERNEL;**580**;Jul 10, 1995;Build 46
"RTN","XUEPCSRT",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified
"RTN","XUEPCSRT",4,0)
 ;
"RTN","XUEPCSRT",5,0)
 Q
"RTN","XUEPCSRT",6,0)
 ;
"RTN","XUEPCSRT",7,0)
PRESCBR(XUSD0) ;called from print option - XU EPCS PRIVS
"RTN","XUEPCSRT",8,0)
 ;XUSD0 is D0
"RTN","XUEPCSRT",9,0)
 ; screening for prescribers with DEA# or VA#
"RTN","XUEPCSRT",10,0)
 N XUSPS
"RTN","XUEPCSRT",11,0)
 S XUSPS=$G(^VA(200,XUSD0,"PS"))
"RTN","XUEPCSRT",12,0)
 Q:($P(XUSPS,U,2)'="")!($P(XUSPS,U,3)'="") 1
"RTN","XUEPCSRT",13,0)
 Q 0
"RTN","XUEPCSRT",14,0)
 ;
"RTN","XUEPCSRT",15,0)
PRIVS(XUSD0) ;called from print option - XU EPCS PRIVS 
"RTN","XUEPCSRT",16,0)
 ;XUSD0 is D0
"RTN","XUEPCSRT",17,0)
 ;user with controlled substance privileges? 
"RTN","XUEPCSRT",18,0)
 ;based on 6 sub-schedules, PS3 node, pieces 1-6
"RTN","XUEPCSRT",19,0)
 N XUSPS3
"RTN","XUEPCSRT",20,0)
 S XUSPS3=$G(^VA(200,XUSD0,"PS3"))
"RTN","XUEPCSRT",21,0)
 Q:($P(XUSPS3,U,1,6)[1) 1 ; yes, if at least one explicit Yes
"RTN","XUEPCSRT",22,0)
 Q:($P(XUSPS3,U,1,6)[0) 0 ; no, if explicit No
"RTN","XUEPCSRT",23,0)
 Q 1 ; default, when all NULL
"RTN","XUEPCSRT",24,0)
 ;
"RTN","XUEPCSRT",25,0)
XT30(XUSD0,ACT) ;called from print option - XU EPCS XDATE EXPIRES
"RTN","XUEPCSRT",26,0)
 ;chk user ACTIVE,with DEA# and xdate expires in 30 days
"RTN","XUEPCSRT",27,0)
 ;XUSD0=IEN, ACT=(1 or 0) active user of not
"RTN","XUEPCSRT",28,0)
 N XDT,DT30,DEA,CNT
"RTN","XUEPCSRT",29,0)
 S CNT=0
"RTN","XUEPCSRT",30,0)
 S XDT=$P($G(^VA(200,XUSD0,"QAR")),U,9),DT30=$$FMADD^XLFDT(DT,30),DEA=$P($G(^VA(200,XUSD0,"PS")),U,2)
"RTN","XUEPCSRT",31,0)
 I (DEA'=""),(XDT'>DT30),(XDT'<DT) S CNT=CNT+1
"RTN","XUEPCSRT",32,0)
 I ACT D
"RTN","XUEPCSRT",33,0)
 .I $$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",34,0)
 I 'ACT D
"RTN","XUEPCSRT",35,0)
 .I '$$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",36,0)
 I CNT=2 Q 1
"RTN","XUEPCSRT",37,0)
 Q 0
"RTN","XUEPCSRT",38,0)
 ;
"RTN","XUEPCSRT",39,0)
RPT1 ;ePCS report - setting or modifing to logical access controls.
"RTN","XUEPCSRT",40,0)
 ;called from option - XU EPCS LOGICAL ACCESS
"RTN","XUEPCSRT",41,0)
 ;Only runs if data has changed from previous day.
"RTN","XUEPCSRT",42,0)
 ;FLG=records exist for previous day.
"RTN","XUEPCSRT",43,0)
 N X,DEV,X1,X2,YT,%,FLG
"RTN","XUEPCSRT",44,0)
 S (FLG,%)=0
"RTN","XUEPCSRT",45,0)
 D NOW^%DTC S X1=X,X2="-1" D C^%DTC S YT=X ;Get the previous day date
"RTN","XUEPCSRT",46,0)
 S %=0 F  S %=$O(^XTV(8991.6,"DT",%)) Q:%=""!(FLG=1)  D
"RTN","XUEPCSRT",47,0)
 .S:YT=$P($G(%),".",1) FLG=1
"RTN","XUEPCSRT",48,0)
 Q:FLG=0
"RTN","XUEPCSRT",49,0)
 S DEV=$$GET^XPAR("SYS","XUEPCS REPORT DEVICE",1,"E")
"RTN","XUEPCSRT",50,0)
 I DEV="" W !!,"DEVICE NOT DEFINED!  Set the parameter XUEPCS REPORT DEVICE." Q
"RTN","XUEPCSRT",51,0)
 S IOP=DEV
"RTN","XUEPCSRT",52,0)
 S DISUPNO=1
"RTN","XUEPCSRT",53,0)
 K DIC
"RTN","XUEPCSRT",54,0)
 S DIC="^XTV(8991.6,",FLDS="[XU EPCS LOGICAL ACCESS PRINT]",BY="@DATE/TIME EDITED",(FR,TO)=YT,L=0
"RTN","XUEPCSRT",55,0)
 D EN1^DIP
"RTN","XUEPCSRT",56,0)
 Q
"RTN","XUEPCSRT",57,0)
 ;
"RTN","XUEPCSRT",58,0)
RPT2 ;ePCS report - allocation history for PSDRPH key
"RTN","XUEPCSRT",59,0)
 ;called from option - XU EPCS PSDRPH AUDIT
"RTN","XUEPCSRT",60,0)
 ;Only runs if data has changed from previous day.
"RTN","XUEPCSRT",61,0)
 ;FLG=records exist for previous day
"RTN","XUEPCSRT",62,0)
 N X,DEV,X1,X2,YT,%,FLG
"RTN","XUEPCSRT",63,0)
 S (FLG,%)=0
"RTN","XUEPCSRT",64,0)
 D NOW^%DTC S X1=X,X2="-1" D C^%DTC S YT=X ;Get the previous day date
"RTN","XUEPCSRT",65,0)
 S %=0 F  S %=$O(^XTV(8991.7,"DT",%)) Q:%=""!(FLG=1)  D
"RTN","XUEPCSRT",66,0)
 .S:YT=$P($G(%),".",1) FLG=1
"RTN","XUEPCSRT",67,0)
 Q:FLG=0
"RTN","XUEPCSRT",68,0)
 S DEV=$$GET^XPAR("SYS","XUEPCS REPORT DEVICE",1,"E")
"RTN","XUEPCSRT",69,0)
 I DEV="" W !!,"DEVICE NOT DEFINED!  Set the parameter XUEPCS REPORT DEVICE." Q
"RTN","XUEPCSRT",70,0)
 S IOP=DEV
"RTN","XUEPCSRT",71,0)
 S DISUPNO=1
"RTN","XUEPCSRT",72,0)
 ;D NOW^%DTC S X1=X,X2="-1" D C^%DTC S YT=X ;Get the previous day date
"RTN","XUEPCSRT",73,0)
 K DIC
"RTN","XUEPCSRT",74,0)
 S DIC="^XTV(8991.7,",FLDS="[XU EPCS PSDRPH KEY PRINT]",BY="@DATE/TIME EDITED",(FR,TO)=YT,L=0
"RTN","XUEPCSRT",75,0)
 D EN1^DIP
"RTN","XUEPCSRT",76,0)
 Q
"RTN","XUEPCSRT",77,0)
 ;
"RTN","XUEPCSRT",78,0)
PSDKEY ;Allocated/de-allocate the PSDRPH key option
"RTN","XUEPCSRT",79,0)
 ;called from option - XU EPCS PSDRPH KEY
"RTN","XUEPCSRT",80,0)
 N XUBOSS,XUDA,XUKEY,XURET,XUNAME,ZZ,OK,NOW,IEN,MSG,INPUT,NOW
"RTN","XUEPCSRT",81,0)
 S XUBOSS=0 S:(DUZ(0)["@"!($D(^XUSEC("XUMGR",DUZ)))) XUBOSS=1
"RTN","XUEPCSRT",82,0)
 I 'XUBOSS W !,"You don't have privileges.  See your package coordinator or site manager." Q
"RTN","XUEPCSRT",83,0)
 S XUKEY=$$LKUP^XPDKEY("PSDRPH") I XUKEY="" W !,"PSDRPH key does not exist" Q
"RTN","XUEPCSRT",84,0)
 K DIC S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("A")="Enter User Name: " D ^DIC Q:Y<0
"RTN","XUEPCSRT",85,0)
 S XUDA=+Y,XUNAME=$P(Y,U,2)
"RTN","XUEPCSRT",86,0)
 D OWNSKEY^XUSRB(.ZZ,"PSDRPH",XUDA) S XURET=ZZ(0) ;chk if user had key
"RTN","XUEPCSRT",87,0)
 S OK=$$ASK(XURET,XUNAME) I 'OK W !,"Nothing done..." Q
"RTN","XUEPCSRT",88,0)
 ;De-allocate key
"RTN","XUEPCSRT",89,0)
 I XURET K DIK S DIK="^VA(200,XUDA,51,",DA(1)=XUDA,DA=XUKEY D ^DIK
"RTN","XUEPCSRT",90,0)
 ;Allocate key
"RTN","XUEPCSRT",91,0)
 I 'XURET S FDA(200.051,"+1,"_XUDA_",",.01)="PSDRPH" D UPDATE^DIE("E","FDA","IEN","MSG")
"RTN","XUEPCSRT",92,0)
 ;Set and record audit data
"RTN","XUEPCSRT",93,0)
 S NOW=$P($$HTE^XLFDT($H),":",1,2)
"RTN","XUEPCSRT",94,0)
 S INPUT="`"_XUDA_"^"_"`"_$G(DUZ)_"^"_$S(XURET:0,1:1) D RECORD(INPUT,NOW)
"RTN","XUEPCSRT",95,0)
 Q
"RTN","XUEPCSRT",96,0)
 ;
"RTN","XUEPCSRT",97,0)
ASK(TYPE,NAME) ;Ask user if Allocate/De-allocate - returns y/n
"RTN","XUEPCSRT",98,0)
 ;TYPE - flag weather Allocate or De-allocate
"RTN","XUEPCSRT",99,0)
 ;Name - user's name
"RTN","XUEPCSRT",100,0)
 N FL,%
"RTN","XUEPCSRT",101,0)
 S FL=0,%=0
"RTN","XUEPCSRT",102,0)
 F  D  Q:FL=1
"RTN","XUEPCSRT",103,0)
 .W !,$S(TYPE:"De-allocate",1:"Allocate")," PSDRPH for ",NAME,"?"
"RTN","XUEPCSRT",104,0)
 .R " YES// ",X:DTIME S:'$T X=U S:X[U FL=1 Q:X[U  S:(X="") X="Y" I "YyNn"'[$E(X,1) W $C(7)," ??",!,"Please enter 'Y' or 'N'"
"RTN","XUEPCSRT",105,0)
 .I $E(X,1)="N"!($E(X,1)="n") S %=0 S FL=1
"RTN","XUEPCSRT",106,0)
 .I $E(X,1)="Y"!($E(X,1)="y") S %=1 S FL=1
"RTN","XUEPCSRT",107,0)
 Q %
"RTN","XUEPCSRT",108,0)
 ;
"RTN","XUEPCSRT",109,0)
RECORD(LINE,NOW) ;Record the edited data into audit file #8991.7
"RTN","XUEPCSRT",110,0)
 N FDA,VALUE,IEN,MSG,I
"RTN","XUEPCSRT",111,0)
 F I=1:1:3 S VALUE=$P(LINE,U,I),FDA(8991.7,"+1,",(I/100))=VALUE
"RTN","XUEPCSRT",112,0)
 S FDA(8991.7,"+1,",.04)=NOW
"RTN","XUEPCSRT",113,0)
 D UPDATE^DIE("E","FDA","IEN","MSG")
"RTN","XUEPCSRT",114,0)
 Q
"RTN","XUEPCSRT",115,0)
 ;
"RTN","XUEPCSRT",116,0)
VUSER1(XUSD0,ACT) ;called from option - XU EPCS DISUSER EXP DATE,XU EPCS EXP DATE
"RTN","XUEPCSRT",117,0)
 ;chk user ACTIVE, with DEA# and null DEA Exp Date
"RTN","XUEPCSRT",118,0)
 ;XUSD0=IEN, ACT=(1 or 0) active user or not
"RTN","XUEPCSRT",119,0)
 N CNT
"RTN","XUEPCSRT",120,0)
 S CNT=0
"RTN","XUEPCSRT",121,0)
 I $P($G(^VA(200,XUSD0,"PS")),U,2)'="" S CNT=CNT+1
"RTN","XUEPCSRT",122,0)
 I $P($G(^VA(200,XUSD0,"QAR")),U,9)="" S CNT=CNT+1
"RTN","XUEPCSRT",123,0)
 I ACT D
"RTN","XUEPCSRT",124,0)
 .I $$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",125,0)
 I 'ACT D
"RTN","XUEPCSRT",126,0)
 .I '$$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",127,0)
 I CNT=3 Q 1
"RTN","XUEPCSRT",128,0)
 Q 0
"RTN","XUEPCSRT",129,0)
 ;
"RTN","XUEPCSRT",130,0)
VUSER2(XUSD0,ACT) ;called from option - XU EPCS PRIVS,XU EPCS DISUSER PRIVS
"RTN","XUEPCSRT",131,0)
 ;chk user ACTIVE, with DEA# or VA# with privilages - sch II-V
"RTN","XUEPCSRT",132,0)
 ;XUSD0=IEN, ACT=(1 or 0) active user or not
"RTN","XUEPCSRT",133,0)
 N CNT
"RTN","XUEPCSRT",134,0)
 S CNT=0
"RTN","XUEPCSRT",135,0)
 I $$PRESCBR^XUEPCSRT(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",136,0)
 I $$PRIVS^XUEPCSRT(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",137,0)
 I ACT D
"RTN","XUEPCSRT",138,0)
 .I $$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",139,0)
 I 'ACT D
"RTN","XUEPCSRT",140,0)
 .I '$$ACTIVE^XUSER(XUSD0) S CNT=CNT+1
"RTN","XUEPCSRT",141,0)
 I CNT=3 Q CNT
"RTN","XUEPCSRT",142,0)
 Q 0
"RTN","XUSC1C")
0^5^B8383983^B8238333
"RTN","XUSC1C",1,0)
XUSC1C ;ISCSF/RWF - Client Interface to Server services. ;04/06/12  09:01
"RTN","XUSC1C",2,0)
 ;;8.0;KERNEL;**283,580**;Jul 10, 1995;Build 46
"RTN","XUSC1C",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","XUSC1C",4,0)
 ;Return 0 = OK, else -1^msg
"RTN","XUSC1C",5,0)
EN(INPUT,OUTPUT,TYPE) ;Call to connect to Server
"RTN","XUSC1C",6,0)
 N X,Y,XUSCCMD,XUSCDAT,XUSCER,XUSCTIME,XUSCTRC,XUSCEXIT
"RTN","XUSC1C",7,0)
 D SETUP
"RTN","XUSC1C",8,0)
 D TRACE("IP:"_XUSC("IP")_" Port: "_XUSC("SOCK"))
"RTN","XUSC1C",9,0)
 N $ESTACK,$ETRAP S $ETRAP="D ERROR^XUSC1C"
"RTN","XUSC1C",10,0)
 D OPEN G:XUSC("STAT") ERR
"RTN","XUSC1C",11,0)
 D HELO G:XUSC("STAT") ERR
"RTN","XUSC1C",12,0)
 ;D SERV G:XUSC("STAT") ERR
"RTN","XUSC1C",13,0)
 D DATA G:XUSC("STAT") ERR
"RTN","XUSC1C",14,0)
 D TURN G:XUSC("STAT") ERR
"RTN","XUSC1C",15,0)
 D GET G:XUSC("STAT") ERR
"RTN","XUSC1C",16,0)
 D QUIT
"RTN","XUSC1C",17,0)
 Q 0
"RTN","XUSC1C",18,0)
ERR ;Report back an error
"RTN","XUSC1C",19,0)
 D TRACE("ERROR "_XUSC("STAT"))
"RTN","XUSC1C",20,0)
 D:'POP QUIT
"RTN","XUSC1C",21,0)
 Q XUSC("STAT")
"RTN","XUSC1C",22,0)
 ;
"RTN","XUSC1C",23,0)
ERROR ;Trap an error
"RTN","XUSC1C",24,0)
 S XUSC("STAT")="-1^M error: "_$ECODE
"RTN","XUSC1C",25,0)
 D ^%ZTER G UNWIND^%ZTER
"RTN","XUSC1C",26,0)
 ;
"RTN","XUSC1C",27,0)
OPEN ;Open connection
"RTN","XUSC1C",28,0)
 N IPCNT,IPA
"RTN","XUSC1C",29,0)
 D TRACE("Make Connection")
"RTN","XUSC1C",30,0)
 F IPCNT=1:1 S IPA=$P(XUSC("IP"),",",IPCNT) Q:IPA=""  D
"RTN","XUSC1C",31,0)
 . I IPA'?1.3N1P1.3N1P1.3N1P1.3N S IPA=$P($$ADDRESS^XLFNSLK(IPA),",")
"RTN","XUSC1C",32,0)
 . I IPA'?1.3N1P1.3N1P1.3N1P1.3N Q
"RTN","XUSC1C",33,0)
 . D TRACE("Call IP "_IPA)
"RTN","XUSC1C",34,0)
 . F XUSCCNT=0:1:5 D  Q:'POP
"RTN","XUSC1C",35,0)
 . . D CALL^%ZISTCP(IPA,XUSC("SOCK"),1)
"RTN","XUSC1C",36,0)
 I POP S XUSC("STAT")="-1^Initial Connection Failed" Q
"RTN","XUSC1C",37,0)
 D TRACE("Got Connection")
"RTN","XUSC1C",38,0)
 U IO
"RTN","XUSC1C",39,0)
 Q
"RTN","XUSC1C",40,0)
HELO ;start conversation
"RTN","XUSC1C",41,0)
 S X=$$POST("HELO "_$$KSP^XUPARAM("WHERE"))
"RTN","XUSC1C",42,0)
 I $E(X,1)'=2 S XUSC("STAT")="-1^Initial HELO Failed",XUSC("REC")=X
"RTN","XUSC1C",43,0)
 I $E(X,1,3)="421" S XUSC("STAT")="-1^Busy"
"RTN","XUSC1C",44,0)
 F  Q:$E(XUSCCMD,1,3)=220  D CREAD^XUSC1S
"RTN","XUSC1C",45,0)
 Q
"RTN","XUSC1C",46,0)
SERV ;Requested Service
"RTN","XUSC1C",47,0)
 D TRACE("Service Request: "_TYPE)
"RTN","XUSC1C",48,0)
 S X=$$POST("SERV "_TYPE)
"RTN","XUSC1C",49,0)
 I $E(X,1)'=2 S XUSC("STAT")="-1^"_X,XUSC("REC")=X
"RTN","XUSC1C",50,0)
 Q
"RTN","XUSC1C",51,0)
DATA ;Send data
"RTN","XUSC1C",52,0)
 D TRACE("Send Data")
"RTN","XUSC1C",53,0)
 D SDATA^XUSC1S1(INPUT,$G(TYPE,"MPI")),CREAD^XUSC1S
"RTN","XUSC1C",54,0)
 I $E(XUSCCMD,1)'=2 S XUSC("STAT")="-1^No 220 after send "_XUSCDAT Q
"RTN","XUSC1C",55,0)
 Q
"RTN","XUSC1C",56,0)
 ;
"RTN","XUSC1C",57,0)
TURN ;Turn channel
"RTN","XUSC1C",58,0)
 S X=$$POST("TURN ") I $E(X,1)'=2 S XUSC("STAT")="-1^No 220 after Turn"
"RTN","XUSC1C",59,0)
 Q
"RTN","XUSC1C",60,0)
GET ;Get responce
"RTN","XUSC1C",61,0)
 D CREAD^XUSC1S I XUSCCMD[220 G GET
"RTN","XUSC1C",62,0)
 I XUSCCMD'["DATA" S XUSC("STAT")="-1^No DATA cmd "_XUSCCMD Q
"RTN","XUSC1C",63,0)
 D DATA^XUSC1S1(OUTPUT)
"RTN","XUSC1C",64,0)
 Q
"RTN","XUSC1C",65,0)
QUIT ;Shut down
"RTN","XUSC1C",66,0)
 D SEND^XUSC1S("QUIT ")
"RTN","XUSC1C",67,0)
 D CLOSE^%ZISTCP
"RTN","XUSC1C",68,0)
 Q
"RTN","XUSC1C",69,0)
POST(MSG) ;Send a command and get responce
"RTN","XUSC1C",70,0)
 D SEND^XUSC1S(MSG)
"RTN","XUSC1C",71,0)
 D CREAD^XUSC1S
"RTN","XUSC1C",72,0)
 Q XUSCCMD
"RTN","XUSC1C",73,0)
 ;
"RTN","XUSC1C",74,0)
TRACE(S1) ;
"RTN","XUSC1C",75,0)
 N %,H
"RTN","XUSC1C",76,0)
 I S1=-1 K ^TMP("XUSC1",$J) Q
"RTN","XUSC1C",77,0)
 Q:'$G(XUSCDBUG)
"RTN","XUSC1C",78,0)
 S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
"RTN","XUSC1C",79,0)
 L +^TMP("XUSC1",$J):1
"RTN","XUSC1C",80,0)
 S %=$G(^TMP("XUSC1",$J,0))+1,^(0)=%,^(%)=H_XUSCTRC_S1
"RTN","XUSC1C",81,0)
 L -^TMP("XUSC1",$J)
"RTN","XUSC1C",82,0)
 Q
"RTN","XUSC1C",83,0)
SETUP ;
"RTN","XUSC1C",84,0)
 S (XUSC("STAT"),XUSCEXIT)=0,XUSCTIME=30,XUSCTRC="C: "
"RTN","XUSC1C",85,0)
 S XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
"RTN","XUSC1C",86,0)
 D TRACE(-1),TRACE("Client Setup")
"RTN","XUSC1C",87,0)
 Q
"RTN","XUSER")
0^1^B47045111^B9027633
"RTN","XUSER",1,0)
XUSER ;SFISC/RWF - A common set of user functions ;11/07/2012  11:56
"RTN","XUSER",2,0)
 ;;8.0;KERNEL;**75,97,99,150,226,267,288,330,370,373,580**;Jul 10, 1995;Build 46
"RTN","XUSER",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","XUSER",4,0)
 ;Covered under DBIA #2343
"RTN","XUSER",5,0)
 Q
"RTN","XUSER",6,0)
LOOKUP(XUF) ;Do a user lookup
"RTN","XUSER",7,0)
 ;Parameter, "Q" to NOT ask OK.
"RTN","XUSER",8,0)
 ;Parameter, "A" Don't select current users who have a termination
"RTN","XUSER",9,0)
 ;               date prior to today's date
"RTN","XUSER",10,0)
 N DIC,XUDA,DIR,Y
"RTN","XUSER",11,0)
LK1 S DIC="^VA(200,",DIC(0)="AEMQZ" D ^DIC S XUDA=Y G:Y'>0 LKX
"RTN","XUSER",12,0)
 S Y=$P(Y(0),"^",11) I Y>0,Y<DT W !?15,"This user was terminated on ",$$FMTE^XLFDT(Y) I $G(XUF)["A" S XUDA=-1 G LK1
"RTN","XUSER",13,0)
 G:$G(XUF)["Q" LKX
"RTN","XUSER",14,0)
 S DIR(0)="Y",DIR("A")=" Is "_$P(XUDA,U,2)_" the one you want",DIR("B")="YES" D ^DIR
"RTN","XUSER",15,0)
 I Y'=1 S XUDA=-1 G:'$D(DIRUT) LK1
"RTN","XUSER",16,0)
LKX Q XUDA
"RTN","XUSER",17,0)
 ;
"RTN","XUSER",18,0)
ACTIVE(XUDA) ;Get if a user is active.
"RTN","XUSER",19,0)
 N %,X1,X2
"RTN","XUSER",20,0)
 S X1=$G(^VA(200,+$G(XUDA),0)),X2=$S(X1="":"",1:0)
"RTN","XUSER",21,0)
 I $L($P(X1,U,3)) S X2="1^"_$S($L($P($G(^VA(200,XUDA,.1)),U,2)):"ACTIVE",1:"NEW")
"RTN","XUSER",22,0)
 S:$P(X1,U,7)=1 X2="0^DISUSER"
"RTN","XUSER",23,0)
 S:X2["ACTIVE" $P(X2,U,3)=$P($G(^VA(200,XUDA,1.1)),U) ;Return last sign-on
"RTN","XUSER",24,0)
 S %=$P(X1,U,11) I %>0,%'>DT S X2="0^TERMINATED^"_%
"RTN","XUSER",25,0)
 Q X2
"RTN","XUSER",26,0)
 ;
"RTN","XUSER",27,0)
BULL ;Called from bulletin in DD of file #200 for 'Sub Alt Name' fld.
"RTN","XUSER",28,0)
 ;This will find users with PSDMGR keys and setup the XMY array for
"RTN","XUSER",29,0)
 ;bulletin recipients. p580 REM
"RTN","XUSER",30,0)
 N PSD,I
"RTN","XUSER",31,0)
 S PSD=$$FIND1^DIC(19.1,"","MX","PSDMGR","","","PSDERR") Q:PSD'>0
"RTN","XUSER",32,0)
 S I=0 F  S I=$O(^VA(200,"AB",PSD,I)) Q:I'>0  S XMY(I)=""
"RTN","XUSER",33,0)
 Q
"RTN","XUSER",34,0)
 ;
"RTN","XUSER",35,0)
PROVIDER(XUDA,XUF) ;See if user qualifies as a CPRS provider
"RTN","XUSER",36,0)
 ;XUDA = IEN of Record in New Person File
"RTN","XUSER",37,0)
 ;XUF = Flag to control processing
"RTN","XUSER",38,0)
 ;      0 or not passed, do not include Visitors
"RTN","XUSER",39,0)
 ;      1 include Visitors
"RTN","XUSER",40,0)
 N %,X1,X2,XUORES
"RTN","XUSER",41,0)
 ;Test to see if XUDA Passed:
"RTN","XUSER",42,0)
 I '$D(XUDA) Q ""
"RTN","XUSER",43,0)
 ;
"RTN","XUSER",44,0)
 ;Test for valid IEN:
"RTN","XUSER",45,0)
 S X1=$G(^VA(200,+$G(XUDA),0)),X2=$S(X1="":"",1:1) Q:X2="" ""
"RTN","XUSER",46,0)
 ;
"RTN","XUSER",47,0)
 ;See if user has XUORES Security Key:
"RTN","XUSER",48,0)
 S XUORES=$D(^XUSEC("XUORES",XUDA))
"RTN","XUSER",49,0)
 ;
"RTN","XUSER",50,0)
 ;Test for Access Code:
"RTN","XUSER",51,0)
 I $P(X1,U,3)]"" Q 1
"RTN","XUSER",52,0)
 ;
"RTN","XUSER",53,0)
 ;Test for a Termination Date not in the Future
"RTN","XUSER",54,0)
 ;AND Not owner of XUORES Security Key:
"RTN","XUSER",55,0)
 S %=$P(X1,U,11) I %>0,%'>DT,'XUORES Q "0^TERMINATED^"_%
"RTN","XUSER",56,0)
 ;
"RTN","XUSER",57,0)
 ;Test if user has XUORES Security key:
"RTN","XUSER",58,0)
 I XUORES Q 1
"RTN","XUSER",59,0)
 ;
"RTN","XUSER",60,0)
 ;Tests for Visitors:
"RTN","XUSER",61,0)
 I +$G(XUF),$D(^VA(200,"BB","VISITOR",XUDA)) Q 1
"RTN","XUSER",62,0)
 I $D(^VA(200,"BB","VISITOR",XUDA)) Q "0^VISITOR"
"RTN","XUSER",63,0)
 ;
"RTN","XUSER",64,0)
 ;Default:
"RTN","XUSER",65,0)
 Q "0^NOT A PROVIDER"
"RTN","XUSER",66,0)
 ;
"RTN","XUSER",67,0)
DEA(FG,IEN) ;sr. ef. Return users DEA # or Facility DEA_"-"_user VA# or null
"RTN","XUSER",68,0)
 ;ICR #2343
"RTN","XUSER",69,0)
 ;If FG is 1: DEA# or VA#
"RTN","XUSER",70,0)
 N DEA,VA,IN,N,N1,INN,XDT,FB
"RTN","XUSER",71,0)
 S IEN=$G(IEN,DUZ),INN=+DUZ(2)
"RTN","XUSER",72,0)
 S N=$G(^VA(200,IEN,"PS")),N1=$G(^VA(200,IEN,"QAR"))
"RTN","XUSER",73,0)
 S DEA=$P(N,U,2),VA=$P(N,U,3),XDT=$P(N1,U,9)
"RTN","XUSER",74,0)
 ;I $P(N,U,6)=4!($P(N,U,6)=3) S FB=1 ;Fee Basis or C&A  provider -p609
"RTN","XUSER",75,0)
 I $L(DEA),$S('$L($P(N1,U,9)):1,1:$P(N1,U,9)>DT) Q DEA
"RTN","XUSER",76,0)
 ;I $L(DEA),$L(XDT),XDT'<DT Q DEA ;p609
"RTN","XUSER",77,0)
 ;I $G(FB) Q "" ;p609
"RTN","XUSER",78,0)
 I $G(FG) Q VA
"RTN","XUSER",79,0)
 S IN=$P($G(^DIC(4,INN,"DEA")),U) ;Check signed-in Inst.
"RTN","XUSER",80,0)
 I '$L(IN) D
"RTN","XUSER",81,0)
 . N XU1 D PARENT^XUAF4("XU1","`"_INN,"PARENT FACILITY")
"RTN","XUSER",82,0)
 . S INN=$O(XU1("P","")) I INN S IN=$P($G(^DIC(4,INN,"DEA")),U)
"RTN","XUSER",83,0)
 . Q
"RTN","XUSER",84,0)
 I $L(VA),$L(IN) Q IN_"-"_VA
"RTN","XUSER",85,0)
 Q ""
"RTN","XUSER",86,0)
 ;
"RTN","XUSER",87,0)
DETOX(IEN) ;Return the Detox/Maintenance ID in file 200 - p580/REM
"RTN","XUSER",88,0)
 ;ICR #2343
"RTN","XUSER",89,0)
 ;Return Detox# - valid detox# and DEA Xdate is valid
"RTN","XUSER",90,0)
 ;Return null - if no detox or the DEA Xdate is unpopulated
"RTN","XUSER",91,0)
 ;Return DEA Expiration Date - valid detox# but expired DEA Xdate
"RTN","XUSER",92,0)
 ;IEN is used to lookup user in file #200
"RTN","XUSER",93,0)
 N DET,XDT,N,N1
"RTN","XUSER",94,0)
 S N=$G(^VA(200,IEN,"PS")),N1=$G(^VA(200,IEN,"QAR"))
"RTN","XUSER",95,0)
 S DET=$P(N,U,11),XDT=$P(N1,U,9)
"RTN","XUSER",96,0)
 I $L(DET),$L(XDT),XDT'<DT Q DET
"RTN","XUSER",97,0)
 I $L(DET),$L(XDT),XDT<DT Q XDT
"RTN","XUSER",98,0)
 ;I $L(DET),$S('$L($P(N1,U,9)):1,1:$P(N1,U,9)>DT) Q DTX
"RTN","XUSER",99,0)
 Q ""
"RTN","XUSER",100,0)
 ;
"RTN","XUSER",101,0)
SDEA(FG,IEN,PSDEA) ;validation for new DEA regulations p580-JC(CPRS)
"RTN","XUSER",102,0)
 ;ICR #2343
"RTN","XUSER",103,0)
 ;Returns: DEA#, Facility DEA_"-"_user VA#, 1, 2, or 4^expiration date 
"RTN","XUSER",104,0)
 ;If FG is 1: DEA# or VA# - similar to $$DEA
"RTN","XUSER",105,0)
 ;IEN is used to lookup user in file #200
"RTN","XUSER",106,0)
 ;PSDEA is the DEA schedule
"RTN","XUSER",107,0)
 N DEA,N3,I,A,NALL,E,DA,XD,N,N1
"RTN","XUSER",108,0)
 S FG=$G(FG),IEN=$G(IEN),PSDEA=$G(PSDEA)
"RTN","XUSER",109,0)
 S DEA=$$DEA(FG,IEN) I DEA="" D  Q E
"RTN","XUSER",110,0)
 . S E=1
"RTN","XUSER",111,0)
 . S N=$G(^VA(200,IEN,"PS")),N1=$G(^VA(200,IEN,"QAR"))
"RTN","XUSER",112,0)
 . S DA=$P(N,U,2),XD=$P(N1,U,9)
"RTN","XUSER",113,0)
 . I $L(DA),$L(XD),XD<DT S Y=XD X ^DD("DD") S E=4_"^"_Y
"RTN","XUSER",114,0)
 I $G(PSDEA)="" Q 1
"RTN","XUSER",115,0)
 I '$D(^VA(200,IEN,"PS3")) Q DEA
"RTN","XUSER",116,0)
 S N3=^VA(200,IEN,"PS3")
"RTN","XUSER",117,0)
 S NALL=1 F I=1:1:6 S A(I)=$P(N3,"^",I) I A(I) S NALL=0
"RTN","XUSER",118,0)
 I NALL D  Q 2
"RTN","XUSER",119,0)
 . I $G(^VA(200,IEN,"PS"))="" Q
"RTN","XUSER",120,0)
 . S $P(^("PS"),"^",2)="",$P(^("PS"),"^",3)=""
"RTN","XUSER",121,0)
 I PSDEA=2 Q $S('A(1):2,1:DEA)
"RTN","XUSER",122,0)
 I PSDEA="2n" Q $S('A(2):2,1:DEA)
"RTN","XUSER",123,0)
 I PSDEA=3 Q $S('A(3):2,1:DEA)
"RTN","XUSER",124,0)
 I PSDEA="3n" Q $S('A(4):2,1:DEA)
"RTN","XUSER",125,0)
 I PSDEA=4 Q $S('A(5):2,1:DEA)
"RTN","XUSER",126,0)
 I PSDEA=5 Q $S('A(6):2,1:DEA)
"RTN","XUSER",127,0)
 Q DEA
"RTN","XUSER",128,0)
 ;
"RTN","XUSER",129,0)
VDEA(RETURN,IEN)  ;ISP/RFR - Verify a provider is properly configured for ePCS
"RTN","XUSER",130,0)
 ;PARAMETERS: IEN - Internal Entry Number in the NEW PERSON file (#200)
"RTN","XUSER",131,0)
 ;            RETURN - Reference to an array in which text explaining
"RTN","XUSER",132,0)
 ;                     deficiencies and listing prescribable schedules
"RTN","XUSER",133,0)
 ;                     is placed, with each deficiency and the list of
"RTN","XUSER",134,0)
 ;                     schedules on a separate node
"RTN","XUSER",135,0)
 ;RETURN: 1 - Provider is properly configured for ePCS
"RTN","XUSER",136,0)
 ;        0 - Provider is not properly configured for ePCS
"RTN","XUSER",137,0)
 N STATUS,DEA,RETVAL,DATE
"RTN","XUSER",138,0)
 S RETVAL=1,STATUS=$$ACTIVE(IEN)
"RTN","XUSER",139,0)
 I STATUS="" S RETURN("User account does not exist.")="",RETVAL=0
"RTN","XUSER",140,0)
 I STATUS=0 S RETURN("User cannot sign on.")="",RETVAL=0
"RTN","XUSER",141,0)
 I +STATUS=0,($P(STATUS,U,2)'="") S RETURN("User account status: "_$P(STATUS,U,2))="",RETVAL=0
"RTN","XUSER",142,0)
 Q:STATUS="" RETVAL
"RTN","XUSER",143,0)
 I '$D(^XUSEC("ORES",IEN)) D
"RTN","XUSER",144,0)
 .S RETURN("Does not hold the ORES security key.")="",RETVAL=0
"RTN","XUSER",145,0)
 I +$P($G(^VA(200,IEN,"PS")),U,1)'=1 D
"RTN","XUSER",146,0)
 .S RETURN("Is not authorized to write medication orders.")="",RETVAL=0
"RTN","XUSER",147,0)
 I $P($G(^VA(200,IEN,"PS")),U,2)'="" D
"RTN","XUSER",148,0)
 .N DATE
"RTN","XUSER",149,0)
 .S DATE=+$P($G(^VA(200,IEN,"QAR")),U,9)
"RTN","XUSER",150,0)
 .I DATE=0 S RETURN("Has a DEA number with no expiration date.")="",RETVAL=0
"RTN","XUSER",151,0)
 .I DATE>0,(DATE<=DT) S RETURN("Has an expired DEA number.")="",RETVAL=0
"RTN","XUSER",152,0)
 I $P($G(^VA(200,IEN,"PS")),U,2)="",($P($G(^VA(200,IEN,"PS")),U,3)="") D
"RTN","XUSER",153,0)
 .S RETURN("Has neither a DEA number nor a VA number.")="",RETVAL=0
"RTN","XUSER",154,0)
 S DATE=+$P($G(^VA(200,IEN,"PS")),U,4)
"RTN","XUSER",155,0)
 I DATE>0,(DATE<=DT) D
"RTN","XUSER",156,0)
 .S RETURN("Is no longer able to write medication orders (inactive date).")="",RETVAL=0
"RTN","XUSER",157,0)
 I $D(^VA(200,IEN,"PS3")) D
"RTN","XUSER",158,0)
 .N NODE
"RTN","XUSER",159,0)
 .S NODE=$$STRIP^XLFSTR(^VA(200,IEN,"PS3"),U),NODE=$$STRIP^XLFSTR(NODE,0)
"RTN","XUSER",160,0)
 .I $G(NODE)="" S RETURN("Is not permitted to prescribe any schedules.")="",RETVAL=0 Q
"RTN","XUSER",161,0)
 .I $G(NODE)'="" D
"RTN","XUSER",162,0)
 ..N PIECE,SCHED,SPEC,ASCHED
"RTN","XUSER",163,0)
 ..S SPEC("SCHEDULE ")=""
"RTN","XUSER",164,0)
 ..S ASCHED=1
"RTN","XUSER",165,0)
 ..F PIECE=1:1:6 D
"RTN","XUSER",166,0)
 ...I +$P(^VA(200,IEN,"PS3"),U,PIECE)>0 D
"RTN","XUSER",167,0)
 ....N LABEL,ERROR
"RTN","XUSER",168,0)
 ....S LABEL=$$REPLACE^XLFSTR($$GET1^DID(200,"55."_PIECE,,"LABEL",,"ERROR"),.SPEC)
"RTN","XUSER",169,0)
 ....S:$G(LABEL)="" LABEL="Unknown field #55."_PIECE
"RTN","XUSER",170,0)
 ....S SCHED=$S($G(SCHED)'="":SCHED_U,1:"")_LABEL
"RTN","XUSER",171,0)
 ...I +$P(^VA(200,IEN,"PS3"),U,PIECE)=0 S ASCHED=0
"RTN","XUSER",172,0)
 ..I ASCHED=1 S RETURN("Is permitted to prescribe all schedules.")=""
"RTN","XUSER",173,0)
 ..I ASCHED=0 D
"RTN","XUSER",174,0)
 ...N DELIMIT,INDEX,TEXT
"RTN","XUSER",175,0)
 ...S DELIMIT=", "
"RTN","XUSER",176,0)
 ...F INDEX=1:1:$L(SCHED,U) D
"RTN","XUSER",177,0)
 ....S:INDEX=$L(SCHED,U) DELIMIT=" and "
"RTN","XUSER",178,0)
 ....S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(SCHED,U,INDEX)
"RTN","XUSER",179,0)
 ...S RETURN("Is permitted to prescribe schedule"_$S($L(SCHED,U)>1:"s",1:"")_" "_TEXT_".")=""
"RTN","XUSER",180,0)
 I '$D(^VA(200,IEN,"PS3")) S RETURN("Is permitted to prescribe all schedules.")=""
"RTN","XUSER",181,0)
 Q RETVAL
"RTN","XUSER",182,0)
 ;
"RTN","XUSER",183,0)
DIV4(XUROOT,XUDUZ) ;Return the Divisions that this user is assigned to.
"RTN","XUSER",184,0)
 ;Returns 0 - no institution for user, 1 - institution for user
"RTN","XUSER",185,0)
 ;XUROOT is passed by reference.
"RTN","XUSER",186,0)
 N %,%1 S:$G(XUDUZ)="" XUDUZ=DUZ S (%,%1)=0
"RTN","XUSER",187,0)
 F  S %=$O(^VA(200,XUDUZ,2,%)) Q:%'>0  S XUROOT(%)=$P($G(^(%,0)),U,2),%1=1
"RTN","XUSER",188,0)
 Q %1
"RTN","XUSER",189,0)
 ;
"RTN","XUSER",190,0)
NAME(IEN,FL) ;Return the full name from Name Components file
"RTN","XUSER",191,0)
 N NA S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=IEN
"RTN","XUSER",192,0)
 S FL=$G(FL,"G") ;Valid are Famly or Given
"RTN","XUSER",193,0)
 S:"FG"'[FL FL="G"
"RTN","XUSER",194,0)
 Q $$NAMEFMT^XLFNAME(.NA,FL,"CMDP")
"RTN","XUSER",195,0)
 ;
"RTN","XUSER",196,0)
HL7(IEN) ;Return a HL7 name from the components file
"RTN","XUSER",197,0)
 N NA S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=IEN
"RTN","XUSER",198,0)
 Q $$HLNAME^XLFNAME(.NA,"","~")
"RTN","XUSER",199,0)
 ;
"RTN","XUSER",200,0)
SCR200() ;Whole File Screen logic for file 200
"RTN","XUSER",201,0)
 ;
"RTN","XUSER",202,0)
 ; Test to see if FileMan can "talk" to the user, IA# 4577
"RTN","XUSER",203,0)
 I $G(DIC(0))'["E" Q 1
"RTN","XUSER",204,0)
 ;
"RTN","XUSER",205,0)
 ; Test to see if index being searched is SSN, IA# 4578
"RTN","XUSER",206,0)
 I $G(DINDEX)'="SSN" Q 1
"RTN","XUSER",207,0)
 ;
"RTN","XUSER",208,0)
 ; Test for Security Key
"RTN","XUSER",209,0)
 I $G(DUZ),$D(^XUSEC("XUSHOWSSN",DUZ)) Q 1
"RTN","XUSER",210,0)
 ;
"RTN","XUSER",211,0)
 ; Default - None of the above is TRUE
"RTN","XUSER",212,0)
 Q 0
"RTN","XUSER2")
0^3^B15407315^B13847196
"RTN","XUSER2",1,0)
XUSER2 ;ISF/RWF - New Person File Utilities ;02/01/2012
"RTN","XUSER2",2,0)
 ;;8.0;KERNEL;**267,251,344,534,580**;Jul 10, 1995;Build 46
"RTN","XUSER2",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","XUSER2",4,0)
 Q
"RTN","XUSER2",5,0)
VALDEA(X,F) ;Check for a valid DEA#
"RTN","XUSER2",6,0)
 ;Returns 0 for NOT Valid, 1 for Valid
"RTN","XUSER2",7,0)
 ;F = 1 for Facility DEA check.
"RTN","XUSER2",8,0)
 I $D(X) K:$L(X)>9!($L(X)<9)!'(X?2U7N) X
"RTN","XUSER2",9,0)
 S F=$G(F)
"RTN","XUSER2",10,0)
 I $D(X),'F,$D(DA),$D(^VA(200,"PS1",X)),$O(^(X,0))'=DA D EN^DDIOL($C(7)_"CAN'T FILE: DUPLICATE DEA NUMBER") K X
"RTN","XUSER2",11,0)
 I $D(X),'F,$D(DA),$E(X,2)'=$E($P(^VA(200,DA,0),"^")) D EN^DDIOL($C(7)_"WARNING: DEA# FORMAT MISMATCH -- CHECK SECOND LETTER")
"RTN","XUSER2",12,0)
 I $D(X),'$$DEANUM(X) D EN^DDIOL($C(7)_"CAN'T FILE: DEA# FORMAT MISMATCH -- NUMERIC ALGORITHM FAILED") K X
"RTN","XUSER2",13,0)
 Q $D(X)
"RTN","XUSER2",14,0)
 ;
"RTN","XUSER2",15,0)
DEANUM(X) ;Check DEA # part
"RTN","XUSER2",16,0)
 N VA1,VA2
"RTN","XUSER2",17,0)
 S VA1=$E(X,3)+$E(X,5)+$E(X,7)+(2*($E(X,4)+$E(X,6)+$E(X,8)))
"RTN","XUSER2",18,0)
 S VA1=VA1#10,VA2=$E(X,9)
"RTN","XUSER2",19,0)
 Q VA1=VA2
"RTN","XUSER2",20,0)
 ;
"RTN","XUSER2",21,0)
VANUM ;Check that the VA# is not Active for anybody else. Called from ^DD(200,53.3,0)
"RTN","XUSER2",22,0)
 ;Needs DA, DT and X
"RTN","XUSER2",23,0)
 Q:'$D(X)!'$D(DA)
"RTN","XUSER2",24,0)
 N %
"RTN","XUSER2",25,0)
 I $D(^VA(200,"PS2",X)) D
"RTN","XUSER2",26,0)
 . S %=0
"RTN","XUSER2",27,0)
 . F  S %=$O(^VA(200,"PS2",X,%)) Q:'%  I %'=DA,$S('$P($G(^VA(200,%,"PS")),"^",4):1,1:$P(^("PS"),"^",4)'<DT) K X Q
"RTN","XUSER2",28,0)
 . Q
"RTN","XUSER2",29,0)
 I '$D(X) D EN^DDIOL($C(7)_"That VA# is in active use.  ","","!,?5")
"RTN","XUSER2",30,0)
 Q
"RTN","XUSER2",31,0)
 ;
"RTN","XUSER2",32,0)
GETUPN(RET) ;Get SUBJECT ALTERNATIVE NAME for PIV card check. -p580
"RTN","XUSER2",33,0)
 S RET=$P($G(^VA(200,DUZ,501)),U,2)
"RTN","XUSER2",34,0)
 Q
"RTN","XUSER2",35,0)
 ;
"RTN","XUSER2",36,0)
SETUPN(RET,V) ;Set the SUBJECT ALTERNATIVE NAME from the PIV card. -p580
"RTN","XUSER2",37,0)
 N FDA,ERR
"RTN","XUSER2",38,0)
 S RET=0,FDA(200,DUZ_",",501.2)=V
"RTN","XUSER2",39,0)
 D FILE^DIE("KE","FDA","ERR") I '$D(ERR) S RET=1
"RTN","XUSER2",40,0)
 Q
"RTN","XUSER2",41,0)
 ;
"RTN","XUSER2",42,0)
REQ(XUV,XUFLAG) ;Called from forms:
"RTN","XUSER2",43,0)
 ; XUEXISTING USER, XUNEW USER, XUREACT USER, XU-CLINICAL TRAINEE
"RTN","XUSER2",44,0)
 ;from the:
"RTN","XUSER2",45,0)
 ; - Form-level pre-action
"RTN","XUSER2",46,0)
 ; - Post action on change for "Is this person a Clinical Trainee?"
"RTN","XUSER2",47,0)
 ;In:
"RTN","XUSER2",48,0)
 ; XUV = 1 if user is a clinical trainee; 0 otherwise
"RTN","XUSER2",49,0)
 ;          If XUV is not passed, its value is obtained from the
"RTN","XUSER2",50,0)
 ;          CLINICAL CORE TRAINEE(#12.6).
"RTN","XUSER2",51,0)
 ; XUFLAG = 1 if called from the XU-CLINICAL TRAINEE form;
"RTN","XUSER2",52,0)
 ;          otherwise, called from the other forms
"RTN","XUSER2",53,0)
 ;
"RTN","XUSER2",54,0)
 N BLOCK,PAGE,FIELD,F126
"RTN","XUSER2",55,0)
 ; BLOCK = Block
"RTN","XUSER2",56,0)
 ; PAGE = Page number
"RTN","XUSER2",57,0)
 ; FIELD = Field number
"RTN","XUSER2",58,0)
 I $G(XUFLAG) S BLOCK="XU-CLINICAL TRAINEE 1",PAGE=1
"RTN","XUSER2",59,0)
 E  D
"RTN","XUSER2",60,0)
 . S BLOCK="XUEXISTING USER TRAINEE"
"RTN","XUSER2",61,0)
 . S PAGE=5
"RTN","XUSER2",62,0)
 ;
"RTN","XUSER2",63,0)
 I $G(XUV)="" D  ;Value not Passed get current value
"RTN","XUSER2",64,0)
 . N ZERR
"RTN","XUSER2",65,0)
 . S XUV=$$GET^DDSVAL(200,DA,"CLINICAL CORE TRAINEE",.ZERR,"I")
"RTN","XUSER2",66,0)
 . S XUV=$S(XUV="N":0,XUV="":0,1:1)
"RTN","XUSER2",67,0)
 S F126=XUV
"RTN","XUSER2",68,0)
 ;
"RTN","XUSER2",69,0)
 ;CURRENT DEGREE LEVEL 12.1
"RTN","XUSER2",70,0)
 ;PROGRAM OF STUDY 12.2
"RTN","XUSER2",71,0)
 ;LAST TRAINING MONTH & YEAR 12.3
"RTN","XUSER2",72,0)
 ;VHA TRAINING FACILITY 12.4
"RTN","XUSER2",73,0)
 ;DATE HL7 TRAINEE RECORD BUILT 12.5
"RTN","XUSER2",74,0)
 ;CLINICAL CORE TRAINEE 12.6
"RTN","XUSER2",75,0)
 ;DATE NO LONGER TRAINEE 12.7
"RTN","XUSER2",76,0)
 ;START OF TRAINING 12.8
"RTN","XUSER2",77,0)
 ;
"RTN","XUSER2",78,0)
 I F126 D  Q  ;Logic for when field 12.6 equals YES or Null
"RTN","XUSER2",79,0)
 . N FIELD
"RTN","XUSER2",80,0)
 . ;Make fields required
"RTN","XUSER2",81,0)
 . F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,1)
"RTN","XUSER2",82,0)
 . ;Delete value in field 12.7 & make it uneditable
"RTN","XUSER2",83,0)
 . S FIELD=12.7 D PUT^DDSVAL(200,DA,FIELD,"@","","I")
"RTN","XUSER2",84,0)
 . S FIELD="12.7F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
"RTN","XUSER2",85,0)
 . D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
"RTN","XUSER2",86,0)
 . ;Make the following fields editable
"RTN","XUSER2",87,0)
 . F FIELD="12.1F","12.2F","12.3F","12.4F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,0)
"RTN","XUSER2",88,0)
 . Q
"RTN","XUSER2",89,0)
 I 'F126 D  Q  ;Logic for when field 12.6 equals NO
"RTN","XUSER2",90,0)
 . N FIELD,ZERR,F122,F127
"RTN","XUSER2",91,0)
 . S F122=$$GET^DDSVAL(200,DA,12.2,.ZERR,"I")
"RTN","XUSER2",92,0)
 . S F127=$$GET^DDSVAL(200,DA,12.7,.ZERR,"I")
"RTN","XUSER2",93,0)
 . I F122="" D  Q  ;Not a trainee, probably a mistake
"RTN","XUSER2",94,0)
 .. ;Make fields not required
"RTN","XUSER2",95,0)
 .. F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
"RTN","XUSER2",96,0)
 .. ;Make field uneditable
"RTN","XUSER2",97,0)
 .. F FIELD="12.1F","12.2F","12.3F","12.4F","12.7F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
"RTN","XUSER2",98,0)
 .. Q
"RTN","XUSER2",99,0)
 . I F122]"",F127]"" Q
"RTN","XUSER2",100,0)
 . ;Make fields not required
"RTN","XUSER2",101,0)
 . F FIELD="12.2F","12.4F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,0)
"RTN","XUSER2",102,0)
 . ;Make the following field required & editable
"RTN","XUSER2",103,0)
 . S FIELD="12.7F" D REQ^DDSUTL(FIELD,BLOCK,PAGE,1)
"RTN","XUSER2",104,0)
 . S FIELD="12.7F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,0)
"RTN","XUSER2",105,0)
 . ;Don't allow editing of the following fields
"RTN","XUSER2",106,0)
 . F FIELD="12.1F","12.2F","12.3F","12.4F","12.8F" D UNED^DDSUTL(FIELD,BLOCK,PAGE,1)
"RTN","XUSER2",107,0)
 . Q
"RTN","XUSER2",108,0)
 Q
"SEC","^DIC",8991.6,8991.6,0,"AUDIT")
@
"SEC","^DIC",8991.6,8991.6,0,"DD")
@
"SEC","^DIC",8991.6,8991.6,0,"DEL")
@
"SEC","^DIC",8991.6,8991.6,0,"LAYGO")
@
"SEC","^DIC",8991.6,8991.6,0,"RD")
@
"SEC","^DIC",8991.6,8991.6,0,"WR")
@
"SEC","^DIC",8991.7,8991.7,0,"AUDIT")
@
"SEC","^DIC",8991.7,8991.7,0,"DD")
@
"SEC","^DIC",8991.7,8991.7,0,"DEL")
@
"SEC","^DIC",8991.7,8991.7,0,"LAYGO")
@
"SEC","^DIC",8991.7,8991.7,0,"RD")
@
"SEC","^DIC",8991.7,8991.7,0,"WR")
@
"VER")
8.0^22.0
"^DD",4,4,52.1,0)
FACILITY DEA EXPIRATION DATE^D^^DEA;2^S %DT="EX" D ^%DT S X=Y K:Y<1 X
"^DD",4,4,52.1,3)
Enter expiration date for DEA#.
"^DD",4,4,52.1,21,0)
^.001^1^1^3120828^^
"^DD",4,4,52.1,21,1,0)
This field contains the expiration date for DEA#.
"^DD",4,4,52.1,"DT")
3110728
"^DD",19,19,69,0)
DIS(0)^K^^69;E1,245^K:$L(X)>245 X D:$D(X) ^DIM
"^DD",19,19,69,3)
Enter standard M code which sets $T.
"^DD",19,19,69,9)
@
"^DD",19,19,69,21,0)
^.001^18^18^3100504^^^^
"^DD",19,19,69,21,1,0)
Used in the PRINT type option. This is executable M code which sets $T
"^DD",19,19,69,21,2,0)
to select desired entries for the sort process. If the code produces a
"^DD",19,19,69,21,3,0)
truth value of 1, the entry will be printed. (A truth value of 0 will not
"^DD",19,19,69,21,4,0)
allow the entry to be printed.) At the time the code is executed, the
"^DD",19,19,69,21,5,0)
internal entry number (IEN) of the entry is stored in the variable D0.
"^DD",19,19,69,21,6,0)
 
"^DD",19,19,69,21,7,0)
For example, the following would print patients who were NOT born in the
"^DD",19,19,69,21,8,0)
1970's:
"^DD",19,19,69,21,9,0)
 
"^DD",19,19,69,21,10,0)
DIS(0)=I $P(^DPT(D0,0),U,3)<2700101!($P(^(0),U,3)>2791231)
"^DD",19,19,69,21,11,0)

"^DD",19,19,69,21,12,0)
If used in conjunction with fields DIS(1), DIS(2), and DIS(3), the entry
"^DD",19,19,69,21,13,0)
will print if DIS(0) and DIS(1) are true, OR if DIS(0) and DIS(2) are true,
"^DD",19,19,69,21,14,0)
OR if DIS(0) and DIS(3) are true.
"^DD",19,19,69,21,15,0)

"^DD",19,19,69,21,16,0)
Note: You may have DIS(0) only, or DIS(0) in combination with DIS(1) only,
"^DD",19,19,69,21,17,0)
or DIS(1) and DIS(2), or DIS(1), DIS(2), and DIS(3).
"^DD",19,19,69,21,18,0)

"^DD",19,19,69,"DT")
2910321
"^DD",19,19,69.1,0)
DIS(1)^K^^69.1;E1,245^K:$L(X)>245 X D:$D(X) ^DIM
"^DD",19,19,69.1,3)
Enter standard M code which sets $T.
"^DD",19,19,69.1,9)
@
"^DD",19,19,69.1,21,0)
^.001^5^5^3100504^^
"^DD",19,19,69.1,21,1,0)
This field may be used in PRINT options along with DIS(0) and the other DIS(n)
"^DD",19,19,69.1,21,2,0)
fields. Each DIS field is examined in order (beginning with 0) for M code that
"^DD",19,19,69.1,21,3,0)
will produce a $T value to determine whether or not the data pointed to by D0
"^DD",19,19,69.1,21,4,0)
should be printed. See the description of D(0) (field #69) for more information.
"^DD",19,19,69.1,21,5,0)

"^DD",19,19,69.1,"DT")
2910321
"^DD",19,19,69.2,0)
DIS(2)^K^^69.2;E1,245^K:$L(X)>245 X D:$D(X) ^DIM
"^DD",19,19,69.2,3)
Enter standard M code which sets $T.
"^DD",19,19,69.2,9)
@
"^DD",19,19,69.2,21,0)
^.001^5^5^3100504^^
"^DD",19,19,69.2,21,1,0)
This field may be used in PRINT options along with DIS(0) and the other DIS(n)
"^DD",19,19,69.2,21,2,0)
fields. Each DIS field is examined in order (beginning with 0) for M code that
"^DD",19,19,69.2,21,3,0)
will produce a $T value to determine whether or not the data pointed to by D0
"^DD",19,19,69.2,21,4,0)
should be printed. See the description of D(0) (field #69) for more information.
"^DD",19,19,69.2,21,5,0)

"^DD",19,19,69.2,"DT")
2910321
"^DD",19,19,69.3,0)
DIS(3)^K^^69.3;E1,245^K:$L(X)>245 X D:$D(X) ^DIM
"^DD",19,19,69.3,3)
Enter standard M code which sets $T.
"^DD",19,19,69.3,9)
@
"^DD",19,19,69.3,21,0)
^.001^5^5^3100504^^
"^DD",19,19,69.3,21,1,0)
This field may be used in PRINT options along with DIS(0) and the other DIS(n)
"^DD",19,19,69.3,21,2,0)
fields. Each DIS field is examined in order (beginning with 0) for M code that
"^DD",19,19,69.3,21,3,0)
will produce a $T value to determine whether or not the data pointed to by D0
"^DD",19,19,69.3,21,4,0)
should be printed. See the description of D(0) (field #69) for more information.
"^DD",19,19,69.3,21,5,0)

"^DD",19,19,69.3,"DT")
2910321
"^DD",200,200,53.11,0)
DETOX/MAINTENANCE ID NUMBER^F^^PS;11^K:$L(X)>9!($L(X)<3)!'(X?2A7N) X
"^DD",200,200,53.11,3)
Enter the Detox/Maintenance ID number for the provider.
"^DD",200,200,53.11,21,0)
^.001^6^6^3120828^^^^
"^DD",200,200,53.11,21,1,0)
This field holds the Detoxification/Maintenance ID number used for the 
"^DD",200,200,53.11,21,2,0)
substance abuse providers that is "DATA-waived". (one X, one alpha, 
"^DD",200,200,53.11,21,3,0)
7 numbers)
"^DD",200,200,53.11,21,4,0)

"^DD",200,200,53.11,21,5,0)

"^DD",200,200,53.11,21,6,0)

"^DD",200,200,53.11,"DT")
3111019
"^DD",200,200,53.2,0)
DEA#^FX^^PS;2^K:'$$VALDEA^XUSER2(X) X
"^DD",200,200,53.2,1,0)
^.1^^-1
"^DD",200,200,53.2,1,1,0)
200^PS1
"^DD",200,200,53.2,1,1,1)
S ^VA(200,"PS1",$E(X,1,30),DA)=""
"^DD",200,200,53.2,1,1,2)
K ^VA(200,"PS1",$E(X,1,30),DA)
"^DD",200,200,53.2,1,1,3)
Lookup providers by their DEA number
"^DD",200,200,53.2,1,1,"%D",0)
^^1^1^2931208^^
"^DD",200,200,53.2,1,1,"%D",1,0)
This was 'APS1' before.  Also used to stop duplicate numbers.
"^DD",200,200,53.2,1,1,"DT")
2930924
"^DD",200,200,53.2,3)
Enter the DEA number 2 letters 7 numbers.
"^DD",200,200,53.2,4)
W:$X>5 ! W ?5,"Enter the DEA number as two upper case letters followed by 7 digits",!,?5,"e.g. AA1234567.  Each provider must have a unique number.",!
"^DD",200,200,53.2,20,0)
^.3LA^1^1
"^DD",200,200,53.2,20,1,0)
PS
"^DD",200,200,53.2,20,2,0)
PSO
"^DD",200,200,53.2,21,0)
^.001^4^4^3120828^^^^
"^DD",200,200,53.2,21,1,0)
This field is used to enter the Drug Enforcement Agency (DEA) number.
"^DD",200,200,53.2,21,2,0)
Enter the DEA number as two upper case letters followed by 7 digits.
"^DD",200,200,53.2,21,3,0)
e.g., AA1234567.  Each provider must have a unique number.
"^DD",200,200,53.2,21,4,0)

"^DD",200,200,53.2,23,0)
^.001^22^22^3120828^^^^
"^DD",200,200,53.2,23,1,0)
This is the algorithm for the DEA number checking.
"^DD",200,200,53.2,23,2,0)

"^DD",200,200,53.2,23,3,0)
The first letter for practitioners (physicians, dentists, veterinarians,
"^DD",200,200,53.2,23,4,0)
pharmacies etc.) is either an "A" or "B"
"^DD",200,200,53.2,23,5,0)
 
"^DD",200,200,53.2,23,6,0)
The second letter should be the first letter of the practitioner's last
"^DD",200,200,53.2,23,7,0)
name.  Sometimes this does not match if the registrant changed their name 
"^DD",200,200,53.2,23,8,0)
or the DEA did not get it correct the first time.
"^DD",200,200,53.2,23,9,0)
 
"^DD",200,200,53.2,23,10,0)
The check digit algorithm is as follows:
"^DD",200,200,53.2,23,11,0)
 
"^DD",200,200,53.2,23,12,0)
AS1234563
"^DD",200,200,53.2,23,13,0)
 
"^DD",200,200,53.2,23,14,0)
1 + 3 + 5 =   9
"^DD",200,200,53.2,23,15,0)
2 + 4 + 6 = 12 x 2 = 24
"^DD",200,200,53.2,23,16,0)
 
"^DD",200,200,53.2,23,17,0)
9 + 24 = 33
"^DD",200,200,53.2,23,18,0)
 
"^DD",200,200,53.2,23,19,0)
The last digit of the total must equal the check digit (the last
"^DD",200,200,53.2,23,20,0)
digit of the DEA number).
"^DD",200,200,53.2,23,21,0)
(33#10)=$E("AS1234563",9)
"^DD",200,200,53.2,23,22,0)

"^DD",200,200,53.2,"DT")
3021223
"^DD",200,200,53.3,0)
VA#^FX^^PS;3^S X=$$UP^XLFSTR(X) K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<3)!(X[" ") X D VANUM^XUSER2
"^DD",200,200,53.3,1,0)
^.1^^-1
"^DD",200,200,53.3,1,1,0)
200^PS2
"^DD",200,200,53.3,1,1,1)
S ^VA(200,"PS2",$E(X,1,30),DA)=""
"^DD",200,200,53.3,1,1,2)
K ^VA(200,"PS2",$E(X,1,30),DA)
"^DD",200,200,53.3,1,1,3)
Lookup providers by their VA number
"^DD",200,200,53.3,1,1,"%D",0)
^^1^1^2931208^^
"^DD",200,200,53.3,1,1,"%D",1,0)
This was 'APS2' before. Also used to stop duplicate numbers.
"^DD",200,200,53.3,1,1,"DT")
2930924
"^DD",200,200,53.3,3)
Enter the VA number 3 to 10 characters with NO spaces.
"^DD",200,200,53.3,4)
D EN^DDIOL("Enter the VA number.  VA number must be unique among active providers.",,"!,?5")
"^DD",200,200,53.3,20,0)
^.3LA^1^1
"^DD",200,200,53.3,20,1,0)
PS
"^DD",200,200,53.3,20,2,0)
PSO
"^DD",200,200,53.3,21,0)
^^2^2^3021210^
"^DD",200,200,53.3,21,1,0)
This field is used to enter the VA number.
"^DD",200,200,53.3,21,2,0)
The VA number must be unique.
"^DD",200,200,53.3,"DT")
3121018
"^DD",200,200,55.1,0)
SCHEDULE II NARCOTIC^S^1:Yes;0:No;^PS3;1^Q
"^DD",200,200,55.1,3)
Provider has privileges for schedule II narcotic?
"^DD",200,200,55.1,21,0)
^.001^2^2^3120828^^^^
"^DD",200,200,55.1,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.1,21,2,0)
Schedule II narcotic.
"^DD",200,200,55.1,"DT")
3111019
"^DD",200,200,55.2,0)
SCHEDULE II NON-NARCOTIC^S^1:Yes;0:No;^PS3;2^Q
"^DD",200,200,55.2,3)
Provider has privileges for schedule II non-narcotic?
"^DD",200,200,55.2,21,0)
^.001^2^2^3111019^^^^
"^DD",200,200,55.2,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.2,21,2,0)
Schedule II non-narcotic.
"^DD",200,200,55.2,"DT")
3111019
"^DD",200,200,55.3,0)
SCHEDULE III NARCOTIC^S^1:Yes;0:No;^PS3;3^Q
"^DD",200,200,55.3,3)
Provider has privileges for schedule III narcotic?
"^DD",200,200,55.3,21,0)
^.001^2^2^3111019^^^
"^DD",200,200,55.3,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.3,21,2,0)
Schedule III narcotic.
"^DD",200,200,55.3,"DT")
3111019
"^DD",200,200,55.4,0)
SCHEDULE III NON-NARCOTIC^S^1:Yes;0:No;^PS3;4^Q
"^DD",200,200,55.4,3)
Provider has privileges for schedule III non-narcotic?
"^DD",200,200,55.4,21,0)
^.001^2^2^3111019^^^
"^DD",200,200,55.4,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.4,21,2,0)
Schedule III non-narcotic.
"^DD",200,200,55.4,"DT")
3111019
"^DD",200,200,55.5,0)
SCHEDULE IV^S^1:Yes;0:No;^PS3;5^Q
"^DD",200,200,55.5,3)
Provider has privileges for schedule IV?
"^DD",200,200,55.5,21,0)
^.001^2^2^3111019^^^
"^DD",200,200,55.5,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.5,21,2,0)
Schedule IV controlled substances.
"^DD",200,200,55.5,"DT")
3111019
"^DD",200,200,55.6,0)
SCHEDULE V^S^1:Yes;0:No;^PS3;6^Q
"^DD",200,200,55.6,3)
Provider has privileges for schedule V?
"^DD",200,200,55.6,21,0)
^.001^2^2^3111019^^
"^DD",200,200,55.6,21,1,0)
This field is used to determine if the provider has privileges for 
"^DD",200,200,55.6,21,2,0)
Schedule V controlled substances.
"^DD",200,200,55.6,"DT")
3111019
"^DD",200,200,501.2,0)
SUBJECT ALTERNATIVE NAME^FaX^^501;2^K:$L(X)>50!($L(X)<3)!'(X["@") X I $D(X) N XUSSAN S XUSSAN=$O(^VA(200,"ASAN",X,"")) K:(XUSSAN>0)&(XUSSAN'=DA) X
"^DD",200,200,501.2,1,0)
^.1
"^DD",200,200,501.2,1,1,0)
^^BULLETIN MESSAGE
"^DD",200,200,501.2,1,1,1)
Q
"^DD",200,200,501.2,1,1,2)
S Y(0)=X,D0=DA X "N DIIND F DIIND=2.001:.001 Q:$D(^DD(200,501.2,1,1,DIIND))[0  X ^(DIIND)" K XMY S XMB="XUSSPKI SAN" D BULL^XUSER D ^XMB:$D(^XMB(3.6,"B",XMB)) K Y,XMB
"^DD",200,200,501.2,1,1,2.001)
S X=Y(0) S X=X S XMB(1)=X
"^DD",200,200,501.2,1,1,2.002)
S X=Y(0) S Y(1)=$S($D(^VA(200,D0,501)):^(501),1:"") S X=$P(Y(1),U,2) S XMB(2)=X
"^DD",200,200,501.2,1,1,2.003)
S X=Y(0) S Y(1)=$S($D(^VA(200,D0,0)):^(0),1:"") S X=$P(Y(1),U,1) S XMB(3)=X
"^DD",200,200,501.2,1,1,3)
This cross-reference must not be deleted because it has special code in DD.
"^DD",200,200,501.2,1,1,"%D",0)
^^4^4^3120822^
"^DD",200,200,501.2,1,1,"%D",1,0)
When the Subject Alternative Name field in file #200 is either modified or
"^DD",200,200,501.2,1,1,"%D",2,0)
deleted, this bulletin will be fired off.  Users holding the PSDMGR key
"^DD",200,200,501.2,1,1,"%D",3,0)
will receive this bulletin.  This cross reference must not be deleted
"^DD",200,200,501.2,1,1,"%D",4,0)
because it contains special code in the DD that calls BULL^XUSER.
"^DD",200,200,501.2,1,1,"CREATE VALUE")
NO EFFECT
"^DD",200,200,501.2,1,1,"DELETE PARAMETER #1")
OLD SUBJECT ALTERNATIVE NAME
"^DD",200,200,501.2,1,1,"DELETE PARAMETER #2")
SUBJECT ALTERNATIVE NAME
"^DD",200,200,501.2,1,1,"DELETE PARAMETER #3")
NAME
"^DD",200,200,501.2,1,1,"DELETE VALUE")
XUSSPKI SAN
"^DD",200,200,501.2,1,2,0)
200^ASAN
"^DD",200,200,501.2,1,2,1)
S ^VA(200,"ASAN",$E(X,1,30),DA)=""
"^DD",200,200,501.2,1,2,2)
K ^VA(200,"ASAN",$E(X,1,30),DA)
"^DD",200,200,501.2,1,2,3)
This cross-reference is used to insure that all Subject Alternative Name entries are unique and is required by the DEA electronic-Prescribing of Controlled Substances rules.
"^DD",200,200,501.2,1,2,"%D",0)
^.101^2^2^3130321^^^
"^DD",200,200,501.2,1,2,"%D",1,0)
This is a cross-reference used to insure that the Subject Alternative Name entries are unique as required by DEA rules for electronic-Prescribing of Controlled Substances.  
"^DD",200,200,501.2,1,2,"%D",2,0)

"^DD",200,200,501.2,1,2,"DT")
3130321
"^DD",200,200,501.2,3)
Answer must be 3-50 characters in length and contain an '@' character and be unique in the file
"^DD",200,200,501.2,21,0)
^.001^12^12^3130321^^^^
"^DD",200,200,501.2,21,1,0)
This is a name from the PIV card field SUBJECT ALTERNATIVE NAME
"^DD",200,200,501.2,21,2,0)
also known as USER PRINCIPLE NAME. 
"^DD",200,200,501.2,21,3,0)
 
"^DD",200,200,501.2,21,4,0)
The subject alternative name extension allows identities to be bound
"^DD",200,200,501.2,21,5,0)
to the subject of the certificate.  These identities may be included
"^DD",200,200,501.2,21,6,0)
in addition to or in place of the identity in the subject field of
"^DD",200,200,501.2,21,7,0)
the certificate.  Subject alternative name is defined by an Internet 
"^DD",200,200,501.2,21,8,0)
electronic mail address.
"^DD",200,200,501.2,21,9,0)
 
"^DD",200,200,501.2,21,10,0)
When the subjectAltName extension contains an Internet mail address,
"^DD",200,200,501.2,21,11,0)
the address MUST be stored in the rfc822Name.
"^DD",200,200,501.2,21,12,0)

"^DD",200,200,501.2,23,0)
^.001^3^3^3130321^^^^
"^DD",200,200,501.2,23,1,0)
This field has a bulletin type xref that must not be deleted because 
"^DD",200,200,501.2,23,2,0)
it contains special code in the DD.  The code will call BULL^XUSER then 
"^DD",200,200,501.2,23,3,0)
fire off bulletins to users holding the PSDMGR key.
"^DD",200,200,501.2,"AUDIT")
y
"^DD",200,200,501.2,"DT")
3130321
"^DD",8991.6,8991.6,0)
FIELD^^.06^6
"^DD",8991.6,8991.6,0,"DT")
3111125
"^DD",8991.6,8991.6,0,"IX","B",8991.6,.01)

"^DD",8991.6,8991.6,0,"IX","C",8991.6,.02)

"^DD",8991.6,8991.6,0,"IX","DT",8991.6,.06)

"^DD",8991.6,8991.6,0,"NM","XUEPCS DATA")

"^DD",8991.6,8991.6,.01,0)
NAME^RP200'^VA(200,^0;1^Q
"^DD",8991.6,8991.6,.01,1,0)
^.1
"^DD",8991.6,8991.6,.01,1,1,0)
8991.6^B
"^DD",8991.6,8991.6,.01,1,1,1)
S ^XTV(8991.6,"B",$E(X,1,30),DA)=""
"^DD",8991.6,8991.6,.01,1,1,2)
K ^XTV(8991.6,"B",$E(X,1,30),DA)
"^DD",8991.6,8991.6,.01,3)
This is the user that was edited.
"^DD",8991.6,8991.6,.01,"DT")
3111125
"^DD",8991.6,8991.6,.02,0)
EDITED BY^RP200'^VA(200,^0;2^Q
"^DD",8991.6,8991.6,.02,1,0)
^.1
"^DD",8991.6,8991.6,.02,1,1,0)
8991.6^C
"^DD",8991.6,8991.6,.02,1,1,1)
S ^XTV(8991.6,"C",$E(X,1,30),DA)=""
"^DD",8991.6,8991.6,.02,1,1,2)
K ^XTV(8991.6,"C",$E(X,1,30),DA)
"^DD",8991.6,8991.6,.02,1,1,3)
THIS DATA SHOULD BE RETAINED
"^DD",8991.6,8991.6,.02,1,1,"%D",0)
^^1^1^3111125^
"^DD",8991.6,8991.6,.02,1,1,"%D",1,0)
Provides a cross-reference on the editor of the data.
"^DD",8991.6,8991.6,.02,1,1,"DT")
3111125
"^DD",8991.6,8991.6,.02,3)
This is the individual in file 200 that did the editing
"^DD",8991.6,8991.6,.02,21,0)
^.001^2^2^3120307^^^
"^DD",8991.6,8991.6,.02,21,1,0)
This field captures the internal entry number in file 200 of the 
"^DD",8991.6,8991.6,.02,21,2,0)
individual who did the editing.
"^DD",8991.6,8991.6,.02,"DT")
3111125
"^DD",8991.6,8991.6,.03,0)
FIELD EDITED^RFO^^0;3^K:$L(X)>10!($L(X)<1) X
"^DD",8991.6,8991.6,.03,2)
S Y(0)=Y S:Y'="" Y=$P(^DD(200,+Y,0),U)
"^DD",8991.6,8991.6,.03,2.1)
S:Y'="" Y=$P(^DD(200,+Y,0),U)
"^DD",8991.6,8991.6,.03,3)
This field contains the field number in file 200 of the field that was edited.
"^DD",8991.6,8991.6,.03,"DT")
3120823
"^DD",8991.6,8991.6,.04,0)
ORIGINAL DATA^RF^^0;4^K:$L(X)>50!($L(X)<1) X
"^DD",8991.6,8991.6,.04,3)
This field contains the original data value before editing
"^DD",8991.6,8991.6,.04,"DT")
3111125
"^DD",8991.6,8991.6,.05,0)
EDITED DATA^RF^^0;5^K:$L(X)>50!($L(X)<1) X
"^DD",8991.6,8991.6,.05,3)
This field contains the value for the edited field after editing was completed.
"^DD",8991.6,8991.6,.05,"DT")
3111125
"^DD",8991.6,8991.6,.06,0)
DATE/TIME EDITED^RD^^0;6^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X
"^DD",8991.6,8991.6,.06,1,0)
^.1
"^DD",8991.6,8991.6,.06,1,1,0)
8991.6^DT
"^DD",8991.6,8991.6,.06,1,1,1)
S ^XTV(8991.6,"DT",$E(X,1,30),DA)=""
"^DD",8991.6,8991.6,.06,1,1,2)
K ^XTV(8991.6,"DT",$E(X,1,30),DA)
"^DD",8991.6,8991.6,.06,1,1,"%D",0)
^^2^2^3120927^
"^DD",8991.6,8991.6,.06,1,1,"%D",1,0)
This xref is for date/time edited.
"^DD",8991.6,8991.6,.06,1,1,"%D",2,0)

"^DD",8991.6,8991.6,.06,1,1,"DT")
3120927
"^DD",8991.6,8991.6,.06,3)
This is the date/time that the editing occurred.
"^DD",8991.6,8991.6,.06,"DT")
3120927
"^DD",8991.7,8991.7,0)
FIELD^^.04^4
"^DD",8991.7,8991.7,0,"DDA")
N
"^DD",8991.7,8991.7,0,"DT")
3120309
"^DD",8991.7,8991.7,0,"IX","B",8991.7,.01)

"^DD",8991.7,8991.7,0,"IX","C",8991.7,.02)

"^DD",8991.7,8991.7,0,"IX","DT",8991.7,.04)

"^DD",8991.7,8991.7,0,"NM","XUEPCS PSDRPH AUDIT")

"^DD",8991.7,8991.7,.01,0)
NAME^RP200'^VA(200,^0;1^Q
"^DD",8991.7,8991.7,.01,1,0)
^.1
"^DD",8991.7,8991.7,.01,1,1,0)
8991.7^B
"^DD",8991.7,8991.7,.01,1,1,1)
S ^XTV(8991.7,"B",$E(X,1,30),DA)=""
"^DD",8991.7,8991.7,.01,1,1,2)
K ^XTV(8991.7,"B",$E(X,1,30),DA)
"^DD",8991.7,8991.7,.01,3)
Select the user who was edited.
"^DD",8991.7,8991.7,.01,21,0)
^^1^1^3120308^
"^DD",8991.7,8991.7,.01,21,1,0)
This is the user who was edited.
"^DD",8991.7,8991.7,.01,"DT")
3120307
"^DD",8991.7,8991.7,.02,0)
EDITED BY^RP200'^VA(200,^0;2^Q
"^DD",8991.7,8991.7,.02,1,0)
^.1
"^DD",8991.7,8991.7,.02,1,1,0)
8991.7^C
"^DD",8991.7,8991.7,.02,1,1,1)
S ^XTV(8991.7,"C",$E(X,1,30),DA)=""
"^DD",8991.7,8991.7,.02,1,1,2)
K ^XTV(8991.7,"C",$E(X,1,30),DA)
"^DD",8991.7,8991.7,.02,1,1,"%D",0)
^^1^1^3120308^
"^DD",8991.7,8991.7,.02,1,1,"%D",1,0)
Provide a cross reference on the editor of the data.
"^DD",8991.7,8991.7,.02,1,1,"DT")
3120308
"^DD",8991.7,8991.7,.02,3)
Select the user who did the editing.
"^DD",8991.7,8991.7,.02,21,0)
^^1^1^3120308^
"^DD",8991.7,8991.7,.02,21,1,0)
This is the user who did the editing.
"^DD",8991.7,8991.7,.02,"DT")
3120308
"^DD",8991.7,8991.7,.03,0)
ALLOCATION STATUS^RS^0:DE-ALLOCATED;1:ALLOCATED;^0;3^Q
"^DD",8991.7,8991.7,.03,3)
Choose the allocation status.
"^DD",8991.7,8991.7,.03,21,0)
^.001^2^2^3120309^^^^
"^DD",8991.7,8991.7,.03,21,1,0)
This field determines if the PSDRPH key was allocated or de-allocated to 
"^DD",8991.7,8991.7,.03,21,2,0)
the user.
"^DD",8991.7,8991.7,.03,"DT")
3120309
"^DD",8991.7,8991.7,.04,0)
DATE/TIME EDITED^RD^^0;4^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X
"^DD",8991.7,8991.7,.04,1,0)
^.1
"^DD",8991.7,8991.7,.04,1,1,0)
8991.7^DT
"^DD",8991.7,8991.7,.04,1,1,1)
S ^XTV(8991.7,"DT",$E(X,1,30),DA)=""
"^DD",8991.7,8991.7,.04,1,1,2)
K ^XTV(8991.7,"DT",$E(X,1,30),DA)
"^DD",8991.7,8991.7,.04,1,1,"DT")
3120927
"^DD",8991.7,8991.7,.04,3)
Enter the date/time that the editing occurred.
"^DD",8991.7,8991.7,.04,21,0)
^^1^1^3120313^
"^DD",8991.7,8991.7,.04,21,1,0)
This field records the date/time the editing occurred.
"^DD",8991.7,8991.7,.04,"DT")
3120927
"^DIC",8991.6,8991.6,0)
XUEPCS DATA^8991.6
"^DIC",8991.6,8991.6,0,"GL")
^XTV(8991.6,
"^DIC",8991.6,"B","XUEPCS DATA",8991.6)

"^DIC",8991.7,8991.7,0)
XUEPCS PSDRPH AUDIT^8991.7
"^DIC",8991.7,8991.7,0,"GL")
^XTV(8991.7,
"^DIC",8991.7,8991.7,"%D",0)
^^2^2^3120308^
"^DIC",8991.7,8991.7,"%D",1,0)
This file is used for the ePCS DEA project and it stores audit data. Data
"^DIC",8991.7,8991.7,"%D",2,0)
is stored when a user is allocated or de-allocated the 'PSDRPH' key.
"^DIC",8991.7,"B","XUEPCS PSDRPH AUDIT",8991.7)

**INSTALL NAME**
OR*3.0*218
"BLD",8459,0)
OR*3.0*218^ORDER ENTRY/RESULTS REPORTING^0^3130402^y
"BLD",8459,1,0)
^^3^3^3121017^
"BLD",8459,1,1,0)
CONTAINS COMPONENTS NEEDED TO COMPLETE THE PRE-INSTALLATION OF
"BLD",8459,1,2,0)
COMPUTERIZED PATIENT RECORD SYSTEM (CPRS) VERSION 29. REFER TO THE PATCH
"BLD",8459,1,3,0)
DESCRIPTION FOR INSTALLATION INSTRUCTIONS AND COMPONENT INFORMATION.
"BLD",8459,4,0)
^9.64PA^100.7^1
"BLD",8459,4,100.7,0)
100.7
"BLD",8459,4,100.7,222)
y^y^f^^^^n
"BLD",8459,4,"B",100.7,100.7)

"BLD",8459,6.3)
87
"BLD",8459,"INI")
PRE^ORY218
"BLD",8459,"INID")
^y^n
"BLD",8459,"INIT")
POST^ORY218
"BLD",8459,"KRN",0)
^9.67PA^779.2^20
"BLD",8459,"KRN",.4,0)
.4
"BLD",8459,"KRN",.401,0)
.401
"BLD",8459,"KRN",.402,0)
.402
"BLD",8459,"KRN",.403,0)
.403
"BLD",8459,"KRN",.5,0)
.5
"BLD",8459,"KRN",.84,0)
.84
"BLD",8459,"KRN",3.6,0)
3.6
"BLD",8459,"KRN",3.8,0)
3.8
"BLD",8459,"KRN",9.2,0)
9.2
"BLD",8459,"KRN",9.8,0)
9.8
"BLD",8459,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",8459,"KRN",9.8,"NM",1,0)
ORDEA01^^0^B39471115
"BLD",8459,"KRN",9.8,"NM",2,0)
ORUTL^^0^B53928458
"BLD",8459,"KRN",9.8,"NM",3,0)
ORDEA01A^^0^B172812749
"BLD",8459,"KRN",9.8,"NM",4,0)
ORDEA01B^^0^B16135241
"BLD",8459,"KRN",9.8,"NM","B","ORDEA01",1)

"BLD",8459,"KRN",9.8,"NM","B","ORDEA01A",3)

"BLD",8459,"KRN",9.8,"NM","B","ORDEA01B",4)

"BLD",8459,"KRN",9.8,"NM","B","ORUTL",2)

"BLD",8459,"KRN",19,0)
19
"BLD",8459,"KRN",19,"NM",0)
^9.68A^12^5
"BLD",8459,"KRN",19,"NM",2,0)
OR EPCS MENU^^0
"BLD",8459,"KRN",19,"NM",4,0)
OR EPCS SITE PARAMETER^^0
"BLD",8459,"KRN",19,"NM",5,0)
OR EPCS USERS PARAMETER^^0
"BLD",8459,"KRN",19,"NM",11,0)
OR EPCS PROVIDER CONFIG CHECK^^0
"BLD",8459,"KRN",19,"NM",12,0)
OR EPCS VALIDATION REPORTS^^0
"BLD",8459,"KRN",19,"NM","B","OR EPCS MENU",2)

"BLD",8459,"KRN",19,"NM","B","OR EPCS PROVIDER CONFIG CHECK",11)

"BLD",8459,"KRN",19,"NM","B","OR EPCS SITE PARAMETER",4)

"BLD",8459,"KRN",19,"NM","B","OR EPCS USERS PARAMETER",5)

"BLD",8459,"KRN",19,"NM","B","OR EPCS VALIDATION REPORTS",12)

"BLD",8459,"KRN",19.1,0)
19.1
"BLD",8459,"KRN",19.1,"NM",0)
^9.68A^2^2
"BLD",8459,"KRN",19.1,"NM",1,0)
OREPCSSITE^^0
"BLD",8459,"KRN",19.1,"NM",2,0)
OREPCSUSERS^^0
"BLD",8459,"KRN",19.1,"NM","B","OREPCSSITE",1)

"BLD",8459,"KRN",19.1,"NM","B","OREPCSUSERS",2)

"BLD",8459,"KRN",101,0)
101
"BLD",8459,"KRN",409.61,0)
409.61
"BLD",8459,"KRN",771,0)
771
"BLD",8459,"KRN",779.2,0)
779.2
"BLD",8459,"KRN",870,0)
870
"BLD",8459,"KRN",8989.51,0)
8989.51
"BLD",8459,"KRN",8989.52,0)
8989.52
"BLD",8459,"KRN",8994,0)
8994
"BLD",8459,"KRN","B",.4,.4)

"BLD",8459,"KRN","B",.401,.401)

"BLD",8459,"KRN","B",.402,.402)

"BLD",8459,"KRN","B",.403,.403)

"BLD",8459,"KRN","B",.5,.5)

"BLD",8459,"KRN","B",.84,.84)

"BLD",8459,"KRN","B",3.6,3.6)

"BLD",8459,"KRN","B",3.8,3.8)

"BLD",8459,"KRN","B",9.2,9.2)

"BLD",8459,"KRN","B",9.8,9.8)

"BLD",8459,"KRN","B",19,19)

"BLD",8459,"KRN","B",19.1,19.1)

"BLD",8459,"KRN","B",101,101)

"BLD",8459,"KRN","B",409.61,409.61)

"BLD",8459,"KRN","B",771,771)

"BLD",8459,"KRN","B",779.2,779.2)

"BLD",8459,"KRN","B",870,870)

"BLD",8459,"KRN","B",8989.51,8989.51)

"BLD",8459,"KRN","B",8989.52,8989.52)

"BLD",8459,"KRN","B",8994,8994)

"BLD",8459,"PRE")

"BLD",8459,"QUES",0)
^9.62^^0
"BLD",8459,"REQB",0)
^9.611^1^1
"BLD",8459,"REQB",1,0)
OR*3.0*280^2
"BLD",8459,"REQB","B","OR*3.0*280",1)

"FIA",100.7)
OE/RR EPCS PARAMETERS
"FIA",100.7,0)
^ORD(100.7,
"FIA",100.7,0,0)
100.7P
"FIA",100.7,0,1)
y^y^f^^^^n
"FIA",100.7,0,10)

"FIA",100.7,0,11)

"FIA",100.7,0,"RLRO")

"FIA",100.7,0,"VR")
3.0^OR
"FIA",100.7,100.7)
0
"FIA",100.7,100.71)
0
"INI")
PRE^ORY218
"INIT")
POST^ORY218
"KRN",19,14108,-1)
0^4
"KRN",19,14108,0)
OR EPCS SITE PARAMETER^ePCS Site Enable/Disable^^R^^OREPCSSITE^^^^^^ORDER ENTRY/RESULTS REPORTING^^
"KRN",19,14108,1,0)
^19.06^2^2^3130116^^
"KRN",19,14108,1,1,0)
Allows users to enable or disable CPRS' ePCS functionality at the site 
"KRN",19,14108,1,2,0)
level.
"KRN",19,14108,20)

"KRN",19,14108,25)
SITE^ORDEA01
"KRN",19,14108,"U")
EPCS SITE ENABLE/DISABLE
"KRN",19,14109,-1)
0^5
"KRN",19,14109,0)
OR EPCS USERS PARAMETER^ePCS User Enable/Disable^^R^^OREPCSUSERS^^^^^^ORDER ENTRY/RESULTS REPORTING^^^^1
"KRN",19,14109,1,0)
^19.06^2^2^3130116^^^
"KRN",19,14109,1,1,0)
Allows users to enable or disable CPRS' ePCS functionality at the user 
"KRN",19,14109,1,2,0)
level.
"KRN",19,14109,3)
XUEPCSEDIT
"KRN",19,14109,20)

"KRN",19,14109,25)
USER^ORDEA01
"KRN",19,14109,"U")
EPCS USER ENABLE/DISABLE
"KRN",19,14110,-1)
0^2
"KRN",19,14110,0)
OR EPCS MENU^GUI ePCS Management Menu^^M^^^^^^^^ORDER ENTRY/RESULTS REPORTING
"KRN",19,14110,1,0)
^19.06^2^2^3130214^^
"KRN",19,14110,1,1,0)
This menu contains all of the options needed to manage the electronic 
"KRN",19,14110,1,2,0)
Prescribing of Controlled Substances (ePCS) functionality in CPRS.
"KRN",19,14110,10,0)
^19.01IP^6^4
"KRN",19,14110,10,1,0)
14108^SITE^1
"KRN",19,14110,10,1,"^")
OR EPCS SITE PARAMETER
"KRN",19,14110,10,2,0)
14109^USER^2
"KRN",19,14110,10,2,"^")
OR EPCS USERS PARAMETER
"KRN",19,14110,10,5,0)
14149^CHK^
"KRN",19,14110,10,5,"^")
OR EPCS PROVIDER CONFIG CHECK
"KRN",19,14110,10,6,0)
14174^REP
"KRN",19,14110,10,6,"^")
OR EPCS VALIDATION REPORTS
"KRN",19,14110,99)
62867,33611
"KRN",19,14110,"U")
GUI EPCS MANAGEMENT MENU
"KRN",19,14149,-1)
0^11
"KRN",19,14149,0)
OR EPCS PROVIDER CONFIG CHECK^Check Provider ePCS Configuration^^R^^^^^^^^ORDER ENTRY/RESULTS REPORTING
"KRN",19,14149,1,0)
^19.06^3^3^3130214^^
"KRN",19,14149,1,1,0)
This option will prompt the user to select a person from the NEW PERSON 
"KRN",19,14149,1,2,0)
FILE (#200) and will detail whether that user can or cannot sign 
"KRN",19,14149,1,3,0)
controlled substance orders.
"KRN",19,14149,25)
PRVCHK^ORDEA01
"KRN",19,14149,"U")
CHECK PROVIDER EPCS CONFIGURAT
"KRN",19,14174,-1)
0^12
"KRN",19,14174,0)
OR EPCS VALIDATION REPORTS^ePCS Data Validation Reports^^R^^^^^^^^ORDER ENTRY/RESULTS REPORTING
"KRN",19,14174,1,0)
^^2^2^3130214^
"KRN",19,14174,1,1,0)
Allows the user to run a number of reports that will be used to validate 
"KRN",19,14174,1,2,0)
data necessary to ensure proper setup of the ePCS functionality.
"KRN",19,14174,25)
REPORTS^ORDEA01
"KRN",19,14174,"U")
EPCS DATA VALIDATION REPORTS
"KRN",19.1,657,-1)
0^2
"KRN",19.1,657,0)
OREPCSUSERS^OR EPCS USERS PARAMETER ACCESS^^n^0
"KRN",19.1,657,1,0)
^^2^2^3130116^
"KRN",19.1,657,1,1,0)
Users who hold this key will be allowed to execute the ePCS User 
"KRN",19.1,657,1,2,0)
Enable/Disable [OR EPCS USERS PARAMETER] option.
"KRN",19.1,657,4)

"KRN",19.1,657,5,0)
^19.15P^1^1
"KRN",19.1,657,5,1,0)
XUEPCSEDIT
"KRN",19.1,658,-1)
0^1
"KRN",19.1,658,0)
OREPCSSITE^OR EPCS SITE PARAMETER ACCESS^^n^0
"KRN",19.1,658,1,0)
^^2^2^3130116^
"KRN",19.1,658,1,1,0)
Users who hold this key will be allowed to execute the ePCS Site 
"KRN",19.1,658,1,2,0)
Enable/Disable [OR EPCS SITE PARAMETER] option.
"KRN",19.1,658,5,0)
^19.15P^1^1
"KRN",19.1,658,5,1,0)
XUEPCSEDIT
"MBREQ")
1
"ORD",3,19.1)
19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"PKG",170,-1)
1^1
"PKG",170,0)
ORDER ENTRY/RESULTS REPORTING^OR^Order Entry/Results Reporting
"PKG",170,20,0)
^9.402P^^
"PKG",170,22,0)
^9.49I^1^1
"PKG",170,22,1,0)
3.0^2971217^2980917^11712
"PKG",170,22,1,"PAH",1,0)
218^3130402^49
"PKG",170,22,1,"PAH",1,1,0)
^^3^3^3130402
"PKG",170,22,1,"PAH",1,1,1,0)
CONTAINS COMPONENTS NEEDED TO COMPLETE THE PRE-INSTALLATION OF
"PKG",170,22,1,"PAH",1,1,2,0)
COMPUTERIZED PATIENT RECORD SYSTEM (CPRS) VERSION 29. REFER TO THE PATCH
"PKG",170,22,1,"PAH",1,1,3,0)
DESCRIPTION FOR INSTALLATION INSTRUCTIONS AND COMPONENT INFORMATION.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
5
"RTN","ORDEA01")
0^1^B39471115
"RTN","ORDEA01",1,0)
ORDEA01 ;ISP/RFR - DEA TOOLS;03/20/2013  07:07
"RTN","ORDEA01",2,0)
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
"RTN","ORDEA01",3,0)
 Q
"RTN","ORDEA01",4,0)
SITE ;Edit the site-level parameter
"RTN","ORDEA01",5,0)
 N DA,SITE
"RTN","ORDEA01",6,0)
 S DA=$O(^ORD(100.7,0))
"RTN","ORDEA01",7,0)
 I +$G(DA)=0 D
"RTN","ORDEA01",8,0)
 .N FDA,ERROR,IEN
"RTN","ORDEA01",9,0)
 .S SITE=$P($$SITE^VASITE(),U,2)
"RTN","ORDEA01",10,0)
 .S FDA(100.7,"+1,",.01)=SITE,FDA(100.7,"+1,",.02)="YES"
"RTN","ORDEA01",11,0)
 .D UPDATE^DIE("E","FDA","IEN","ERROR")
"RTN","ORDEA01",12,0)
 .I $D(ERROR) D  Q
"RTN","ORDEA01",13,0)
 ..N IDX
"RTN","ORDEA01",14,0)
 ..S IDX=0 F  S IDX=$O(ERROR("DIERR",IDX)) Q:'IDX  D
"RTN","ORDEA01",15,0)
 ...W "FILEMAN ERROR #"_ERROR("DIERR",IDX)_":",!
"RTN","ORDEA01",16,0)
 ...W ERROR("DIERR",IDX,"TEXT",1)
"RTN","ORDEA01",17,0)
 .S DA=IEN(1)
"RTN","ORDEA01",18,0)
 I +$G(DA)>0,($G(SITE)="") S SITE=$$GET1^DIQ(100.7,DA_",",.01)
"RTN","ORDEA01",19,0)
 Q:+$G(DA)=0
"RTN","ORDEA01",20,0)
 W !!,"This option is used to enable or disable electronic prescribing of outpatient",!
"RTN","ORDEA01",21,0)
 W "controlled substances for your entire site. Yes enables it and No disables it.",!
"RTN","ORDEA01",22,0)
 W !,"CONFIGURING SITE "_SITE,!
"RTN","ORDEA01",23,0)
 N DIE,DR
"RTN","ORDEA01",24,0)
 S DIE="^ORD(100.7,",DR=.02
"RTN","ORDEA01",25,0)
 D ^DIE
"RTN","ORDEA01",26,0)
 Q
"RTN","ORDEA01",27,0)
USER ;Edit user-level parameter
"RTN","ORDEA01",28,0)
 N DA
"RTN","ORDEA01",29,0)
 S DA=$O(^ORD(100.7,0))
"RTN","ORDEA01",30,0)
 I +$G(DA)=0 D  Q
"RTN","ORDEA01",31,0)
 .W !!,"NO SITE CONFIGURED.",!!
"RTN","ORDEA01",32,0)
 .W "You must first run the ePCS Site Enable/Disable [OR EPCS SITE PARAMETER] option",!
"RTN","ORDEA01",33,0)
 .W "before running this option.",!
"RTN","ORDEA01",34,0)
 .H 4
"RTN","ORDEA01",35,0)
 W !!,"This option is used to enable or disable electronic prescribing of outpatient",!
"RTN","ORDEA01",36,0)
 W "controlled substances for individual users.",!
"RTN","ORDEA01",37,0)
 W !,"CONFIGURING SITE "_$$GET1^DIQ(100.7,DA_",",.01),!
"RTN","ORDEA01",38,0)
 N EXIT
"RTN","ORDEA01",39,0)
 F  D  Q:+$G(EXIT)
"RTN","ORDEA01",40,0)
 .N DIC,X,Y,DTOUT,DUOUT,IEN,ACTION,DIR,DIRUT,DIROUT
"RTN","ORDEA01",41,0)
 .S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Select the USER NAME: "
"RTN","ORDEA01",42,0)
 .D ^DIC
"RTN","ORDEA01",43,0)
 .S:+Y<1 EXIT=1
"RTN","ORDEA01",44,0)
 .Q:+Y<1
"RTN","ORDEA01",45,0)
 .S IEN=Y,ACTION=$S($D(^ORD(100.7,"C",+IEN)):"enabled^disable",1:"disabled^enable")
"RTN","ORDEA01",46,0)
 .W !!,$P(IEN,U,2)_" is currently "_$P(ACTION,U,1)_"."
"RTN","ORDEA01",47,0)
 .K X,Y
"RTN","ORDEA01",48,0)
 .S DIR(0)="Y^A",DIR("A")="Do you want to "_$P(ACTION,U,2)_" "_$P(IEN,U,2)
"RTN","ORDEA01",49,0)
 .S DIR("B")="NO"
"RTN","ORDEA01",50,0)
 .D ^DIR
"RTN","ORDEA01",51,0)
 .Q:$D(DIRUT)
"RTN","ORDEA01",52,0)
 .I Y=1 D
"RTN","ORDEA01",53,0)
 ..N FDA,ERROR,SCHEDULES,SEX
"RTN","ORDEA01",54,0)
 ..I $P(ACTION,U,1)="disabled" D
"RTN","ORDEA01",55,0)
 ...N RETURN,PROBLEM,OUTPUT,TEXT,DELIMIT,COUNT
"RTN","ORDEA01",56,0)
 ...S RETURN=$$VDEA^XUSER(.RETURN,+IEN),SEX=$$GET1^DIQ(200,+IEN_",",4),SEX=$S(SEX="MALE":"he",SEX="FEMALE":"she",1:"it")
"RTN","ORDEA01",57,0)
 ...I RETURN D
"RTN","ORDEA01",58,0)
 ....S FDA(100.71,"+1,"_DA_",",.01)=+IEN
"RTN","ORDEA01",59,0)
 ....D UPDATE^DIE("S","FDA",,"ERROR")
"RTN","ORDEA01",60,0)
 ...S PROBLEM="" F  S PROBLEM=$O(RETURN(PROBLEM)) Q:$G(PROBLEM)=""  D
"RTN","ORDEA01",61,0)
 ....I PROBLEM'["Is permitted to prescribe" D
"RTN","ORDEA01",62,0)
 .....S COUNT=+$G(COUNT)+1,PROBLEM(COUNT)=$$LOW^XLFSTR($E(PROBLEM,1))_$P($E(PROBLEM,2,*),".",1)
"RTN","ORDEA01",63,0)
 .....S:PROBLEM(COUNT)["user account status:" PROBLEM(COUNT)=$P(PROBLEM(COUNT),":",1)_" is"_$P(PROBLEM(COUNT),":",2)
"RTN","ORDEA01",64,0)
 ....S:PROBLEM["Is permitted to prescribe" SCHEDULES=$$LOW^XLFSTR($E(PROBLEM,1))_$E(PROBLEM,2,*)
"RTN","ORDEA01",65,0)
 ...S PROBLEM=+$G(COUNT)
"RTN","ORDEA01",66,0)
 ...I 'RETURN D
"RTN","ORDEA01",67,0)
 ....W !!
"RTN","ORDEA01",68,0)
 ....S DELIMIT=", "
"RTN","ORDEA01",69,0)
 ....F COUNT=1:1:PROBLEM  D
"RTN","ORDEA01",70,0)
 .....S:COUNT=PROBLEM DELIMIT=" and "
"RTN","ORDEA01",71,0)
 .....S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_PROBLEM(COUNT)
"RTN","ORDEA01",72,0)
 ....S TEXT="Cannot enable "_$P(IEN,U,2)_" to sign controlled substance orders because "_$S($E(TEXT,1,4)'="user":SEX_" ",1:"")_TEXT_"."
"RTN","ORDEA01",73,0)
 ....D WRAP^ORUTL(TEXT,"OUTPUT")
"RTN","ORDEA01",74,0)
 ....F COUNT=1:1:OUTPUT W OUTPUT(COUNT),!
"RTN","ORDEA01",75,0)
 ..I $P(ACTION,U,1)="enabled" D
"RTN","ORDEA01",76,0)
 ...S FDA(100.71,$O(^ORD(100.7,"C",+IEN,DA,0))_","_DA_",",.01)="@"
"RTN","ORDEA01",77,0)
 ...D FILE^DIE("S","FDA","ERROR")
"RTN","ORDEA01",78,0)
 ..I $D(ERROR) D
"RTN","ORDEA01",79,0)
 ...N IDX
"RTN","ORDEA01",80,0)
 ...S IDX=0 F  S IDX=$O(ERROR("DIERR",IDX)) Q:'IDX  D
"RTN","ORDEA01",81,0)
 ....W !!,"FILEMAN ERROR #"_ERROR("DIERR",IDX)_":",!
"RTN","ORDEA01",82,0)
 ....W ERROR("DIERR",IDX,"TEXT",1),!
"RTN","ORDEA01",83,0)
 ..I '$D(ERROR),($D(FDA)) D
"RTN","ORDEA01",84,0)
 ...N OUTPUT,COUNT,TEXT
"RTN","ORDEA01",85,0)
 ...S TEXT="Successfully "_$P(ACTION,U,2)_"d "_$P(IEN,U,2)
"RTN","ORDEA01",86,0)
 ...S TEXT=TEXT_$S($G(SCHEDULES)'="":" and "_SEX_" "_SCHEDULES,1:".")
"RTN","ORDEA01",87,0)
 ...D WRAP^ORUTL(TEXT,"OUTPUT")
"RTN","ORDEA01",88,0)
 ...W !!
"RTN","ORDEA01",89,0)
 ...F COUNT=1:1:OUTPUT W OUTPUT(COUNT),!
"RTN","ORDEA01",90,0)
 Q
"RTN","ORDEA01",91,0)
PRVCHK ;CHECK SINGLE PROVIDER IS PROPERLY SETUP
"RTN","ORDEA01",92,0)
 N DIC,Y,X,DTOUT,DUOUT
"RTN","ORDEA01",93,0)
 S DIC="^VA(200,",DIC(0)="AEOQ"
"RTN","ORDEA01",94,0)
 S DIC("A")="Select the provider: "
"RTN","ORDEA01",95,0)
 D ^DIC
"RTN","ORDEA01",96,0)
 Q:+Y<1
"RTN","ORDEA01",97,0)
 W !!
"RTN","ORDEA01",98,0)
 N STATUS,RETURN,TEXT,OUTPUT,LINE,LAST
"RTN","ORDEA01",99,0)
 S STATUS=$$VDEA^XUSER(.RETURN,+Y)
"RTN","ORDEA01",100,0)
 S STATUS=$$CHKSWIT(.RETURN,+Y,STATUS)
"RTN","ORDEA01",101,0)
 S TEXT="This provider is"_$S(STATUS=0:" not",1:"")_" able to write controlled substance orders"
"RTN","ORDEA01",102,0)
 I STATUS=0 S OUTPUT=2,OUTPUT(1)=TEXT_" for the",OUTPUT(2)="following reasons:"
"RTN","ORDEA01",103,0)
 I STATUS=1 S TEXT=TEXT_" and "
"RTN","ORDEA01",104,0)
 S RETURN="" F  S RETURN=$O(RETURN(RETURN)) Q:$G(RETURN)=""  D
"RTN","ORDEA01",105,0)
 .I STATUS=1 D
"RTN","ORDEA01",106,0)
 ..D WRAP^ORUTL(TEXT_"is"_$P(RETURN,"Is",2),"OUTPUT")
"RTN","ORDEA01",107,0)
 ..S TEXT=""
"RTN","ORDEA01",108,0)
 .I STATUS=0 D
"RTN","ORDEA01",109,0)
 ..I RETURN["Is permitted to prescribe" D WRAP^ORUTL("Once all of the issues above are resolved, the provider is"_$P(RETURN,"Is",2),"LAST")
"RTN","ORDEA01",110,0)
 ..I RETURN'["Is permitted to prescribe" S OUTPUT=OUTPUT+1,OUTPUT(OUTPUT)=RETURN
"RTN","ORDEA01",111,0)
 I '$D(OUTPUT) D WRAP^ORUTL(TEXT_"is permitted to prescribe any schedule.","OUTPUT")
"RTN","ORDEA01",112,0)
 F LINE=1:1:OUTPUT W OUTPUT(LINE),!
"RTN","ORDEA01",113,0)
 W:$D(LAST) !
"RTN","ORDEA01",114,0)
 F LINE=1:1:+$G(LAST) W LAST(LINE),!
"RTN","ORDEA01",115,0)
 G PRVCHK
"RTN","ORDEA01",116,0)
 Q
"RTN","ORDEA01",117,0)
CHKSWIT(RETURN,IEN,RETVAL) ;CHECK THE LITTLE SWITCH
"RTN","ORDEA01",118,0)
 I '$D(^ORD(100.7,"C",IEN)) D
"RTN","ORDEA01",119,0)
 .S RETURN("Is not an ENABLED USER in the OE/RR EPCS PARAMETERS file.")="",RETVAL=0
"RTN","ORDEA01",120,0)
 Q RETVAL
"RTN","ORDEA01",121,0)
REPORTS ;PROMPT THE USER FOR THE REPORT TO RUN
"RTN","ORDEA01",122,0)
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,REP
"RTN","ORDEA01",123,0)
 S REP("CFG")="Provider Incomplete Configuration;INCOMPL^ORDEA01A;INCOMPLQ^ORDEA01A"
"RTN","ORDEA01",124,0)
 S REP("DUP")="Duplicate VA Numbers;DUPVA^ORDEA01A;DUPVAQ^ORDEA01A"
"RTN","ORDEA01",125,0)
 S REP("DET")="DETOX/MAINTENANCE ID List;DETOX^ORDEA01A;DETOXQ^ORDEA01A"
"RTN","ORDEA01",126,0)
 S REP("LAS")="Provider Last Names Containing Punctuation;LAST^ORDEA01A;LASTQ^ORDEA01A"
"RTN","ORDEA01",127,0)
 S REP("FEE")="Fee Basis/C & A Providers Without a DEA Number;FEEDEA^ORDEA01B;FEEDEAQ^ORDEA01B"
"RTN","ORDEA01",128,0)
 S DIR(0)="SO"
"RTN","ORDEA01",129,0)
 S REP="" F  S REP=$O(REP(REP)) Q:$G(REP)=""  S $P(DIR(0),U,2)=$P(DIR(0),U,2)_REP_":"_$P(REP(REP),";")_";"
"RTN","ORDEA01",130,0)
 S DIR("A")="Select the data validation report to run"
"RTN","ORDEA01",131,0)
 D ^DIR
"RTN","ORDEA01",132,0)
 Q:$D(DIRUT)
"RTN","ORDEA01",133,0)
 Q:'$D(REP(Y))
"RTN","ORDEA01",134,0)
 S REP=Y
"RTN","ORDEA01",135,0)
 D @$P(REP(Y),";",2)
"RTN","ORDEA01",136,0)
 Q
"RTN","ORDEA01",137,0)
DISPRMPT() ;PROMPT THE USER TO INCLUDE DISUSERED AND TERMINATED USERS
"RTN","ORDEA01",138,0)
 ;RETURNS: ^ IF USER QUIT OR TIMED OUT
"RTN","ORDEA01",139,0)
 ;         OTHERWISE, THE VALUE OF VARIABLE Y
"RTN","ORDEA01",140,0)
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","ORDEA01",141,0)
 S DIR(0)="Y"_U,DIR("A",1)="Do you want to include DISUSERed and TERMINATED users"
"RTN","ORDEA01",142,0)
 S DIR("A")="in the output",DIR("B")="NO"
"RTN","ORDEA01",143,0)
 D ^DIR
"RTN","ORDEA01",144,0)
 Q:$D(DIRUT) U
"RTN","ORDEA01",145,0)
 Q Y
"RTN","ORDEA01A")
0^3^B172812749
"RTN","ORDEA01A",1,0)
ORDEA01A ;ISP/RFR - DEA REPORTS 01;03/28/2013  12:57
"RTN","ORDEA01A",2,0)
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
"RTN","ORDEA01A",3,0)
 Q
"RTN","ORDEA01A",4,0)
DUPVA ;DUPLICATE VA#'S REPORT
"RTN","ORDEA01A",5,0)
 ;REP IS HANDLED BY REPORTS^ORDEA01
"RTN","ORDEA01A",6,0)
 N DISINC,DIV,SAVE
"RTN","ORDEA01A",7,0)
 W !!,"This report identifies all users with similar VA numbers. To identify",!
"RTN","ORDEA01A",8,0)
 W "similar numbers, the software builds a temporary index. First, it removes all",!
"RTN","ORDEA01A",9,0)
 W "non-alphanumeric characters (such as punctuation and spaces) from the user's",!
"RTN","ORDEA01A",10,0)
 W "VA number, then changes all letters to uppercase, and finally adds the VA",!
"RTN","ORDEA01A",11,0)
 W "number to the temporary index. It then uses that index to build a list of",!
"RTN","ORDEA01A",12,0)
 W "similar or duplicate numbers. For example, kc123, KC 123, and KC-123 are",!
"RTN","ORDEA01A",13,0)
 W "considered similar.",!
"RTN","ORDEA01A",14,0)
 S DISINC=$$DISPRMPT^ORDEA01()
"RTN","ORDEA01A",15,0)
 Q:DISINC=U
"RTN","ORDEA01A",16,0)
 S SAVE=("DISINC")=""
"RTN","ORDEA01A",17,0)
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
"RTN","ORDEA01A",18,0)
 Q
"RTN","ORDEA01A",19,0)
DUPVAQ ;TASKMAN ENTRY POINT
"RTN","ORDEA01A",20,0)
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
"RTN","ORDEA01A",21,0)
 N DOCS,ERROR,KEY,INDEX,NUMBER,DUPL,PGNUM,COL,STOP,OUTPUT
"RTN","ORDEA01A",22,0)
 ;RETRIEVE ALL USERS WITH A VA #
"RTN","ORDEA01A",23,0)
 S DOCS=$NA(^TMP($J,"ORDUPVA")),DUPL=$NA(^TMP($J,"ORDUPVA","DUPL"))
"RTN","ORDEA01A",24,0)
 K @DOCS
"RTN","ORDEA01A",25,0)
 D LIST^DIC(200,,"@;.01;53.3","PQ",,,,"PS2",,,DOCS,"ERROR")
"RTN","ORDEA01A",26,0)
 I $D(ERROR) D  Q
"RTN","ORDEA01A",27,0)
 .D FMERROR^ORUTL(.ERROR)
"RTN","ORDEA01A",28,0)
 .S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",29,0)
 ;ORDER THE RETURNED LIST BY VA #
"RTN","ORDEA01A",30,0)
 S INDEX=0 F  S INDEX=$O(@DOCS@("DILIST",INDEX)) Q:+$G(INDEX)=0  D
"RTN","ORDEA01A",31,0)
 .S NUMBER=$P(@DOCS@("DILIST",INDEX,0),U,3),KEY=$$UP^XLFSTR(NUMBER)
"RTN","ORDEA01A",32,0)
 .S KEY=$$STRIP(KEY)
"RTN","ORDEA01A",33,0)
 .Q:$G(KEY)=""
"RTN","ORDEA01A",34,0)
 .N ACCOUNT S ACCOUNT=$$ACTIVE^XUSER($P(@DOCS@("DILIST",INDEX,0),U))
"RTN","ORDEA01A",35,0)
 .I 'DISINC,(+ACCOUNT<1),($P(ACCOUNT,U,2)'="") Q
"RTN","ORDEA01A",36,0)
 .S ACCOUNT("TEXT")=$S($P(ACCOUNT,U,2)'="":$P(ACCOUNT,U,2),ACCOUNT=0:"CANNOT SIGN ON",1:"UNKNOWN")
"RTN","ORDEA01A",37,0)
 .S @DUPL@(KEY)=+$G(@DUPL@(KEY))+1
"RTN","ORDEA01A",38,0)
 .S @DUPL@(KEY,@DUPL@(KEY),NUMBER)=$$LJ^XLFSTR($P(@DOCS@("DILIST",INDEX,0),U,2),37," ")_ACCOUNT("TEXT")
"RTN","ORDEA01A",39,0)
 ;OUTPUT THE DUPLICATES
"RTN","ORDEA01A",40,0)
 S COL(1)=$$LJ^XLFSTR("VA#",12," ")_$$LJ^XLFSTR("NAME",37," ")_"ACCOUNT STATUS"
"RTN","ORDEA01A",41,0)
 S KEY="" F  S KEY=$O(@DUPL@(KEY)) Q:$G(KEY)=""!($G(STOP))  D
"RTN","ORDEA01A",42,0)
 .I @DUPL@(KEY)>1 D
"RTN","ORDEA01A",43,0)
 ..S OUTPUT=1
"RTN","ORDEA01A",44,0)
 ..I (@DUPL@(KEY)+$Y+CBUFFER)>IOSL!($Y=0) S STOP=$$HEADER^ORUTL("NON-UNIQUE VA NUMBERS REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",45,0)
 ..Q:$G(STOP)
"RTN","ORDEA01A",46,0)
 ..S INDEX=0 F  S INDEX=$O(@DUPL@(KEY,INDEX)) Q:+$G(INDEX)=0  D
"RTN","ORDEA01A",47,0)
 ...S NUMBER=$O(@DUPL@(KEY,INDEX,""))
"RTN","ORDEA01A",48,0)
 ...W $$LJ^XLFSTR(NUMBER,12," ")_@DUPL@(KEY,INDEX,NUMBER),!
"RTN","ORDEA01A",49,0)
 ..W $$REPEAT^XLFSTR("=",60),!
"RTN","ORDEA01A",50,0)
 I '$G(STOP) D
"RTN","ORDEA01A",51,0)
 .I '$G(OUTPUT) D  Q:$G(STOP)
"RTN","ORDEA01A",52,0)
 ..S STOP=$$HEADER^ORUTL("NON-UNIQUE VA NUMBERS REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",53,0)
 ..Q:STOP
"RTN","ORDEA01A",54,0)
 ..W !,$$CJ^XLFSTR("All VA Numbers are unique.",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",55,0)
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("NON-UNIQUE VA NUMBERS REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",56,0)
 .Q:$G(STOP)
"RTN","ORDEA01A",57,0)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
"RTN","ORDEA01A",58,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",59,0)
 Q
"RTN","ORDEA01A",60,0)
STRIP(TEXT) ;REMOVE PUNCTUATION CHARACTERS AND SPACES
"RTN","ORDEA01A",61,0)
 N %
"RTN","ORDEA01A",62,0)
 F %=1:1:$L(TEXT) N CHR S CHR=$A($E(TEXT,%)) I CHR<48!(CHR>57&(CHR<65))!(CHR>90&(CHR<97))!(CHR>122) S TEXT=$TR(TEXT,$E(TEXT,%))
"RTN","ORDEA01A",63,0)
 Q TEXT
"RTN","ORDEA01A",64,0)
INCOMPL ;INCOMPLETE PROVIDER SETUP REPORT
"RTN","ORDEA01A",65,0)
 ;REP IS HANDLED BY REPORTS^ORDEA01
"RTN","ORDEA01A",66,0)
 W !!,"This report identifies all active providers who are unable to sign controlled",!
"RTN","ORDEA01A",67,0)
 W "substance orders. For the purposes of this report, a provider is a user who",!
"RTN","ORDEA01A",68,0)
 W "holds the ORES security key.",!
"RTN","ORDEA01A",69,0)
 W !,"By default, the report lists the prescribable schedules for each provider",!
"RTN","ORDEA01A",70,0)
 W "(including those providers that are properly configured).",!
"RTN","ORDEA01A",71,0)
 N INCLUDE,DISINC,DIV,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,SAVE
"RTN","ORDEA01A",72,0)
 S DIR(0)="Y"_U,DIR("A")="Do you want to include prescribable schedules in the output"
"RTN","ORDEA01A",73,0)
 S DIR("B")="NO"
"RTN","ORDEA01A",74,0)
 S DIR("?",1)="By answering YES, the report will list the schedules each provider is able to"
"RTN","ORDEA01A",75,0)
 S DIR("?",2)="prescribe and will include those providers who are able to sign controlled"
"RTN","ORDEA01A",76,0)
 S DIR("?",3)="substance orders."
"RTN","ORDEA01A",77,0)
 S DIR("?",4)="By answering NO, the report will not list the prescribable schedules and will"
"RTN","ORDEA01A",78,0)
 S DIR("?",5)="only include those providers who are unable to sign controlled substance"
"RTN","ORDEA01A",79,0)
 S DIR("?")="orders."
"RTN","ORDEA01A",80,0)
 D ^DIR
"RTN","ORDEA01A",81,0)
 Q:$D(DIRUT)
"RTN","ORDEA01A",82,0)
 S INCLUDE=Y
"RTN","ORDEA01A",83,0)
 K X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","ORDEA01A",84,0)
 W !
"RTN","ORDEA01A",85,0)
 S DISINC=$$DISPRMPT^ORDEA01()
"RTN","ORDEA01A",86,0)
 Q:DISINC=U
"RTN","ORDEA01A",87,0)
 S X=$$DIVPRMPT^ORUTL(.DIV)
"RTN","ORDEA01A",88,0)
 Q:X<1
"RTN","ORDEA01A",89,0)
 S SAVE("INCLUDE")="",SAVE("DISINC")="",SAVE("DIV(")=""
"RTN","ORDEA01A",90,0)
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
"RTN","ORDEA01A",91,0)
 Q
"RTN","ORDEA01A",92,0)
INCOMPLQ ;TASKMAN ENTRY POINT
"RTN","ORDEA01A",93,0)
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
"RTN","ORDEA01A",94,0)
 N DATA,Y,INDENT
"RTN","ORDEA01A",95,0)
 S DATA=$NA(^TMP($J,"ORDATA"))
"RTN","ORDEA01A",96,0)
 K @DATA
"RTN","ORDEA01A",97,0)
 S INDENT(0)=$$REPEAT^XLFSTR(" ",37),INDENT(1)=$$REPEAT^XLFSTR("-",34)
"RTN","ORDEA01A",98,0)
 ;IA #10076
"RTN","ORDEA01A",99,0)
 S Y=0 F  S Y=$O(^XUSEC("ORES",Y)) Q:+$G(Y)=0  D
"RTN","ORDEA01A",100,0)
 .N DIVISION S DIVISION=$$HASDIV^ORUTL(Y,.DIV)
"RTN","ORDEA01A",101,0)
 .Q:$G(DIVISION)=""
"RTN","ORDEA01A",102,0)
 .N ACCOUNT S ACCOUNT=$$ACTIVE^XUSER(Y)
"RTN","ORDEA01A",103,0)
 .I 'DISINC,(+ACCOUNT<1),($P(ACCOUNT,U,2)'="") Q
"RTN","ORDEA01A",104,0)
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
"RTN","ORDEA01A",105,0)
 .I ACCOUNT=0 S ACCOUNT=1
"RTN","ORDEA01A",106,0)
 .N RETURN,STATUS
"RTN","ORDEA01A",107,0)
 .S STATUS=$$VDEA^XUSER(.RETURN,Y)
"RTN","ORDEA01A",108,0)
 .S STATUS=$$CHKSWIT^ORDEA01(.RETURN,Y,STATUS)
"RTN","ORDEA01A",109,0)
 .I $D(RETURN)>9 D
"RTN","ORDEA01A",110,0)
 ..N REASON,NAME,LINE
"RTN","ORDEA01A",111,0)
 ..S NAME=$$LJ^XLFSTR($$GET1^DIQ(200,Y_",",.01),35," ")
"RTN","ORDEA01A",112,0)
 ..S LINE=0,INDENT=0
"RTN","ORDEA01A",113,0)
 ..S REASON="" F  S REASON=$O(RETURN(REASON)) Q:$G(REASON)=""  D
"RTN","ORDEA01A",114,0)
 ...I '$G(INCLUDE),(REASON["Is permitted") Q
"RTN","ORDEA01A",115,0)
 ...N BODY
"RTN","ORDEA01A",116,0)
 ...D WRAP^ORUTL($S('INDENT:NAME_"  ",1:INDENT(0))_REASON,"BODY")
"RTN","ORDEA01A",117,0)
 ...S INDENT=1
"RTN","ORDEA01A",118,0)
 ...S BODY=0 F  S BODY=$O(BODY(BODY)) Q:'BODY  S LINE=LINE+1,@DATA@(DIVISION,STATUS,+ACCOUNT,NAME,LINE)=BODY(BODY)
"RTN","ORDEA01A",119,0)
 ..S @DATA@(DIVISION,STATUS,+ACCOUNT,NAME)=LINE
"RTN","ORDEA01A",120,0)
 N DIVISION,NAME,LINE,STATUS,TEXT,OUTPUT,STOP,ACCOUNT,COL,PGNUM
"RTN","ORDEA01A",121,0)
 S DIVISION="" F  S DIVISION=$O(@DATA@(DIVISION)) Q:$G(DIVISION)=""!($G(STOP))  D
"RTN","ORDEA01A",122,0)
 .S COL(1)="DIVISION: "_DIVISION
"RTN","ORDEA01A",123,0)
 .F STATUS=0:1:1 D  Q:$G(STOP)
"RTN","ORDEA01A",124,0)
 ..I STATUS=1,('$G(INCLUDE)) Q
"RTN","ORDEA01A",125,0)
 ..Q:$D(@DATA@(DIVISION,STATUS))<10
"RTN","ORDEA01A",126,0)
 ..S TEXT=$S(STATUS=0:"un",1:"")_"able"
"RTN","ORDEA01A",127,0)
 ..S COL(2)=$$LJ^XLFSTR("PROVIDER NAME",37," ")_$S(TEXT="unable":"DEFICIENCY",1:"")
"RTN","ORDEA01A",128,0)
 ..S COL(2)=COL(2)_$S(TEXT="unable"&INCLUDE=1:"/",1:"")_$S(INCLUDE=1:"PRESCRIBABLE SCHEDULES",1:"")
"RTN","ORDEA01A",129,0)
 ..S STOP=$$HEADER^ORUTL("PROVIDER INCOMPLETE CONFIGURATION REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",130,0)
 ..Q:$G(STOP)
"RTN","ORDEA01A",131,0)
 ..F ACCOUNT=1:-1:0 D  Q:$G(STOP)
"RTN","ORDEA01A",132,0)
 ...Q:$D(@DATA@(DIVISION,STATUS,ACCOUNT))<10
"RTN","ORDEA01A",133,0)
 ...N BUFFER S BUFFER=@DATA@(DIVISION,STATUS,ACCOUNT,$O(@DATA@(DIVISION,STATUS,ACCOUNT,"")))
"RTN","ORDEA01A",134,0)
 ...S BUFFER=BUFFER+$S(ACCOUNT=0&($Y>4):3,ACCOUNT=0:2,1:0)
"RTN","ORDEA01A",135,0)
 ...I (BUFFER+$Y+CBUFFER)>IOSL!($Y=0) D  Q:$G(STOP)
"RTN","ORDEA01A",136,0)
 ....S STOP=$$HEADER^ORUTL("PROVIDER INCOMPLETE CONFIGURATION REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",137,0)
 ...I ACCOUNT=0 D
"RTN","ORDEA01A",138,0)
 ....W:$Y>4 !
"RTN","ORDEA01A",139,0)
 ....W $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",140,0)
 ....W $$CJ^XLFSTR(INDENT(1),$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",141,0)
 ...S NAME="" F  S NAME=$O(@DATA@(DIVISION,STATUS,ACCOUNT,NAME)) Q:$G(NAME)=""!($G(STOP))  D
"RTN","ORDEA01A",142,0)
 ....I (@DATA@(DIVISION,STATUS,ACCOUNT,NAME)+$Y+CBUFFER)>IOSL D  Q:$G(STOP)
"RTN","ORDEA01A",143,0)
 .....S STOP=$$HEADER^ORUTL("PROVIDER INCOMPLETE CONFIGURATION REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",144,0)
 ....F LINE=1:1:@DATA@(DIVISION,STATUS,ACCOUNT,NAME)  D
"RTN","ORDEA01A",145,0)
 .....W @DATA@(DIVISION,STATUS,ACCOUNT,NAME,LINE),!
"RTN","ORDEA01A",146,0)
 .....S OUTPUT=1
"RTN","ORDEA01A",147,0)
 ....W:LINE>0 !
"RTN","ORDEA01A",148,0)
 I '$G(STOP) D
"RTN","ORDEA01A",149,0)
 .I '$G(OUTPUT) D  Q:$G(STOP)
"RTN","ORDEA01A",150,0)
 ..S STOP=$$HEADER^ORUTL("PROVIDER INCOMPLETE CONFIGURATION REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",151,0)
 ..Q:STOP
"RTN","ORDEA01A",152,0)
 ..N TEXT,BODY
"RTN","ORDEA01A",153,0)
 ..S TEXT="All providers are able to sign controlled substance orders"
"RTN","ORDEA01A",154,0)
 ..I $D(DIV) D
"RTN","ORDEA01A",155,0)
 ...N IDX,STATIONS
"RTN","ORDEA01A",156,0)
 ...S IDX="" F  S IDX=$O(DIV(IDX)) Q:$G(IDX)=""  D
"RTN","ORDEA01A",157,0)
 ....N DELIMIT
"RTN","ORDEA01A",158,0)
 ....S DELIMIT=$S($O(DIV(IDX))'="":", ",1:" and ")
"RTN","ORDEA01A",159,0)
 ....S STATIONS=$S($G(STATIONS)'="":STATIONS_DELIMIT,1:"")_DIV(IDX)
"RTN","ORDEA01A",160,0)
 ...S TEXT=TEXT_" in "_STATIONS
"RTN","ORDEA01A",161,0)
 ..D WRAP^ORUTL(TEXT_".","BODY")
"RTN","ORDEA01A",162,0)
 ..S BODY=0 F  S BODY=$O(BODY(BODY)) Q:'BODY  W BODY(BODY),!
"RTN","ORDEA01A",163,0)
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("PROVIDER INCOMPLETE CONFIGURATION REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",164,0)
 .Q:$G(STOP)
"RTN","ORDEA01A",165,0)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
"RTN","ORDEA01A",166,0)
 K @DATA
"RTN","ORDEA01A",167,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",168,0)
 Q
"RTN","ORDEA01A",169,0)
DETOX ;DETOX/MAINTENANCE ID Report
"RTN","ORDEA01A",170,0)
 ;REP IS HANDLED BY REPORTS^ORDEA01
"RTN","ORDEA01A",171,0)
 N DISINC
"RTN","ORDEA01A",172,0)
 W !!,"This report identifies all users who have a DETOX/MAINTENANCE ID number",!
"RTN","ORDEA01A",173,0)
 W "in the NEW PERSON FILE (#200).",!
"RTN","ORDEA01A",174,0)
 S DISINC=$$DISPRMPT^ORDEA01()
"RTN","ORDEA01A",175,0)
 Q:DISINC=U
"RTN","ORDEA01A",176,0)
 S SAVE=("DISINC")=""
"RTN","ORDEA01A",177,0)
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
"RTN","ORDEA01A",178,0)
 Q
"RTN","ORDEA01A",179,0)
DETOXQ ;TASKMAN ENTRY POINT
"RTN","ORDEA01A",180,0)
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
"RTN","ORDEA01A",181,0)
 N DOCS,DATA,ERROR,INDEX,PGNUM,COL,STOP,ACCOUNT,OUTPUT
"RTN","ORDEA01A",182,0)
 ;RETRIEVE ALL USERS WITH A DETOX/MAINTENANCE ID NUMBER
"RTN","ORDEA01A",183,0)
 S DOCS=$NA(^TMP($J,"ORDETOX")),DATA=$NA(^TMP($J,"ORDETOXDATA"))
"RTN","ORDEA01A",184,0)
 K @DOCS,@DATA
"RTN","ORDEA01A",185,0)
 S COL(1)="                                     DETOX/MAINTENANCE"
"RTN","ORDEA01A",186,0)
 S COL(2)="NAME                                 ID NUMBER          ACCOUNT STATUS"
"RTN","ORDEA01A",187,0)
 D LIST^DIC(200,,"@;.01;53.11","PQ",,,,,"I $P($G(^VA(200,Y,""PS"")),U,11)'=""""",,DOCS,"ERROR")
"RTN","ORDEA01A",188,0)
 I $D(ERROR) D  Q
"RTN","ORDEA01A",189,0)
 .D FMERROR^ORUTL(.ERROR)
"RTN","ORDEA01A",190,0)
 .S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",191,0)
 .K @DOCS
"RTN","ORDEA01A",192,0)
 S INDEX=0 F  S INDEX=$O(@DOCS@("DILIST",INDEX)) Q:+$G(INDEX)=0  D
"RTN","ORDEA01A",193,0)
 .N ACCOUNT S ACCOUNT=$$ACTIVE^XUSER($P(@DOCS@("DILIST",INDEX,0),U))
"RTN","ORDEA01A",194,0)
 .I 'DISINC,(+ACCOUNT<1),($P(ACCOUNT,U,2)'="") Q
"RTN","ORDEA01A",195,0)
 .S ACCOUNT("TEXT")=$S($P(ACCOUNT,U,2)'="":$P(ACCOUNT,U,2),ACCOUNT=0:"CANNOT SIGN ON",1:"UNKNOWN")
"RTN","ORDEA01A",196,0)
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
"RTN","ORDEA01A",197,0)
 .I ACCOUNT=0 S ACCOUNT=1
"RTN","ORDEA01A",198,0)
 .S @DATA@(+ACCOUNT,$P(@DOCS@("DILIST",INDEX,0),U,2))=$$LJ^XLFSTR($P(@DOCS@("DILIST",INDEX,0),U,3),19,"  ")_ACCOUNT("TEXT")
"RTN","ORDEA01A",199,0)
 F ACCOUNT=1:-1:0  D  Q:$G(STOP)
"RTN","ORDEA01A",200,0)
 .Q:'$D(@DATA@(ACCOUNT))
"RTN","ORDEA01A",201,0)
 .I ACCOUNT=0 D
"RTN","ORDEA01A",202,0)
 ..I ($Y+CBUFFER+4)>IOSL!($Y=0) D  Q:$G(STOP)
"RTN","ORDEA01A",203,0)
 ...S STOP=$$HEADER^ORUTL("PROVIDERS WITH A DETOX/MAINTENANCE ID",.PGNUM,.COL)
"RTN","ORDEA01A",204,0)
 ..W !,$$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",205,0)
 ..W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$S(+$G(IOM)>0:IOM,1:80)," "),!
"RTN","ORDEA01A",206,0)
 .S NAME="" F  S NAME=$O(@DATA@(ACCOUNT,NAME)) Q:NAME=""!($G(STOP))  D
"RTN","ORDEA01A",207,0)
 ..I ($Y+CBUFFER)>IOSL!($Y=0) D  Q:$G(STOP)
"RTN","ORDEA01A",208,0)
 ...S STOP=$$HEADER^ORUTL("PROVIDERS WITH A DETOX/MAINTENANCE ID",.PGNUM,.COL)
"RTN","ORDEA01A",209,0)
 ..W $$LJ^XLFSTR(NAME,37," ")_@DATA@(ACCOUNT,NAME),!
"RTN","ORDEA01A",210,0)
 ..S OUTPUT=1
"RTN","ORDEA01A",211,0)
 I '$G(STOP) D
"RTN","ORDEA01A",212,0)
 .I '$G(OUTPUT) D  Q:$G(STOP)
"RTN","ORDEA01A",213,0)
 ..S STOP=$$HEADER^ORUTL("PROVIDERS WITH A DETOX/MAINTENANCE ID",.PGNUM,.COL)
"RTN","ORDEA01A",214,0)
 ..Q:STOP
"RTN","ORDEA01A",215,0)
 ..W !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",216,0)
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("PROVIDERS WITH A DETOX/MAINTENANCE ID",.PGNUM,.COL)
"RTN","ORDEA01A",217,0)
 .Q:$G(STOP)
"RTN","ORDEA01A",218,0)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
"RTN","ORDEA01A",219,0)
 K @DOCS,@DATA
"RTN","ORDEA01A",220,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",221,0)
 Q
"RTN","ORDEA01A",222,0)
LAST ;List those providers that contain a space and/or punctuation in the last name
"RTN","ORDEA01A",223,0)
 ;REP IS HANDLED BY REPORTS^ORDEA01
"RTN","ORDEA01A",224,0)
 W !!,"This report identifies providers with one or more space or punctuation",!
"RTN","ORDEA01A",225,0)
 W "characters in their family (last) name. These providers may not be able to",!
"RTN","ORDEA01A",226,0)
 W "link their PIV card using CPRS GUI. For these providers, someone may have",!
"RTN","ORDEA01A",227,0)
 W "to use the Data Entry for e-Prescribing Controlled Substances GUI and",!
"RTN","ORDEA01A",228,0)
 W "manually enter the subject alternative name stored on the provider's PIV",!
"RTN","ORDEA01A",229,0)
 W "card.",!!
"RTN","ORDEA01A",230,0)
 W "Additionally, it is recommended that for those providers who's NAME COMPONENTS",!
"RTN","ORDEA01A",231,0)
 W "file (#20) entry does not exactly match the value in the NAME field (#.01) in",!
"RTN","ORDEA01A",232,0)
 W "the NEW PERSON file (#200), either the NAME COMPONENTS file entry or the value",!
"RTN","ORDEA01A",233,0)
 W "in the NAME field in the NEW PERSON file are modified so that both are the same.",!
"RTN","ORDEA01A",234,0)
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DISINC,DIV,SCREEN2,SAVE
"RTN","ORDEA01A",235,0)
 S DISINC=$$DISPRMPT^ORDEA01()
"RTN","ORDEA01A",236,0)
 Q:DISINC=U
"RTN","ORDEA01A",237,0)
 W !
"RTN","ORDEA01A",238,0)
 S DIR(0)="Y"_U
"RTN","ORDEA01A",239,0)
 S DIR("A",1)="Do you want to include providers who have already linked their PIV card"
"RTN","ORDEA01A",240,0)
 S DIR("A")="with their VistA account"
"RTN","ORDEA01A",241,0)
 S DIR("B")="NO"
"RTN","ORDEA01A",242,0)
 D ^DIR
"RTN","ORDEA01A",243,0)
 Q:$D(DIRUT)
"RTN","ORDEA01A",244,0)
 I 'Y S SCREEN2="I $$GET1^DIQ(200,Y_"","",501.2)="""""
"RTN","ORDEA01A",245,0)
 S X=$$DIVPRMPT^ORUTL(.DIV)
"RTN","ORDEA01A",246,0)
 Q:X<1
"RTN","ORDEA01A",247,0)
 S SAVE("DISINC")="",SAVE("DIV(")=""
"RTN","ORDEA01A",248,0)
 S:$D(SCREEN2) SAVE("SCREEN2")=""
"RTN","ORDEA01A",249,0)
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
"RTN","ORDEA01A",250,0)
 Q
"RTN","ORDEA01A",251,0)
LASTQ ;TASKMAN ENTRY POINT
"RTN","ORDEA01A",252,0)
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
"RTN","ORDEA01A",253,0)
 N Y,OUT,DATA,REASON,PGNUM,COL,STOP,OUTPUT,DHEADER
"RTN","ORDEA01A",254,0)
 S DATA=$NA(^TMP($J,"ORLASTMP")) K @DATA
"RTN","ORDEA01A",255,0)
 S COL(2)=$$LJ^XLFSTR("PROVIDER NAME",37," ")_"ACCOUNT STATUS"
"RTN","ORDEA01A",256,0)
 S REASON="THE NAME COMPONENTS FILE (#20) ENTRY DOES NOT MATCH THE NAME FIELD (#.01) IN THE "
"RTN","ORDEA01A",257,0)
 S REASON=REASON_"NEW PERSON FILE (#200)."
"RTN","ORDEA01A",258,0)
 ;IA #10076
"RTN","ORDEA01A",259,0)
 S Y=0 F  S Y=$O(^XUSEC("ORES",Y)) Q:+$G(Y)=0  D
"RTN","ORDEA01A",260,0)
 .N STATUS S STATUS=$$ACTIVE^XUSER(Y)
"RTN","ORDEA01A",261,0)
 .I 'DISINC,(+STATUS<1),($P(STATUS,U,2)'="") Q
"RTN","ORDEA01A",262,0)
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
"RTN","ORDEA01A",263,0)
 .S STATUS("TEXT")=$S($P(STATUS,U,2)'="":$P(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")
"RTN","ORDEA01A",264,0)
 .I STATUS=0 S STATUS=1
"RTN","ORDEA01A",265,0)
 .N DIVISION S DIVISION=$$HASDIV^ORUTL(Y,.DIV)
"RTN","ORDEA01A",266,0)
 .Q:DIVISION=""
"RTN","ORDEA01A",267,0)
 .I $D(SCREEN2) X SCREEN2 I '$T Q
"RTN","ORDEA01A",268,0)
 .N ONAME,CNAME,ITEM
"RTN","ORDEA01A",269,0)
 .S ONAME=$$GET1^DIQ(200,Y_",",.01)
"RTN","ORDEA01A",270,0)
 .D NAMECOMP^XLFNAME(.ONAME)
"RTN","ORDEA01A",271,0)
 .S ONAME("STRIPPED")=$$STRIP(ONAME("FAMILY"))
"RTN","ORDEA01A",272,0)
 .S CNAME("FILE")=200,CNAME("FIELD")=.01,CNAME("IENS")=Y_","
"RTN","ORDEA01A",273,0)
 .S CNAME=$$NAMEFMT^XLFNAME(.CNAME,"F","C")
"RTN","ORDEA01A",274,0)
 .D NAMECOMP^XLFNAME(.CNAME)
"RTN","ORDEA01A",275,0)
 .S CNAME("STRIPPED")=$$STRIP(CNAME("FAMILY"))
"RTN","ORDEA01A",276,0)
 .I ONAME("FAMILY")'=ONAME("STRIPPED") S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
"RTN","ORDEA01A",277,0)
 .I ONAME("FAMILY")=ONAME("STRIPPED")&(CNAME("FAMILY")'=CNAME("STRIPPED")) D
"RTN","ORDEA01A",278,0)
 ..S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
"RTN","ORDEA01A",279,0)
 ..S @DATA@(DIVISION,+STATUS,ONAME,CNAME)=""
"RTN","ORDEA01A",280,0)
 .F ITEM="FAMILY","GIVEN","MIDDLE","SUFFIX" D
"RTN","ORDEA01A",281,0)
 ..I ONAME(ITEM)'=CNAME(ITEM) D
"RTN","ORDEA01A",282,0)
 ...S @DATA@(DIVISION,+STATUS,ONAME)=STATUS("TEXT")
"RTN","ORDEA01A",283,0)
 ...S @DATA@(DIVISION,+STATUS,ONAME,CNAME)=REASON
"RTN","ORDEA01A",284,0)
 N DIVISION S DIVISION="" F  S DIVISION=$O(@DATA@(DIVISION)) Q:$G(DIVISION)=""!($G(STOP))  D
"RTN","ORDEA01A",285,0)
 .S COL(1)="DIVISION: "_DIVISION
"RTN","ORDEA01A",286,0)
 .S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",287,0)
 .Q:STOP
"RTN","ORDEA01A",288,0)
 .S DHEADER=0
"RTN","ORDEA01A",289,0)
 .N STATUS F STATUS=1:-1:0  D  Q:STOP
"RTN","ORDEA01A",290,0)
 ..N NAME S NAME="" F  S NAME=$O(@DATA@(DIVISION,STATUS,NAME)) Q:$G(NAME)=""!(STOP)  D
"RTN","ORDEA01A",291,0)
 ...N NAMEC,OUT S NAMEC="" F  S NAMEC=$O(@DATA@(DIVISION,STATUS,NAME,NAMEC)) Q:$G(NAMEC)=""!(STOP)  D
"RTN","ORDEA01A",292,0)
 ....D WRAP^ORUTL("    NAME COMPONENTS: "_NAMEC,"OUT") S OUT=OUT+1
"RTN","ORDEA01A",293,0)
 ....I $G(@DATA@(DIVISION,STATUS,NAME,NAMEC))'="" D WRAP^ORUTL("    "_@DATA@(DIVISION,STATUS,NAME,NAMEC),"OUT")
"RTN","ORDEA01A",294,0)
 ...I ($Y+$G(OUT)+CBUFFER+$S(STATUS=0&('DHEADER):3,1:0))>IOSL D  Q:STOP
"RTN","ORDEA01A",295,0)
 ....S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",296,0)
 ...I STATUS=0,('DHEADER) D
"RTN","ORDEA01A",297,0)
 ....W:$Y>4 !
"RTN","ORDEA01A",298,0)
 ....W $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",299,0)
 ....W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",300,0)
 ....S DHEADER=1
"RTN","ORDEA01A",301,0)
 ...W $$LJ^XLFSTR(NAME,37," ")_@DATA@(DIVISION,STATUS,NAME),!
"RTN","ORDEA01A",302,0)
 ...S OUT=0 F  S OUT=$O(OUT(OUT)) Q:'OUT  W OUT(OUT),!
"RTN","ORDEA01A",303,0)
 ...S OUTPUT=1
"RTN","ORDEA01A",304,0)
 I '$G(STOP) D
"RTN","ORDEA01A",305,0)
 .I '$G(OUTPUT) D  Q:$G(STOP)
"RTN","ORDEA01A",306,0)
 ..S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",307,0)
 ..Q:STOP
"RTN","ORDEA01A",308,0)
 ..W !,$$CJ^XLFSTR("No family (last) name issues found.",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01A",309,0)
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("PROVIDER LAST NAME REPORT",.PGNUM,.COL)
"RTN","ORDEA01A",310,0)
 .Q:$G(STOP)
"RTN","ORDEA01A",311,0)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
"RTN","ORDEA01A",312,0)
 K @DATA
"RTN","ORDEA01A",313,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01A",314,0)
 Q
"RTN","ORDEA01B")
0^4^B16135241
"RTN","ORDEA01B",1,0)
ORDEA01B ;ISP/RFR - DEA REPORTS 02;03/28/2013  12:54
"RTN","ORDEA01B",2,0)
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
"RTN","ORDEA01B",3,0)
 Q
"RTN","ORDEA01B",4,0)
FEEDEA ;List those Fee Basis and C & A providers without a DEA number
"RTN","ORDEA01B",5,0)
 ;REP IS HANDLED BY REPORTS^ORDEA01
"RTN","ORDEA01B",6,0)
 W !!,"This report identifies Fee Basis and C & A providers who do not have a DEA#",!
"RTN","ORDEA01B",7,0)
 W "value in the NEW PERSON file (#200). These providers will need values entered",!
"RTN","ORDEA01B",8,0)
 W "into the DEA# (#53.2) and DEA EXPIRATION DATE (#747.44) fields in the",!
"RTN","ORDEA01B",9,0)
 W "NEW PERSON file (#200) before they can order controlled substances.",!
"RTN","ORDEA01B",10,0)
 N DISINC,DIV,SAVE,X
"RTN","ORDEA01B",11,0)
 S DISINC=$$DISPRMPT^ORDEA01()
"RTN","ORDEA01B",12,0)
 Q:DISINC=U
"RTN","ORDEA01B",13,0)
 S X=$$DIVPRMPT^ORUTL(.DIV)
"RTN","ORDEA01B",14,0)
 Q:X<1
"RTN","ORDEA01B",15,0)
 S SAVE("DISINC")="",SAVE("DIV(")=""
"RTN","ORDEA01B",16,0)
 D DEVICE^ORUTL($P(REP(REP),";",3),"OR "_$$UP^XLFSTR($P(REP(REP),";")),"Q",.SAVE)
"RTN","ORDEA01B",17,0)
 Q
"RTN","ORDEA01B",18,0)
FEEDEAQ ;TASKMAN ENTRY POINT
"RTN","ORDEA01B",19,0)
 ;CBUFFER IS HANDLED BY DEVICE^ORUTL OR TASKMAN
"RTN","ORDEA01B",20,0)
 N PROVIDERS,ERROR,IN,IDX,STATUS,DATA,PGNUM,COL,STOP,OUTPUT
"RTN","ORDEA01B",21,0)
 S IN=$NA(^TMP("DILIST",$J)) K @IN
"RTN","ORDEA01B",22,0)
 S DATA=$NA(^TMP($J,"ORFEEDATA")) K @DATA
"RTN","ORDEA01B",23,0)
 D LIST^DIC(200,,"@;.01;53.6;9.2I","P",,,,,"I ""^3^4^""[(U_$P($G(^VA(200,Y,""PS"")),U,6)_U)&($P($G(^VA(200,Y,""PS"")),U,2)="""")",,,"ERROR")
"RTN","ORDEA01B",24,0)
 I $D(ERROR) D  Q
"RTN","ORDEA01B",25,0)
 .D FMERROR^ORUTL(.ERROR)
"RTN","ORDEA01B",26,0)
 .S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01B",27,0)
 S COL(2)=$$REPEAT^XLFSTR(" ",37)_"PROVIDER   TERMINATION  ACCOUNT"
"RTN","ORDEA01B",28,0)
 S COL(3)=$$LJ^XLFSTR("PROVIDER NAME",35," ")_"    TYPE        DATE      STATUS"
"RTN","ORDEA01B",29,0)
 I '$D(@IN) D  Q
"RTN","ORDEA01B",30,0)
 .S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",31,0)
 .Q:STOP
"RTN","ORDEA01B",32,0)
 .W !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01B",33,0)
 .S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01B",34,0)
 S IDX=0 F  S IDX=$O(@IN@(IDX)) Q:+$G(IDX)=0  D
"RTN","ORDEA01B",35,0)
 .N DIVISION S DIVISION=$$HASDIV^ORUTL($P(@IN@(IDX,0),U),.DIV)
"RTN","ORDEA01B",36,0)
 .Q:DIVISION=""
"RTN","ORDEA01B",37,0)
 .N STATUS S STATUS=$$ACTIVE^XUSER($P(@IN@(IDX,0),U,1))
"RTN","ORDEA01B",38,0)
 .I 'DISINC,(+STATUS<1),($P(STATUS,U,2)'="") Q
"RTN","ORDEA01B",39,0)
 .;INCLUDE USERS WHO CANNOT SIGN-ON IN ACTIVE LISTING
"RTN","ORDEA01B",40,0)
 .S STATUS("TEXT")=$S($P(STATUS,U,2)'="":$P(STATUS,U,2),STATUS=0:"CANNOT SIGN ON",1:"UNKNOWN")
"RTN","ORDEA01B",41,0)
 .I STATUS=0 S STATUS=1
"RTN","ORDEA01B",42,0)
 .N DATE,IDATE S DATE=+$P(@IN@(IDX,0),U,4),IDATE=9999999-DATE S DATE=$$LJ^XLFSTR($S(DATE>0:$$FMTE^XLFDT(DATE,"5D"),1:""),11," ")
"RTN","ORDEA01B",43,0)
 .S @DATA@(DIVISION,+STATUS,IDATE,$P(@IN@(IDX,0),U,2))=$$LJ^XLFSTR($P(@IN@(IDX,0),U,2),35," ")_"  "_$$LJ^XLFSTR($P(@IN@(IDX,0),U,3),9)_"  "_DATE_"  "_STATUS("TEXT")
"RTN","ORDEA01B",44,0)
 N DIVISION S DIVISION="" F  S DIVISION=$O(@DATA@(DIVISION)) Q:$G(DIVISION)=""!($G(STOP))  D
"RTN","ORDEA01B",45,0)
 .S COL(1)="DIVISION: "_DIVISION
"RTN","ORDEA01B",46,0)
 .S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",47,0)
 .Q:STOP
"RTN","ORDEA01B",48,0)
 .N STATUS F STATUS=1:-1:0  D  Q:STOP
"RTN","ORDEA01B",49,0)
 ..Q:'$D(@DATA@(DIVISION,STATUS))
"RTN","ORDEA01B",50,0)
 ..I STATUS=0 D  Q:STOP
"RTN","ORDEA01B",51,0)
 ...I ($Y+4+CBUFFER)>IOSL S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",52,0)
 ...Q:STOP
"RTN","ORDEA01B",53,0)
 ...W:$Y>5 !
"RTN","ORDEA01B",54,0)
 ...W $$CJ^XLFSTR("*** DISUSERED/TERMINATED USERS ***",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01B",55,0)
 ...W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",34),$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01B",56,0)
 ..S IDATE=0 F  S IDATE=$O(@DATA@(DIVISION,STATUS,IDATE)) Q:+$G(IDATE)=0!(STOP)  D
"RTN","ORDEA01B",57,0)
 ...N NAME S NAME="" F  S NAME=$O(@DATA@(DIVISION,STATUS,IDATE,NAME)) Q:$G(NAME)=""!(STOP)  D
"RTN","ORDEA01B",58,0)
 ....I ($Y+CBUFFER)>IOSL D  Q:STOP
"RTN","ORDEA01B",59,0)
 .....S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",60,0)
 ....W @DATA@(DIVISION,STATUS,IDATE,NAME),!
"RTN","ORDEA01B",61,0)
 ....S OUTPUT=1
"RTN","ORDEA01B",62,0)
 I '$G(STOP) D
"RTN","ORDEA01B",63,0)
 .I '$G(OUTPUT) D  Q:$G(STOP)
"RTN","ORDEA01B",64,0)
 ..S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",65,0)
 ..Q:STOP
"RTN","ORDEA01B",66,0)
 ..W !,$$CJ^XLFSTR("0 PROVIDERS FOUND",$S(+$G(IOM)>0:(IOM-1),1:79)," "),!
"RTN","ORDEA01B",67,0)
 .I ($Y+2)>IOSL S STOP=$$HEADER^ORUTL("FEE BASIS/C & A PROVIDER MISSING DEA# REPORT",.PGNUM,.COL)
"RTN","ORDEA01B",68,0)
 .Q:$G(STOP)
"RTN","ORDEA01B",69,0)
 .W !,$$CJ^XLFSTR("[END OF REPORT]",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
"RTN","ORDEA01B",70,0)
 K @IN,@DATA
"RTN","ORDEA01B",71,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","ORDEA01B",72,0)
 Q
"RTN","ORUTL")
0^2^B53928458
"RTN","ORUTL",1,0)
ORUTL ;SLC/DCM,RWF - Order utilities;03/20/2013  13:11
"RTN","ORUTL",2,0)
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**95,280,218**;;Build 87
"RTN","ORUTL",3,0)
LOC ;;GET PT. LOCATION
"RTN","ORUTL",4,0)
 S C(1)=$S($D(ORL(2))#2:$S(ORL(2)[";":$S($D(@("^"_$P(ORL(2),";",2)_+ORL(2)_",0)")):$P(^(0),"^"),1:""),1:""),1:"")
"RTN","ORUTL",5,0)
 I 'OR4,ORVP[";DPT(",$D(ORL(2)),ORL(2) Q
"RTN","ORUTL",6,0)
 G:$L(C(1)) LOC1 S (CT,C)=0,O=1 I ORVP[";DPT(",$O(^DPT(+ORVP,"DE",0))>0 W !!,"Currently enrolled in the following clinics: ",!
"RTN","ORUTL",7,0)
 I  S I=0 F L=0:0 S I=$O(^DPT(+ORVP,"DE",I)) Q:I'>0  I $D(^(I,0)) S Y=^(0) I $P(Y,"^",2)'="I",'$P(Y,"^",3) I $D(^SC(+Y,0)) S X=^(0) D
"RTN","ORUTL",8,0)
 . I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),"^",2) I $S('ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) Q
"RTN","ORUTL",9,0)
 . S CT=CT+1 W:(CT#2) !?17 W:'(CT#2) ?47 W $P(X,"^") S C=C+1,C(1)=$P(X,"^") S:C'=1 C=-1
"RTN","ORUTL",10,0)
 W !
"RTN","ORUTL",11,0)
LOC1 S C=1 W !,"Patient Location: " W:C=1&($L(C(1))) C(1),"//" R X:DTIME G QUIT:'$T,QUIT:C'=1&(X=""),LOC:$L(X)>20!(X'?.ANP),QUIT:X[U
"RTN","ORUTL",12,0)
 S DIC("S")="I ""FI""'[$P(^(0),""^"",3),'$P($G(^(""OOS"")),""^"")",DIC=44,DIC(0)=$S(C=1&($L(C(1)))&(X=""):"EMQOZX",1:"EMQZ")
"RTN","ORUTL",13,0)
 S:X="" X=C(1) D ^DIC G LOC:X["?" S:Y>0 ORL=+Y_";SC(",ORL(0)=$S($L($P(Y(0),"^",2)):$P(Y(0),"^",2),1:$E($P(Y(0),"^"),1,4))
"RTN","ORUTL",14,0)
 K ORIA,ORRA I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
"RTN","ORUTL",15,0)
 I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7)," This location has been inactivated." K ORL G LOC
"RTN","ORUTL",16,0)
 I Y<0 W "  You must select a standard location." G LOC
"RTN","ORUTL",17,0)
 K DIC,C,ORIA,ORRA Q
"RTN","ORUTL",18,0)
QUIT S OREND=1 K DIC,C Q
"RTN","ORUTL",19,0)
READ ;;Hold screen
"RTN","ORUTL",20,0)
 I $D(IOST) Q:$E(IOST)'="C"
"RTN","ORUTL",21,0)
 W ! I $D(IOSL),$Y<(IOSL-4) G READ
"RTN","ORUTL",22,0)
 W !?5,"Press return to continue  " R X:$S($D(DTIME):DTIME,1:300)
"RTN","ORUTL",23,0)
 Q
"RTN","ORUTL",24,0)
CHKNAM(X,Y) ;Input transform to not allow certain characters
"RTN","ORUTL",25,0)
 ;X is the text to be checked, Y are the characters not allowed as sent in by the input transform of the field
"RTN","ORUTL",26,0)
 N I,J I '$D(Y) S Y="-;,=^" ;if no special characters sent in, set list to all
"RTN","ORUTL",27,0)
 F I=1:1:$L(Y) I X[($E(Y,I)) S J=1
"RTN","ORUTL",28,0)
 Q +$G(J)
"RTN","ORUTL",29,0)
CHKMNE(X) ;Input transform to not allow use of standard Lmgr Mnemonics
"RTN","ORUTL",30,0)
 N Y
"RTN","ORUTL",31,0)
 S Y=$$UP^XLFSTR(X) ;check to make sure mnemonic isn't set to lower case of restricted entries.  List Manager is case insensitive
"RTN","ORUTL",32,0)
 I Y="ADPL"!(Y="DN")!(Y="Q")!(Y="FS")!(Y="GO")!(Y="?")!(Y="??")!(Y="LS")!(Y="+")!(Y="-")!(Y="PL")!(Y="PS")!(Y="RD")!(Y="SL")!(Y="<")!(Y=">")!(Y="UP")!(Y="PI")!(Y="CWAD")!(Y="TD")!(Y="EX") Q 1
"RTN","ORUTL",33,0)
 Q 0
"RTN","ORUTL",34,0)
PAD(ORX,ORL) ; Pads string to specified length
"RTN","ORUTL",35,0)
 N ORY
"RTN","ORUTL",36,0)
 S ORY="",$P(ORY," ",(ORL-$L(ORX))+1)=""
"RTN","ORUTL",37,0)
 Q ORY
"RTN","ORUTL",38,0)
MAIL(XMTEXT,XMSUB,XMY,SUBSCR) ;SEND AN EMAIL
"RTN","ORUTL",39,0)
 ;PARAMETERS: XMTEXT => STRING CONTAINING NAME OF ARRAY CONTAINING MESSAGE TEXT (REQUIRED)
"RTN","ORUTL",40,0)
 ;            XMSUB  => STRING CONTAINING THE SUBJECT OF THE MESSAGE (REQUIRED)
"RTN","ORUTL",41,0)
 ;            XMY    => REFERENCE TO AN ARRAY CONTAINING THE RECIPIENTS (OPTIONAL)
"RTN","ORUTL",42,0)
 ;            SUBSCR => STRING CONTAINING THE SUBSCIPT WITHIN ^XTMP WHERE RECIPIENTS ARE STORED (OPTIONAL)
"RTN","ORUTL",43,0)
 ;RETURN: $$MAIL => STRING CONTAINING XMMG (ERROR STRING)^XMERR (NUMBER OF ERRORS)
"RTN","ORUTL",44,0)
 N XMMG,XMDUZ,XMZ,XMERR,DIFROM,ORMSG
"RTN","ORUTL",45,0)
 Q:'$D(XMTEXT)!($G(XMSUB)="")
"RTN","ORUTL",46,0)
 I $D(XMY)=0 D
"RTN","ORUTL",47,0)
 .I $G(SUBSCR)'="",($Q(^XTMP(SUBSCR,0))[SUBSCR) D  Q
"RTN","ORUTL",48,0)
 ..K ^XTMP(SUBSCR,0)
"RTN","ORUTL",49,0)
 ..M XMY=^XTMP(SUBSCR)
"RTN","ORUTL",50,0)
 ..K ^XTMP(SUBSCR)
"RTN","ORUTL",51,0)
 .I $D(ZTQUEUED)>0 D
"RTN","ORUTL",52,0)
 ..S XMY(DUZ)=""
"RTN","ORUTL",53,0)
 .E  D
"RTN","ORUTL",54,0)
 ..S ORMSG(1)=" "
"RTN","ORUTL",55,0)
 ..S ORMSG(2)="Select the recipient(s) of the report below."
"RTN","ORUTL",56,0)
 ..D MAILOUT(.ORMSG)
"RTN","ORUTL",57,0)
 N DUZ ;FORCE SENDER TO BE POSTMASTER
"RTN","ORUTL",58,0)
 D ^XMD ;ICR #10070
"RTN","ORUTL",59,0)
 K ORMSG
"RTN","ORUTL",60,0)
 I $D(XMMG)>0 D
"RTN","ORUTL",61,0)
 .S ORMSG(1)=" "
"RTN","ORUTL",62,0)
 .S ORMSG(2)="Unable to email the report:"
"RTN","ORUTL",63,0)
 .S ORMSG(3)=XMMG
"RTN","ORUTL",64,0)
 .D MAILOUT(.ORMSG)
"RTN","ORUTL",65,0)
 Q $G(XMMG)_U_$G(XMERR)
"RTN","ORUTL",66,0)
MAILOUT(MESSAGE) ;OUTPUT THE ORMSG ARRAY FROM MAIL LINE TAG
"RTN","ORUTL",67,0)
 ;IF KIDS IS NOT EXECUTING, OUTPUT THE MESSAGE TO THE SCREEN
"RTN","ORUTL",68,0)
 I $G(XPDNM)="" D
"RTN","ORUTL",69,0)
 .N LINE S LINE=0 F  S LINE=$O(MESSAGE(LINE)) Q:+$G(LINE)=0  W MESSAGE(LINE),!
"RTN","ORUTL",70,0)
 E  D MES^XPDUTL(.MESSAGE)
"RTN","ORUTL",71,0)
 Q
"RTN","ORUTL",72,0)
WRAP(ORLINE,OROUTPUT) ;WRAP THE TEXT SO THAT IT IS NO MORE THAN IOM (80 OR 132) CHARACTERS WIDE
"RTN","ORUTL",73,0)
 ;PARAMETERS: ORLINE  =>SINGLE LINE OF TEXT TO WRAP
"RTN","ORUTL",74,0)
 ;            OROUTPUT=>NAME OF ARRAY THAT WILL STORE THE WRAPPED TEXT IN THE FORMAT:
"RTN","ORUTL",75,0)
 ;                      OROUTPUT=NUMBER OF LINES OF TEXT RETURNED
"RTN","ORUTL",76,0)
 ;                      OROUTPUT(N)=LINE N OF TEXT
"RTN","ORUTL",77,0)
 N ORRETURN,ORTEMP,ORTEMP1,ORCHR,ORINDENT,ORIOM
"RTN","ORUTL",78,0)
 S @OROUTPUT=1+$G(@OROUTPUT),ORIOM=$G(IOM)
"RTN","ORUTL",79,0)
 S:ORIOM="" ORIOM=80
"RTN","ORUTL",80,0)
 I ORLINE[":",($L($P(ORLINE,":"))<ORIOM) S ORINDENT=$$REPEAT^XLFSTR(" ",$L($P(ORLINE,":"))+2)
"RTN","ORUTL",81,0)
 I ORLINE'[":",($E(ORLINE,1)=" ") D
"RTN","ORUTL",82,0)
 .F ORCHR=1:1:$L(ORLINE) Q:$E(ORLINE,ORCHR)'=" "
"RTN","ORUTL",83,0)
 .S ORINDENT=$$REPEAT^XLFSTR(" ",ORCHR-1)
"RTN","ORUTL",84,0)
 I ORLINE'[":",($E(ORLINE,1)'=" ") D
"RTN","ORUTL",85,0)
 .N START,END
"RTN","ORUTL",86,0)
 .F ORCHR=1:1:$L(ORLINE) Q:+$G(END)  D
"RTN","ORUTL",87,0)
 ..I '+$G(START),($E(ORLINE,ORCHR)=" "),($E(ORLINE,ORCHR+1)=" ") S START=1
"RTN","ORUTL",88,0)
 ..I +$G(START),($E(ORLINE,ORCHR)'=" ") S END=1
"RTN","ORUTL",89,0)
 .S:+$G(START)>0 ORINDENT=$$REPEAT^XLFSTR(" ",ORCHR-2)
"RTN","ORUTL",90,0)
 S ORTEMP=1,ORTEMP(ORTEMP)=ORLINE
"RTN","ORUTL",91,0)
 F  Q:$L(ORTEMP(ORTEMP))<(ORIOM+1)  D
"RTN","ORUTL",92,0)
 .F ORCHR=ORIOM:-1:1 Q:$E(ORTEMP(ORTEMP),ORCHR)=" "
"RTN","ORUTL",93,0)
 .S:ORCHR=1 ORCHR=ORIOM
"RTN","ORUTL",94,0)
 .S ORTEMP1=ORTEMP(ORTEMP)
"RTN","ORUTL",95,0)
 .S ORTEMP(ORTEMP)=$E(ORTEMP1,1,ORCHR),ORTEMP=ORTEMP+1
"RTN","ORUTL",96,0)
 .S ORTEMP(ORTEMP)=$G(ORINDENT)_$E(ORTEMP1,ORCHR+1,*)
"RTN","ORUTL",97,0)
 S ORTEMP=0 F  S ORTEMP=$O(ORTEMP(ORTEMP)) Q:+ORTEMP=0  D
"RTN","ORUTL",98,0)
 .S:ORTEMP>1 @OROUTPUT=@OROUTPUT+1
"RTN","ORUTL",99,0)
 .S @OROUTPUT@(@OROUTPUT)=ORTEMP(ORTEMP)
"RTN","ORUTL",100,0)
 Q
"RTN","ORUTL",101,0)
DEVICE(ZTRTN,ZTDESC,%ZIS,ZTSAVE) ;PROMPT THE USER FOR THE OUTPUT DEVICE
"RTN","ORUTL",102,0)
 ;PARAMETERS: ZTRTN  => LINE TAG THAT STARTS PRINTING THE REPORT
"RTN","ORUTL",103,0)
 ;            ZTDESC => TASKMAN TASK DESCRIPTION
"RTN","ORUTL",104,0)
 ;            %ZIS   => FLAGS TO PASS TO ^%ZIS
"RTN","ORUTL",105,0)
 ;            ZTSAVE => VARIABLES TO SAVE FOR TASKMAN
"RTN","ORUTL",106,0)
 N POP,CBUFFER
"RTN","ORUTL",107,0)
 S %ZIS("B")="",CBUFFER=0
"RTN","ORUTL",108,0)
 D ^%ZIS
"RTN","ORUTL",109,0)
 Q:+$G(POP)
"RTN","ORUTL",110,0)
 I $D(IO("Q")) D  Q
"RTN","ORUTL",111,0)
 .N ZTSK,ORTEXT
"RTN","ORUTL",112,0)
 .S ORTEXT=$P(ZTDESC,"OR ",2)
"RTN","ORUTL",113,0)
 .S ZTSAVE("CBUFFER")=""
"RTN","ORUTL",114,0)
 .D ^%ZTLOAD,HOME^%ZIS
"RTN","ORUTL",115,0)
 .K IO("Q")
"RTN","ORUTL",116,0)
 .I +$G(ZTSK)>0 W !,"Successfully queued the "_ORTEXT_" report.",!,"Task Number: "_ZTSK,! H 2
"RTN","ORUTL",117,0)
 I '$D(IO("Q")) D 
"RTN","ORUTL",118,0)
 .U IO
"RTN","ORUTL",119,0)
 .I $E(IOST,1,2)="C-" W @IOF S CBUFFER=3
"RTN","ORUTL",120,0)
 .D @ZTRTN,^%ZISC
"RTN","ORUTL",121,0)
 Q
"RTN","ORUTL",122,0)
HEADER(TITLE,PAGE,HEADER) ;OUTPUT THE REPORT'S HEADER
"RTN","ORUTL",123,0)
 ;PARAMETERS: TITLE  => THE TITLE OF THE REPORT
"RTN","ORUTL",124,0)
 ;            PAGE   => (REFERENCE) PAGE NUMBER
"RTN","ORUTL",125,0)
 ;            HEADER => (REFERENCE) COLUMN NAMES, FORMATTED AS:
"RTN","ORUTL",126,0)
 ;                      COLUMN(LINE_NUMBER)=TEXT
"RTN","ORUTL",127,0)
 ;                      NOTE: LINE_NUMBER STARTS AT ONE
"RTN","ORUTL",128,0)
 ;RETURNS: 0 => USER WANTS TO CONTINUE PRINTING
"RTN","ORUTL",129,0)
 ;         1 => USER DOES NOT WANT TO CONTINUE PRINTING
"RTN","ORUTL",130,0)
 I $D(ZTQUEUED),($$S^%ZTLOAD) D  Q 1
"RTN","ORUTL",131,0)
 .S ZTSTOP=$$S^%ZTLOAD("Received stop request"),ZTSTOP=1
"RTN","ORUTL",132,0)
 N X,END
"RTN","ORUTL",133,0)
 S PAGE=+$G(PAGE)+1
"RTN","ORUTL",134,0)
 I PAGE>1 D  Q:$G(END) 1
"RTN","ORUTL",135,0)
 .I $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:$G(END)
"RTN","ORUTL",136,0)
 .W @IOF
"RTN","ORUTL",137,0)
 N NOW,INDEX
"RTN","ORUTL",138,0)
 S NOW=$$UP^XLFSTR($$HTE^XLFDT($H)),NOW=$P(NOW,"@",1)_"  "_$P($P(NOW,"@",2),":",1,2)
"RTN","ORUTL",139,0)
 W $$LJ^XLFSTR($E(TITLE,1,46),47," ")_NOW_"   PAGE "_PAGE,!
"RTN","ORUTL",140,0)
 S INDEX=0 F  S INDEX=$O(HEADER(INDEX)) Q:'INDEX  W HEADER(INDEX),!
"RTN","ORUTL",141,0)
 W $$REPEAT^XLFSTR("-",(IOM-1)),!
"RTN","ORUTL",142,0)
 Q 0
"RTN","ORUTL",143,0)
FMERROR(ERROR) ;OUTPUT FILEMAN ERROR
"RTN","ORUTL",144,0)
 ;PARAMETERS: ERROR => (REFERENCE) ARRAY CONTAINING THE FILEMAN ERROR
"RTN","ORUTL",145,0)
 N OUT
"RTN","ORUTL",146,0)
 W !!,"Unable to generate the report due to the following FileMan error:",!
"RTN","ORUTL",147,0)
 W "FILEMAN ERROR #"_ERROR("DIERR",1)_":",!
"RTN","ORUTL",148,0)
 N IDX S IDX="" F  S IDX=$O(ERROR("DIERR",1,"TEXT",IDX)) Q:'IDX  D WRAP(ERROR("DIERR",1,"TEXT",IDX),"OUT")
"RTN","ORUTL",149,0)
 S IDX=0 F  S IDX=$O(OUT(IDX)) Q:+$G(IDX)=0  W OUT(IDX),!
"RTN","ORUTL",150,0)
 Q
"RTN","ORUTL",151,0)
DIVPRMPT(DIV) ;PROMPT THE USER FOR WHICH ACTIVE DIVISION(S)
"RTN","ORUTL",152,0)
 ;PARAMETERS: DIV => REFERENCE TO ARRAY WHICH WILL CONTAIN THE SELECTED DIVISION(S) WHEN THIS FINISHES
"RTN","ORUTL",153,0)
 ;                   FORMAT: DIV(FILE #4 IEN)=INSTITUTION NAME
"RTN","ORUTL",154,0)
 ;                           IF THE USER SELECTS ALL DIVISIONS, THEN ONLY THE FOLLOWING IS RETURNED:
"RTN","ORUTL",155,0)
 ;                           DIV("ALL")="all divisions"
"RTN","ORUTL",156,0)
 ;RETURNS: -1 USER ENTERED CARET AT PROMPT IF SITE IS MULTIDIVISIONAL
"RTN","ORUTL",157,0)
 ;          0 INSTITUTION FILE POINTER IS MISSING FOR ALL SELECTED DIVISIONS
"RTN","ORUTL",158,0)
 ;          1 SUCCESSFUL SELECTION OF DIVISION(S)
"RTN","ORUTL",159,0)
 N SELDIV,BADDIV,TIUDI,IDX,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,COUNT,DELIMIT
"RTN","ORUTL",160,0)
 F  D  Q:+$G(SELDIV)=1!(+$G(SELDIV)=-1)
"RTN","ORUTL",161,0)
 .D SELDIV^TIULA
"RTN","ORUTL",162,0)
 .S IDX=0 F  S IDX=$O(TIUDI(IDX)) Q:+$G(IDX)=0  D
"RTN","ORUTL",163,0)
 ..S DIV(TIUDI(IDX))=$P($$SITE^VASITE(,IDX),U,2),COUNT=1+$G(COUNT)
"RTN","ORUTL",164,0)
 .I SELDIV=1,('$D(DIV)) S DIV("ALL")="all divisions"
"RTN","ORUTL",165,0)
 .I $D(BADDIV) D
"RTN","ORUTL",166,0)
 ..N TEXT,OUTPUT
"RTN","ORUTL",167,0)
 ..S DELIMIT=", "
"RTN","ORUTL",168,0)
 ..F IDX=1:1:$L(BADDIV,",")  D
"RTN","ORUTL",169,0)
 ...S:IDX=$L(BADDIV,",") DELIMIT=" and "
"RTN","ORUTL",170,0)
 ...S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(BADDIV,",",IDX)
"RTN","ORUTL",171,0)
 ..S BADDIV="I'm sorry, but "_TEXT_" "_$S($L(BADDIV,",")=1:"is not a valid division.",$L(BADDIV,",")>1:"are not valid divisions.",1:"you selected an invalid division.")
"RTN","ORUTL",172,0)
 ..D WRAP^ORUTL(BADDIV,"OUTPUT")
"RTN","ORUTL",173,0)
 ..W !!
"RTN","ORUTL",174,0)
 ..F IDX=1:1:OUTPUT W OUTPUT(IDX),!
"RTN","ORUTL",175,0)
 ..I $D(DIV) D
"RTN","ORUTL",176,0)
 ...S DIR(0)="Y"_U,DIR("A")="Do you want to continue with the valid division"_$S(COUNT>1:"s",1:"")_" already selected"
"RTN","ORUTL",177,0)
 ...S DIR("B")="YES"
"RTN","ORUTL",178,0)
 ...D ^DIR
"RTN","ORUTL",179,0)
 ...Q:$D(DIRUT)
"RTN","ORUTL",180,0)
 ...S:Y SELDIV=1
"RTN","ORUTL",181,0)
 Q SELDIV
"RTN","ORUTL",182,0)
HASDIV(Y,DIV) ;DETERMINE IF THE SPECIFIED USER BELONGS TO A SET OF DIVISIONS RETURNED BY DIVPRMPT^ORUTL
"RTN","ORUTL",183,0)
 ;PARAMETERS: Y => IEN IN THE NEW PERSON FILE (#200)
"RTN","ORUTL",184,0)
 ;            DIV => REFERENCE TO ARRAY CONTAINING SELECTED DIVISIONS
"RTN","ORUTL",185,0)
 ;                   FORMAT: DIV(FILE #4 IEN)=INSTITUTION NAME
"RTN","ORUTL",186,0)
 ;RETURNS: NAME OF Y'S DIVISION
"RTN","ORUTL",187,0)
 ;         EMPTY STRING IF Y'S DIVISION IS NOT A SELECTED DIVISION
"RTN","ORUTL",188,0)
 N DIVISION S DIVISION=""
"RTN","ORUTL",189,0)
 I $D(DIV) D
"RTN","ORUTL",190,0)
 .N DIVISIONS,IDX,HASDIV
"RTN","ORUTL",191,0)
 .;IA #2533
"RTN","ORUTL",192,0)
 .S HASDIV=$$DIV4^XUSER(.DIVISIONS,Y)
"RTN","ORUTL",193,0)
 .I HASDIV=0 D
"RTN","ORUTL",194,0)
 ..N IEN
"RTN","ORUTL",195,0)
 ..S IEN=$P($$SITE^VASITE(),U,1)
"RTN","ORUTL",196,0)
 ..S:+IEN=0 IEN=DUZ(2)
"RTN","ORUTL",197,0)
 ..S DIVISIONS(IEN)=1
"RTN","ORUTL",198,0)
 .I $G(DIV("ALL"))="all divisions" D  Q
"RTN","ORUTL",199,0)
 ..N IEN
"RTN","ORUTL",200,0)
 ..S IEN=0 F  S IEN=$O(DIVISIONS(IEN)) Q:+$G(IEN)=0  D
"RTN","ORUTL",201,0)
 ...S:DIVISIONS(IEN) DIVISION=$$GET1^DIQ(4,IEN_",",.01)
"RTN","ORUTL",202,0)
 ..S:DIVISION="" DIVISION=$$GET1^DIQ(4,$O(DIVISIONS(0))_",",.01)
"RTN","ORUTL",203,0)
 .S IDX=0 F  S IDX=$O(DIVISIONS(IDX)) Q:+$G(IDX)=0  D
"RTN","ORUTL",204,0)
 ..I $D(DIV(IDX)) D
"RTN","ORUTL",205,0)
 ...I DIVISION'="",(DIVISIONS(IDX)=1) S DIVISION=DIV(IDX)
"RTN","ORUTL",206,0)
 ...I DIVISION="" S DIVISION=DIV(IDX)
"RTN","ORUTL",207,0)
 Q DIVISION
"RTN","ORY218")
0^^B9816646
"RTN","ORY218",1,0)
ORY218 ;SLC/JLC-Update PKI user flag for DEA ;01/16/2013  06:25
"RTN","ORY218",2,0)
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
"RTN","ORY218",3,0)
 Q
"RTN","ORY218",4,0)
PRE ;Pre-install
"RTN","ORY218",5,0)
 ;IF THE FILE ALREADY EXITS, DELETE THE DATA DICTIONARY
"RTN","ORY218",6,0)
 I $D(^DIC(100.7))>0 D
"RTN","ORY218",7,0)
 .N FILE
"RTN","ORY218",8,0)
 .D FILE^DID(100.7,,"NAME","FILE")
"RTN","ORY218",9,0)
 .D BMES^XPDUTL("Deleting existing "_$G(FILE("NAME"))_" data dictionary while preserving data...")
"RTN","ORY218",10,0)
 .N DIU
"RTN","ORY218",11,0)
 .S DIU="^ORD(100.7,",DIU(0)="T"
"RTN","ORY218",12,0)
 .D EN^DIU2
"RTN","ORY218",13,0)
 .D MES^XPDUTL("DONE")
"RTN","ORY218",14,0)
 Q
"RTN","ORY218",15,0)
POST ;Post-install
"RTN","ORY218",16,0)
 N FDA,IENS,IEN,ERROR,Y,EXIT,SITE
"RTN","ORY218",17,0)
 D BMES^XPDUTL("Cleaning up menus...")
"RTN","ORY218",18,0)
 ;IA #10156
"RTN","ORY218",19,0)
 S IEN=$$FIND1^DIC(19,,"X","ORW PARAM GUI")
"RTN","ORY218",20,0)
 I +$G(IEN)=0 D  Q
"RTN","ORY218",21,0)
 .D MES^XPDUTL("ERROR: Could not find the ORW PARAM GUI option in the OPTION file (#19).")
"RTN","ORY218",22,0)
 N RETURN,ADD
"RTN","ORY218",23,0)
 S ADD=1
"RTN","ORY218",24,0)
 ;IA #10156
"RTN","ORY218",25,0)
 D GETS^DIQ(19,IEN_",","10*",,"RETURN","ERROR")
"RTN","ORY218",26,0)
 I $D(ERROR) D ERROR(.ERROR)  Q
"RTN","ORY218",27,0)
 I $D(RETURN) D
"RTN","ORY218",28,0)
 .N IDX
"RTN","ORY218",29,0)
 .S IDX=0 F  S IDX=$O(RETURN(19.01,IDX)) Q:+$G(IDX)=0  D
"RTN","ORY218",30,0)
 ..S:RETURN(19.01,IDX,.01)="OR EPCS MENU" ADD=0
"RTN","ORY218",31,0)
 I ADD=1 D
"RTN","ORY218",32,0)
 .D MES^XPDUTL("   Adding OR EPCS MENU to ORW PARAM GUI")
"RTN","ORY218",33,0)
 .S ERROR=$$ADD^XPDMENU("ORW PARAM GUI","OR EPCS MENU","DEA")
"RTN","ORY218",34,0)
 .D:ERROR=1 MES^XPDUTL("DONE")
"RTN","ORY218",35,0)
 .D:ERROR=0 MES^XPDUTL("OR EPCS MENU option was not added to the option ORW PARAM GUI")
"RTN","ORY218",36,0)
 K ERROR,IEN
"RTN","ORY218",37,0)
 I ADD=0 D MES^XPDUTL("DONE")
"RTN","ORY218",38,0)
 S EXIT="1^DONE - SITE SUCCESSFULLY CONFIGURED",SITE=$P($$SITE^VASITE(),U,2)
"RTN","ORY218",39,0)
 D BMES^XPDUTL("Configuring site "_SITE_" for ePCS...")
"RTN","ORY218",40,0)
 I $O(^ORD(100.7,0)) S EXIT="1^DONE - SITE ALREADY CONFIGURED"
"RTN","ORY218",41,0)
 I '$O(^ORD(100.7,0)) D
"RTN","ORY218",42,0)
 .S IENS="+1,",FDA(100.7,IENS,.01)=SITE,FDA(100.7,IENS,.02)="YES"
"RTN","ORY218",43,0)
 .D UPDATE^DIE("E","FDA","IEN","ERROR") K FDA
"RTN","ORY218",44,0)
 .I $D(ERROR) D ERROR(.ERROR)  Q
"RTN","ORY218",45,0)
 .I $G(IEN(1))="" D  Q
"RTN","ORY218",46,0)
 ..D MES^XPDUTL("ERROR: FileMan did not return the new entry's internal entry number.")
"RTN","ORY218",47,0)
 ..D MES^XPDUTL("Site not successfully configured.")
"RTN","ORY218",48,0)
 .S IENS="+2,"_IEN(1)_",",Y=0
"RTN","ORY218",49,0)
 .F  S Y=$O(^XUSEC("ORES",Y)) Q:'Y!('+EXIT)  D
"RTN","ORY218",50,0)
 ..I '$$ACTIVE^XUSER(Y)!($$DEA^XUSER(,Y)="") Q
"RTN","ORY218",51,0)
 ..N DATA
"RTN","ORY218",52,0)
 ..D GETS^DIQ(200,Y_",","53.1;53.4","I","DATA","ERROR")
"RTN","ORY218",53,0)
 ..I $D(ERROR) D ERROR(.ERROR) S EXIT="0^Site not successfully configured." Q
"RTN","ORY218",54,0)
 ..I '+DATA(200,Y_",",53.1,"I") Q
"RTN","ORY218",55,0)
 ..N DATE
"RTN","ORY218",56,0)
 ..S DATE=+DATA(200,Y_",",53.4,"I")
"RTN","ORY218",57,0)
 ..I DATE>0,(DATE<=DT) Q
"RTN","ORY218",58,0)
 ..S FDA(100.71,IENS,.01)=Y D UPDATE^DIE("","FDA",,"ERROR")
"RTN","ORY218",59,0)
 ..I $D(ERROR) D ERROR(.ERROR) S EXIT="0^Site not successfully configured."
"RTN","ORY218",60,0)
 ..K FDA
"RTN","ORY218",61,0)
 D MES^XPDUTL($P(EXIT,U,2))
"RTN","ORY218",62,0)
 Q
"RTN","ORY218",63,0)
ERROR(MESSAGE) ;HANDLE AN ERROR MESSAGE FROM FILEMAN
"RTN","ORY218",64,0)
 N IDX
"RTN","ORY218",65,0)
 S IDX=0 F  S IDX=$O(MESSAGE("DIERR",IDX)) Q:'IDX  D
"RTN","ORY218",66,0)
 .D MES^XPDUTL("FILEMAN ERROR #"_MESSAGE("DIERR",IDX)_":")
"RTN","ORY218",67,0)
 .D MES^XPDUTL(MESSAGE("DIERR",IDX,"TEXT",1))
"RTN","ORY218",68,0)
 Q
"SEC","^DIC",100.7,100.7,0,"AUDIT")
@
"SEC","^DIC",100.7,100.7,0,"DD")
@
"SEC","^DIC",100.7,100.7,0,"DEL")
@
"SEC","^DIC",100.7,100.7,0,"LAYGO")
@
"SEC","^DIC",100.7,100.7,0,"RD")
@
"SEC","^DIC",100.7,100.7,0,"WR")
@
"VER")
8.0^22.0
"^DD",100.7,100.7,0)
FIELD^^1^3
"^DD",100.7,100.7,0,"DDA")
N
"^DD",100.7,100.7,0,"DT")
3121107
"^DD",100.7,100.7,0,"IX","B",100.7,.01)

"^DD",100.7,100.7,0,"IX","C",100.71,.01)

"^DD",100.7,100.7,0,"NM","OE/RR EPCS PARAMETERS")

"^DD",100.7,100.7,0,"VRPK")
OR
"^DD",100.7,100.7,.01,0)
SITE NAME^R*P4'Xa^DIC(4,^0;1^S DIC("S")="I $Q(^ORD(100.7,0))'[""^ORD(100.7,"",(+$P($G(^DIC(4,Y,99)),U,4)'=1)" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X
"^DD",100.7,100.7,.01,1,0)
^.1
"^DD",100.7,100.7,.01,1,1,0)
100.7^B
"^DD",100.7,100.7,.01,1,1,1)
S ^ORD(100.7,"B",$E(X,1,30),DA)=""
"^DD",100.7,100.7,.01,1,1,2)
K ^ORD(100.7,"B",$E(X,1,30),DA)
"^DD",100.7,100.7,.01,3)
Select the site for which you want to configure ePCS.
"^DD",100.7,100.7,.01,12)
Only one entry is allowed and only active sites are selectable.
"^DD",100.7,100.7,.01,12.1)
S DIC("S")="I $Q(^ORD(100.7,0))'[""^ORD(100.7,"",(+$P($G(^DIC(4,Y,99)),U,4)'=1)"
"^DD",100.7,100.7,.01,21,0)
^^1^1^3121017^
"^DD",100.7,100.7,.01,21,1,0)
The site for which the parameter values apply.
"^DD",100.7,100.7,.01,"AUDIT")
y
"^DD",100.7,100.7,.01,"DT")
3121017
"^DD",100.7,100.7,.02,0)
ENABLE EPCS?^RSa^0:NO;1:YES;^0;2^Q
"^DD",100.7,100.7,.02,3)
Select YES to enable ePCS functionality, NO to disable it.
"^DD",100.7,100.7,.02,21,0)
^^1^1^3121017^
"^DD",100.7,100.7,.02,21,1,0)
Stores whether ePCS is enabled for the selected site or not.
"^DD",100.7,100.7,.02,"AUDIT")
y
"^DD",100.7,100.7,.02,"DT")
3121017
"^DD",100.7,100.7,1,0)
ENABLED USERS^100.71P^^1;0
"^DD",100.7,100.7,1,21,0)
^^1^1^3121017^
"^DD",100.7,100.7,1,21,1,0)
Users for which ePCS is enabled.
"^DD",100.7,100.71,0)
ENABLED USERS SUB-FIELD^^.01^1
"^DD",100.7,100.71,0,"DT")
3121107
"^DD",100.7,100.71,0,"IX","B",100.71,.01)

"^DD",100.7,100.71,0,"NM","ENABLED USERS")

"^DD",100.7,100.71,0,"UP")
100.7
"^DD",100.7,100.71,.01,0)
ENABLED USER^M*P200'a^VA(200,^0;1^S DIC("S")="N RETURN I $$VDEA^XUSER(.RETURN,Y)" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X
"^DD",100.7,100.71,.01,1,0)
^.1
"^DD",100.7,100.71,.01,1,1,0)
100.71^B
"^DD",100.7,100.71,.01,1,1,1)
S ^ORD(100.7,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",100.7,100.71,.01,1,1,2)
K ^ORD(100.7,DA(1),1,"B",$E(X,1,30),DA)
"^DD",100.7,100.71,.01,1,2,0)
100.7^C
"^DD",100.7,100.71,.01,1,2,1)
S ^ORD(100.7,"C",$E(X,1,30),DA(1),DA)=""
"^DD",100.7,100.71,.01,1,2,2)
K ^ORD(100.7,"C",$E(X,1,30),DA(1),DA)
"^DD",100.7,100.71,.01,1,2,"%D",0)
^^1^1^3121017^
"^DD",100.7,100.71,.01,1,2,"%D",1,0)
List of users for which ePCS is enabled.
"^DD",100.7,100.71,.01,1,2,"DT")
3120626
"^DD",100.7,100.71,.01,3)
Select the user for which ePCS is enabled.
"^DD",100.7,100.71,.01,12)
Only active users that hold the ORES security key, are authorized to write medication orders, and have a valid DEA/VA number are selectable.
"^DD",100.7,100.71,.01,12.1)
S DIC("S")="N RETURN I $$VDEA^XUSER(.RETURN,Y)"
"^DD",100.7,100.71,.01,21,0)
^^1^1^3121017^
"^DD",100.7,100.71,.01,21,1,0)
User for which ePCS is enabled.
"^DD",100.7,100.71,.01,"AUDIT")
y
"^DD",100.7,100.71,.01,"DT")
3121107
"^DIC",100.7,100.7,0)
OE/RR EPCS PARAMETERS^100.7
"^DIC",100.7,100.7,0,"GL")
^ORD(100.7,
"^DIC",100.7,100.7,"%",0)
^1.005^^0
"^DIC",100.7,100.7,"%D",0)
^^2^2^3121017^
"^DIC",100.7,100.7,"%D",1,0)
This file stores the electronic Prescribing of Controlled Substances 
"^DIC",100.7,100.7,"%D",2,0)
(ePCS) parameters used by CPRS.
"^DIC",100.7,"B","OE/RR EPCS PARAMETERS",100.7)

**INSTALL NAME**
PSD*3.0*76
"BLD",8639,0)
PSD*3.0*76^CONTROLLED SUBSTANCES^0^3130325^y
"BLD",8639,1,0)
^^14^14^3130325^
"BLD",8639,1,1,0)
The e-Prescribing of Controlled Substances (ePCS) project, which is 
"BLD",8639,1,2,0)
scheduled to be released later this year, will provide enhanced 
"BLD",8639,1,3,0)
functionality to allow for the electronic prescribing of controlled
"BLD",8639,1,4,0)
substances while meeting Drug Enforcement Administration's regulations and
"BLD",8639,1,5,0)
requirements.
"BLD",8639,1,6,0)
 
"BLD",8639,1,7,0)
In preparation for this project, new security key PSDRPH is being added 
"BLD",8639,1,8,0)
in this patch. This key authorizes pharmacists to finish/verify digitally
"BLD",8639,1,9,0)
signed Schedule II-V Controlled Substance (CS) orders placed via
"BLD",8639,1,10,0)
COMPUTERIZED PATIENT RECORD SYSTEM (CPRS) V. 3.0. It should be assigned
"BLD",8639,1,11,0)
only to registered pharmacists working with Schedule II-V drugs.
"BLD",8639,1,12,0)
 
"BLD",8639,1,13,0)
The assignment of security key PSDRPH may be done at any time after the 
"BLD",8639,1,14,0)
release of this patch to begin the setup process required for ePCS.
"BLD",8639,4,0)
^9.64PA^^
"BLD",8639,6)
1^
"BLD",8639,6.3)
8
"BLD",8639,"KRN",0)
^9.67PA^779.2^20
"BLD",8639,"KRN",.4,0)
.4
"BLD",8639,"KRN",.401,0)
.401
"BLD",8639,"KRN",.402,0)
.402
"BLD",8639,"KRN",.403,0)
.403
"BLD",8639,"KRN",.5,0)
.5
"BLD",8639,"KRN",.84,0)
.84
"BLD",8639,"KRN",3.6,0)
3.6
"BLD",8639,"KRN",3.8,0)
3.8
"BLD",8639,"KRN",9.2,0)
9.2
"BLD",8639,"KRN",9.8,0)
9.8
"BLD",8639,"KRN",9.8,"NM",0)
^9.68A^^0
"BLD",8639,"KRN",19,0)
19
"BLD",8639,"KRN",19,"NM",0)
^9.68A^^0
"BLD",8639,"KRN",19.1,0)
19.1
"BLD",8639,"KRN",19.1,"NM",0)
^9.68A^1^1
"BLD",8639,"KRN",19.1,"NM",1,0)
PSDRPH^^0
"BLD",8639,"KRN",19.1,"NM","B","PSDRPH",1)

"BLD",8639,"KRN",101,0)
101
"BLD",8639,"KRN",409.61,0)
409.61
"BLD",8639,"KRN",771,0)
771
"BLD",8639,"KRN",779.2,0)
779.2
"BLD",8639,"KRN",870,0)
870
"BLD",8639,"KRN",8989.51,0)
8989.51
"BLD",8639,"KRN",8989.52,0)
8989.52
"BLD",8639,"KRN",8994,0)
8994
"BLD",8639,"KRN","B",.4,.4)

"BLD",8639,"KRN","B",.401,.401)

"BLD",8639,"KRN","B",.402,.402)

"BLD",8639,"KRN","B",.403,.403)

"BLD",8639,"KRN","B",.5,.5)

"BLD",8639,"KRN","B",.84,.84)

"BLD",8639,"KRN","B",3.6,3.6)

"BLD",8639,"KRN","B",3.8,3.8)

"BLD",8639,"KRN","B",9.2,9.2)

"BLD",8639,"KRN","B",9.8,9.8)

"BLD",8639,"KRN","B",19,19)

"BLD",8639,"KRN","B",19.1,19.1)

"BLD",8639,"KRN","B",101,101)

"BLD",8639,"KRN","B",409.61,409.61)

"BLD",8639,"KRN","B",771,771)

"BLD",8639,"KRN","B",779.2,779.2)

"BLD",8639,"KRN","B",870,870)

"BLD",8639,"KRN","B",8989.51,8989.51)

"BLD",8639,"KRN","B",8989.52,8989.52)

"BLD",8639,"KRN","B",8994,8994)

"BLD",8639,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",8639,"QUES",0)
^9.62^^
"BLD",8639,"REQB",0)
^9.611^^0
"KRN",19.1,636,-1)
0^1
"KRN",19.1,636,0)
PSDRPH^Pharmacy Prescribing for CS
"KRN",19.1,636,1,0)
^19.11^7^7^3110920^^^^
"KRN",19.1,636,1,1,0)
This key authorizes pharmacists to verify and dispense controlled substance
"KRN",19.1,636,1,2,0)
prescription(s). The PSDRPH security key should be given to registered 
"KRN",19.1,636,1,3,0)
Pharmacists working on controlled substances to honor Drug Enforcement 
"KRN",19.1,636,1,4,0)
Administration regulations, and should not be given to non-pharmacists 
"KRN",19.1,636,1,5,0)
except in cases where the package coordinator (ADPAC) is not a registered 
"KRN",19.1,636,1,6,0)
pharmacist.
"KRN",19.1,636,1,7,0)

"MBREQ")
0
"ORD",3,19.1)
19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1
"ORD",3,19.1,0)
SECURITY KEY
"PKG",276,-1)
1^1
"PKG",276,0)
CONTROLLED SUBSTANCES^PSD^Controlled Substances Inventory and Tracking module.
"PKG",276,22,0)
^9.49I^1^1
"PKG",276,22,1,0)
3.0^2970213^2970430^11595
"PKG",276,22,1,"PAH",1,0)
76^3130325
"PKG",276,22,1,"PAH",1,1,0)
^^14^14^3130325
"PKG",276,22,1,"PAH",1,1,1,0)
The e-Prescribing of Controlled Substances (ePCS) project, which is 
"PKG",276,22,1,"PAH",1,1,2,0)
scheduled to be released later this year, will provide enhanced 
"PKG",276,22,1,"PAH",1,1,3,0)
functionality to allow for the electronic prescribing of controlled
"PKG",276,22,1,"PAH",1,1,4,0)
substances while meeting Drug Enforcement Administration's regulations and
"PKG",276,22,1,"PAH",1,1,5,0)
requirements.
"PKG",276,22,1,"PAH",1,1,6,0)
 
"PKG",276,22,1,"PAH",1,1,7,0)
In preparation for this project, new security key PSDRPH is being added 
"PKG",276,22,1,"PAH",1,1,8,0)
in this patch. This key authorizes pharmacists to finish/verify digitally
"PKG",276,22,1,"PAH",1,1,9,0)
signed Schedule II-V Controlled Substance (CS) orders placed via
"PKG",276,22,1,"PAH",1,1,10,0)
COMPUTERIZED PATIENT RECORD SYSTEM (CPRS) V. 3.0. It should be assigned
"PKG",276,22,1,"PAH",1,1,11,0)
only to registered pharmacists working with Schedule II-V drugs.
"PKG",276,22,1,"PAH",1,1,12,0)
 
"PKG",276,22,1,"PAH",1,1,13,0)
The assignment of security key PSDRPH may be done at any time after the 
"PKG",276,22,1,"PAH",1,1,14,0)
release of this patch to begin the setup process required for ePCS.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"VER")
8.0^22.0
**END**
**END**