USH_PRF_LEGAL_SOLUTION_1_0.KID

KIDS Distribution saved on Aug 27, 2013@08:45:32
USH PRF LEGAL SOLUTION 1.0
**KIDS**:USH PRF LEGAL SOLUTION 1.0^TIU*1.0*275^DG*5.3*864^GMTS*2.7*103^

**INSTALL NAME**
USH PRF LEGAL SOLUTION 1.0
"BLD",8698,0)
USH PRF LEGAL SOLUTION 1.0^^1^3130827^y
"BLD",8698,1,0)
^^2^2^3130805^
"BLD",8698,1,1,0)
Under Secretary for Health Patient Record Flag Legal Solution.
"BLD",8698,1,2,0)

"BLD",8698,6.3)
4
"BLD",8698,10,0)
^9.63^3^3
"BLD",8698,10,1,0)
TIU*1.0*275^1
"BLD",8698,10,2,0)
DG*5.3*864^1
"BLD",8698,10,3,0)
GMTS*2.7*103^1
"BLD",8698,10,"B","DG*5.3*864",2)

"BLD",8698,10,"B","GMTS*2.7*103",3)

"BLD",8698,10,"B","TIU*1.0*275",1)

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

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

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

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

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

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

"BLD",8698,"KRN","B",3.6,3.6)

"BLD",8698,"KRN","B",3.8,3.8)

"BLD",8698,"KRN","B",9.2,9.2)

"BLD",8698,"KRN","B",9.8,9.8)

"BLD",8698,"KRN","B",19,19)

"BLD",8698,"KRN","B",19.1,19.1)

"BLD",8698,"KRN","B",101,101)

"BLD",8698,"KRN","B",409.61,409.61)

"BLD",8698,"KRN","B",771,771)

"BLD",8698,"KRN","B",779.2,779.2)

"BLD",8698,"KRN","B",870,870)

"BLD",8698,"KRN","B",8989.51,8989.51)

"BLD",8698,"KRN","B",8989.52,8989.52)

"BLD",8698,"KRN","B",8994,8994)

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

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"VER")
8.0^22.0
**INSTALL NAME**
TIU*1.0*275
"BLD",8511,0)
TIU*1.0*275^TEXT INTEGRATION UTILITIES^0^3130827^y
"BLD",8511,1,0)
^^1^1^3130102^
"BLD",8511,1,1,0)
See patch description on FORUM for patch TIU*1.0*275.
"BLD",8511,4,0)
^9.64PA^^
"BLD",8511,6)
2^
"BLD",8511,6.3)
8
"BLD",8511,"INIT")
TIUPS275
"BLD",8511,"KRN",0)
^9.67PA^779.2^20
"BLD",8511,"KRN",.4,0)
.4
"BLD",8511,"KRN",.401,0)
.401
"BLD",8511,"KRN",.402,0)
.402
"BLD",8511,"KRN",.403,0)
.403
"BLD",8511,"KRN",.5,0)
.5
"BLD",8511,"KRN",.84,0)
.84
"BLD",8511,"KRN",3.6,0)
3.6
"BLD",8511,"KRN",3.8,0)
3.8
"BLD",8511,"KRN",9.2,0)
9.2
"BLD",8511,"KRN",9.8,0)
9.8
"BLD",8511,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",8511,"KRN",9.8,"NM",1,0)
TIUPS275^^0^B9548345
"BLD",8511,"KRN",9.8,"NM","B","TIUPS275",1)

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

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

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

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

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

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

"BLD",8511,"KRN","B",3.6,3.6)

"BLD",8511,"KRN","B",3.8,3.8)

"BLD",8511,"KRN","B",9.2,9.2)

"BLD",8511,"KRN","B",9.8,9.8)

"BLD",8511,"KRN","B",19,19)

"BLD",8511,"KRN","B",19.1,19.1)

"BLD",8511,"KRN","B",101,101)

"BLD",8511,"KRN","B",409.61,409.61)

"BLD",8511,"KRN","B",771,771)

"BLD",8511,"KRN","B",779.2,779.2)

"BLD",8511,"KRN","B",870,870)

"BLD",8511,"KRN","B",8989.51,8989.51)

"BLD",8511,"KRN","B",8989.52,8989.52)

"BLD",8511,"KRN","B",8994,8994)

"BLD",8511,"QUES",0)
^9.62^^
"INIT")
TIUPS275
"MBREQ")
1
"PKG",193,-1)
1^1
"PKG",193,0)
TEXT INTEGRATION UTILITIES^TIU^Text Integration Utilities 
"PKG",193,20,0)
^9.402P^^
"PKG",193,22,0)
^9.49I^1^1
"PKG",193,22,1,0)
1.0^3010321^3010321^11
"PKG",193,22,1,"PAH",1,0)
275^3130827^1342
"PKG",193,22,1,"PAH",1,1,0)
^^1^1^3130827
"PKG",193,22,1,"PAH",1,1,1,0)
See patch description on FORUM for patch TIU*1.0*275.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
1
"RTN","TIUPS275")
0^1^B9548345
"RTN","TIUPS275",1,0)
TIUPS275 ;ISD/HGW - Post-Install for 275 ;07/16/13  13:51
"RTN","TIUPS275",2,0)
 ;;1.0;TEXT INTEGRATION UTILITIES;**275**;Nov 13, 2012;Build 8
"RTN","TIUPS275",3,0)
 ;  Post Installation Routine for patch TIU*1.0*275
"RTN","TIUPS275",4,0)
 ;  Installs Title and maps it to Enterprise Standard Title and Document Class
"RTN","TIUPS275",5,0)
 ;
"RTN","TIUPS275",6,0)
 ;  EXTERNAL REFERENCES
"RTN","TIUPS275",7,0)
 ;    BMES^XPDUTL 10141
"RTN","TIUPS275",8,0)
 ;    $$FIND1^DIC
"RTN","TIUPS275",9,0)
 ;    NOW^%DTC
"RTN","TIUPS275",10,0)
 ;    UPDATE^DIE 2053
"RTN","TIUPS275",11,0)
 ;
"RTN","TIUPS275",12,0)
MAIN ; Control subroutine
"RTN","TIUPS275",13,0)
 N TIUFPRIV,TIU275X,TIUDNM,TIUSNM,TIUNATL,TIUDC
"RTN","TIUPS275",14,0)
 S TIUFPRIV=1
"RTN","TIUPS275",15,0)
 S TIUDNM="PATIENT RECORD FLAG CATEGORY I - URGENT    ADDRESS AS FEMALE" ; Name
"RTN","TIUPS275",16,0)
 S TIUSNM="PRF Addr as Female" ; Short Name
"RTN","TIUPS275",17,0)
 S TIUNATL="PATIENT RECORD FLAG" ; Enterprise Standard Title
"RTN","TIUPS275",18,0)
 S TIUDC="PATIENT RECORD FLAG CAT I" ; Document Class
"RTN","TIUPS275",19,0)
 S TIU275X=$$CREATE(TIUDNM,TIUNATL) ; TIU275X is "Success message" or "Error text"
"RTN","TIUPS275",20,0)
 D BMES^XPDUTL(TIU275X)
"RTN","TIUPS275",21,0)
 S TIU275X=$$INSTALL(TIUDNM,TIUDC,TIUSNM) ; TIU275X is "Success message" or "Error text"
"RTN","TIUPS275",22,0)
 D BMES^XPDUTL(TIU275X)
"RTN","TIUPS275",23,0)
 Q
"RTN","TIUPS275",24,0)
CREATE(TIUDNM,TIUNATL) ; Create new DDEF entry
"RTN","TIUPS275",25,0)
 N %,TIUERR,TIUFDA,TIUIEN,TIUMSG
"RTN","TIUPS275",26,0)
 S TIUERR="   Title Created: "_TIUDNM
"RTN","TIUPS275",27,0)
 S TIUFDA(8925.1,"?+1,",.01)=TIUDNM ; NAME
"RTN","TIUPS275",28,0)
 S TIUFDA(8925.1,"?+1,",.03)=TIUDNM ; PRINT NAME
"RTN","TIUPS275",29,0)
 S TIUFDA(8925.1,"?+1,",.04)="DOC" ; TYPE: TITLE
"RTN","TIUPS275",30,0)
 S TIUFDA(8925.1,"?+1,",.06)=$$FIND1^DIC(8930,"","X","CLINICAL COORDINATOR","B") ; OWNER
"RTN","TIUPS275",31,0)
 S TIUFDA(8925.1,"?+1,",.07)=11 ; STATUS: ACTIVE
"RTN","TIUPS275",32,0)
 S TIUFDA(8925.1,"?+1,",.13)=1 ; NATIONAL STANDARD: YES
"RTN","TIUPS275",33,0)
 S TIUFDA(8925.1,"?+1,",3.02)=1 ; OK TO DISTRIBUTE: YES
"RTN","TIUPS275",34,0)
 S TIUFDA(8925.1,"?+1,",99)=$H ; TIMESTAMP
"RTN","TIUPS275",35,0)
 S TIUFDA(8925.1,"?+1,",1501)=$$FIND1^DIC(8926.1,"","X",TIUNATL,"B") ; VHA ENTERPRISE STANDARD TITLE
"RTN","TIUPS275",36,0)
 D NOW^%DTC S TIUFDA(8925.1,"?+1,",1502)=% ; MAP ATTEMPTED
"RTN","TIUPS275",37,0)
 S TIUFDA(8925.1,"?+1,",1503)=DUZ ; MAP ATTEMPTED BY
"RTN","TIUPS275",38,0)
 D UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
"RTN","TIUPS275",39,0)
 I $D(TIUMSG) D  Q TIUERR
"RTN","TIUPS275",40,0)
 . S TIUERR="   **ERROR** "_$G(TIUMSG("DIERR",1))_" Unable to create Title "_TIUDNM
"RTN","TIUPS275",41,0)
 Q TIUERR
"RTN","TIUPS275",42,0)
INSTALL(TIUDNM,TIUDC,TIUSNM) ; Install document definition
"RTN","TIUPS275",43,0)
 N TIUERR,TIUFPRIV,TIUTIEN,TIUDIEN,TIUFDA,TIUIEN,TIUMSG
"RTN","TIUPS275",44,0)
 S TIUERR="   Title attached to Document Class "_TIUDC
"RTN","TIUPS275",45,0)
 S TIUFPRIV=1
"RTN","TIUPS275",46,0)
 ; Find the IEN of the Title
"RTN","TIUPS275",47,0)
 S TIUTIEN=$$FIND1^DIC(8925.1,"","X",TIUDNM,"B")
"RTN","TIUPS275",48,0)
 I 'TIUTIEN D  Q TIUERR
"RTN","TIUPS275",49,0)
 . S TIUERR="   **ERROR** Unable to locate Title "_TIUDNM
"RTN","TIUPS275",50,0)
 ; Find the IEN of the Document Class
"RTN","TIUPS275",51,0)
 S TIUDIEN=$$FIND1^DIC(8925.1,"","X",TIUDC,"B")
"RTN","TIUPS275",52,0)
 I 'TIUDIEN D  Q TIUERR
"RTN","TIUPS275",53,0)
 . S TIUERR="   **ERROR** Unable to locate Document Class "_TIUDC
"RTN","TIUPS275",54,0)
 ; Attach the Title to Document Class
"RTN","TIUPS275",55,0)
 S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",.01)=TIUTIEN ; ITEM
"RTN","TIUPS275",56,0)
 S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",2)="" ; MNEMONIC
"RTN","TIUPS275",57,0)
 S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",3)="" ; SEQUENCE
"RTN","TIUPS275",58,0)
 S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",4)=TIUSNM ; MENU TEXT
"RTN","TIUPS275",59,0)
 D UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
"RTN","TIUPS275",60,0)
 I $D(TIUMSG) D  Q TIUERR
"RTN","TIUPS275",61,0)
 . S TIUERR="   **ERROR** Unable to update Document Class "_TIUDC
"RTN","TIUPS275",62,0)
 Q TIUERR
"VER")
8.0^22.0
**INSTALL NAME**
DG*5.3*864
"BLD",8695,0)
DG*5.3*864^REGISTRATION^0^3130827^y
"BLD",8695,4,0)
^9.64PA^^
"BLD",8695,6)
12^
"BLD",8695,6.3)
16
"BLD",8695,"ABPKG")
n
"BLD",8695,"INID")
^n
"BLD",8695,"INIT")
DG53864P
"BLD",8695,"KRN",0)
^9.67PA^779.2^20
"BLD",8695,"KRN",.4,0)
.4
"BLD",8695,"KRN",.4,"NM",0)
^9.68A^^
"BLD",8695,"KRN",.401,0)
.401
"BLD",8695,"KRN",.401,"NM",0)
^9.68A^^
"BLD",8695,"KRN",.402,0)
.402
"BLD",8695,"KRN",.402,"NM",0)
^9.68A^^0
"BLD",8695,"KRN",.403,0)
.403
"BLD",8695,"KRN",.403,"NM",0)
^9.68A^^
"BLD",8695,"KRN",.5,0)
.5
"BLD",8695,"KRN",.5,"NM",0)
^9.68A^^
"BLD",8695,"KRN",.84,0)
.84
"BLD",8695,"KRN",3.6,0)
3.6
"BLD",8695,"KRN",3.8,0)
3.8
"BLD",8695,"KRN",9.2,0)
9.2
"BLD",8695,"KRN",9.8,0)
9.8
"BLD",8695,"KRN",9.8,"NM",0)
^9.68A^6^6
"BLD",8695,"KRN",9.8,"NM",1,0)
DGPFLMA2^^0^B58607996
"BLD",8695,"KRN",9.8,"NM",2,0)
DGPFLMA3^^0^B74777125
"BLD",8695,"KRN",9.8,"NM",3,0)
DG53864P^^0^B6717089
"BLD",8695,"KRN",9.8,"NM",4,0)
DGREG^^0^B47583853
"BLD",8695,"KRN",9.8,"NM",5,0)
DG10^^0^B19615369
"BLD",8695,"KRN",9.8,"NM",6,0)
DGPFMPI^^0^B2049737
"BLD",8695,"KRN",9.8,"NM","B","DG10",5)

"BLD",8695,"KRN",9.8,"NM","B","DG53864P",3)

"BLD",8695,"KRN",9.8,"NM","B","DGPFLMA2",1)

"BLD",8695,"KRN",9.8,"NM","B","DGPFLMA3",2)

"BLD",8695,"KRN",9.8,"NM","B","DGPFMPI",6)

"BLD",8695,"KRN",9.8,"NM","B","DGREG",4)

"BLD",8695,"KRN",19,0)
19
"BLD",8695,"KRN",19,"NM",0)
^9.68A^^
"BLD",8695,"KRN",19.1,0)
19.1
"BLD",8695,"KRN",19.1,"NM",0)
^9.68A^^
"BLD",8695,"KRN",101,0)
101
"BLD",8695,"KRN",101,"NM",0)
^9.68A^^
"BLD",8695,"KRN",409.61,0)
409.61
"BLD",8695,"KRN",771,0)
771
"BLD",8695,"KRN",779.2,0)
779.2
"BLD",8695,"KRN",870,0)
870
"BLD",8695,"KRN",8989.51,0)
8989.51
"BLD",8695,"KRN",8989.52,0)
8989.52
"BLD",8695,"KRN",8994,0)
8994
"BLD",8695,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",8695,"KRN","B",3.6,3.6)

"BLD",8695,"KRN","B",3.8,3.8)

"BLD",8695,"KRN","B",9.2,9.2)

"BLD",8695,"KRN","B",9.8,9.8)

"BLD",8695,"KRN","B",19,19)

"BLD",8695,"KRN","B",19.1,19.1)

"BLD",8695,"KRN","B",101,101)

"BLD",8695,"KRN","B",409.61,409.61)

"BLD",8695,"KRN","B",771,771)

"BLD",8695,"KRN","B",779.2,779.2)

"BLD",8695,"KRN","B",870,870)

"BLD",8695,"KRN","B",8989.51,8989.51)

"BLD",8695,"KRN","B",8989.52,8989.52)

"BLD",8695,"KRN","B",8994,8994)

"BLD",8695,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",8695,"QUES",0)
^9.62^^
"BLD",8695,"REQB",0)
^9.611^^
"INIT")
DG53864P
"MBREQ")
1
"PKG",6,-1)
1^1
"PKG",6,0)
REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER 
"PKG",6,20,0)
^9.402P^^
"PKG",6,22,0)
^9.49I^1^1
"PKG",6,22,1,0)
5.3^2930813^2931021
"PKG",6,22,1,"PAH",1,0)
864^3130827^1342
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
6
"RTN","DG10")
0^5^B19615369
"RTN","DG10",1,0)
DG10 ;ALB/MRL,DAK,AEG,PHH,TMK-LOAD/EDIT PATIENT DATA ; 08/26/08
"RTN","DG10",2,0)
 ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,773,864**;Aug 13, 1993;Build 16
"RTN","DG10",3,0)
START ;
"RTN","DG10",4,0)
 D LO^DGUTL
"RTN","DG10",5,0)
 I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G Q:$G(DGRPOUT),A1
"RTN","DG10",6,0)
 .; D EN^DGRPD,REG^IVMCQ($G(DFN))
"RTN","DG10",7,0)
 . D EN^DGRPD
"RTN","DG10",8,0)
 . Q:$G(DGRPOUT)
"RTN","DG10",9,0)
 . D REG^IVMCQ($G(DFN))
"RTN","DG10",10,0)
 . D HINQ
"RTN","DG10",11,0)
 ;
"RTN","DG10",12,0)
A W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
"RTN","DG10",13,0)
 N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
"RTN","DG10",14,0)
 ;
"RTN","DG10",15,0)
 ;MPI QUERY
"RTN","DG10",16,0)
 ;check to see if CIRN PD/MPI is installed
"RTN","DG10",17,0)
 N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
"RTN","DG10",18,0)
 K MPIFRTN
"RTN","DG10",19,0)
 D MPIQ^MPIFAPI(DFN)
"RTN","DG10",20,0)
 K MPIFRTN
"RTN","DG10",21,0)
 ;
"RTN","DG10",22,0)
 N DGNOIVMUPD
"RTN","DG10",23,0)
 S DGNOIVMUPD=1 ; Set flag to prevent MT Event Driver from updating converted IVM test
"RTN","DG10",24,0)
 I +$G(DGNEW) D
"RTN","DG10",25,0)
 . ; query CMOR for Patient Record Flag Assignments if NEW patient and
"RTN","DG10",26,0)
 . ; display results
"RTN","DG10",27,0)
 . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
"RTN","DG10",28,0)
 . I $$EN^DGPFMPI(DFN)
"RTN","DG10",29,0)
 ;
"RTN","DG10",30,0)
SKIP ;
"RTN","DG10",31,0)
 S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A
"RTN","DG10",32,0)
 D HINQ,REG^IVMCQ($G(DFN)) G A1
"RTN","DG10",33,0)
 ;
"RTN","DG10",34,0)
HINQ ;
"RTN","DG10",35,0)
 S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D
