XU-8_SEQ-498_PAT-580.KID

Released XU*8*580 SEQ #498
Extracted from mail message
**KIDS**:XU*8.0*580^

**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.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",9002226,0)
9002226
"BLD",1393,"KRN",9002226,"NM",0)
^9.68A^^
"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,"KRN","B",9002226,9002226)

"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)

"BLD",1393,6)
^498
**END**
**END**