"RTN","DG10",36,0)
 .N DGROUT
"RTN","DG10",37,0)
 .S DGROUT=X
"RTN","DG10",38,0)
 .I $G(DFN) D
"RTN","DG10",39,0)
 ..N X,Y,DGRP
"RTN","DG10",40,0)
 ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
"RTN","DG10",41,0)
 ..W !,"     Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
"RTN","DG10",42,0)
 ..W ?40,"   Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
"RTN","DG10",43,0)
 .D @("EN^"_DGROUT) K Y Q  ;from dgdem0
"RTN","DG10",44,0)
 Q
"RTN","DG10",45,0)
 ;
"RTN","DG10",46,0)
 ;   SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management 
"RTN","DG10",47,0)
 ;   to bypass the embossing routines when calling load/edit from IEMM
"RTN","DG10",48,0)
 ;
"RTN","DG10",49,0)
A1 D  G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS
"RTN","DG10",50,0)
 .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
"RTN","DG10",51,0)
 .S %=1 D YN^DICN
"RTN","DG10",52,0)
 .I +$G(DGNEW) Q
"RTN","DG10",53,0)
 .I $$ADD^DGADDUTL($G(DFN)) ;
"RTN","DG10",54,0)
 ;
"RTN","DG10",55,0)
H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
"RTN","DG10",56,0)
 G A1
"RTN","DG10",57,0)
 ;
"RTN","DG10",58,0)
CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP
"RTN","DG10",59,0)
 G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
"RTN","DG10",60,0)
 I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR
"RTN","DG10",61,0)
 ;G:Y ^DGRP9
"RTN","DG10",62,0)
 ;
"RTN","DG10",63,0)
EMBOS ;W ! D EMBOS^DGQEMA G A
"RTN","DG10",64,0)
 G A
"RTN","DG10",65,0)
 ;
"RTN","DG10",66,0)
 ;
"RTN","DG10",67,0)
Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q
"RTN","DG10",68,0)
 ;
"RTN","DG10",69,0)
MT(DFN) ; Check if user requires a means test.  Ask user if they want to proceedif
"RTN","DG10",70,0)
 ; one is required
"RTN","DG10",71,0)
 I '$D(SDIEMM) DO
"RTN","DG10",72,0)
 .N DGREQF,DIV
"RTN","DG10",73,0)
 .D EN^DGMTR
"RTN","DG10",74,0)
 .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
"RTN","DG10",75,0)
 .Q
"RTN","DG10",76,0)
 I $D(SDIEMM) DO
"RTN","DG10",77,0)
 .N DGMTI
"RTN","DG10",78,0)
 .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
"RTN","DG10",79,0)
 .I $P(DGMTI,U,4)="R" D  I 1
"RTN","DG10",80,0)
 ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
"RTN","DG10",81,0)
 ..I '$$OKTOCONT(DGMTDT) Q
"RTN","DG10",82,0)
 ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
"RTN","DG10",83,0)
 .E  D WARNING
"RTN","DG10",84,0)
 .Q
"RTN","DG10",85,0)
 Q
"RTN","DG10",86,0)
 ;
"RTN","DG10",87,0)
WARNING ;
"RTN","DG10",88,0)
 ;prints a warning to the screen about means test
"RTN","DG10",89,0)
 ;
"RTN","DG10",90,0)
 W !!,"A means test for this encounter date was not found and may be required!"
"RTN","DG10",91,0)
 W !,"Further investigation will be needed."
"RTN","DG10",92,0)
 W !
"RTN","DG10",93,0)
 D PAUSE
"RTN","DG10",94,0)
 Q
"RTN","DG10",95,0)
 ;
"RTN","DG10",96,0)
PAUSE ;
"RTN","DG10",97,0)
 N DIR
"RTN","DG10",98,0)
 S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
"RTN","DG10",99,0)
 Q
"RTN","DG10",100,0)
 ;
"RTN","DG10",101,0)
OKTOCONT(Y) ;
"RTN","DG10",102,0)
 ;
"RTN","DG10",103,0)
 N DIR
"RTN","DG10",104,0)
 W !!,"Patient Requires a means Test"
"RTN","DG10",105,0)
 X ^DD("DD")
"RTN","DG10",106,0)
 W !,"Primary Means Test Required from '",Y,"'",!
"RTN","DG10",107,0)
 ;
"RTN","DG10",108,0)
 I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO  G OKQ
"RTN","DG10",109,0)
 .W !,$C(7),"You do not have the appropriate IEMM Security Key.  Contact your supervisor.",!
"RTN","DG10",110,0)
 .D PAUSE
"RTN","DG10",111,0)
 .S Y=0
"RTN","DG10",112,0)
 ;
"RTN","DG10",113,0)
 S DIR("A")="Do you wish to proceed with the means test at this time"
"RTN","DG10",114,0)
 S DIR("B")="YES"
"RTN","DG10",115,0)
 S DIR(0)="Y"
"RTN","DG10",116,0)
 D ^DIR
"RTN","DG10",117,0)
OKQ Q $S(Y=1:1,1:0)
"RTN","DG10",118,0)
 ;
"RTN","DG10",119,0)
CP ;If not (autoexempt or MTested) & no CP test this year then
"RTN","DG10",120,0)
 ;prompt for add/edit cp test
"RTN","DG10",121,0)
 N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
"RTN","DG10",122,0)
 G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
"RTN","DG10",123,0)
 S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
"RTN","DG10",124,0)
 D EN^DGMTCOR
"RTN","DG10",125,0)
 I +$G(DGNOCOPF) S DGMTCOR=0
"RTN","DG10",126,0)
 I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
"RTN","DG10",127,0)
 K DGNOCOPF
"RTN","DG10",128,0)
QTCP Q
"RTN","DG53864P")
0^3^B6717089
"RTN","DG53864P",1,0)
DG53864P ;BP/DMR - POST INT TO ADD PRF
"RTN","DG53864P",2,0)
 ;;5.3;Reqistration;**864**;Aug 13, 1993;Build 16
"RTN","DG53864P",3,0)
 ;
"RTN","DG53864P",4,0)
 ;
"RTN","DG53864P",5,0)
 ; This rountine will create the new URGENT: ADDRESS AS FEMALE Patient Record Flag
"RTN","DG53864P",6,0)
 ; in the PRF NATIONAL FLAG file (#26.15). The routine can be deleted after the
"RTN","DG53864P",7,0)
 ; flag is installed.
"RTN","DG53864P",8,0)
 ;
"RTN","DG53864P",9,0)
EN ;
"RTN","DG53864P",10,0)
 N DGPRF,DGMSG,DGFDA,DGFDAIEN,DGWP,DGTIU,DGMSG,DGERR,DGRESULT,DGLINE
"RTN","DG53864P",11,0)
 ;
"RTN","DG53864P",12,0)
 S DGPRF="URGENT    ADDRESS AS FEMALE"
"RTN","DG53864P",13,0)
 S DGTIU="PATIENT RECORD FLAG CATEGORY I - URGENT    ADDRESS AS FEMALE"
"RTN","DG53864P",14,0)
 ;
"RTN","DG53864P",15,0)
 K DGERR,DGMSG
"RTN","DG53864P",16,0)
 D CHK^DIE(26.15,.07,"E",DGTIU,.DGRESULT,"DGERR")
"RTN","DG53864P",17,0)
 I $D(DGERR)>0 D  Q
"RTN","DG53864P",18,0)
 . D MSG^DIALOG("EA",.DGMSG,"","","DGERR")
"RTN","DG53864P",19,0)
 . S DGLINE=$O(DGMSG(999999),-1)
"RTN","DG53864P",20,0)
 . S DGMSG(DGLINE+1)="Please check that patch TIU*1.0*275 must be installed."
"RTN","DG53864P",21,0)
 . S DGMSG(DGLINE+2)="Exiting install of the new national PRF flag"
"RTN","DG53864P",22,0)
 . D MES^XPDUTL(.DGMSG)
"RTN","DG53864P",23,0)
 ;
"RTN","DG53864P",24,0)
 I $D(^DGPF(26.15,"B",DGPRF))>0 D  Q
"RTN","DG53864P",25,0)
 . S DGMSG(1)="The 'URGENT    ADDRESS AS FEMALE' PRF is already entered in the PRF"
"RTN","DG53864P",26,0)
 . S DGMSG(2)="NATIONAL FLAG file, install will abort."
"RTN","DG53864P",27,0)
 . D MES^XPDUTL(.DGMSG)
"RTN","DG53864P",28,0)
 ; Create entry in file #26.15
"RTN","DG53864P",29,0)
 D BMES^XPDUTL("Installing new national PRF entry")
"RTN","DG53864P",30,0)
 S DGFDA(1,26.15,"+1,",.01)=DGPRF
"RTN","DG53864P",31,0)
 S DGFDA(1,26.15,"+1,",.02)="ACTIVE"
"RTN","DG53864P",32,0)
 S DGFDA(1,26.15,"+1,",.03)="OTHER"
"RTN","DG53864P",33,0)
 S DGFDA(1,26.15,"+1,",.04)="0"
"RTN","DG53864P",34,0)
 S DGFDA(1,26.15,"+1,",.05)="0"
"RTN","DG53864P",35,0)
 S DGFDA(1,26.15,"+1,",.06)=""
"RTN","DG53864P",36,0)
 S DGFDA(1,26.15,"+1,",.07)=DGTIU
"RTN","DG53864P",37,0)
 K DGERR,DGMSG
"RTN","DG53864P",38,0)
 D UPDATE^DIE("E","DGFDA(1)","DGFDAIEN","DGERR")
"RTN","DG53864P",39,0)
 I $D(DGERR)>0 D  Q
"RTN","DG53864P",40,0)
 . D MSG^DIALOG("EA",.DGMSG,"","","DGERR")
"RTN","DG53864P",41,0)
 . D MES^XPDUTL(.DGMSG)
"RTN","DG53864P",42,0)
 ; Create description (word-processing) field
"RTN","DG53864P",43,0)
 K DGERR,DGMSG
"RTN","DG53864P",44,0)
 S DGWP(1,1)="This Patient Record Flag was established to ensure that a transgender"
"RTN","DG53864P",45,0)
 S DGWP(1,2)="Veteran is addressed as Female per a court order agreement. This flag"
"RTN","DG53864P",46,0)
 S DGWP(1,3)="cannot be used without approval of the Under Secretary for Health."
"RTN","DG53864P",47,0)
 D WP^DIE(26.15,DGFDAIEN(1)_",",1,"A","DGWP(1)","DGERR")
"RTN","DG53864P",48,0)
 I $D(DGERR) D  Q
"RTN","DG53864P",49,0)
 . D MSG^DIALOG("EA",.DGMSG,"","","DGERR")
"RTN","DG53864P",50,0)
 . D MES^XPDUTL(.DGMSG)
"RTN","DG53864P",51,0)
 ;
"RTN","DG53864P",52,0)
 D BMES^XPDUTL("Installation of new national PRF entry complete")
"RTN","DG53864P",53,0)
 Q
"RTN","DGPFLMA2")
0^1^B58607996
"RTN","DGPFLMA2",1,0)
DGPFLMA2 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/12/06 12:46pm
"RTN","DGPFLMA2",2,0)
 ;;5.3;Registration;**425,623,554,650,864**;Aug 13, 1993;Build 16
"RTN","DGPFLMA2",3,0)
 ;
"RTN","DGPFLMA2",4,0)
 ;no direct entry
"RTN","DGPFLMA2",5,0)
 QUIT
"RTN","DGPFLMA2",6,0)
 ;
"RTN","DGPFLMA2",7,0)
AF ;Entry point for DGPF ASSIGN FLAG action protocol.
"RTN","DGPFLMA2",8,0)
 ;
"RTN","DGPFLMA2",9,0)
 ;  Input:
"RTN","DGPFLMA2",10,0)
 ;     DGDFN - pointer to patient in PATIENT (#2) file
"RTN","DGPFLMA2",11,0)
 ;
"RTN","DGPFLMA2",12,0)
 ; Output:
"RTN","DGPFLMA2",13,0)
 ;   VALMBCK - 'R' = refresh screen
"RTN","DGPFLMA2",14,0)
 ;
"RTN","DGPFLMA2",15,0)
 N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK  ;input vars for EN^DIWE call
"RTN","DGPFLMA2",16,0)
 N DGABORT   ;abort flag for entering assignment narrative
"RTN","DGPFLMA2",17,0)
 N DGFAC     ;pointer to INSTITUTION (#4) file
"RTN","DGPFLMA2",18,0)
 N DGOK      ;ok flag for entering assignment narrative
"RTN","DGPFLMA2",19,0)
 N DGPFA     ;assignment array
"RTN","DGPFLMA2",20,0)
 N DGPFAH    ;assignment history array
"RTN","DGPFLMA2",21,0)
 N DGRDAT    ;results of review date calculation
"RTN","DGPFLMA2",22,0)
 N DGRESULT  ;result of STOALL api call
"RTN","DGPFLMA2",23,0)
 N DGERR     ;if unable to add assignment
"RTN","DGPFLMA2",24,0)
 N DGPFERR   ;if error returned from STOALL
"RTN","DGPFLMA2",25,0)
 N PRFIEN    ;PRF IEN from file 26.15 dg*5.3*864
"RTN","DGPFLMA2",26,0)
 N PRFNAME   ;PRF NAME (.01) field dg*5.3*864
"RTN","DGPFLMA2",27,0)
 ;
"RTN","DGPFLMA2",28,0)
 ;set screen to full scroll region
"RTN","DGPFLMA2",29,0)
 D FULL^VALM1
"RTN","DGPFLMA2",30,0)
 ;
"RTN","DGPFLMA2",31,0)
 ;quit if patient not selected
"RTN","DGPFLMA2",32,0)
 I '$G(DGDFN) D  Q
"RTN","DGPFLMA2",33,0)
 . D BLD^DIALOG(261129,"Patient has not been selected.","","DGERR","F")
"RTN","DGPFLMA2",34,0)
 . D MSG^DIALOG("WE","","","","DGERR") W *7
"RTN","DGPFLMA2",35,0)
 . D PAUSE^VALM1
"RTN","DGPFLMA2",36,0)
 . S VALMBCK="R"
"RTN","DGPFLMA2",37,0)
 ;
"RTN","DGPFLMA2",38,0)
 ;is user's DUZ(2) an enabled Division for PRF ASSIGNMENT OWNERSHIP
"RTN","DGPFLMA2",39,0)
 I '$D(^DG(40.8,"APRF",+$G(DUZ(2)))) D  Q
"RTN","DGPFLMA2",40,0)
 . D BLD^DIALOG(261129,"Your Division, "_$$STA^XUAF4($G(DUZ(2)))_", is not enabled for PRF Assignment Ownership.","","DGERR","F")
"RTN","DGPFLMA2",41,0)
 . D MSG^DIALOG("WE","","","","DGERR") W *7
"RTN","DGPFLMA2",42,0)
 . D PAUSE^VALM1
"RTN","DGPFLMA2",43,0)
 . S VALMBCK="R"
"RTN","DGPFLMA2",44,0)
 ;
"RTN","DGPFLMA2",45,0)
 D  ;drops out of DO block on assignment failure
"RTN","DGPFLMA2",46,0)
 . ;
"RTN","DGPFLMA2",47,0)
 . ;init assignment and history arrays
"RTN","DGPFLMA2",48,0)
 . K DGPFA,DGPFAH
"RTN","DGPFLMA2",49,0)
 . ;
"RTN","DGPFLMA2",50,0)
 . ;get patient DFN into assignment array
"RTN","DGPFLMA2",51,0)
 . S DGPFA("DFN")=$G(DGDFN)
"RTN","DGPFLMA2",52,0)
 . Q:'DGPFA("DFN")
"RTN","DGPFLMA2",53,0)
 . ;
"RTN","DGPFLMA2",54,0)
 . ;select flag for assignment
"RTN","DGPFLMA2",55,0)
 . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02")
"RTN","DGPFLMA2",56,0)
 . Q:(DGPFA("FLAG")'>0)
"RTN","DGPFLMA2",57,0)
 . ; Urgent    Address is Female,check if user has programmer access dg*5.3*864.
"RTN","DGPFLMA2",58,0)
 . N PRFIEN,PRFNAME,PRFNAT
"RTN","DGPFLMA2",59,0)
 . S PRFNAT="" I $P(DGPFA("FLAG"),";",2)="DGPF(26.15," S PRFNAT=1
"RTN","DGPFLMA2",60,0)
 . S PRFIEN="" I PRFNAT=1 S PRFIEN=$P(DGPFA("FLAG"),";")
"RTN","DGPFLMA2",61,0)
 . S PRFNAME="" I PRFIEN'="" S PRFNAME=$$GET1^DIQ(26.15,PRFIEN,.01)
"RTN","DGPFLMA2",62,0)
 . I PRFNAME="URGENT    ADDRESS AS FEMALE"&(DUZ("0")'="@") D  Q
"RTN","DGPFLMA2",63,0)
 . . W !!!,"The URGENT    ADDRESS AS FEMALE National Flag is limited to purposes"
"RTN","DGPFLMA2",64,0)
 . . W !,"authorized by the Undersecretary for Health only."
"RTN","DGPFLMA2",65,0)
 . . W !!!
"RTN","DGPFLMA2",66,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA2",67,0)
 . ;
"RTN","DGPFLMA2",68,0)
 . ;National ICN when Cat I assignment?
"RTN","DGPFLMA2",69,0)
 . I $P(DGPFA("FLAG"),U)["26.15",'$$MPIOK^DGPFUT(DGPFA("DFN")) D  Q
"RTN","DGPFLMA2",70,0)
 . . W !!,"Unable to proceed with flag assignment..."
"RTN","DGPFLMA2",71,0)
 . . D BLD^DIALOG(261132,"","","DGERR","F")
"RTN","DGPFLMA2",72,0)
 . . D MSG^DIALOG("WE","","","","DGERR") W *7
"RTN","DGPFLMA2",73,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA2",74,0)
 . ;
"RTN","DGPFLMA2",75,0)
 . ;run query for Cat I assignments
"RTN","DGPFLMA2",76,0)
 . I $P(DGPFA("FLAG"),U)["26.15",$$GETSTAT^DGPFHLL1(DGDFN)'="C" D
"RTN","DGPFLMA2",77,0)
 . . N DGDIFF    ;difference between pre and post query count
"RTN","DGPFLMA2",78,0)
 . . N DGFLGCNT  ;total count of Cat I flags
"RTN","DGPFLMA2",79,0)
 . . N DGPRECNT  ;pre-query count of Cat I assignments
"RTN","DGPFLMA2",80,0)
 . . N DGPSTCNT  ;post-query count of Cat I assignments
"RTN","DGPFLMA2",81,0)
 . . ;
"RTN","DGPFLMA2",82,0)
 . . ;get count of current assignments
"RTN","DGPFLMA2",83,0)
 . . S (DGPRECNT,DGPSTCNT)=$$GETALL^DGPFAA(DGDFN,,,1)
"RTN","DGPFLMA2",84,0)
 . . ;
"RTN","DGPFLMA2",85,0)
 . . ;get total count of possible Category I flags
"RTN","DGPFLMA2",86,0)
 . . S DGFLGCNT=$$CNTRECS^DGPFUT1(26.15)
"RTN","DGPFLMA2",87,0)
 . . ;
"RTN","DGPFLMA2",88,0)
 . . ;stop if all flags are assigned
"RTN","DGPFLMA2",89,0)
 . . Q:DGPRECNT=DGFLGCNT
"RTN","DGPFLMA2",90,0)
 . . ;
"RTN","DGPFLMA2",91,0)
 . . ;execute the query...stop on failure
"RTN","DGPFLMA2",92,0)
 . . Q:'$$SNDQRY^DGPFHLS(DGDFN,1,.DGFAC)
"RTN","DGPFLMA2",93,0)
 . . ;
"RTN","DGPFLMA2",94,0)
 . . ;recheck current assignment count
"RTN","DGPFLMA2",95,0)
 . . S DGPSTCNT=$$GETALL^DGPFAA(DGDFN,,,1)
"RTN","DGPFLMA2",96,0)
 . . S DGDIFF=DGPSTCNT-DGPRECNT
"RTN","DGPFLMA2",97,0)
 . . W !!,"    ",$S(DGDIFF=1:"A ",DGDIFF>1:"",1:"No ")_"Category I patient record flag assignment"_$S(DGDIFF>1!('DGDIFF):"s were",1:" was")_" returned"
"RTN","DGPFLMA2",98,0)
 . . W !,"    from "_$P($$NS^XUAF4($G(DGFAC)),U)_$S(DGDIFF:" and filed on your system.",1:".")
"RTN","DGPFLMA2",99,0)
 . . W !
"RTN","DGPFLMA2",100,0)
 . . ;
"RTN","DGPFLMA2",101,0)
 . . ;re-build list when flag assignments have been added
"RTN","DGPFLMA2",102,0)
 . . I DGDIFF D BLDLIST^DGPFLMU(DGDFN)
"RTN","DGPFLMA2",103,0)
 . ;
"RTN","DGPFLMA2",104,0)
 . ;ok to add new assignment?
"RTN","DGPFLMA2",105,0)
 . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),"DGERR") D  Q
"RTN","DGPFLMA2",106,0)
 . . W !!,"Unable to proceed with flag assignment..."
"RTN","DGPFLMA2",107,0)
 . . D MSG^DIALOG("WE","","",5,"DGERR")
"RTN","DGPFLMA2",108,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA2",109,0)
 . ;
"RTN","DGPFLMA2",110,0)
 . ;prompt for owner site
"RTN","DGPFLMA2",111,0)
 . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Enter Owner Site",$$EXTERNAL^DILFD(26.13,.04,"",DUZ(2),"DGERR"),"P^4:EMZ","","I $D(^DG(40.8,""APRF"",+Y)),$$TF^XUAF4(+Y)")
"RTN","DGPFLMA2",112,0)
 . Q:(DGPFA("OWNER")'>0)
"RTN","DGPFLMA2",113,0)
 . ;
"RTN","DGPFLMA2",114,0)
 . ;prompt user for approved by person, quit if not selected
"RTN","DGPFLMA2",115,0)
 . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
"RTN","DGPFLMA2",116,0)
 . Q:(DGPFAH("APPRVBY")'>0)
"RTN","DGPFLMA2",117,0)
 . ;
"RTN","DGPFLMA2",118,0)
 . ;have user enter assignment narrative text (required)
"RTN","DGPFLMA2",119,0)
 . S (DGABORT,DGOK)=0
"RTN","DGPFLMA2",120,0)
 . S DGWPROOT=$NA(^TMP($J,"DGPFNARR"))
"RTN","DGPFLMA2",121,0)
 . K @DGWPROOT
"RTN","DGPFLMA2",122,0)
 . F  D  Q:(DGOK!DGABORT)
"RTN","DGPFLMA2",123,0)
 . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor
"RTN","DGPFLMA2",124,0)
 . . S DIC=$$OREF^DILF(DGWPROOT)
"RTN","DGPFLMA2",125,0)
 . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
"RTN","DGPFLMA2",126,0)
 . . S DIWESUB="Assignment Narrative Text"
"RTN","DGPFLMA2",127,0)
 . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
"RTN","DGPFLMA2",128,0)
 . . S DWPK=1  ;if line editor, don't join lines
"RTN","DGPFLMA2",129,0)
 . . D EN^DIWE
"RTN","DGPFLMA2",130,0)
 . . I $$CKWP^DGPFUT(DGWPROOT) S DGOK=1 Q
"RTN","DGPFLMA2",131,0)
 . . W !,"Assignment Narrative Text is required!",*7
"RTN","DGPFLMA2",132,0)
 . . I '$$CONTINUE^DGPFUT() S DGABORT=1
"RTN","DGPFLMA2",133,0)
 . . ;
"RTN","DGPFLMA2",134,0)
 . ;quit if required assignment narrative not entered
"RTN","DGPFLMA2",135,0)
 . Q:$G(DGABORT)
"RTN","DGPFLMA2",136,0)
 . ;
"RTN","DGPFLMA2",137,0)
 . ;place assignment narrative text into assignment array
"RTN","DGPFLMA2",138,0)
 . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT
"RTN","DGPFLMA2",139,0)
 . ;
"RTN","DGPFLMA2",140,0)
 . ;setup remaining assignment and history array nodes for filing
"RTN","DGPFLMA2",141,0)
 . S DGPFA("STATUS")=1  ;active
"RTN","DGPFLMA2",142,0)
 . S DGPFA("ORIGSITE")=DUZ(2)  ;current user's login site
"RTN","DGPFLMA2",143,0)
 . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()  ;current date/time
"RTN","DGPFLMA2",144,0)
 . S DGPFAH("ACTION")=1  ;new assignment
"RTN","DGPFLMA2",145,0)
 . S DGPFAH("ENTERBY")=DUZ  ;current user
"RTN","DGPFLMA2",146,0)
 . S DGPFAH("COMMENT",1,0)="New record flag assignment."
"RTN","DGPFLMA2",147,0)
 . ;
"RTN","DGPFLMA2",148,0)
 . ;calculate the default review date
"RTN","DGPFLMA2",149,0)
 . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
"RTN","DGPFLMA2",150,0)
 . ;
"RTN","DGPFLMA2",151,0)
 . ;prompt for review date on valid default review date, otherwise null
"RTN","DGPFLMA2",152,0)
 . I DGRDAT>0 D
"RTN","DGPFLMA2",153,0)
 . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
"RTN","DGPFLMA2",154,0)
 . E  S DGPFA("REVIEWDT")=""
"RTN","DGPFLMA2",155,0)
 . Q:DGPFA("REVIEWDT")<0
"RTN","DGPFLMA2",156,0)
 . ;
"RTN","DGPFLMA2",157,0)
 . ;display flag assignment review screen to user
"RTN","DGPFLMA2",158,0)
 . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,"",XQY0,XQORNOD(0))
"RTN","DGPFLMA2",159,0)
 . ;
"RTN","DGPFLMA2",160,0)
 . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0
"RTN","DGPFLMA2",161,0)
 . ;
"RTN","DGPFLMA2",162,0)
 . ;file the assignment and history using STOALL api
"RTN","DGPFLMA2",163,0)
 . W !,"Filing the patient's new record flag assignment..."
"RTN","DGPFLMA2",164,0)
 . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
"RTN","DGPFLMA2",165,0)
 . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
"RTN","DGPFLMA2",166,0)
 . ;
"RTN","DGPFLMA2",167,0)
 . ;send HL7 message if adding an assignment to a CAT I flag
"RTN","DGPFLMA2",168,0)
 . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
"RTN","DGPFLMA2",169,0)
 . . W !?5,"Message sent...updating patient's sites of record."
"RTN","DGPFLMA2",170,0)
 . ;
"RTN","DGPFLMA2",171,0)
 . D PAUSE^VALM1
"RTN","DGPFLMA2",172,0)
 . ;
"RTN","DGPFLMA2",173,0)
 . ;re-build list of flag assignments for patient
"RTN","DGPFLMA2",174,0)
 . D BLDLIST^DGPFLMU(DGDFN)
"RTN","DGPFLMA2",175,0)
 ;
"RTN","DGPFLMA2",176,0)
 S VALMBCK="R"
"RTN","DGPFLMA2",177,0)
 ;
"RTN","DGPFLMA2",178,0)
 Q
"RTN","DGPFLMA3")
0^2^B74777125
"RTN","DGPFLMA3",1,0)
DGPFLMA3 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/2/05 3:24pm
"RTN","DGPFLMA3",2,0)
 ;;5.3;Registration;**425,623,554,650,864**;Aug 13, 1993;Build 16
"RTN","DGPFLMA3",3,0)
 ;
"RTN","DGPFLMA3",4,0)
 ;no direct entry
"RTN","DGPFLMA3",5,0)
 QUIT
"RTN","DGPFLMA3",6,0)
 ;
"RTN","DGPFLMA3",7,0)
EF ;Entry point for DGPF EDIT FLAG ASSIGNMENT action protocol.
"RTN","DGPFLMA3",8,0)
 ;
"RTN","DGPFLMA3",9,0)
 ;  Input: None
"RTN","DGPFLMA3",10,0)
 ;
"RTN","DGPFLMA3",11,0)
 ; Output:
"RTN","DGPFLMA3",12,0)
 ;   VALMBCK - 'R' = refresh screen
"RTN","DGPFLMA3",13,0)
 ;
"RTN","DGPFLMA3",14,0)
 ;input vars for EN^DIWE call
"RTN","DGPFLMA3",15,0)
 N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
"RTN","DGPFLMA3",16,0)
 N DGAROOT   ;assignment narrative word processing root
"RTN","DGPFLMA3",17,0)
 N DGCROOT   ;assignment history comment word processing root
"RTN","DGPFLMA3",18,0)
 N DGABORT   ;abort flag for entering assignment narrative
"RTN","DGPFLMA3",19,0)
 N DGASK     ;return value from $$ANSWER^DGPFUT call
"RTN","DGPFLMA3",20,0)
 N DGOK      ;ok flag for entering assignment narrative
"RTN","DGPFLMA3",21,0)
 N DGCODE    ;action code
"RTN","DGPFLMA3",22,0)
 N DGDFN     ;pointer to patient in PATIENT (#2) file
"RTN","DGPFLMA3",23,0)
 N DGIEN     ;assignment ien
"RTN","DGPFLMA3",24,0)
 N DGPFA     ;assignment array
"RTN","DGPFLMA3",25,0)
 N DGPFAH    ;assignment history array
"RTN","DGPFLMA3",26,0)
 N DGPFERR   ;if error returned from STOALL api call
"RTN","DGPFLMA3",27,0)
 N DGQ       ;quit var for narrative edit
"RTN","DGPFLMA3",28,0)
 N DGRDAT    ;review date
"RTN","DGPFLMA3",29,0)
 N DGRESULT  ;result of STOALL api call
"RTN","DGPFLMA3",30,0)
 N DGERR     ;error if unable to edit assignment
"RTN","DGPFLMA3",31,0)
 N DGETEXT   ;error text
"RTN","DGPFLMA3",32,0)
 N DGSUB     ;for loop var
"RTN","DGPFLMA3",33,0)
 N SEL       ;user selection (list item)
"RTN","DGPFLMA3",34,0)
 N VALMY     ;output of EN^VALM2 call, array of user selected entries
"RTN","DGPFLMA3",35,0)
 ;
"RTN","DGPFLMA3",36,0)
 ;set screen to full scroll region
"RTN","DGPFLMA3",37,0)
 D FULL^VALM1
"RTN","DGPFLMA3",38,0)
 ;
"RTN","DGPFLMA3",39,0)
 ;quit if selected action is not appropriate
"RTN","DGPFLMA3",40,0)
 I '$D(@VALMAR@("IDX")) D  Q
"RTN","DGPFLMA3",41,0)
 . I '$G(DGDFN) S DGETEXT(1)="Patient has not been selected."
"RTN","DGPFLMA3",42,0)
 . E  S DGETEXT(1)="Patient has no record flag assignments."
"RTN","DGPFLMA3",43,0)
 . D BLD^DIALOG(261129,.DGETEXT,"","DGERR","F")
"RTN","DGPFLMA3",44,0)
 . D MSG^DIALOG("WE","","","","DGERR") W *7
"RTN","DGPFLMA3",45,0)
 . D PAUSE^VALM1
"RTN","DGPFLMA3",46,0)
 . S VALMBCK="R"
"RTN","DGPFLMA3",47,0)
 ;
"RTN","DGPFLMA3",48,0)
 ;allow user to select a SINGLE flag assignment for editing
"RTN","DGPFLMA3",49,0)
 S (DGIEN,VALMBCK)=""
"RTN","DGPFLMA3",50,0)
 D EN^VALM2($G(XQORNOD(0)),"S")
"RTN","DGPFLMA3",51,0)
 ;
"RTN","DGPFLMA3",52,0)
 ;process user selection
"RTN","DGPFLMA3",53,0)
 S SEL=$O(VALMY(""))
"RTN","DGPFLMA3",54,0)
 I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
"RTN","DGPFLMA3",55,0)
 . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U)
"RTN","DGPFLMA3",56,0)
 . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2)
"RTN","DGPFLMA3",57,0)
 . ;
"RTN","DGPFLMA3",58,0)
 . ;attempt to obtain lock on assignment record
"RTN","DGPFLMA3",59,0)
 . I '$$LOCK^DGPFAA3(DGIEN) D  Q
"RTN","DGPFLMA3",60,0)
 . . W !!,"Record flag assignment currently in use, can not be edited!"
"RTN","DGPFLMA3",61,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA3",62,0)
 . ;
"RTN","DGPFLMA3",63,0)
 . ;init word processing arrays 
"RTN","DGPFLMA3",64,0)
 . S DGAROOT=$NA(^TMP($J,"DGPFNARR"))
"RTN","DGPFLMA3",65,0)
 . S DGCROOT=$NA(^TMP($J,"DGPFCMNT"))
"RTN","DGPFLMA3",66,0)
 . K @DGAROOT,@DGCROOT
"RTN","DGPFLMA3",67,0)
 . ;
"RTN","DGPFLMA3",68,0)
 . ;get assignment into DGPFA array
"RTN","DGPFLMA3",69,0)
 . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D  Q
"RTN","DGPFLMA3",70,0)
 . . W !!,"Unable to retrieve the record flag assignment selected."
"RTN","DGPFLMA3",71,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA3",72,0)
 . ;
"RTN","DGPFLMA3",73,0)
 . ;urgent address as female flag can't be edited dg*5.3*864
"RTN","DGPFLMA3",74,0)
 . I $P(DGPFA("FLAG"),",",2)="^URGENT    ADDRESS AS FEMALE" D  Q
"RTN","DGPFLMA3",75,0)
 . . W !!
"RTN","DGPFLMA3",76,0)
 . . W !!,"The URGENT    ADDRESS AS FEMALE Flag assignment cannot be edited."
"RTN","DGPFLMA3",77,0)
 . . W !!
"RTN","DGPFLMA3",78,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA3",79,0)
 . ;
"RTN","DGPFLMA3",80,0)
 . ;is assignment edit allowed?
"RTN","DGPFLMA3",81,0)
 . I '$$EDTOK^DGPFAA2(.DGPFA,DUZ(2),"DGERR") D  Q
"RTN","DGPFLMA3",82,0)
 . . W !!,"Assignment can not be edited..."
"RTN","DGPFLMA3",83,0)
 . . D MSG^DIALOG("WE","","",5,"DGERR")
"RTN","DGPFLMA3",84,0)
 . . D PAUSE^VALM1
"RTN","DGPFLMA3",85,0)
 . ;
"RTN","DGPFLMA3",86,0)
 . ;-if assigment is active, set available action codes to Continue
"RTN","DGPFLMA3",87,0)
 . ; and Inactivate; else set code to Reactivate
"RTN","DGPFLMA3",88,0)
 . ;-if Local Flag or PRF Phase 2 active, add Entered in Error code
"RTN","DGPFLMA3",89,0)
 . I +DGPFA("STATUS")=1 D
"RTN","DGPFLMA3",90,0)
 . . S DGCODE="S^C:Continue Assignment;I:Inactivate Assignment"
"RTN","DGPFLMA3",91,0)
 . . I $$P2ON^DGPFPARM()!(DGPFA("FLAG")[26.11) S DGCODE=DGCODE_";E:Entered in Error"
"RTN","DGPFLMA3",92,0)
 . E  S DGCODE="S^R:Reactivate Assignment"
"RTN","DGPFLMA3",93,0)
 . ;
"RTN","DGPFLMA3",94,0)
 . ;prompt user for assignment action, quit if no action selected
"RTN","DGPFLMA3",95,0)
 . S DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE)
"RTN","DGPFLMA3",96,0)
 . Q:(DGPFAH("ACTION")=-1)
"RTN","DGPFLMA3",97,0)
 . S DGPFAH("ACTION")=$S(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4,DGPFAH("ACTION")="E":5)
"RTN","DGPFLMA3",98,0)
 . ;
"RTN","DGPFLMA3",99,0)
 . ;if assignment action is 'Inactivate' or 'Entered in Error',
"RTN","DGPFLMA3",100,0)
 . ;set status to 'Inactive'. default='Active'.
"RTN","DGPFLMA3",101,0)
 . S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1)
"RTN","DGPFLMA3",102,0)
 . ;
"RTN","DGPFLMA3",103,0)
 . ;if action is not 'Inactivate', then prompt user to edit the narr
"RTN","DGPFLMA3",104,0)
 . S (DGABORT,DGOK,DGQ)=0
"RTN","DGPFLMA3",105,0)
 . I (DGPFAH("ACTION")'=3) D
"RTN","DGPFLMA3",106,0)
 . . F  D  Q:(DGOK!DGABORT!DGQ)
"RTN","DGPFLMA3",107,0)
 . . . ; if action code not 'Entered in Error', can't force edit
"RTN","DGPFLMA3",108,0)
 . . . I DGPFAH("ACTION")'=5 D  Q:(DGQ!DGABORT)
"RTN","DGPFLMA3",109,0)
 . . . . S DGASK=$$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y")
"RTN","DGPFLMA3",110,0)
 . . . . I DGASK<0 S DGABORT=1 Q  ;abort edit action
"RTN","DGPFLMA3",111,0)
 . . . . I DGASK'=1 S DGQ=1 Q
"RTN","DGPFLMA3",112,0)
 . . . ;
"RTN","DGPFLMA3",113,0)
 . . . ;--edit narrative - only '5;Entered in Error' Required
"RTN","DGPFLMA3",114,0)
 . . . ;--edit the assignment narrative
"RTN","DGPFLMA3",115,0)
 . . . S DGAROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT)
"RTN","DGPFLMA3",116,0)
 . . . S DIC=$$OREF^DILF(DGAROOT)
"RTN","DGPFLMA3",117,0)
 . . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
"RTN","DGPFLMA3",118,0)
 . . . S DIWESUB="Assignment Narrative Text"
"RTN","DGPFLMA3",119,0)
 . . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
"RTN","DGPFLMA3",120,0)
 . . . S DWPK=1  ;if line editor, don't join lines
"RTN","DGPFLMA3",121,0)
 . . . D EN^DIWE
"RTN","DGPFLMA3",122,0)
 . . . I '$$CKWP^DGPFUT(DGAROOT) D  Q
"RTN","DGPFLMA3",123,0)
 . . . . W !,"Assignment Narrative Text is required!",*7
"RTN","DGPFLMA3",124,0)
 . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
"RTN","DGPFLMA3",125,0)
 . . . ;if number of text lines not the same, a change was made
"RTN","DGPFLMA3",126,0)
 . . . I $O(DGPFA("NARR",""),-1)'=$O(@DGAROOT@(""),-1) S DGOK=1 Q
"RTN","DGPFLMA3",127,0)
 . . . ;now check for a difference in text line content
"RTN","DGPFLMA3",128,0)
 . . . S DGSUB=0
"RTN","DGPFLMA3",129,0)
 . . . F  S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:DGSUB=""  D  Q:DGOK
"RTN","DGPFLMA3",130,0)
 . . . . I DGPFA("NARR",DGSUB,0)'=@DGAROOT@(DGSUB,0) S DGOK=1
"RTN","DGPFLMA3",131,0)
 . . . Q:DGOK
"RTN","DGPFLMA3",132,0)
 . . . I 'DGOK,(DGPFAH("ACTION")=5) D  Q  ;required edit
"RTN","DGPFLMA3",133,0)
 . . . . W !!,"No editing was found to the Narrative text."
"RTN","DGPFLMA3",134,0)
 . . . . W !,"For 'Entered in Error' Action, you must edit the Assignment Narrative Text.",*7,!
"RTN","DGPFLMA3",135,0)
 . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
"RTN","DGPFLMA3",136,0)
 . . . S DGOK=1
"RTN","DGPFLMA3",137,0)
 . ;
"RTN","DGPFLMA3",138,0)
 . Q:$G(DGABORT)
"RTN","DGPFLMA3",139,0)
 . ;
"RTN","DGPFLMA3",140,0)
 . ;if narrative edited, place new narrative into DGPFA array
"RTN","DGPFLMA3",141,0)
 . I $G(DGOK) D
"RTN","DGPFLMA3",142,0)
 . . K DGPFA("NARR")  ;remove old narrative text
"RTN","DGPFLMA3",143,0)
 . . M DGPFA("NARR")=@DGAROOT K @DGAROOT
"RTN","DGPFLMA3",144,0)
 . ;
"RTN","DGPFLMA3",145,0)
 . ;prompt user for 'Approved By' person, quit if not selected
"RTN","DGPFLMA3",146,0)
 . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
"RTN","DGPFLMA3",147,0)
 . Q:(DGPFAH("APPRVBY")'>0)
"RTN","DGPFLMA3",148,0)
 . ;
"RTN","DGPFLMA3",149,0)
 . ;have user enter the edit reason/history comments (required)
"RTN","DGPFLMA3",150,0)
 . S (DGABORT,DGOK)=0
"RTN","DGPFLMA3",151,0)
 . F  D  Q:(DGOK!DGABORT)
"RTN","DGPFLMA3",152,0)
 . . W !!,"Enter the reason for editing this assignment:"  ;needed for line editor
"RTN","DGPFLMA3",153,0)
 . . S DIC=$$OREF^DILF(DGCROOT)
"RTN","DGPFLMA3",154,0)
 . . S DIWETXT="Patient Record Flag - Edit Reason Text"
"RTN","DGPFLMA3",155,0)
 . . S DIWESUB="Edit Reason Text"
"RTN","DGPFLMA3",156,0)
 . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
"RTN","DGPFLMA3",157,0)
 . . S DWPK=1  ;if line editor, don't join lines
"RTN","DGPFLMA3",158,0)
 . . D EN^DIWE
"RTN","DGPFLMA3",159,0)
 . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q
"RTN","DGPFLMA3",160,0)
 . . W !,"Edit Reason is required!",*7
"RTN","DGPFLMA3",161,0)
 . . I '$$CONTINUE^DGPFUT() S DGABORT=1
"RTN","DGPFLMA3",162,0)
 . ;
"RTN","DGPFLMA3",163,0)
 . ;quit if required edit reason/history comments not entered
"RTN","DGPFLMA3",164,0)
 . Q:$G(DGABORT)
"RTN","DGPFLMA3",165,0)
 . ;
"RTN","DGPFLMA3",166,0)
 . ;place comments into history array
"RTN","DGPFLMA3",167,0)
 . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT
"RTN","DGPFLMA3",168,0)
 . ;
"RTN","DGPFLMA3",169,0)
 . ;setup remaining assignment history nodes for filing
"RTN","DGPFLMA3",170,0)
 . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()  ;current date/time
"RTN","DGPFLMA3",171,0)
 . S DGPFAH("ENTERBY")=DUZ             ;current user
"RTN","DGPFLMA3",172,0)
 . ;
"RTN","DGPFLMA3",173,0)
 . ;calculate the default review date
"RTN","DGPFLMA3",174,0)
 . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
"RTN","DGPFLMA3",175,0)
 . ;
"RTN","DGPFLMA3",176,0)
 . ;prompt for review date when valid default review date and ACTIVE
"RTN","DGPFLMA3",177,0)
 . ;status, otherwise null
"RTN","DGPFLMA3",178,0)
 . I DGRDAT>0,DGPFA("STATUS")=1 D
"RTN","DGPFLMA3",179,0)
 . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
"RTN","DGPFLMA3",180,0)
 . E  S DGPFA("REVIEWDT")=""
"RTN","DGPFLMA3",181,0)
 . Q:DGPFA("REVIEWDT")<0
"RTN","DGPFLMA3",182,0)
 . ;
"RTN","DGPFLMA3",183,0)
 . ;display flag assignment review screen to user
"RTN","DGPFLMA3",184,0)
 . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
"RTN","DGPFLMA3",185,0)
 . ;
"RTN","DGPFLMA3",186,0)
 . Q:$$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0
"RTN","DGPFLMA3",187,0)
 . ;
"RTN","DGPFLMA3",188,0)
 . ;file the assignment and history using STOALL api
"RTN","DGPFLMA3",189,0)
 . W !,"Updating the patient's record flag assignment..."
"RTN","DGPFLMA3",190,0)
 . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
"RTN","DGPFLMA3",191,0)
 . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
"RTN","DGPFLMA3",192,0)
 . ;
"RTN","DGPFLMA3",193,0)
 . ;send HL7 message if editing assignment to a CAT I flag
"RTN","DGPFLMA3",194,0)
 . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
"RTN","DGPFLMA3",195,0)
 . . W !?5,"Message sent...updating patient's sites of record."
"RTN","DGPFLMA3",196,0)
 . ;
"RTN","DGPFLMA3",197,0)
 . D PAUSE^VALM1
"RTN","DGPFLMA3",198,0)
 . ;
"RTN","DGPFLMA3",199,0)
 . ;re-build list of flag assignments for patient
"RTN","DGPFLMA3",200,0)
 . D BLDLIST^DGPFLMU(DGDFN)
"RTN","DGPFLMA3",201,0)
 ;
"RTN","DGPFLMA3",202,0)
 ;release lock after edit
"RTN","DGPFLMA3",203,0)
 D UNLOCK^DGPFAA3(DGIEN)
"RTN","DGPFLMA3",204,0)
 ;
"RTN","DGPFLMA3",205,0)
 ;return to LM (refresh screen)
"RTN","DGPFLMA3",206,0)
 S VALMBCK="R"
"RTN","DGPFLMA3",207,0)
 ;
"RTN","DGPFLMA3",208,0)
 Q
"RTN","DGPFMPI")
0^6^B2049737
"RTN","DGPFMPI",1,0)
DGPFMPI ;BP/DMR - PRF TRANSMISSION CALL FOR MPI
"RTN","DGPFMPI",2,0)
 ;;5.3;Registration;**864**;Aug 13, 1993;Build 16
"RTN","DGPFMPI",3,0)
 ;
"RTN","DGPFMPI",4,0)
 ;Routine to transmit PRF, used by MPI during the the patient load/edit
"RTN","DGPFMPI",5,0)
 ;process or as a standalone routine.
"RTN","DGPFMPI",6,0)
 ;
"RTN","DGPFMPI",7,0)
 ;INPUT - DFN
"RTN","DGPFMPI",8,0)
 ;
"RTN","DGPFMPI",9,0)
EN(DFN) ;
"RTN","DGPFMPI",10,0)
 ;
"RTN","DGPFMPI",11,0)
 Q:$G(DFN)'>0 0
"RTN","DGPFMPI",12,0)
 ;
"RTN","DGPFMPI",13,0)
 N DGINST,DGTRANS,DGTF,DGTF2
"RTN","DGPFMPI",14,0)
 S DGTRANS=0,DGTF2=""
"RTN","DGPFMPI",15,0)
 ;
"RTN","DGPFMPI",16,0)
 I $$BLDTFL^DGPFUT2(DFN,.DGTF) D  G EXIT
"RTN","DGPFMPI",17,0)
 . D SITE
"RTN","DGPFMPI",18,0)
 . S DGINST=0
"RTN","DGPFMPI",19,0)
 . F  S DGINST=$O(DGTF2(DGINST)) Q:+$G(DGINST)'>0  D
"RTN","DGPFMPI",20,0)
 . . S DGTRANS=$$SNDQRY^DGPFHLS(DFN,$$QRYON^DGPFPARM(),DGINST)
"RTN","DGPFMPI",21,0)
 ;
"RTN","DGPFMPI",22,0)
EXIT ;
"RTN","DGPFMPI",23,0)
 Q DGTRANS
"RTN","DGPFMPI",24,0)
 ;
"RTN","DGPFMPI",25,0)
 ;Call to run in background, without displaying patient information.
"RTN","DGPFMPI",26,0)
 ;
"RTN","DGPFMPI",27,0)
EN1(DFN) ;
"RTN","DGPFMPI",28,0)
 ;
"RTN","DGPFMPI",29,0)
 Q:$G(DFN)'>0 0
"RTN","DGPFMPI",30,0)
 ;
"RTN","DGPFMPI",31,0)
 N DGTF,DGINST,DGTRANS,DGMODE,DGTF2
"RTN","DGPFMPI",32,0)
 S DGMODE=2
"RTN","DGPFMPI",33,0)
 S DGTRANS=0,DGTF2=""
"RTN","DGPFMPI",34,0)
 ;
"RTN","DGPFMPI",35,0)
 I $$BLDTFL^DGPFUT2(DFN,.DGTF) D  G EXIT1
"RTN","DGPFMPI",36,0)
 . D SITE
"RTN","DGPFMPI",37,0)
 . S DGINST=0
"RTN","DGPFMPI",38,0)
 . F  S DGINST=$O(DGTF2(DGINST)) Q:+$G(DGINST)'>0  D
"RTN","DGPFMPI",39,0)
 . . S DGTRANS=$$SNDQRY^DGPFHLS(DFN,DGMODE,DGINST)
"RTN","DGPFMPI",40,0)
 ;
"RTN","DGPFMPI",41,0)
EXIT1 ;
"RTN","DGPFMPI",42,0)
 Q DGTRANS
"RTN","DGPFMPI",43,0)
 ;
"RTN","DGPFMPI",44,0)
SITE ;
"RTN","DGPFMPI",45,0)
 N FAC,IEN
"RTN","DGPFMPI",46,0)
 ;
"RTN","DGPFMPI",47,0)
 S FAC=0,IEN=0
"RTN","DGPFMPI",48,0)
 F  S FAC=$O(DGTF(FAC)) Q:+$G(FAC)'>0  D
"RTN","DGPFMPI",49,0)
 . S IEN=$$GET1^DIQ(4,FAC,99) Q:+IEN'>0  D
"RTN","DGPFMPI",50,0)
 . . S DGTF2(IEN)=DGTF(FAC)
"RTN","DGPFMPI",51,0)
 Q
"RTN","DGREG")
0^4^B47583853
"RTN","DGREG",1,0)
DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ; 8/24/05 1:40pm
"RTN","DGREG",2,0)
 ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658,864**;Aug 13, 1993;Build 16
"RTN","DGREG",3,0)
START ;
"RTN","DGREG",4,0)
EN D LO^DGUTL S DGCLPR=""
"RTN","DGREG",5,0)
 N DGDIV
"RTN","DGREG",6,0)
 S DGDIV=$$PRIM^VASITE
"RTN","DGREG",7,0)
 S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
"RTN","DGREG",8,0)
 I $P(^DG(43,1,0),U,39) S %ZIS="NQ",%ZIS("A")="Select 1010 printer: " D ^%ZIS Q:POP  S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV="" I $E(IOST,1,2)'["P-" W !,$C(7),"Not a printer" G DGREG
"RTN","DGREG",9,0)
 K %ZIS("B")
"RTN","DGREG",10,0)
 I '$D(DGIO),$P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) W !,"Using closest printer ",Y,! F I=10,"PRF","RT","HS" S DGIO(I)=Y
"RTN","DGREG",11,0)
A D ENDREG($G(DFN))
"RTN","DGREG",12,0)
 W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP
"RTN","DGREG",13,0)
 ;
"RTN","DGREG",14,0)
 ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
"RTN","DGREG",15,0)
 S DOD="" I $G(DFN) S DOD=$P($G(^DPT(DFN,.35)),"^",1)
"RTN","DGREG",16,0)
 I DOD S Y=DOD,DGPME=0 D DIED^DGPMV I DGPME K DFN,DGRPOUT G A
"RTN","DGREG",17,0)
 ;
"RTN","DGREG",18,0)
 D CIRN
"RTN","DGREG",19,0)
 ;
"RTN","DGREG",20,0)
 I +$G(DGNEW) D
"RTN","DGREG",21,0)
 . ; query CMOR for Patient Record Flag Assignments if NEW patient and
"RTN","DGREG",22,0)
 . ; display results.
"RTN","DGREG",23,0)
 . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
"RTN","DGREG",24,0)
 . I $$EN^DGPFMPI(DFN)
"RTN","DGREG",25,0)
 ;
"RTN","DGREG",26,0)
 D ROMQRY
"RTN","DGREG",27,0)
 ;
"RTN","DGREG",28,0)
 S (DGFC,CURR)=0
"RTN","DGREG",29,0)
 D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
"RTN","DGREG",30,0)
 S %ZIS="N",IOP="HOME" D ^%ZIS S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) D ENDREG($G(DFN)) D HL7A08^VAFCDD01 K DFN,DGRPOUT G A
"RTN","DGREG",31,0)
 D HINQ^DG10
"RTN","DGREG",32,0)
 I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3
"RTN","DGREG",33,0)
 D REG^IVMCQ($G(DFN))  ; send financial query  
"RTN","DGREG",34,0)
 G A1
"RTN","DGREG",35,0)
 ;
"RTN","DGREG",36,0)
RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3
"RTN","DGREG",37,0)
 Q
"RTN","DGREG",38,0)
 ;
"RTN","DGREG",39,0)
A1 W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN D  G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G Q:'$D(DA)
"RTN","DGREG",40,0)
 .I +$G(DGNEW) Q
"RTN","DGREG",41,0)
 .I $$ADD^DGADDUTL($G(DFN)) ;
"RTN","DGREG",42,0)
 G CH
"RTN","DGREG",43,0)
PR W !!,"Is the patient currently being followed in a clinic for the same condition" S %=0 D YN^DICN G Q:%=-1
"RTN","DGREG",44,0)
 I '% W !?4,$C(7),"Enter 'Y' if the patient is being followed in clinic for condition for which",!?6,"registered, 'N' if not." G PR
"RTN","DGREG",45,0)
 S CURR=% G SEEN
"RTN","DGREG",46,0)
 ;
"RTN","DGREG",47,0)
CK S DGEDCN=1 D ^DGRPC
"RTN","DGREG",48,0)
CH S X=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0),X1=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) I 'X,'X1 G CH1
"RTN","DGREG",49,0)
CH1 S DA=DFN G PR:'$D(^DPT("ADA",1,DA)) W !!,"There is still an open disposition--register aborted.",$C(7),$C(7) G Q
"RTN","DGREG",50,0)
SEEN W !!,"Is the patient to be examined in the medical center today" S %=1 D YN^DICN S SEEN=% G:%<0 Q I %'>0 W !!,"Enter 'Y' if the patient is to be examined today, 'N' if not.",$C(7) G SEEN
"RTN","DGREG",51,0)
ABIL D ^DGREGG
"RTN","DGREG",52,0)
ENR ; next line appears to be dead code.  left commented just to test.  mli 4/28/94
"RTN","DGREG",53,0)
 ;S DE=0 F I=0:0 S I=$O(^DPT(DA,"DE",I)) Q:'I  I $P(^(I,0),"^",3)'?7N Q  D PR:'DE S L=+$P($S($D(^SC(L,0)):^(0),1:""),"^",1)
"RTN","DGREG",54,0)
REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// "
"RTN","DGREG",55,0)
 W !,%DT("A") R ANS:DTIME S:'$T ANS="^" S:ANS="" ANS="N" S X=ANS G Q:ANS="^" S DA(1)=DFN D CHK^DIE(2.101,.01,"E",X,.RESULT) G REG:RESULT="^"!('$D(RESULT)),PR3:'(RESULT#1) S Y=RESULT
"RTN","DGREG",56,0)
 I (RESULT'="^") W "  ("_RESULT(0)_")"
"RTN","DGREG",57,0)
 S DINUM=9999999-RESULT
"RTN","DGREG",58,0)
 S (DFN1,Y1)=DINUM,APD=Y I $D(^DPT(DFN,"DIS",Y1)) W !!,"You must enter a date that does not exist.",$C(7),$C(7) G REG
"RTN","DGREG",59,0)
 G:$D(^DPT("ADA",1,DA)) CH1 L @(DIE_DINUM_")"):2 G:'$T MSG S:'($D(^DPT(DA(1),"DIS",0))#2) ^(0)="^2.101D^^" S DIC(0)="L",X=+Y D ^DIC
"RTN","DGREG",60,0)
 ;
"RTN","DGREG",61,0)
 ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT
"RTN","DGREG",62,0)
 S VAFCDDT=X
"RTN","DGREG",63,0)
 ;
"RTN","DGREG",64,0)
 S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ
"RTN","DGREG",65,0)
 D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK
"RTN","DGREG",66,0)
 I $D(DTOUT) D  G Q
"RTN","DGREG",67,0)
 .K DTOUT
"RTN","DGREG",68,0)
 .N DA,DIK
"RTN","DGREG",69,0)
 .S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS"","
"RTN","DGREG",70,0)
 .D ^DIK
"RTN","DGREG",71,0)
 .W !!?5,"User Time-out.  Required registration data could be missing."
"RTN","DGREG",72,0)
 .W !,?5,"This registration has been deleted."
"RTN","DGREG",73,0)
 ; check whether facility applying to (division) is inactive
"RTN","DGREG",74,0)
 I '$$DIVCHK^DGREGFAC(DFN,DFN1) G CONT
"RTN","DGREG",75,0)
ASKDIV W !!?5,"The facility chosen either has no pointer to an Institution"
"RTN","DGREG",76,0)
 W !?5,"file record or the Institution file record is inactive."
"RTN","DGREG",77,0)
 W !?5,"Please choose another division."
"RTN","DGREG",78,0)
 S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="3" D ^DIE
"RTN","DGREG",79,0)
 I $$DIVCHK^DGREGFAC(DFN,DFN1) G ASKDIV
"RTN","DGREG",80,0)
CONT ; continue
"RTN","DGREG",81,0)
 S DGXXXD=1 D EL^DGREGE I $P(^DPT(DFN,"DIS",DFN1,0),"^",3)=4 S DA=DFN,DIE="^DPT(",DR=".368;.369" D ^DIE S DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DA=DFN1
"RTN","DGREG",82,0)
 S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^")
"RTN","DGREG",83,0)
 I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE
"RTN","DGREG",84,0)
 G ^DGREG0
"RTN","DGREG",85,0)
PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG
"RTN","DGREG",86,0)
PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG
"RTN","DGREG",87,0)
H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1
"RTN","DGREG",88,0)
Q K DG,DQ G Q1^DGREG0
"RTN","DGREG",89,0)
Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q
"RTN","DGREG",90,0)
EL S DR=DR_";13//" I $D(^DPT(DFN,.36)),$D(^DIC(8,+^(.36),0)) S DR=DR_$P(^(0),"^",1) Q
"RTN","DGREG",91,0)
 S DR=DR_"HUMANITARIAN EMERGENCY" Q
"RTN","DGREG",92,0)
FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1
"RTN","DGREG",93,0)
 ;
"RTN","DGREG",94,0)
WARN I $S('$D(^DPT(DFN,.1)):0,$P(^(.1),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY AN INPATIENT***",! H 2
"RTN","DGREG",95,0)
 I $S('$D(^DPT(DFN,.107)):0,$P(^(.107),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY A LODGER***",! H 2
"RTN","DGREG",96,0)
 Q
"RTN","DGREG",97,0)
MSG W !,"Another user is editing, try later ..." G Q
"RTN","DGREG",98,0)
 ;
"RTN","DGREG",99,0)
BEGINREG(DFN) ;
"RTN","DGREG",100,0)
 ;Description: This is called at the beginning of the registration process.
"RTN","DGREG",101,0)
 ;Concurrent processes can check the lock to determine if the patient is
"RTN","DGREG",102,0)
 ;currently being registered.
"RTN","DGREG",103,0)
 ;
"RTN","DGREG",104,0)
 Q:'$G(DFN) 0
"RTN","DGREG",105,0)
 I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!!
"RTN","DGREG",106,0)
 L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
"RTN","DGREG",107,0)
 I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record
"RTN","DGREG",108,0)
 Q
"RTN","DGREG",109,0)
 ;
"RTN","DGREG",110,0)
ENDREG(DFN) ;
"RTN","DGREG",111,0)
 ;Description: releases the lock obtained by calling BEGINREG.
"RTN","DGREG",112,0)
 ;
"RTN","DGREG",113,0)
 Q:'$G(DFN)
"RTN","DGREG",114,0)
 L -^TMP(DFN,"REGISTRATION IN PROGRESS")
"RTN","DGREG",115,0)
 D UNLOCK^DGENPTA1(DFN)
"RTN","DGREG",116,0)
 Q
"RTN","DGREG",117,0)
 ;
"RTN","DGREG",118,0)
IFREG(DFN) ;
"RTN","DGREG",119,0)
 ;Description: tests whether the lock set by BEGINREG is set
"RTN","DGREG",120,0)
 ;
"RTN","DGREG",121,0)
 ;Input:  DFN
"RTN","DGREG",122,0)
 ;Output:
"RTN","DGREG",123,0)
 ;      Function Value = 1 if lock is set, 0 otherwise
"RTN","DGREG",124,0)
 ;
"RTN","DGREG",125,0)
 N RETURN
"RTN","DGREG",126,0)
 Q:'$G(DFN) 0
"RTN","DGREG",127,0)
 L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
"RTN","DGREG",128,0)
 S RETURN='$T
"RTN","DGREG",129,0)
 L -^TMP(DFN,"REGISTRATION IN PROGRESS")
"RTN","DGREG",130,0)
 Q RETURN
"RTN","DGREG",131,0)
 Q
"RTN","DGREG",132,0)
CIRN ;MPI QUERY
"RTN","DGREG",133,0)
 ;check to see if CIRN PD/MPI is installed
"RTN","DGREG",134,0)
 N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
"RTN","DGREG",135,0)
 K MPIFRTN
"RTN","DGREG",136,0)
 D MPIQ^MPIFAPI(DFN)
"RTN","DGREG",137,0)
 K MPIFRTN
"RTN","DGREG",138,0)
 Q
"RTN","DGREG",139,0)
ROMQRY ;
"RTN","DGREG",140,0)
 I +$G(DGNEW) D
"RTN","DGREG",141,0)
 . ; query LST for Patient Demographic Information if NEW patient and
"RTN","DGREG",142,0)
 . ; file into patient's record.
"RTN","DGREG",143,0)
 . N A
"RTN","DGREG",144,0)
 . I $$ROMQRY^DGROAPI(DFN) D
"RTN","DGREG",145,0)
 . . ;display busy message to interactive users
"RTN","DGREG",146,0)
 . .S DGMSG(1)="Data retrieval from LST site has been completed successfully"
"RTN","DGREG",147,0)
 . .S DGMSG(2)="Thank you for your patience."
"RTN","DGREG",148,0)
 . .D EN^DDIOL(.DGMSG) R A:5
"RTN","DGREG",149,0)
 . E  D
"RTN","DGREG",150,0)
 . . ;display busy message to interactive users
"RTN","DGREG",151,0)
 . .S DGMSG(1)="Data retrieval from LST site has not been successful."
"RTN","DGREG",152,0)
 . .S DGMSG(2)="Please continue the Registration Process."
"RTN","DGREG",153,0)
 . .D EN^DDIOL(.DGMSG) R A:5
"RTN","DGREG",154,0)
 . ;
"RTN","DGREG",155,0)
 Q
"VER")
8.0^22.0
**INSTALL NAME**
GMTS*2.7*103
"BLD",8693,0)
GMTS*2.7*103^HEALTH SUMMARY^0^3130827^y
"BLD",8693,1,0)
^^5^5^3130717^
"BLD",8693,1,1,0)
Distributes ONE new HEALTH SUMMARY COMPONENT and TWO new HEALTH SUMMARY 
"BLD",8693,1,2,0)
TYPEs, one of which will be a REMOTE type.
"BLD",8693,1,3,0)
Component: CAT 1 PRF STATUS (IEN=257)
"BLD",8693,1,4,0)
    Types: VA-CAT 1 PRF STATUS
"BLD",8693,1,5,0)
           REMOTE CAT 1 PRF STATUS (IEN=500021)
"BLD",8693,4,0)
^9.64PA^811.8^1
"BLD",8693,4,811.8,0)
811.8
"BLD",8693,4,811.8,222)
n^n^f^^n^^y^o^n
"BLD",8693,4,811.8,224)
I $$EXFINC^PXRMEXSI(Y,"EXARRAY","GMTSY103")
"BLD",8693,4,"B",811.8,811.8)

"BLD",8693,6.3)
7
"BLD",8693,"INI")
PRE^GMTSY103
"BLD",8693,"INIT")
POST^GMTSY103
"BLD",8693,"KRN",0)
^9.67PA^779.2^20
"BLD",8693,"KRN",.4,0)
.4
"BLD",8693,"KRN",.401,0)
.401
"BLD",8693,"KRN",.402,0)
.402
"BLD",8693,"KRN",.403,0)
.403
"BLD",8693,"KRN",.5,0)
.5
"BLD",8693,"KRN",.84,0)
.84
"BLD",8693,"KRN",3.6,0)
3.6
"BLD",8693,"KRN",3.8,0)
3.8
"BLD",8693,"KRN",9.2,0)
9.2
"BLD",8693,"KRN",9.8,0)
9.8
"BLD",8693,"KRN",9.8,"NM",0)
^9.68A^2^2
"BLD",8693,"KRN",9.8,"NM",1,0)
GMTSRFHX^^0^B19895758
"BLD",8693,"KRN",9.8,"NM",2,0)
GMTSY103^^0^B35203734
"BLD",8693,"KRN",9.8,"NM","B","GMTSRFHX",1)

"BLD",8693,"KRN",9.8,"NM","B","GMTSY103",2)

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

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

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

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

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

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

"BLD",8693,"KRN","B",3.6,3.6)

"BLD",8693,"KRN","B",3.8,3.8)

"BLD",8693,"KRN","B",9.2,9.2)

"BLD",8693,"KRN","B",9.8,9.8)

"BLD",8693,"KRN","B",19,19)

"BLD",8693,"KRN","B",19.1,19.1)

"BLD",8693,"KRN","B",101,101)

"BLD",8693,"KRN","B",409.61,409.61)

"BLD",8693,"KRN","B",771,771)

"BLD",8693,"KRN","B",779.2,779.2)

"BLD",8693,"KRN","B",870,870)

"BLD",8693,"KRN","B",8989.51,8989.51)

"BLD",8693,"KRN","B",8989.52,8989.52)

"BLD",8693,"KRN","B",8994,8994)

"BLD",8693,"PRE")
GMTSY103
"BLD",8693,"QUES",0)
^9.62^^
"BLD",8693,"REQB",0)
^9.611^^
"DATA",811.8,262,0)
VA-HS TYPES GMTS*2.7*103^THOMPSON,WILLIAM A at SALT LAKE CITY OIFO^3130718.124038
"DATA",811.8,262,100,0)
^811.801^84^84
"DATA",811.8,262,100,1,0)
<?xml version="1.0" standalone="yes"?>
"DATA",811.8,262,100,2,0)
<REMINDER_EXCHANGE_FILE_ENTRY>
"DATA",811.8,262,100,3,0)
<PACKAGE_VERSION>2.0P28</PACKAGE_VERSION>
"DATA",811.8,262,100,4,0)
<INDEX_AT>67</INDEX_AT>
"DATA",811.8,262,100,5,0)
<SOURCE>
"DATA",811.8,262,100,6,0)
<NAME>VA-HS TYPES GMTS*2.7*103</NAME>
"DATA",811.8,262,100,7,0)
<USER>THOMPSON,WILLIAM A</USER>
"DATA",811.8,262,100,8,0)
<SITE>SALT LAKE CITY OIFO</SITE>
"DATA",811.8,262,100,9,0)
<DATE_PACKED>07/18/2013@12:40:38</DATE_PACKED>
"DATA",811.8,262,100,10,0)
</SOURCE>
"DATA",811.8,262,100,11,0)
<DESCRIPTION><![CDATA[
"DATA",811.8,262,100,12,0)
Contains two Health Summary Types to be installed by patch GMTS*2.7*103.
"DATA",811.8,262,100,13,0)
VA-PT RECORD FLAG STATUS
"DATA",811.8,262,100,14,0)
REMOTE PT RECORD FLAG STATUS
"DATA",811.8,262,100,15,0)
]]></DESCRIPTION>
"DATA",811.8,262,100,16,0)
<KEYWORDS>
"DATA",811.8,262,100,17,0)
<KEYWORD>GMTS*2.7*103</KEYWORD>
"DATA",811.8,262,100,18,0)
<KEYWORD>HRMHP</KEYWORD>
"DATA",811.8,262,100,19,0)
</KEYWORDS>
"DATA",811.8,262,100,20,0)
<FILEMAN_FILE>
"DATA",811.8,262,100,21,0)
<FILE_NAME>HEALTH SUMMARY TYPE</FILE_NAME>
"DATA",811.8,262,100,22,0)
<FILE_NUMBER>142</FILE_NUMBER>
"DATA",811.8,262,100,23,0)
<POINT_01>VA-PT RECORD FLAG STATUS</POINT_01>
"DATA",811.8,262,100,24,0)
<INTERNAL_ENTRY_NUMBER>1279</INTERNAL_ENTRY_NUMBER>
"DATA",811.8,262,100,25,0)
<CHECKSUM>1042232216</CHECKSUM>
"DATA",811.8,262,100,26,0)
<SELECTED>YES</SELECTED>
"DATA",811.8,262,100,27,0)
<FILEMAN_FDA>
"DATA",811.8,262,100,28,0)
<![CDATA[
"DATA",811.8,262,100,29,0)
142;+1279,;.01~VA-PT RECORD FLAG STATUS
"DATA",811.8,262,100,30,0)
142;+1279,;.05~GMTSMGR
"DATA",811.8,262,100,31,0)
142;+1279,;.09~Nationally Exported, Uneditable
"DATA",811.8,262,100,32,0)
142;+1279,;99~63021,33155
"DATA",811.8,262,100,33,0)
142.01;+1280,+1279,;.01~5
"DATA",811.8,262,100,34,0)
142.01;+1280,+1279,;1~CAT I PT RECORD FLAG STATUS
"DATA",811.8,262,100,35,0)
]]>
"DATA",811.8,262,100,36,0)
</FILEMAN_FDA>
"DATA",811.8,262,100,37,0)
<IEN_ROOT>
"DATA",811.8,262,100,38,0)
<![CDATA[
"DATA",811.8,262,100,39,0)
1280^5
"DATA",811.8,262,100,40,0)
]]>
"DATA",811.8,262,100,41,0)
</IEN_ROOT>
"DATA",811.8,262,100,42,0)
</FILEMAN_FILE>
"DATA",811.8,262,100,43,0)
<FILEMAN_FILE>
"DATA",811.8,262,100,44,0)
<FILE_NAME>HEALTH SUMMARY TYPE</FILE_NAME>
"DATA",811.8,262,100,45,0)
<FILE_NUMBER>142</FILE_NUMBER>
"DATA",811.8,262,100,46,0)
<POINT_01>REMOTE PT RECORD FLAG STATUS</POINT_01>
"DATA",811.8,262,100,47,0)
<INTERNAL_ENTRY_NUMBER>5000021</INTERNAL_ENTRY_NUMBER>
"DATA",811.8,262,100,48,0)
<CHECKSUM>1261992951</CHECKSUM>
"DATA",811.8,262,100,49,0)
<SELECTED>YES</SELECTED>
"DATA",811.8,262,100,50,0)
<FILEMAN_FDA>
"DATA",811.8,262,100,51,0)
<![CDATA[
"DATA",811.8,262,100,52,0)
142;+5000021,;.01~REMOTE PT RECORD FLAG STATUS
"DATA",811.8,262,100,53,0)
142;+5000021,;.02~Remote Pt Record Flag Status
"DATA",811.8,262,100,54,0)
142;+5000021,;.05~GMTSMGR
"DATA",811.8,262,100,55,0)
142;+5000021,;.09~Nationally Exported, Uneditable
"DATA",811.8,262,100,56,0)
142;+5000021,;99~63021,33155
"DATA",811.8,262,100,57,0)
142.01;+5000022,+5000021,;.01~5
"DATA",811.8,262,100,58,0)
142.01;+5000022,+5000021,;1~CAT I PT RECORD FLAG STATUS
"DATA",811.8,262,100,59,0)
]]>
"DATA",811.8,262,100,60,0)
</FILEMAN_FDA>
"DATA",811.8,262,100,61,0)
<IEN_ROOT>
"DATA",811.8,262,100,62,0)
<![CDATA[
"DATA",811.8,262,100,63,0)
5000022^5
"DATA",811.8,262,100,64,0)
]]>
"DATA",811.8,262,100,65,0)
</IEN_ROOT>
"DATA",811.8,262,100,66,0)
</FILEMAN_FILE>
"DATA",811.8,262,100,67,0)
<INDEX>
"DATA",811.8,262,100,68,0)
<NUMBER_OF_COMPONENTS>2</NUMBER_OF_COMPONENTS>
"DATA",811.8,262,100,69,0)
<COMPONENT>
"DATA",811.8,262,100,70,0)
<FDA_END>34</FDA_END>
"DATA",811.8,262,100,71,0)
<FDA_START>29</FDA_START>
"DATA",811.8,262,100,72,0)
<FILE_START>20</FILE_START>
"DATA",811.8,262,100,73,0)
<IEN_ROOT_END>39</IEN_ROOT_END>
"DATA",811.8,262,100,74,0)
<IEN_ROOT_START>39</IEN_ROOT_START>
"DATA",811.8,262,100,75,0)
</COMPONENT>
"DATA",811.8,262,100,76,0)
<COMPONENT>
"DATA",811.8,262,100,77,0)
<FDA_END>58</FDA_END>
"DATA",811.8,262,100,78,0)
<FDA_START>52</FDA_START>
"DATA",811.8,262,100,79,0)
<FILE_START>43</FILE_START>
"DATA",811.8,262,100,80,0)
<IEN_ROOT_END>63</IEN_ROOT_END>
"DATA",811.8,262,100,81,0)
<IEN_ROOT_START>63</IEN_ROOT_START>
"DATA",811.8,262,100,82,0)
</COMPONENT>
"DATA",811.8,262,100,83,0)
</INDEX>
"DATA",811.8,262,100,84,0)
</REMINDER_EXCHANGE_FILE_ENTRY>
"DATA",811.8,262,110,0)
^811.804^13^13
"DATA",811.8,262,110,1,0)
Source:      THOMPSON,WILLIAM A at SALT LAKE CITY OIFO
"DATA",811.8,262,110,2,0)
Date Packed: 07/18/2013@12:40:38
"DATA",811.8,262,110,3,0)
Package Version: 2.0P28
"DATA",811.8,262,110,4,0)

"DATA",811.8,262,110,5,0)
Description:
"DATA",811.8,262,110,6,0)
Contains two Health Summary Types to be installed by patch GMTS*2.7*103.
"DATA",811.8,262,110,7,0)
VA-PT RECORD FLAG STATUS
"DATA",811.8,262,110,8,0)
REMOTE PT RECORD FLAG STATUS
"DATA",811.8,262,110,9,0)

"DATA",811.8,262,110,10,0)
Keywords:
"DATA",811.8,262,110,11,0)
GMTS*2.7*103,HRMHP
"DATA",811.8,262,110,12,0)

"DATA",811.8,262,110,13,0)
Components:
"FIA",811.8)
REMINDER EXCHANGE
"FIA",811.8,0)
^PXD(811.8,
"FIA",811.8,0,0)
811.8s
"FIA",811.8,0,1)
n^n^f^^n^^y^o^n
"FIA",811.8,0,10)

"FIA",811.8,0,11)
I $$EXFINC^PXRMEXSI(Y,"EXARRAY","GMTSY103")
"FIA",811.8,0,"RLRO")

"FIA",811.8,0,"VR")
2.7^GMTS
"FIA",811.8,811.8)
0
"FIA",811.8,811.801)
0
"FIA",811.8,811.802)
0
"FIA",811.8,811.8021)
0
"FIA",811.8,811.803)
0
"FIA",811.8,811.8031)
0
"FIA",811.8,811.80315)
0
"FIA",811.8,811.804)
0
"INI")
PRE^GMTSY103
"INIT")
POST^GMTSY103
"IX",811.8,811.8,"B",0)
811.8^B^Uniqueness Index for Key 'A' of File #811.8^R^^R^IR^I^811.8^^^^^LS
"IX",811.8,811.8,"B",1)
S ^PXD(811.8,"B",X(1),X(2),DA)=""
"IX",811.8,811.8,"B",2)
K ^PXD(811.8,"B",X(1),X(2),DA)
"IX",811.8,811.8,"B",2.5)
K ^PXD(811.8,"B")
"IX",811.8,811.8,"B",11.1,0)
^.114IA^2^2
"IX",811.8,811.8,"B",11.1,1,0)
1^F^811.8^.01^^1
"IX",811.8,811.8,"B",11.1,2,0)
2^F^811.8^.03^^2
"IX",811.8,811.8,"D",0)
811.8^D^Cross-reference on date and time^R^^F^IR^I^811.8^^^^^LS
"IX",811.8,811.8,"D",1)
S ^PXD(811.8,"D",X,DA)=""
"IX",811.8,811.8,"D",2)
K ^PXD(811.8,"D",X,DA)
"IX",811.8,811.8,"D",2.5)
K ^PXD(811.8,"D")
"IX",811.8,811.8,"D",11.1,0)
^.114IA^1^1
"IX",811.8,811.8,"D",11.1,1,0)
1^F^811.8^.03^^1^F
"IX",811.8,811.8,"D",11.1,1,3)

"IX",811.8,811.803,"B",0)
811.803^B^New style B cross-reference^R^^F^IR^I^811.803^^^^^LS
"IX",811.8,811.803,"B",1)
S ^PXD(811.8,DA(1),130,"B",X,DA)=""
"IX",811.8,811.803,"B",2)
K ^PXD(811.8,DA(1),130,"B",X,DA)
"IX",811.8,811.803,"B",2.5)
K ^PXD(811.8,DA(1),130,"B")
"IX",811.8,811.803,"B",11.1,0)
^.114IA^1^1
"IX",811.8,811.803,"B",11.1,1,0)
1^F^811.803^.01^^1^F
"KEY",811.8,811.8,"A",0)
811.8^A^P^743
"KEY",811.8,811.8,"A",2,0)
^.312IA^2^2
"KEY",811.8,811.8,"A",2,1,0)
.01^811.8^1
"KEY",811.8,811.8,"A",2,2,0)
.03^811.8^2
"KEYPTR",811.8,811.8,"A")
811.8^B
"MBREQ")
1
"PKG",126,-1)
1^1
"PKG",126,0)
HEALTH SUMMARY^GMTS^Integrated Health Summary Tools^^^3010208
"PKG",126,20,0)
^9.402P^^
"PKG",126,22,0)
^9.49I^1^1
"PKG",126,22,1,0)
2.7^2951020^2951020^11
"PKG",126,22,1,"PAH",1,0)
103^3130827
"PKG",126,22,1,"PAH",1,1,0)
^^5^5^3130827
"PKG",126,22,1,"PAH",1,1,1,0)
Distributes ONE new HEALTH SUMMARY COMPONENT and TWO new HEALTH SUMMARY 
"PKG",126,22,1,"PAH",1,1,2,0)
TYPEs, one of which will be a REMOTE type.
"PKG",126,22,1,"PAH",1,1,3,0)
Component: CAT 1 PRF STATUS (IEN=257)
"PKG",126,22,1,"PAH",1,1,4,0)
    Types: VA-CAT 1 PRF STATUS
"PKG",126,22,1,"PAH",1,1,5,0)
           REMOTE CAT 1 PRF STATUS (IEN=500021)
"PRE")
GMTSY103
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
2
"RTN","GMTSRFHX")
0^1^B19895758
"RTN","GMTSRFHX",1,0)
GMTSRFHX ;WAT;Driver for CAT 1 PRF STATUS Component ;07/18/13  13:17
"RTN","GMTSRFHX",2,0)
 ;;2.7;Health Summary;**103**;Oct 20, 1995;Build 7
"RTN","GMTSRFHX",3,0)
 Q
"RTN","GMTSRFHX",4,0)
 ;;ICR REFERENCE
"RTN","GMTSRFHX",5,0)
 ;;$$GETINF^DGPFAPIH  4903
"RTN","GMTSRFHX",6,0)
 ;;$$GETFLAG^DGPFAPIU  5491
"RTN","GMTSRFHX",7,0)
 ;;$$GETACT^DGPFAPI    3860
"RTN","GMTSRFHX",8,0)
 ;;^DGPF(26.15,"B"     5991
"RTN","GMTSRFHX",9,0)
 ;
"RTN","GMTSRFHX",10,0)
EN ; entry point
"RTN","GMTSRFHX",11,0)
 N GMTSARR,COUNT,GMTSHX,FLGNAME,FLGPTR,RESULT,CAT,INCR,STATUS,NATL,FOUND,ERRMSG
"RTN","GMTSRFHX",12,0)
 N FLAGS S FLAGS=0,COUNT="",CAT="NATIONAL",RESULT="",INCR=1,STATUS="ACTIVE",NATL=0,FOUND=0,FLGNAME=""
"RTN","GMTSRFHX",13,0)
 Q:+$G(DFN)'>0
"RTN","GMTSRFHX",14,0)
 S FLAGS=$$GETACT^DGPFAPI(DFN,"GMTSARR")
"RTN","GMTSRFHX",15,0)
 I +$G(FLAGS)>0 D
"RTN","GMTSRFHX",16,0)
 .F  S COUNT=$O(GMTSARR(COUNT)) Q:COUNT=""  D
"RTN","GMTSRFHX",17,0)
 ..I GMTSARR(COUNT,"CATEGORY")["NATIONAL" S NATL=1 Q
"RTN","GMTSRFHX",18,0)
 D:+$G(NATL)>0 HEADER
"RTN","GMTSRFHX",19,0)
 I +$G(FLAGS)>0 D
"RTN","GMTSRFHX",20,0)
 .F  S COUNT=$O(GMTSARR(COUNT)) Q:COUNT=""  D
"RTN","GMTSRFHX",21,0)
 ..I GMTSARR(COUNT,"CATEGORY")["NATIONAL" D
"RTN","GMTSRFHX",22,0)
 ...S FLGPTR=$P(GMTSARR(COUNT,"FLAG"),U)
"RTN","GMTSRFHX",23,0)
 ...S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSHX")
"RTN","GMTSRFHX",24,0)
 ...Q:+$G(RESULT)'>0  ;if no results, no need to print
"RTN","GMTSRFHX",25,0)
 ...D PRNTACT(COUNT)
"RTN","GMTSRFHX",26,0)
 I +$G(NATL)=0 D NOACTIVE
"RTN","GMTSRFHX",27,0)
 ;;
"RTN","GMTSRFHX",28,0)
 S RESULT="" ;reset RESULT for INACTIVE flag processing
"RTN","GMTSRFHX",29,0)
 F  S FLGNAME=$O(^DGPF(26.15,"B",FLGNAME)) Q:$G(FLGNAME)=""  D
"RTN","GMTSRFHX",30,0)
 .S INCR=INCR+1
"RTN","GMTSRFHX",31,0)
 .S FLGPTR=$$GETFLAG^DGPFAPIU(FLGNAME,"N")
"RTN","GMTSRFHX",32,0)
 .I $G(FLGPTR)["-1" S ERRMSG=$P(FLGPTR,";",2) D ERR Q
"RTN","GMTSRFHX",33,0)
 .S RESULT=$$GETINF^DGPFAPIH(DFN,FLGPTR,,,"GMTSARR")
"RTN","GMTSRFHX",34,0)
 .Q:+$G(RESULT)'>0  ;if no results, skip to next flag
"RTN","GMTSRFHX",35,0)
 .S STATUS=$$GETSTAT(FLGNAME,CAT) Q:STATUS="ACTIVE"  ;only want INACTIVE for this print
"RTN","GMTSRFHX",36,0)
 .D:GMTSARR("CATEGORY")["NATIONAL" PRNTINAC S FOUND=FOUND+1 ;only print NATIONAL flag info
"RTN","GMTSRFHX",37,0)
 D:+$G(FOUND)'>0 NOINACTV ;if STATUS never changes, no Inactive flags found
"RTN","GMTSRFHX",38,0)
 Q
"RTN","GMTSRFHX",39,0)
 ;
"RTN","GMTSRFHX",40,0)
GETSTAT(NAME,CATEG) ;get status of PRF assignment
"RTN","GMTSRFHX",41,0)
 N GMTSAFLG,GMTSFCNT,INDEX,FLAGSTAT
"RTN","GMTSRFHX",42,0)
 S FLAGSTAT="INACTIVE"
"RTN","GMTSRFHX",43,0)
 S GMTSFCNT=$$GETACT^DGPFAPI(DFN,"GMTSAFLG")>0 I $G(GMTSFCNT)>0 D
"RTN","GMTSRFHX",44,0)
 .S INDEX=""
"RTN","GMTSRFHX",45,0)
 .F  S INDEX=$O(GMTSAFLG(INDEX)) Q:INDEX=""  D
"RTN","GMTSRFHX",46,0)
 ..I GMTSAFLG(INDEX,"FLAG")[$G(NAME)&(GMTSAFLG(INDEX,"CATEGORY")[$G(CATEG)) S FLAGSTAT="ACTIVE"
"RTN","GMTSRFHX",47,0)
 Q FLAGSTAT
"RTN","GMTSRFHX",48,0)
 ;
"RTN","GMTSRFHX",49,0)
NOACTIVE ;no active flags header
"RTN","GMTSRFHX",50,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",51,0)
 W "No ACTIVE Category I Patient Record Flag assignment(s) found.",!
"RTN","GMTSRFHX",52,0)
 Q
"RTN","GMTSRFHX",53,0)
 ;
"RTN","GMTSRFHX",54,0)
NOINACTV ;no Inactive flags header
"RTN","GMTSRFHX",55,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",56,0)
 W !,"No INACTIVE Category I Patient Record Flag assignment(s) found.",!
"RTN","GMTSRFHX",57,0)
 Q
"RTN","GMTSRFHX",58,0)
HEADER(TOTAL) ;write a header
"RTN","GMTSRFHX",59,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",60,0)
 W "ACTIVE Category I Patient Record Flag assignment(s):",!
"RTN","GMTSRFHX",61,0)
 Q
"RTN","GMTSRFHX",62,0)
 ;
"RTN","GMTSRFHX",63,0)
PRNTACT(ENTRY) ;show assignment info and hx for Active flags
"RTN","GMTSRFHX",64,0)
 N COUNTER S COUNTER=""
"RTN","GMTSRFHX",65,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",66,0)
 W !,?2,"FLAG NAME: "_$P(GMTSARR(ENTRY,"FLAG"),"^",2)
"RTN","GMTSRFHX",67,0)
 W !,?3,"Current Status: "_$$GETSTAT($P(GMTSARR(ENTRY,"FLAG"),"^",2),"NATIONAL")
"RTN","GMTSRFHX",68,0)
 W !,?3,"Date Assigned: "_$P(GMTSARR(ENTRY,"ASSIGNDT"),"^",2)
"RTN","GMTSRFHX",69,0)
 W !,?3,"Next Review Date: "_$P(GMTSARR(ENTRY,"REVIEWDT"),"^",2)
"RTN","GMTSRFHX",70,0)
 W !,?3,"Owner Site: "_$P(GMTSARR(ENTRY,"OWNER"),"^",2)
"RTN","GMTSRFHX",71,0)
 W !,?3,"Originating Site: "_$P(GMTSARR(ENTRY,"ORIGSITE"),"^",2)
"RTN","GMTSRFHX",72,0)
 W !,?3,"Assignment History:"
"RTN","GMTSRFHX",73,0)
 F  S COUNTER=$O(GMTSHX("HIST",COUNTER)) Q:COUNTER=""  D
"RTN","GMTSRFHX",74,0)
 .W !,?5,"Date: "_$P(GMTSHX("HIST",COUNTER,"DATETIME"),"^",2)
"RTN","GMTSRFHX",75,0)
 .W !,?5,"Action: "_$P(GMTSHX("HIST",COUNTER,"ACTION"),"^",2)
"RTN","GMTSRFHX",76,0)
 .W !,?5,"Approved By: "_$P(GMTSHX("HIST",COUNTER,"APPRVBY"),"^",2),!
"RTN","GMTSRFHX",77,0)
 W:COUNTER="" !
"RTN","GMTSRFHX",78,0)
 Q
"RTN","GMTSRFHX",79,0)
 ;
"RTN","GMTSRFHX",80,0)
PRNTINAC(ENTRY) ;show assignment info and hx for Inctive flags
"RTN","GMTSRFHX",81,0)
 N COUNTER S COUNTER=""
"RTN","GMTSRFHX",82,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",83,0)
 W !,"INACTIVE Category I Patient Record Flag assignment(s):",!
"RTN","GMTSRFHX",84,0)
 W !,?2,"FLAG NAME: "_$P(GMTSARR("FLAG"),"^",2)
"RTN","GMTSRFHX",85,0)
 W !,?3,"Current Status: "_$$GETSTAT($P(GMTSARR("FLAG"),"^",2),"NATIONAL")
"RTN","GMTSRFHX",86,0)
 W !,?3,"Date Assigned: "_$P(GMTSARR("ASSIGNDT"),"^",2)
"RTN","GMTSRFHX",87,0)
 W !,?3,"Next Review Date: "_$P(GMTSARR("REVIEWDT"),"^",2)
"RTN","GMTSRFHX",88,0)
 W !,?3,"Owner Site: "_$P(GMTSARR("OWNER"),"^",2)
"RTN","GMTSRFHX",89,0)
 W !,?3,"Originating Site: "_$P(GMTSARR("ORIGSITE"),"^",2)
"RTN","GMTSRFHX",90,0)
 W !,?3,"Assignment History:"
"RTN","GMTSRFHX",91,0)
 F  S COUNTER=$O(GMTSARR("HIST",COUNTER)) Q:COUNTER=""  D
"RTN","GMTSRFHX",92,0)
 .W !,?5,"Date: "_$P(GMTSARR("HIST",COUNTER,"DATETIME"),"^",2)
"RTN","GMTSRFHX",93,0)
 .W !,?5,"Action: "_$P(GMTSARR("HIST",COUNTER,"ACTION"),"^",2)
"RTN","GMTSRFHX",94,0)
 .W !,?5,"Approved By: "_$P(GMTSARR("HIST",COUNTER,"APPRVBY"),"^",2),!!
"RTN","GMTSRFHX",95,0)
 Q
"RTN","GMTSRFHX",96,0)
ERR ;can't find flag
"RTN","GMTSRFHX",97,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","GMTSRFHX",98,0)
 W !,"Category I PRF "_$G(FLGNAME)_", is "_$G(ERRMSG)_".",!
"RTN","GMTSRFHX",99,0)
 Q
"RTN","GMTSY103")
0^2^B35203734
"RTN","GMTSY103",1,0)
GMTSY103 ;WAT - INSTALL FOR GMTS*2.7*103 ;08/07/13  06:09
"RTN","GMTSY103",2,0)
 ;;2.7;Health Summary;**103**;Oct 20, 1995;Build 7
"RTN","GMTSY103",3,0)
 ;
"RTN","GMTSY103",4,0)
 ;UPDATE^DIE 2053
"RTN","GMTSY103",5,0)
 ;^DIK 10013
"RTN","GMTSY103",6,0)
 ;FIND and $$FIND1^DIC 2051
"RTN","GMTSY103",7,0)
 ;CLEAN^DILF 2054
"RTN","GMTSY103",8,0)
 ;B/MES^XPDUTL, $$PATCH^XPDUTL 10141
"RTN","GMTSY103",9,0)
 ;^PXRMEXSI 4371
"RTN","GMTSY103",10,0)
 ;5687 - allows GMTS to transport Reminder Exchange files in KIDS build
"RTN","GMTSY103",11,0)
 N GMTSABRT
"RTN","GMTSY103",12,0)
 I $$PATCH^XPDUTL("GMTS*2.7*103") D BMES^XPDUTL("GMTS*2.7*103 has been previously installed.  Environment check complete.") Q
"RTN","GMTSY103",13,0)
 D BMES^XPDUTL(" Verifying installation environment...")
"RTN","GMTSY103",14,0)
 D MES^XPDUTL("Checking Health Summary Component file (#142.1).")
"RTN","GMTSY103",15,0)
 D MES^XPDUTL("Any environment errors will abort the install and unload the transport global.")
"RTN","GMTSY103",16,0)
 I $D(^GMT(142.1,257))>0 D
"RTN","GMTSY103",17,0)
 .D MES^XPDUTL(" Environment Error:  IEN collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
"RTN","GMTSY103",18,0)
 .D BMES^XPDUTL("  Health Summary Component file IEN 257 must be empty/non-existent.")
"RTN","GMTSY103",19,0)
 I +$G(GMTSABRT)<1&(+$$LU(142.1,"CAT I PT RECORD FLAG STATUS","X",,"B")>0) D
"RTN","GMTSY103",20,0)
 .D MES^XPDUTL(" Environment Error:  NAME collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
"RTN","GMTSY103",21,0)
 .D BMES^XPDUTL("  Local Health Summary Component file entry matched to NAME=CAT I PT RECORD FLAG STATUS.")
"RTN","GMTSY103",22,0)
 I +$G(GMTSABRT)<1&(+$$LU(142.1,"PRF1","X",,"C")>0) D
"RTN","GMTSY103",23,0)
 .D MES^XPDUTL(" Environment Error:  ABBREVIATION collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
"RTN","GMTSY103",24,0)
 .D BMES^XPDUTL("  Local Health Summary Component file entry matched to ABBREVIATION=PRF1.")
"RTN","GMTSY103",25,0)
 ;
"RTN","GMTSY103",26,0)
 I +$G(GMTSABRT) D BMES^XPDUTL(" Please re-install GMTS*2.7*103 after the necessary changes have been made.") S XPDABORT=1 Q
"RTN","GMTSY103",27,0)
 I +$G(GMTSABRT)<1 D BMES^XPDUTL("Environment check passed.  Install will continue...")
"RTN","GMTSY103",28,0)
 Q
"RTN","GMTSY103",29,0)
 ;
"RTN","GMTSY103",30,0)
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
"RTN","GMTSY103",31,0)
 Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
"RTN","GMTSY103",32,0)
 ;
"RTN","GMTSY103",33,0)
PRE ;pre
"RTN","GMTSY103",34,0)
 D DELEX
"RTN","GMTSY103",35,0)
 Q
"RTN","GMTSY103",36,0)
 ;
"RTN","GMTSY103",37,0)
POST ;post
"RTN","GMTSY103",38,0)
 D BMES^XPDUTL("Installing Health Summary Component...")
"RTN","GMTSY103",39,0)
 D CI
"RTN","GMTSY103",40,0)
 D BMES^XPDUTL("Installing Health Summary Types...")
"RTN","GMTSY103",41,0)
 D STUB
"RTN","GMTSY103",42,0)
 D SMEXINS^PXRMEXSI("EXARRAY","GMTSY103")
"RTN","GMTSY103",43,0)
 Q
"RTN","GMTSY103",44,0)
 ;
"RTN","GMTSY103",45,0)
CI ; Component Install
"RTN","GMTSY103",46,0)
 N GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI
"RTN","GMTSY103",47,0)
 S GMTSCPS="PRF1"
"RTN","GMTSY103",48,0)
 F GMTSCI=1:1 Q:'$L($P(GMTSCPS,";",GMTSCI))  D
"RTN","GMTSY103",49,0)
 . S GMTSCP=$P(GMTSCPS,";",GMTSCI) K GMTSIN
"RTN","GMTSY103",50,0)
 . D ARRAY Q:'$D(GMTSIN)
"RTN","GMTSY103",51,0)
 . I $L($G(GMTSIN("TIM"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"TIM")=$G(GMTSIN("TIM"))
"RTN","GMTSY103",52,0)
 . I $L($G(GMTSIN("OCC"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"OCC")=$G(GMTSIN("OCC"))
"RTN","GMTSY103",53,0)
 . S GMTSINST=$$ADD^GMTSXPD1(.GMTSIN),GMTSTOT=+($G(GMTSTOT))+($G(GMTSINST))
"RTN","GMTSY103",54,0)
 ; Rebuild Ad Hoc Health Summary Type
"RTN","GMTSY103",55,0)
 D:+($G(GMTSTOT))>0 BUILD^GMTSXPD3
"RTN","GMTSY103",56,0)
 D LIM
"RTN","GMTSY103",57,0)
 I +$$ROK("GMTSXPS1")>0 D
"RTN","GMTSY103",58,0)
 . N GMTSHORT S GMTSHORT=1,GMTSINST="",GMTSBLD="GMTS*2.7*103" D SEND^GMTSXPS1
"RTN","GMTSY103",59,0)
 Q
"RTN","GMTSY103",60,0)
ARRAY ; Build Array
"RTN","GMTSY103",61,0)
 K GMTSIN N GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX S GMTSPDX=1,GMTSCP=$G(GMTSCP) Q:'$L(GMTSCP)
"RTN","GMTSY103",62,0)
 F GMTSI=1:1 D  Q:'$L(GMTSTXT)
"RTN","GMTSY103",63,0)
 . S GMTSTXT="",GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")" X GMTSEX S:$L(GMTSTXT,";")'>3 GMTSTXT="" Q:'$L(GMTSTXT)
"RTN","GMTSY103",64,0)
 . S GMTSFLD=$P(GMTSTXT,";",2),GMTSUB=$P(GMTSTXT,";",3),GMTSVAL=$P(GMTSTXT,";",4)
"RTN","GMTSY103",65,0)
 . S:$E(GMTSFLD,1)=1&(+GMTSFLD<2) GMTSVAL=$P(GMTSTXT,";",4,5)
"RTN","GMTSY103",66,0)
 . S:$E(GMTSFLD,1)=" "!('$L(GMTSFLD)) GMTSTXT="" Q:GMTSTXT=""
"RTN","GMTSY103",67,0)
 . S:$L(GMTSFLD)&('$L(GMTSUB)) GMTSIN(GMTSFLD)=GMTSVAL Q:$L(GMTSFLD)&('$L(GMTSUB))  S:$L(GMTSFLD)&($L(GMTSUB)) GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
"RTN","GMTSY103",68,0)
 . S:$G(GMTSFLD)=7&(+($G(GMTSUB))>0) GMTSPDX=0
"RTN","GMTSY103",69,0)
 K:+($G(GMTSPDX))=0 GMTSIN("PDX")
"RTN","GMTSY103",70,0)
 Q
"RTN","GMTSY103",71,0)
LIM ; Limits
"RTN","GMTSY103",72,0)
 N GMTSI,GMTST,GMTSO,GMTSA S GMTSI=0 F  S GMTSI=$O(GMTSLIM(GMTSI)) Q:+GMTSI=0  D
"RTN","GMTSY103",73,0)
 . S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",3),GMTST=$G(GMTSLIM(+GMTSI,"TIM")) S:'$L(GMTST) GMTST=$S(GMTSA="Y ":"1Y ",1:"")
"RTN","GMTSY103",74,0)
 . S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",5),GMTSO=$G(GMTSLIM(+GMTSI,"OCC")) S:'$L(GMTSO) GMTSO=$S(GMTSA="Y ":"10 ",1:"")
"RTN","GMTSY103",75,0)
 . D TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
"RTN","GMTSY103",76,0)
 Q
"RTN","GMTSY103",77,0)
ROK(X) ; Routine OK
"RTN","GMTSY103",78,0)
 S X=$G(X) Q:'$L(X) 0 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX
"RTN","GMTSY103",79,0)
 Q:'$L(GMTSTXT) 0  Q 1
"RTN","GMTSY103",80,0)
 ;
"RTN","GMTSY103",81,0)
PRF1 ; CAT I PT RECORD FLAG STATUS Component Data
"RTN","GMTSY103",82,0)
 ;0;;257
"RTN","GMTSY103",83,0)
 ;.01;;CAT I PT RECORD FLAG STATUS
"RTN","GMTSY103",84,0)
 ;1;;EN;GMTSRFHX
"RTN","GMTSY103",85,0)
 ;1.1;;0
"RTN","GMTSY103",86,0)
 ;2;;
"RTN","GMTSY103",87,0)
 ;3;;PRF1
"RTN","GMTSY103",88,0)
 ;3.5;;4
"RTN","GMTSY103",89,0)
 ;3.5;1;This component displays the Active and Inactive Category 1 Patient Record
"RTN","GMTSY103",90,0)
 ;3.5;2;Flags assigned to a given patient.  The full assignment history is
"RTN","GMTSY103",91,0)
 ;3.5;3;included with each instance of flag assignment.  Active flag assignments
"RTN","GMTSY103",92,0)
 ;3.5;4;are displayed first, followed by Inactive flag assignments.
"RTN","GMTSY103",93,0)
 ;4;;
"RTN","GMTSY103",94,0)
 ;5;;
"RTN","GMTSY103",95,0)
 ;6;;
"RTN","GMTSY103",96,0)
 ;7;;0
"RTN","GMTSY103",97,0)
 ;8;;
"RTN","GMTSY103",98,0)
 ;9;;
"RTN","GMTSY103",99,0)
 ;10;;
"RTN","GMTSY103",100,0)
 ;11;;
"RTN","GMTSY103",101,0)
 ;12;;
"RTN","GMTSY103",102,0)
 ;13;;
"RTN","GMTSY103",103,0)
 ;14;;
"RTN","GMTSY103",104,0)
 ;PDX;;1
"RTN","GMTSY103",105,0)
 ;
"RTN","GMTSY103",106,0)
 Q
"RTN","GMTSY103",107,0)
 ;
"RTN","GMTSY103",108,0)
STUB ;create stub entries
"RTN","GMTSY103",109,0)
 ;UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
"RTN","GMTSY103",110,0)
 D BMES^XPDUTL("Creating stub entries for Remote Health Summary Type.")
"RTN","GMTSY103",111,0)
 D DELRTYPE
"RTN","GMTSY103",112,0)
 N FDA,MSG,HSIEN,NAME,NUMBER
"RTN","GMTSY103",113,0)
 S FDA(142,"+1,",.01)="REMOTE PT RECORD FLAG STATUS"
"RTN","GMTSY103",114,0)
 S HSIEN(1)=5000021
"RTN","GMTSY103",115,0)
 D UPDATE^DIE("","FDA","HSIEN","MSG")
"RTN","GMTSY103",116,0)
 I $D(MSG)>0 D AWRITE("MSG")
"RTN","GMTSY103",117,0)
 D CLEAN^DILF
"RTN","GMTSY103",118,0)
 Q
"RTN","GMTSY103",119,0)
 ;
"RTN","GMTSY103",120,0)
DELRTYPE ;remove previous version of type
"RTN","GMTSY103",121,0)
 D BMES^XPDUTL("Removing any previous version of Remote Health Summary Type")
"RTN","GMTSY103",122,0)
 N DA,DIK,X,Y
"RTN","GMTSY103",123,0)
 S DIK="^GMT(142,"
"RTN","GMTSY103",124,0)
 S DA=5000021 D ^DIK
"RTN","GMTSY103",125,0)
 S DA=$O(^GMT(142,"B","REMOTE PT RECORD FLAG STATUS","")) D:+$G(DA) ^DIK
"RTN","GMTSY103",126,0)
 Q
"RTN","GMTSY103",127,0)
 ;
"RTN","GMTSY103",128,0)
DELEX ;remove prior version of exchange entry
"RTN","GMTSY103",129,0)
 N ARRAY,IC,IND,LIST,GMTSVAL,NUM
"RTN","GMTSY103",130,0)
 D BMES^XPDUTL("Cleaning up any previous versions of Reminder Exchange file entry")
"RTN","GMTSY103",131,0)
 D EXARRAY("L",.ARRAY)
"RTN","GMTSY103",132,0)
 S IC=0
"RTN","GMTSY103",133,0)
 F  S IC=$O(ARRAY(IC)) Q:'IC  D
"RTN","GMTSY103",134,0)
 . S GMTSVAL(1)=ARRAY(IC,1)
"RTN","GMTSY103",135,0)
 . D FIND^DIC(811.8,"","","U",.GMTSVAL,"","","","","LIST")
"RTN","GMTSY103",136,0)
 . I '$D(LIST) Q
"RTN","GMTSY103",137,0)
 . S NUM=$P(LIST("DILIST",0),U,1)
"RTN","GMTSY103",138,0)
 . I NUM'=0 D
"RTN","GMTSY103",139,0)
 .. F IND=1:1:NUM D
"RTN","GMTSY103",140,0)
 ... N DA,DIK
"RTN","GMTSY103",141,0)
 ... S DIK="^PXD(811.8,"
"RTN","GMTSY103",142,0)
 ... S DA=LIST("DILIST",2,IND)
"RTN","GMTSY103",143,0)
 ... D ^DIK
"RTN","GMTSY103",144,0)
 Q
"RTN","GMTSY103",145,0)
 ;
"RTN","GMTSY103",146,0)
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
"RTN","GMTSY103",147,0)
 ;MODE values: I for include in build, A for include action.
"RTN","GMTSY103",148,0)
 N LN
"RTN","GMTSY103",149,0)
 S LN=0
"RTN","GMTSY103",150,0)
 ;
"RTN","GMTSY103",151,0)
 S LN=LN+1
"RTN","GMTSY103",152,0)
 S ARRAY(LN,1)="VA-HS TYPES GMTS*2.7*103"
"RTN","GMTSY103",153,0)
 I MODE["I" S ARRAY(LN,2)="07/18/2013@12:40:38"
"RTN","GMTSY103",154,0)
 I MODE["A" S ARRAY(LN,3)="O"
"RTN","GMTSY103",155,0)
 ;
"RTN","GMTSY103",156,0)
 Q
"RTN","GMTSY103",157,0)
 ;
"RTN","GMTSY103",158,0)
AWRITE(REF) ;Write all the descendants of the array reference.
"RTN","GMTSY103",159,0)
 ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
"RTN","GMTSY103",160,0)
 ;coied from PXRMUTIL
"RTN","GMTSY103",161,0)
 N DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,GMTSTEXT
"RTN","GMTSY103",162,0)
 I REF="" Q
"RTN","GMTSY103",163,0)
 S LN=0
"RTN","GMTSY103",164,0)
 S PROOT=$P(REF,")",1)
"RTN","GMTSY103",165,0)
 ;Build the root so we can tell when we are done.
"RTN","GMTSY103",166,0)
 S TEMP=$NA(@REF)
"RTN","GMTSY103",167,0)
 S ROOT=$P(TEMP,")",1)
"RTN","GMTSY103",168,0)
 S REF=$Q(@REF)
"RTN","GMTSY103",169,0)
 I REF'[ROOT Q
"RTN","GMTSY103",170,0)
 S DONE=0
"RTN","GMTSY103",171,0)
 F  Q:(REF="")!(DONE)  D
"RTN","GMTSY103",172,0)
 . S START=$F(REF,ROOT)
"RTN","GMTSY103",173,0)
 . S LEN=$L(REF)
"RTN","GMTSY103",174,0)
 . S IND=$E(REF,START,LEN)
"RTN","GMTSY103",175,0)
 . S LN=LN+1,GMTSTEXT(LN)=PROOT_IND_"="_@REF
"RTN","GMTSY103",176,0)
 . S REF=$Q(@REF)
"RTN","GMTSY103",177,0)
 . I REF'[ROOT S DONE=1
"RTN","GMTSY103",178,0)
 D MES^XPDUTL(.GMTSTEXT)
"RTN","GMTSY103",179,0)
 Q
"RTN","GMTSY103",180,0)
 ;
"VER")
8.0^22.0
"^DD",811.8,811.8,0)
FIELD^^130^8
"^DD",811.8,811.8,0,"DDA")
N
"^DD",811.8,811.8,0,"DT")
3080125
"^DD",811.8,811.8,0,"NM","REMINDER EXCHANGE")

"^DD",811.8,811.8,0,"SCR")
I 0>1
"^DD",811.8,811.8,0,"VRPK")
PXRM
"^DD",811.8,811.8,.01,0)
NAME^RFX^^0;1^K:$L(X)>64!($L(X)<3)!'(X'?1P.E) X
"^DD",811.8,811.8,.01,.1)

"^DD",811.8,811.8,.01,1,0)
^.1^^0
"^DD",811.8,811.8,.01,3)
Do not edit this field.
"^DD",811.8,811.8,.01,21,0)
^.001^2^2^3050124^^^^
"^DD",811.8,811.8,.01,21,1,0)
This is the name of the entry in the Exchange File. It will be the same
"^DD",811.8,811.8,.01,21,2,0)
as the name of the reminder definition that was packed.
"^DD",811.8,811.8,.01,"DT")
3010601
"^DD",811.8,811.8,.02,0)
SOURCE^F^^0;2^K:$L(X)>64!($L(X)<3) X
"^DD",811.8,811.8,.02,3)
Do not edit this field.
"^DD",811.8,811.8,.02,21,0)
^.001^3^3^3070313^^^
"^DD",811.8,811.8,.02,21,1,0)
This is the source of the packed reminder. It will contain the name of
"^DD",811.8,811.8,.02,21,2,0)
the person who packed it and their site.
"^DD",811.8,811.8,.02,21,3,0)

"^DD",811.8,811.8,.02,"DT")
3000706
"^DD",811.8,811.8,.03,0)
DATE PACKED^D^^0;3^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X
"^DD",811.8,811.8,.03,3)
Do not edit this field.
"^DD",811.8,811.8,.03,21,0)
^.001^3^3^3050124^^^
"^DD",811.8,811.8,.03,21,1,0)
This is the date and time the reminder was originally packed. When a
"^DD",811.8,811.8,.03,21,2,0)
packed reminder is put into the Exchange File from a MailMan message or
"^DD",811.8,811.8,.03,21,3,0)
a host file, this will reflect the original packing date and time.
"^DD",811.8,811.8,.03,"DT")
3000712
"^DD",811.8,811.8,100,0)
PACKED REMINDER^811.801A^^100;0
"^DD",811.8,811.8,100,9)
@
"^DD",811.8,811.8,100,21,0)
^.001^1^1^3050126^^^^
"^DD",811.8,811.8,100,21,1,0)
This multiple stores the packed reminder definition in XML format.
"^DD",811.8,811.8,100,"DT")
3030312
"^DD",811.8,811.8,110,0)
DESCRIPTION^811.804^^110;0
"^DD",811.8,811.8,110,21,0)
^.001^4^4^3050124^^^^
"^DD",811.8,811.8,110,21,1,0)
This contains formatted information about the Exchange File entry. It
"^DD",811.8,811.8,110,21,2,0)
includes source information, a brief description, and keywords. This
"^DD",811.8,811.8,110,21,3,0)
information will be displayed when an entry is selected for possible
"^DD",811.8,811.8,110,21,4,0)
installation.
"^DD",811.8,811.8,119,0)
NUMBER OF UNIQUE COMPONENTS^NJ6,0^^119;1^K:+X'=X!(X>100000)!(X<0)!(X?.E1"."1N.N) X
"^DD",811.8,811.8,119,3)
Do not edit this field.
"^DD",811.8,811.8,119,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8,119,21,1,0)
This is the number of unique components in the packed reminder.
"^DD",811.8,811.8,119,"DT")
3030609
"^DD",811.8,811.8,120,0)
COMPONENT LIST^811.802A^^120;0
"^DD",811.8,811.8,120,21,0)
^.001^1^1^3080206^^^^
"^DD",811.8,811.8,120,21,1,0)
This is a list of components that are included in the packed reminder.
"^DD",811.8,811.8,130,0)
INSTALLATION HISTORY^811.803DA^^130;0
"^DD",811.8,811.8,130,21,0)
^.001^2^2^3070808^^^^
"^DD",811.8,811.8,130,21,1,0)
This multiple is used to record a history of packed reminder
"^DD",811.8,811.8,130,21,2,0)
installations.
"^DD",811.8,811.801,0)
PACKED REMINDER SUB-FIELD^^.01^1
"^DD",811.8,811.801,0,"DT")
3030609
"^DD",811.8,811.801,0,"IX","B",811.801,.01)

"^DD",811.8,811.801,0,"NM","PACKED REMINDER")

"^DD",811.8,811.801,0,"UP")
811.8
"^DD",811.8,811.801,.01,0)
XML DATA^WL^^0;1^Q
"^DD",811.8,811.801,.01,1,0)
^.1
"^DD",811.8,811.801,.01,1,1,0)
811.801^B
"^DD",811.8,811.801,.01,1,1,1)
S ^PXD(811.8,DA(1),100,"B",$E(X,1,30),DA)=""
"^DD",811.8,811.801,.01,1,1,2)
K ^PXD(811.8,DA(1),100,"B",$E(X,1,30),DA)
"^DD",811.8,811.801,.01,1,1,"DT")
3030415
"^DD",811.8,811.801,.01,3)
Do not edit this field.
"^DD",811.8,811.801,.01,9)
@
"^DD",811.8,811.801,.01,21,0)
^.001^1^1^3050126^^^^
"^DD",811.8,811.801,.01,21,1,0)
This is a line of XML data.
"^DD",811.8,811.801,.01,"DT")
3030609
"^DD",811.8,811.802,0)
COMPONENT LIST SUB-FIELD^^1^4
"^DD",811.8,811.802,0,"DT")
3080125
"^DD",811.8,811.802,0,"NM","COMPONENT LIST")

"^DD",811.8,811.802,0,"UP")
811.8
"^DD",811.8,811.802,.01,0)
COMPONENT^F^^0;1^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.802,.01,1,0)
^.1^^0
"^DD",811.8,811.802,.01,3)
Do not edit this field.
"^DD",811.8,811.802,.01,21,0)
^.001^1^1^3050124^^^
"^DD",811.8,811.802,.01,21,1,0)
This is the name of the component; for example, ROUTINE or EDUCATION TOPIC.
"^DD",811.8,811.802,.01,"DT")
3050112
"^DD",811.8,811.802,.02,0)
FILE NUMBER^NJ14,4X^^0;2^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."5N.N) X
"^DD",811.8,811.802,.02,3)
Do not edit this field.
"^DD",811.8,811.802,.02,21,0)
^.001^2^2^3050126^^^^
"^DD",811.8,811.802,.02,21,1,0)
This is the file number of the component. If the component is a routine,
"^DD",811.8,811.802,.02,21,2,0)
then the file number will be 0.
"^DD",811.8,811.802,.02,"DT")
3050111
"^DD",811.8,811.802,.03,0)
NUMBER OF ITEMS^NJ4,0^^0;3^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X
"^DD",811.8,811.802,.03,3)
Do not edit this field.
"^DD",811.8,811.802,.03,21,0)
^.001^4^4^3050124^^^
"^DD",811.8,811.802,.03,21,1,0)
This is the number of this type of component that is included in the
"^DD",811.8,811.802,.03,21,2,0)
packed reminder. For example, if this particular component is Health
"^DD",811.8,811.802,.03,21,3,0)
Factors and there are three of them in the packed reminder, the NUMBER
"^DD",811.8,811.802,.03,21,4,0)
OF ITEMS would be 3.
"^DD",811.8,811.802,.03,"DT")
3001101
"^DD",811.8,811.802,1,0)
ITEM LIST^811.8021A^^1;0
"^DD",811.8,811.802,1,21,0)
^.001^3^3^3080206^^^^
"^DD",811.8,811.802,1,21,1,0)
This is the list of items of the component type. For example, if the
"^DD",811.8,811.802,1,21,2,0)
component type is Health Factors and there are three of them, the three
"^DD",811.8,811.802,1,21,3,0)
entries are specified in this list.
"^DD",811.8,811.8021,0)
ITEM LIST SUB-FIELD^^4^7
"^DD",811.8,811.8021,0,"DT")
3080125
"^DD",811.8,811.8021,0,"NM","ITEM LIST")

"^DD",811.8,811.8021,0,"UP")
811.802
"^DD",811.8,811.8021,.01,0)
ITEM^F^^0;1^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8021,.01,1,0)
^.1^^0
"^DD",811.8,811.8021,.01,3)
Do not edit this field.
"^DD",811.8,811.8021,.01,21,0)
^.001^1^1^3050124^^^
"^DD",811.8,811.8021,.01,21,1,0)
This is the name of the item.
"^DD",811.8,811.8021,.01,"DT")
3050112
"^DD",811.8,811.8021,.02,0)
START LINE^NJ6,0^^0;2^K:+X'=X!(X>100000)!(X<1)!(X?.E1"."1N.N) X
"^DD",811.8,811.8021,.02,3)
Do not edit this field.
"^DD",811.8,811.8021,.02,21,0)
^.001^1^1^3050124^^^
"^DD",811.8,811.8021,.02,21,1,0)
This is the line in node 100 where the data for this item starts.
"^DD",811.8,811.8021,.02,"DT")
3050124
"^DD",811.8,811.8021,.03,0)
END LINE^NJ6,0^^0;3^K:+X'=X!(X>100000)!(X<1)!(X?.E1"."1N.N) X
"^DD",811.8,811.8021,.03,3)
Do not edit this field.
"^DD",811.8,811.8021,.03,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8021,.03,21,1,0)
This is the line in node 100 where the data for this item ends.
"^DD",811.8,811.8021,.03,"DT")
3050124
"^DD",811.8,811.8021,1,0)
IEN ROOT START LINE^NJ6,0^^0;4^K:+X'=X!(X>100000)!(X<1)!(X?.E1"."1N.N) X
"^DD",811.8,811.8021,1,3)
Do not edit this field.
"^DD",811.8,811.8021,1,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8021,1,21,1,0)
This is the line in node 100 where the ien root for this item starts.
"^DD",811.8,811.8021,1,"DT")
3050124
"^DD",811.8,811.8021,2,0)
IEN ROOT END LINE^NJ6,0^^0;5^K:+X'=X!(X>100000)!(X<1)!(X?.E1"."1N.N) X
"^DD",811.8,811.8021,2,3)
Do not edit this field.
"^DD",811.8,811.8021,2,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8021,2,21,1,0)
This is the line in node 100 where the ien root ends.
"^DD",811.8,811.8021,2,"DT")
3050124
"^DD",811.8,811.8021,3,0)
OK TO INSTALL^S^0:NO;1:YES;^0;6^Q
"^DD",811.8,811.8021,3,21,0)
^^4^4^3080122^
"^DD",811.8,811.8021,3,21,1,0)
If this field is YES then the item can be installed. The value for
"^DD",811.8,811.8021,3,21,2,0)
this field is determined when the list of components and items in
"^DD",811.8,811.8021,3,21,3,0)
the Exchange File is built.
"^DD",811.8,811.8021,3,21,4,0)

"^DD",811.8,811.8021,3,"DT")
3080122
"^DD",811.8,811.8021,4,0)
SELECTABLE^S^0:NO;1:YES;^0;7^Q
"^DD",811.8,811.8021,4,21,0)
^.001^6^6^3080206^^
"^DD",811.8,811.8021,4,21,1,0)
If this field is marked YES then the item can be selected for
"^DD",811.8,811.8021,4,21,2,0)
installation. This will include all Clinical Reminder items selected
"^DD",811.8,811.8021,4,21,3,0)
for packing by the user, reminder dialogs that are linked to a reminder
"^DD",811.8,811.8021,4,21,4,0)
definition, and entries from files that are exchangeable.
"^DD",811.8,811.8021,4,21,5,0)

"^DD",811.8,811.8021,4,21,6,0)

"^DD",811.8,811.8021,4,"DT")
3080206
"^DD",811.8,811.803,0)
INSTALLATION HISTORY SUB-FIELD^^2^4
"^DD",811.8,811.803,0,"DT")
3070808
"^DD",811.8,811.803,0,"NM","INSTALLATION HISTORY")

"^DD",811.8,811.803,0,"UP")
811.8
"^DD",811.8,811.803,.01,0)
INSTALLATION DATE AND TIME^D^^0;1^S %DT="EST" D ^%DT S X=Y K:Y<1 X
"^DD",811.8,811.803,.01,1,0)
^.1^^0
"^DD",811.8,811.803,.01,3)
Do not edit this field.
"^DD",811.8,811.803,.01,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.803,.01,21,1,0)
This is the date and time of the installation.
"^DD",811.8,811.803,.01,"DT")
3001121
"^DD",811.8,811.803,.02,0)
INSTALLED BY^F^^0;2^K:$L(X)>45!($L(X)<1) X
"^DD",811.8,811.803,.02,3)
Do not edit this field.
"^DD",811.8,811.803,.02,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.803,.02,21,1,0)
This is the person who did the installation.
"^DD",811.8,811.803,.02,"DT")
3001116
"^DD",811.8,811.803,1,0)
COMPONENT LIST^811.8031A^^1;0
"^DD",811.8,811.803,1,21,0)
^.001^2^2^3050124^^^
"^DD",811.8,811.803,1,21,1,0)
This multiple contains a list of the packed reminder components that
"^DD",811.8,811.803,1,21,2,0)
were selected as part of this installation.
"^DD",811.8,811.803,2,0)
INSTALLATION TYPE^F^^0;3^K:$L(X)>30!($L(X)<1) X
"^DD",811.8,811.803,2,3)
Answer must be 1-30 characters in length.
"^DD",811.8,811.803,2,21,0)
^.001^3^3^3070808^^
"^DD",811.8,811.803,2,21,1,0)
This field is used to store the installation type.
"^DD",811.8,811.803,2,21,2,0)

"^DD",811.8,811.803,2,21,3,0)

"^DD",811.8,811.803,2,"DT")
3070808
"^DD",811.8,811.8031,0)
COMPONENT LIST SUB-FIELD^^5^6
"^DD",811.8,811.8031,0,"DT")
3010313
"^DD",811.8,811.8031,0,"IX","B",811.8031,.01)

"^DD",811.8,811.8031,0,"NM","COMPONENT LIST")

"^DD",811.8,811.8031,0,"UP")
811.803
"^DD",811.8,811.8031,.01,0)
INDEX^NJ6,0^^0;1^K:+X'=X!(X>100000)!(X<0)!(X?.E1"."1N.N) X
"^DD",811.8,811.8031,.01,1,0)
^.1
"^DD",811.8,811.8031,.01,1,1,0)
811.8031^B
"^DD",811.8,811.8031,.01,1,1,1)
S ^PXD(811.8,DA(2),130,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",811.8,811.8031,.01,1,1,2)
K ^PXD(811.8,DA(2),130,DA(1),1,"B",$E(X,1,30),DA)
"^DD",811.8,811.8031,.01,3)
Do not edit this field.
"^DD",811.8,811.8031,.01,21,0)
^.001^2^2^3050124^^^
"^DD",811.8,811.8031,.01,21,1,0)
This number corresponds to the item number in the List Manager display
"^DD",811.8,811.8031,.01,21,2,0)
of the components in the Exchange File entry.
"^DD",811.8,811.8031,.01,"DT")
3001115
"^DD",811.8,811.8031,1,0)
COMPONENT^F^^0;2^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,1,3)
Do not edit this field.
"^DD",811.8,811.8031,1,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,1,21,1,0)
This is the type of component, Education Topic, Health Factor, etc.
"^DD",811.8,811.8031,1,"DT")
3001115
"^DD",811.8,811.8031,2,0)
ITEM^F^^0;3^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,2,3)
Do not edit this field.
"^DD",811.8,811.8031,2,21,0)
^.001^2^2^3050124^^
"^DD",811.8,811.8031,2,21,1,0)
This is the name of the component. For example, if the component is
"^DD",811.8,811.8031,2,21,2,0)
a Health Factor then this is the name of the Health Factor.
"^DD",811.8,811.8031,2,"DT")
3001115
"^DD",811.8,811.8031,3,0)
ACTION^F^^0;4^K:$L(X)>4!($L(X)<1) X
"^DD",811.8,811.8031,3,3)
Do not edit this field.
"^DD",811.8,811.8031,3,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,3,21,1,0)
This is the action that was taken with the item.
"^DD",811.8,811.8031,3,"DT")
3001115
"^DD",811.8,811.8031,4,0)
NEWNAME^F^^0;5^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,4,3)
Do not edit this field.
"^DD",811.8,811.8031,4,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,4,21,1,0)
If the item was copied to a new name then the new name is stored here.
"^DD",811.8,811.8031,4,"DT")
3001115
"^DD",811.8,811.8031,5,0)
ADDITIONAL DETAILS^811.80315A^^1;0
"^DD",811.8,811.8031,5,21,0)
^.001^3^3^3050124^^^
"^DD",811.8,811.8031,5,21,1,0)
This multiple is used to store additional details about the
"^DD",811.8,811.8031,5,21,2,0)
installation. As an example, if a finding in a reminder definition is
"^DD",811.8,811.8031,5,21,3,0)
replaced with another finding that information is stored here.
"^DD",811.8,811.80315,0)
ADDITIONAL DETAILS SUB-FIELD^^.01^1
"^DD",811.8,811.80315,0,"DT")
3010313
"^DD",811.8,811.80315,0,"IX","B",811.80315,.01)

"^DD",811.8,811.80315,0,"NM","ADDITIONAL DETAILS")

"^DD",811.8,811.80315,0,"UP")
811.8031
"^DD",811.8,811.80315,.01,0)
ADDITIONAL DETAILS^F^^0;1^K:$L(X)>80!($L(X)<1) X
"^DD",811.8,811.80315,.01,1,0)
^.1
"^DD",811.8,811.80315,.01,1,1,0)
811.80315^B
"^DD",811.8,811.80315,.01,1,1,1)
S ^PXD(811.8,DA(3),130,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",811.8,811.80315,.01,1,1,2)
K ^PXD(811.8,DA(3),130,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)
"^DD",811.8,811.80315,.01,3)
Do not edit this field.
"^DD",811.8,811.80315,.01,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.80315,.01,21,1,0)
This is a line of additional information.
"^DD",811.8,811.80315,.01,"DT")
3010313
"^DD",811.8,811.804,0)
DESCRIPTION SUB-FIELD^^.01^1
"^DD",811.8,811.804,0,"DT")
3001221
"^DD",811.8,811.804,0,"NM","DESCRIPTION")

"^DD",811.8,811.804,0,"UP")
811.8
"^DD",811.8,811.804,.01,0)
DESCRIPTION^W^^0;1^Q
"^DD",811.8,811.804,.01,3)
Do not edit this field.
"^DD",811.8,811.804,.01,"DT")
3001221
"^DIC",811.8,811.8,0)
REMINDER EXCHANGE^811.8
"^DIC",811.8,811.8,0,"GL")
^PXD(811.8,
"^DIC",811.8,811.8,"%",0)
^1.005^^0
"^DIC",811.8,811.8,"%D",0)
^1.001^3^3^3050126^^^^
"^DIC",811.8,811.8,"%D",1,0)
The Reminder Exchange File is used to store packed reminder
"^DIC",811.8,811.8,"%D",2,0)
definitions. All the entries in this file are managed by the
"^DIC",811.8,811.8,"%D",3,0)
Reminder Exchange Utility and should never be edited by hand.
"^DIC",811.8,"B","REMINDER EXCHANGE",811.8)

**END**
**END**
1,1)
S ^PXD(811.8,DA(2),130,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",811.8,811.8031,.01,1,1,2)
K ^PXD(811.8,DA(2),130,DA(1),1,"B",$E(X,1,30),DA)
"^DD",811.8,811.8031,.01,3)
Do not edit this field.
"^DD",811.8,811.8031,.01,21,0)
^.001^2^2^3050124^^^
"^DD",811.8,811.8031,.01,21,1,0)
This number corresponds to the item number in the List Manager display
"^DD",811.8,811.8031,.01,21,2,0)
of the components in the Exchange File entry.
"^DD",811.8,811.8031,.01,"DT")
3001115
"^DD",811.8,811.8031,1,0)
COMPONENT^F^^0;2^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,1,3)
Do not edit this field.
"^DD",811.8,811.8031,1,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,1,21,1,0)
This is the type of component, Education Topic, Health Factor, etc.
"^DD",811.8,811.8031,1,"DT")
3001115
"^DD",811.8,811.8031,2,0)
ITEM^F^^0;3^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,2,3)
Do not edit this field.
"^DD",811.8,811.8031,2,21,0)
^.001^2^2^3050124^^
"^DD",811.8,811.8031,2,21,1,0)
This is the name of the component. For example, if the component is
"^DD",811.8,811.8031,2,21,2,0)
a Health Factor then this is the name of the Health Factor.
"^DD",811.8,811.8031,2,"DT")
3001115
"^DD",811.8,811.8031,3,0)
ACTION^F^^0;4^K:$L(X)>4!($L(X)<1) X
"^DD",811.8,811.8031,3,3)
Do not edit this field.
"^DD",811.8,811.8031,3,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,3,21,1,0)
This is the action that was taken with the item.
"^DD",811.8,811.8031,3,"DT")
3001115
"^DD",811.8,811.8031,4,0)
NEWNAME^F^^0;5^K:$L(X)>64!($L(X)<1) X
"^DD",811.8,811.8031,4,3)
Do not edit this field.
"^DD",811.8,811.8031,4,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.8031,4,21,1,0)
If the item was copied to a new name then the new name is stored here.
"^DD",811.8,811.8031,4,"DT")
3001115
"^DD",811.8,811.8031,5,0)
ADDITIONAL DETAILS^811.80315A^^1;0
"^DD",811.8,811.8031,5,21,0)
^.001^3^3^3050124^^^
"^DD",811.8,811.8031,5,21,1,0)
This multiple is used to store additional details about the
"^DD",811.8,811.8031,5,21,2,0)
installation. As an example, if a finding in a reminder definition is
"^DD",811.8,811.8031,5,21,3,0)
replaced with another finding that information is stored here.
"^DD",811.8,811.80315,0)
ADDITIONAL DETAILS SUB-FIELD^^.01^1
"^DD",811.8,811.80315,0,"DT")
3010313
"^DD",811.8,811.80315,0,"IX","B",811.80315,.01)

"^DD",811.8,811.80315,0,"NM","ADDITIONAL DETAILS")

"^DD",811.8,811.80315,0,"UP")
811.8031
"^DD",811.8,811.80315,.01,0)
ADDITIONAL DETAILS^F^^0;1^K:$L(X)>80!($L(X)<1) X
"^DD",811.8,811.80315,.01,1,0)
^.1
"^DD",811.8,811.80315,.01,1,1,0)
811.80315^B
"^DD",811.8,811.80315,.01,1,1,1)
S ^PXD(811.8,DA(3),130,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",811.8,811.80315,.01,1,1,2)
K ^PXD(811.8,DA(3),130,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)
"^DD",811.8,811.80315,.01,3)
Do not edit this field.
"^DD",811.8,811.80315,.01,21,0)
^.001^1^1^3050124^^
"^DD",811.8,811.80315,.01,21,1,0)
This is a line of additional information.
"^DD",811.8,811.80315,.01,"DT")
3010313
"^DD",811.8,811.804,0)
DESCRIPTION SUB-FIELD^^.01^1
"^DD",811.8,811.804,0,"DT")
3001221
"^DD",811.8,811.804,0,"NM","DESCRIPTION")

"^DD",811.8,811.804,0,"UP")
811.8
"^DD",811.8,811.804,.01,0)
DESCRIPTION^W^^0;1^Q
"^DD",811.8,811.804,.01,3)
Do not edit this field.
"^DD",811.8,811.804,.01,"DT")
3001221
"^DIC",811.8,811.8,0)
REMINDER EXCHANGE^811.8
"^DIC",811.8,811.8,0,"GL")
^PXD(811.8,
"^DIC",811.8,811.8,"%",0)
^1.005^^0
"^DIC",811.8,811.8,"%D",0)
^1.001^3^3^3050126^^^^
"^DIC",811.8,811.8,"%D",1,0)
The Reminder Exchange File is used to store packed reminder
"^DIC",811.8,811.8,"%D",2,0)
definitions. All the entries in this file are managed by the
"^DIC",811.8,811.8,"%D",3,0)
Reminder Exchange Utility and should never be edited by hand.
"^DIC",811.8,"B","REMINDER EXCHANGE",811.8)

**END**
**END**