KIDS Distribution saved on Sep 02, 2003@10:42:09 DG*5.3*425 - Patient Record Flags **KIDS**:DG*5.3*425^ **INSTALL NAME** DG*5.3*425 "BLD",3025,0) DG*5.3*425^REGISTRATION^0^3030902^y "BLD",3025,1,0) ^^2^2^3011031^ "BLD",3025,1,1,0) Please refer to patch DG*5.3*425 in the National Patch Module for a "BLD",3025,1,2,0) complete description of this patch. "BLD",3025,4,0) ^9.64PA^26.18^8 "BLD",3025,4,26.11,0) 26.11 "BLD",3025,4,26.11,222) y^n^f^^^^n "BLD",3025,4,26.12,0) 26.12 "BLD",3025,4,26.12,222) y^n^f^^^^n "BLD",3025,4,26.13,0) 26.13 "BLD",3025,4,26.13,222) y^y^f^^^^n "BLD",3025,4,26.14,0) 26.14 "BLD",3025,4,26.14,222) y^n^f^^^^n "BLD",3025,4,26.15,0) 26.15 "BLD",3025,4,26.15,222) y^n^f^^^^n "BLD",3025,4,26.16,0) 26.16 "BLD",3025,4,26.16,222) y^n^f^^n^^y^o^n "BLD",3025,4,26.17,0) 26.17 "BLD",3025,4,26.17,222) y^n^f^^^^n "BLD",3025,4,26.18,0) 26.18 "BLD",3025,4,26.18,222) y^n^f^^^^n "BLD",3025,4,"B",26.11,26.11) "BLD",3025,4,"B",26.12,26.12) "BLD",3025,4,"B",26.13,26.13) "BLD",3025,4,"B",26.14,26.14) "BLD",3025,4,"B",26.15,26.15) "BLD",3025,4,"B",26.16,26.16) "BLD",3025,4,"B",26.17,26.17) "BLD",3025,4,"B",26.18,26.18) "BLD",3025,"INID") ^n "BLD",3025,"INIT") POST^DG53P425 "BLD",3025,"KRN",0) ^9.67PA^19^17 "BLD",3025,"KRN",.4,0) .4 "BLD",3025,"KRN",.401,0) .401 "BLD",3025,"KRN",.402,0) .402 "BLD",3025,"KRN",.403,0) .403 "BLD",3025,"KRN",.5,0) .5 "BLD",3025,"KRN",.84,0) .84 "BLD",3025,"KRN",3.6,0) 3.6 "BLD",3025,"KRN",3.8,0) 3.8 "BLD",3025,"KRN",3.8,"NM",0) ^9.68A^2^2 "BLD",3025,"KRN",3.8,"NM",1,0) DGPF BEHAVIORAL FLAG REVIEW^^0 "BLD",3025,"KRN",3.8,"NM",2,0) DGPF HL7 TRANSMISSION ERRORS^^0 "BLD",3025,"KRN",3.8,"NM","B","DGPF BEHAVIORAL FLAG REVIEW",1) "BLD",3025,"KRN",3.8,"NM","B","DGPF HL7 TRANSMISSION ERRORS",2) "BLD",3025,"KRN",9.2,0) 9.2 "BLD",3025,"KRN",9.8,0) 9.8 "BLD",3025,"KRN",9.8,"NM",0) ^9.68A^66^61 "BLD",3025,"KRN",9.8,"NM",1,0) DGPFHLU^^0^B25993743 "BLD",3025,"KRN",9.8,"NM",2,0) DGPFHLU1^^0^B28767858 "BLD",3025,"KRN",9.8,"NM",3,0) DGPFHLU2^^0^B22238545 "BLD",3025,"KRN",9.8,"NM",4,0) DGPFHLU3^^0^B34322832 "BLD",3025,"KRN",9.8,"NM",5,0) DGPFHLU4^^0^B16669354 "BLD",3025,"KRN",9.8,"NM",6,0) DGPFHLUT^^0^B30959687 "BLD",3025,"KRN",9.8,"NM",7,0) DGPFHLR^^0^B30149519 "BLD",3025,"KRN",9.8,"NM",8,0) DGPFHLS^^0^B29645251 "BLD",3025,"KRN",9.8,"NM",9,0) DGPFHLL^^0^B8636516 "BLD",3025,"KRN",9.8,"NM",10,0) DGPFDD^^0^B5388550 "BLD",3025,"KRN",9.8,"NM",11,0) DGPFUT^^0^B25005178 "BLD",3025,"KRN",9.8,"NM",12,0) DGPFUT1^^0^B26680017 "BLD",3025,"KRN",9.8,"NM",13,0) DGPFUT2^^0^B32476578 "BLD",3025,"KRN",9.8,"NM",14,0) DGPFLMA^^0^B1371064 "BLD",3025,"KRN",9.8,"NM",15,0) DGPFLMA1^^0^B5185010 "BLD",3025,"KRN",9.8,"NM",16,0) DGPFLMA2^^0^B29486174 "BLD",3025,"KRN",9.8,"NM",17,0) DGPFLMA3^^0^B53692057 "BLD",3025,"KRN",9.8,"NM",18,0) DGPFLMA4^^0^B36618689 "BLD",3025,"KRN",9.8,"NM",19,0) DG10^^0^B17758260 "BLD",3025,"KRN",9.8,"NM",24,0) DGPFLMAD^^0^B1178565 "BLD",3025,"KRN",9.8,"NM",25,0) DGPFLMU^^0^B15922307 "BLD",3025,"KRN",9.8,"NM",26,0) DGPFLMU1^^0^B40071877 "BLD",3025,"KRN",9.8,"NM",27,0) DGPFAPI^^0^B34047337 "BLD",3025,"KRN",9.8,"NM",28,0) DGPFALF^^0^B22618813 "BLD",3025,"KRN",9.8,"NM",29,0) DGPFALF1^^0^B9183285 "BLD",3025,"KRN",9.8,"NM",30,0) DGPFALH^^0^B23450364 "BLD",3025,"KRN",9.8,"NM",31,0) DGPFANF^^0^B6427977 "BLD",3025,"KRN",9.8,"NM",32,0) DGPFHLU5^^0^B32860836 "BLD",3025,"KRN",9.8,"NM",33,0) DGPFHLQ^^0^B44034534 "BLD",3025,"KRN",9.8,"NM",34,0) DGPFHLQ1^^0^B9671329 "BLD",3025,"KRN",9.8,"NM",35,0) DGPFHLQ2^^0^B6044251 "BLD",3025,"KRN",9.8,"NM",36,0) DGPFHLQ3^^0^B25817891 "BLD",3025,"KRN",9.8,"NM",37,0) DGPFLF^^0^B2708557 "BLD",3025,"KRN",9.8,"NM",38,0) DGPFLF1^^0^B31012393 "BLD",3025,"KRN",9.8,"NM",39,0) DGPFLF2^^0^B7086828 "BLD",3025,"KRN",9.8,"NM",40,0) DGPFLFD^^0^B2491174 "BLD",3025,"KRN",9.8,"NM",41,0) DGPFLFD1^^0^B39735415 "BLD",3025,"KRN",9.8,"NM",42,0) DGPFLF3^^0^B51672864 "BLD",3025,"KRN",9.8,"NM",43,0) DGPFBGR^^0^B44753141 "BLD",3025,"KRN",9.8,"NM",44,0) DGPFLF4^^0^B37339881 "BLD",3025,"KRN",9.8,"NM",45,0) DGPFLF5^^0^B50535397 "BLD",3025,"KRN",9.8,"NM",46,0) DGREG^^0^B35298833 "BLD",3025,"KRN",9.8,"NM",47,0) DGRPT^^0^B1410821 "BLD",3025,"KRN",9.8,"NM",48,0) DGSEC^^0^B42562784 "BLD",3025,"KRN",9.8,"NM",49,0) DGPFRFA^^0^B16565125 "BLD",3025,"KRN",9.8,"NM",51,0) DGPFRFA1^^0^B41598008 "BLD",3025,"KRN",9.8,"NM",52,0) DGPFAA^^0^B35630618 "BLD",3025,"KRN",9.8,"NM",53,0) DGPFAA1^^0^B954394 "BLD",3025,"KRN",9.8,"NM",54,0) DGPFAA2^^0^B42180474 "BLD",3025,"KRN",9.8,"NM",55,0) DGPFAA3^^0^B3807769 "BLD",3025,"KRN",9.8,"NM",56,0) DGPFAAH^^0^B30752743 "BLD",3025,"KRN",9.8,"NM",57,0) DGPFAAH1^^0^B1218620 "BLD",3025,"KRN",9.8,"NM",58,0) DGPFLF6^^0^B17883747 "BLD",3025,"KRN",9.8,"NM",59,0) DGPFRFR^^0^B16456376 "BLD",3025,"KRN",9.8,"NM",60,0) DGPFRFR1^^0^B42214767 "BLD",3025,"KRN",9.8,"NM",61,0) DGPFPARM^^0^B1696408 "BLD",3025,"KRN",9.8,"NM",62,0) DG53P425^^0^B29268783 "BLD",3025,"KRN",9.8,"NM",63,0) DGPFLMD^^0^B1757260 "BLD",3025,"KRN",9.8,"NM",64,0) DGPFLMD1^^0^B11731182 "BLD",3025,"KRN",9.8,"NM",65,0) DGPFHLU6^^0^B6178112 "BLD",3025,"KRN",9.8,"NM",66,0) DGPFHLRT^^0^B8257718 "BLD",3025,"KRN",9.8,"NM","B","DG10",19) "BLD",3025,"KRN",9.8,"NM","B","DG53P425",62) "BLD",3025,"KRN",9.8,"NM","B","DGPFAA",52) "BLD",3025,"KRN",9.8,"NM","B","DGPFAA1",53) "BLD",3025,"KRN",9.8,"NM","B","DGPFAA2",54) "BLD",3025,"KRN",9.8,"NM","B","DGPFAA3",55) "BLD",3025,"KRN",9.8,"NM","B","DGPFAAH",56) "BLD",3025,"KRN",9.8,"NM","B","DGPFAAH1",57) "BLD",3025,"KRN",9.8,"NM","B","DGPFALF",28) "BLD",3025,"KRN",9.8,"NM","B","DGPFALF1",29) "BLD",3025,"KRN",9.8,"NM","B","DGPFALH",30) "BLD",3025,"KRN",9.8,"NM","B","DGPFANF",31) "BLD",3025,"KRN",9.8,"NM","B","DGPFAPI",27) "BLD",3025,"KRN",9.8,"NM","B","DGPFBGR",43) "BLD",3025,"KRN",9.8,"NM","B","DGPFDD",10) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLL",9) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLQ",33) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLQ1",34) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLQ2",35) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLQ3",36) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLR",7) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLRT",66) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLS",8) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU",1) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU1",2) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU2",3) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU3",4) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU4",5) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU5",32) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLU6",65) "BLD",3025,"KRN",9.8,"NM","B","DGPFHLUT",6) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF",37) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF1",38) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF2",39) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF3",42) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF4",44) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF5",45) "BLD",3025,"KRN",9.8,"NM","B","DGPFLF6",58) "BLD",3025,"KRN",9.8,"NM","B","DGPFLFD",40) "BLD",3025,"KRN",9.8,"NM","B","DGPFLFD1",41) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMA",14) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMA1",15) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMA2",16) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMA3",17) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMA4",18) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMAD",24) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMD",63) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMD1",64) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMU",25) "BLD",3025,"KRN",9.8,"NM","B","DGPFLMU1",26) "BLD",3025,"KRN",9.8,"NM","B","DGPFPARM",61) "BLD",3025,"KRN",9.8,"NM","B","DGPFRFA",49) "BLD",3025,"KRN",9.8,"NM","B","DGPFRFA1",51) "BLD",3025,"KRN",9.8,"NM","B","DGPFRFR",59) "BLD",3025,"KRN",9.8,"NM","B","DGPFRFR1",60) "BLD",3025,"KRN",9.8,"NM","B","DGPFUT",11) "BLD",3025,"KRN",9.8,"NM","B","DGPFUT1",12) "BLD",3025,"KRN",9.8,"NM","B","DGPFUT2",13) "BLD",3025,"KRN",9.8,"NM","B","DGREG",46) "BLD",3025,"KRN",9.8,"NM","B","DGRPT",47) "BLD",3025,"KRN",9.8,"NM","B","DGSEC",48) "BLD",3025,"KRN",19,0) 19 "BLD",3025,"KRN",19,"NM",0) ^9.68A^11^8 "BLD",3025,"KRN",19,"NM",1,0) DGPF RECORD FLAG ASSIGNMENT^^0 "BLD",3025,"KRN",19,"NM",3,0) DGPF RECORD FLAG MANAGEMENT^^0 "BLD",3025,"KRN",19,"NM",4,0) DGPF BACKGROUND PROCESSING^^0 "BLD",3025,"KRN",19,"NM",6,0) DGPF FLAG ASSIGNMENT REPORT^^0 "BLD",3025,"KRN",19,"NM",8,0) DGPF PRF SYSTEM CONFIGURATION^^0 "BLD",3025,"KRN",19,"NM",9,0) DGPF RECORD FLAG REPORTS MENU^^0 "BLD",3025,"KRN",19,"NM",10,0) DGPF RECORD FLAGS MAIN MENU^^0 "BLD",3025,"KRN",19,"NM",11,0) DGPF ASSIGNMENT DUE REVIEW RPT^^0 "BLD",3025,"KRN",19,"NM","B","DGPF ASSIGNMENT DUE REVIEW RPT",11) "BLD",3025,"KRN",19,"NM","B","DGPF BACKGROUND PROCESSING",4) "BLD",3025,"KRN",19,"NM","B","DGPF FLAG ASSIGNMENT REPORT",6) "BLD",3025,"KRN",19,"NM","B","DGPF PRF SYSTEM CONFIGURATION",8) "BLD",3025,"KRN",19,"NM","B","DGPF RECORD FLAG ASSIGNMENT",1) "BLD",3025,"KRN",19,"NM","B","DGPF RECORD FLAG MANAGEMENT",3) "BLD",3025,"KRN",19,"NM","B","DGPF RECORD FLAG REPORTS MENU",9) "BLD",3025,"KRN",19,"NM","B","DGPF RECORD FLAGS MAIN MENU",10) "BLD",3025,"KRN",19.1,0) 19.1 "BLD",3025,"KRN",19.1,"NM",0) ^9.68A^4^4 "BLD",3025,"KRN",19.1,"NM",1,0) DGPF RECORD FLAG ASSIGNMENT^^0 "BLD",3025,"KRN",19.1,"NM",2,0) DGPF LOCAL FLAG EDIT^^0 "BLD",3025,"KRN",19.1,"NM",3,0) DGPF PRF ACCESS^^0 "BLD",3025,"KRN",19.1,"NM",4,0) DGPF PRF CONFIG^^0 "BLD",3025,"KRN",19.1,"NM","B","DGPF LOCAL FLAG EDIT",2) "BLD",3025,"KRN",19.1,"NM","B","DGPF PRF ACCESS",3) "BLD",3025,"KRN",19.1,"NM","B","DGPF PRF CONFIG",4) "BLD",3025,"KRN",19.1,"NM","B","DGPF RECORD FLAG ASSIGNMENT",1) "BLD",3025,"KRN",101,0) 101 "BLD",3025,"KRN",101,"NM",0) ^9.68A^18^16 "BLD",3025,"KRN",101,"NM",1,0) DGPF ASSIGN FLAG^^0 "BLD",3025,"KRN",101,"NM",2,0) DGPF CHANGE ASSIGNMENT OWNERSHIP^^0 "BLD",3025,"KRN",101,"NM",3,0) DGPF DISPLAY ASSIGNMENT DETAIL^^0 "BLD",3025,"KRN",101,"NM",4,0) DGPF EDIT ASSIGNMENT^^0 "BLD",3025,"KRN",101,"NM",5,0) DGPF PRF ORF/R04 SUBSC^^0 "BLD",3025,"KRN",101,"NM",6,0) DGPF PRF ORU/R01 EVENT^^0 "BLD",3025,"KRN",101,"NM",7,0) DGPF PRF ORU/R01 SUBSC^^0 "BLD",3025,"KRN",101,"NM",8,0) DGPF PRF QRY/R02 EVENT^^0 "BLD",3025,"KRN",101,"NM",10,0) DGPF RECORD FLAG MANAGEMENT MENU^^0 "BLD",3025,"KRN",101,"NM",11,0) DGPF SELECT PATIENT^^0 "BLD",3025,"KRN",101,"NM",12,0) DGPF SORT FLAG LIST^^0 "BLD",3025,"KRN",101,"NM",13,0) DGPF ADD FLAG^^0 "BLD",3025,"KRN",101,"NM",14,0) DGPF EDIT FLAG^^0 "BLD",3025,"KRN",101,"NM",16,0) DGPF DISPLAY FLAG DETAIL^^0 "BLD",3025,"KRN",101,"NM",17,0) DGPF RECORD FLAG ASSIGNMENT MENU^^0 "BLD",3025,"KRN",101,"NM",18,0) DGPF CHANGE CATEGORY^^0 "BLD",3025,"KRN",101,"NM","B","DGPF ADD FLAG",13) "BLD",3025,"KRN",101,"NM","B","DGPF ASSIGN FLAG",1) "BLD",3025,"KRN",101,"NM","B","DGPF CHANGE ASSIGNMENT OWNERSHIP",2) "BLD",3025,"KRN",101,"NM","B","DGPF CHANGE CATEGORY",18) "BLD",3025,"KRN",101,"NM","B","DGPF DISPLAY ASSIGNMENT DETAIL",3) "BLD",3025,"KRN",101,"NM","B","DGPF DISPLAY FLAG DETAIL",16) "BLD",3025,"KRN",101,"NM","B","DGPF EDIT ASSIGNMENT",4) "BLD",3025,"KRN",101,"NM","B","DGPF EDIT FLAG",14) "BLD",3025,"KRN",101,"NM","B","DGPF PRF ORF/R04 SUBSC",5) "BLD",3025,"KRN",101,"NM","B","DGPF PRF ORU/R01 EVENT",6) "BLD",3025,"KRN",101,"NM","B","DGPF PRF ORU/R01 SUBSC",7) "BLD",3025,"KRN",101,"NM","B","DGPF PRF QRY/R02 EVENT",8) "BLD",3025,"KRN",101,"NM","B","DGPF RECORD FLAG ASSIGNMENT MENU",17) "BLD",3025,"KRN",101,"NM","B","DGPF RECORD FLAG MANAGEMENT MENU",10) "BLD",3025,"KRN",101,"NM","B","DGPF SELECT PATIENT",11) "BLD",3025,"KRN",101,"NM","B","DGPF SORT FLAG LIST",12) "BLD",3025,"KRN",409.61,0) 409.61 "BLD",3025,"KRN",409.61,"NM",0) ^9.68A^5^5 "BLD",3025,"KRN",409.61,"NM",1,0) DGPF RECORD FLAG ASSIGNMENT^^0 "BLD",3025,"KRN",409.61,"NM",2,0) DGPF ASSIGNMENT DETAIL^^0 "BLD",3025,"KRN",409.61,"NM",3,0) DGPF RECORD FLAG MANAGEMENT^^0 "BLD",3025,"KRN",409.61,"NM",4,0) DGPF FLAG DETAIL^^0 "BLD",3025,"KRN",409.61,"NM",5,0) DGPF ACTIVE ASSIGNMENTS^^0 "BLD",3025,"KRN",409.61,"NM","B","DGPF ACTIVE ASSIGNMENTS",5) "BLD",3025,"KRN",409.61,"NM","B","DGPF ASSIGNMENT DETAIL",2) "BLD",3025,"KRN",409.61,"NM","B","DGPF FLAG DETAIL",4) "BLD",3025,"KRN",409.61,"NM","B","DGPF RECORD FLAG ASSIGNMENT",1) "BLD",3025,"KRN",409.61,"NM","B","DGPF RECORD FLAG MANAGEMENT",3) "BLD",3025,"KRN",771,0) 771 "BLD",3025,"KRN",771,"NM",0) ^9.68A^4^4 "BLD",3025,"KRN",771,"NM",1,0) PRF-QRY^^0 "BLD",3025,"KRN",771,"NM",2,0) PRF-QRYRESP^^0 "BLD",3025,"KRN",771,"NM",3,0) PRF-RECV^^0 "BLD",3025,"KRN",771,"NM",4,0) PRF-SEND^^0 "BLD",3025,"KRN",771,"NM","B","PRF-QRY",1) "BLD",3025,"KRN",771,"NM","B","PRF-QRYRESP",2) "BLD",3025,"KRN",771,"NM","B","PRF-RECV",3) "BLD",3025,"KRN",771,"NM","B","PRF-SEND",4) "BLD",3025,"KRN",870,0) 870 "BLD",3025,"KRN",8994,0) 8994 "BLD",3025,"KRN","B",.4,.4) "BLD",3025,"KRN","B",.401,.401) "BLD",3025,"KRN","B",.402,.402) "BLD",3025,"KRN","B",.403,.403) "BLD",3025,"KRN","B",.5,.5) "BLD",3025,"KRN","B",.84,.84) "BLD",3025,"KRN","B",3.6,3.6) "BLD",3025,"KRN","B",3.8,3.8) "BLD",3025,"KRN","B",9.2,9.2) "BLD",3025,"KRN","B",9.8,9.8) "BLD",3025,"KRN","B",19,19) "BLD",3025,"KRN","B",19.1,19.1) "BLD",3025,"KRN","B",101,101) "BLD",3025,"KRN","B",409.61,409.61) "BLD",3025,"KRN","B",771,771) "BLD",3025,"KRN","B",870,870) "BLD",3025,"KRN","B",8994,8994) "BLD",3025,"PRE") DG53P425 "BLD",3025,"QUES",0) ^9.62^^ "BLD",3025,"REQB",0) ^9.611^5^2 "BLD",3025,"REQB",4,0) DG*5.3*391^2 "BLD",3025,"REQB",5,0) DG*5.3*513^2 "BLD",3025,"REQB","B","DG*5.3*391",4) "BLD",3025,"REQB","B","DG*5.3*513",5) "DATA",26.16,1,0) BEHAVIORAL "DATA",26.16,2,0) RESEARCH "DATA",26.16,3,0) CLINICAL "DATA",26.16,4,0) OTHER "FIA",26.11) PRF LOCAL FLAG "FIA",26.11,0) ^DGPF(26.11, "FIA",26.11,0,0) 26.11I "FIA",26.11,0,1) y^n^f^^^^n "FIA",26.11,0,10) "FIA",26.11,0,11) "FIA",26.11,0,"RLRO") "FIA",26.11,0,"VR") 5.3^DG "FIA",26.11,26.11) 0 "FIA",26.11,26.111) 0 "FIA",26.11,26.112) 0 "FIA",26.12) PRF LOCAL FLAG HISTORY "FIA",26.12,0) ^DGPF(26.12, "FIA",26.12,0,0) 26.12PI "FIA",26.12,0,1) y^n^f^^^^n "FIA",26.12,0,10) "FIA",26.12,0,11) "FIA",26.12,0,"RLRO") "FIA",26.12,0,"VR") 5.3^DG "FIA",26.12,26.12) 0 "FIA",26.12,26.122) 0 "FIA",26.13) PRF ASSIGNMENT "FIA",26.13,0) ^DGPF(26.13, "FIA",26.13,0,0) 26.13PI "FIA",26.13,0,1) y^y^f^^^^n "FIA",26.13,0,10) "FIA",26.13,0,11) "FIA",26.13,0,"RLRO") "FIA",26.13,0,"VR") 5.3^DG "FIA",26.13,26.13) 0 "FIA",26.13,26.132) 0 "FIA",26.14) PRF ASSIGNMENT HISTORY "FIA",26.14,0) ^DGPF(26.14, "FIA",26.14,0,0) 26.14IP "FIA",26.14,0,1) y^n^f^^^^n "FIA",26.14,0,10) "FIA",26.14,0,11) "FIA",26.14,0,"RLRO") "FIA",26.14,0,"VR") 5.3^DG "FIA",26.14,26.14) 0 "FIA",26.14,26.141) 0 "FIA",26.15) PRF NATIONAL FLAG "FIA",26.15,0) ^DGPF(26.15, "FIA",26.15,0,0) 26.15I "FIA",26.15,0,1) y^n^f^^^^n "FIA",26.15,0,10) "FIA",26.15,0,11) "FIA",26.15,0,"RLRO") "FIA",26.15,0,"VR") 5.3^DG "FIA",26.15,26.15) 0 "FIA",26.15,26.151) 0 "FIA",26.15,26.152) 0 "FIA",26.16) PRF TYPE "FIA",26.16,0) ^DGPF(26.16, "FIA",26.16,0,0) 26.16 "FIA",26.16,0,1) y^n^f^^n^^y^o^n "FIA",26.16,0,10) "FIA",26.16,0,11) "FIA",26.16,0,"RLRO") "FIA",26.16,0,"VR") 5.3^DG "FIA",26.16,26.16) 0 "FIA",26.17) PRF HL7 TRANSMISSION LOG "FIA",26.17,0) ^DGPF(26.17, "FIA",26.17,0,0) 26.17I "FIA",26.17,0,1) y^n^f^^^^n "FIA",26.17,0,10) "FIA",26.17,0,11) "FIA",26.17,0,"RLRO") "FIA",26.17,0,"VR") 5.3^DG "FIA",26.17,26.17) 0 "FIA",26.18) PRF PARAMETERS "FIA",26.18,0) ^DGPF(26.18, "FIA",26.18,0,0) 26.18 "FIA",26.18,0,1) y^n^f^^^^n "FIA",26.18,0,10) "FIA",26.18,0,11) "FIA",26.18,0,"RLRO") "FIA",26.18,0,"VR") 5.3^DG "FIA",26.18,26.18) 0 "INIT") POST^DG53P425 "IX",26.11,26.11,"AINACT",0) 26.11^AINACT^Trigger for Status change to all Assignments.^MU^^F^I^I^26.11^^^^^A "IX",26.11,26.11,"AINACT",.1,0) ^^3^3^3030228^ "IX",26.11,26.11,"AINACT",.1,1,0) The trigger process will Inactivate ALL active Patient Record Flag "IX",26.11,26.11,"AINACT",.1,2,0) Assignment records in the PRF ASSIGNMENT (#26.13) file associated with "IX",26.11,26.11,"AINACT",.1,3,0) this flag. "IX",26.11,26.11,"AINACT",1) I X(1)=0,X1(1)=1 D INACT^DGPFDD(DA,X(1),26.11,DUZ) "IX",26.11,26.11,"AINACT",1.4) "IX",26.11,26.11,"AINACT",2) Q "IX",26.11,26.11,"AINACT",2.4) "IX",26.11,26.11,"AINACT",11.1,0) ^.114IA^1^1 "IX",26.11,26.11,"AINACT",11.1,1,0) 1^F^26.11^.02^^^F "IX",26.11,26.11,"ASTAT",0) 26.11^ASTAT^This is a sort only index of the STATUS & NAME fields.^R^^R^IR^I^26.11^^^^^S "IX",26.11,26.11,"ASTAT",1) S ^DGPF(26.11,"ASTAT",X(1),$E(X(2),1,30),DA)="" "IX",26.11,26.11,"ASTAT",2) K ^DGPF(26.11,"ASTAT",X(1),$E(X(2),1,30),DA) "IX",26.11,26.11,"ASTAT",2.5) K ^DGPF(26.11,"ASTAT") "IX",26.11,26.11,"ASTAT",11.1,0) ^.114IA^2^2 "IX",26.11,26.11,"ASTAT",11.1,1,0) 1^F^26.11^.02^^1^F "IX",26.11,26.11,"ASTAT",11.1,2,0) 2^F^26.11^.01^30^2^F "IX",26.11,26.11,"ATYP",0) 26.11^ATYP^This is a sort only index of the TYPE and NAME fields.^R^^R^IR^I^26.11^^^^^S "IX",26.11,26.11,"ATYP",1) S ^DGPF(26.11,"ATYP",X(1),$E(X(2),1,30),DA)="" "IX",26.11,26.11,"ATYP",2) K ^DGPF(26.11,"ATYP",X(1),$E(X(2),1,30),DA) "IX",26.11,26.11,"ATYP",2.5) K ^DGPF(26.11,"ATYP") "IX",26.11,26.11,"ATYP",11.1,0) ^.114IA^2^2 "IX",26.11,26.11,"ATYP",11.1,1,0) 1^F^26.11^.03^^1^F "IX",26.11,26.11,"ATYP",11.1,1,3) "IX",26.11,26.11,"ATYP",11.1,2,0) 2^F^26.11^.01^30^2^F "IX",26.11,26.11,"ATYP",11.1,2,3) "IX",26.12,26.12,"C",0) 26.12^C^This is a regular index on the FLAG NAME & FLAG EDIT DATE/TIME fields.^R^^R^IR^I^26.12^^^^^LS "IX",26.12,26.12,"C",1) S ^DGPF(26.12,"C",X(1),X(2),DA)="" "IX",26.12,26.12,"C",2) K ^DGPF(26.12,"C",X(1),X(2),DA) "IX",26.12,26.12,"C",2.5) K ^DGPF(26.12,"C") "IX",26.12,26.12,"C",11.1,0) ^.114IA^2^2 "IX",26.12,26.12,"C",11.1,1,0) 1^F^26.12^.01^^1^F "IX",26.12,26.12,"C",11.1,1,3) "IX",26.12,26.12,"C",11.1,2,0) 2^F^26.12^.02^^2^F "IX",26.12,26.12,"C",11.1,2,3) "IX",26.13,26.13,"AFLAG",0) 26.13^AFLAG^Index the Flag Name(var pointer) and Patient fields.^R^^R^IR^I^26.13^^^^^S "IX",26.13,26.13,"AFLAG",1) S ^DGPF(26.13,"AFLAG",X(1),X(2),DA)="" "IX",26.13,26.13,"AFLAG",2) K ^DGPF(26.13,"AFLAG",X(1),X(2),DA) "IX",26.13,26.13,"AFLAG",2.5) K ^DGPF(26.13,"AFLAG") "IX",26.13,26.13,"AFLAG",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"AFLAG",11.1,1,0) 1^F^26.13^.02^^1^F "IX",26.13,26.13,"AFLAG",11.1,1,3) "IX",26.13,26.13,"AFLAG",11.1,2,0) 2^F^26.13^.01^^2^F "IX",26.13,26.13,"AFLAG",11.1,2,3) "IX",26.13,26.13,"AFREV",0) 26.13^AFREV^Index the Review Date and Patient Name fields^R^^R^IR^I^26.13^^^^^S "IX",26.13,26.13,"AFREV",1) S ^DGPF(26.13,"AFREV",X(1),X(2),DA)="" "IX",26.13,26.13,"AFREV",2) K ^DGPF(26.13,"AFREV",X(1),X(2),DA) "IX",26.13,26.13,"AFREV",2.5) K ^DGPF(26.13,"AFREV") "IX",26.13,26.13,"AFREV",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"AFREV",11.1,1,0) 1^F^26.13^.06^^1^F "IX",26.13,26.13,"AFREV",11.1,1,3) "IX",26.13,26.13,"AFREV",11.1,2,0) 2^F^26.13^.01^^2^F "IX",26.13,26.13,"AFREV",11.1,2,3) "IX",26.13,26.13,"ANDAT",0) 26.13^ANDAT^Computed notification date^R^^R^IR^I^26.13^^^^^S "IX",26.13,26.13,"ANDAT",1) S ^DGPF(26.13,"ANDAT",X(3),DA)="" "IX",26.13,26.13,"ANDAT",2) K ^DGPF(26.13,"ANDAT",X(3),DA) "IX",26.13,26.13,"ANDAT",2.5) K ^DGPF(26.13,"ANDAT") "IX",26.13,26.13,"ANDAT",11.1,0) ^.114IA^3^3 "IX",26.13,26.13,"ANDAT",11.1,1,0) 1^F^26.13^.02^^^F "IX",26.13,26.13,"ANDAT",11.1,1,3) "IX",26.13,26.13,"ANDAT",11.1,2,0) 2^F^26.13^.06^^^F "IX",26.13,26.13,"ANDAT",11.1,2,3) "IX",26.13,26.13,"ANDAT",11.1,3,0) 3^C^^^^1 "IX",26.13,26.13,"ANDAT",11.1,3,1.5) S X=$$NOTIFYDT^DGPFAA3(X(1),X(2)),X=$S(X>0:X,1:"") "IX",26.13,26.13,"ASTAT",0) 26.13^ASTAT^Index the STATUS and FLAG NAME fields.^R^^R^IR^I^26.13^^^^^S "IX",26.13,26.13,"ASTAT",1) S ^DGPF(26.13,"ASTAT",X(1),X(2),DA)="" "IX",26.13,26.13,"ASTAT",2) K ^DGPF(26.13,"ASTAT",X(1),X(2),DA) "IX",26.13,26.13,"ASTAT",2.5) K ^DGPF(26.13,"ASTAT") "IX",26.13,26.13,"ASTAT",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"ASTAT",11.1,1,0) 1^F^26.13^.03^^1^F "IX",26.13,26.13,"ASTAT",11.1,1,3) "IX",26.13,26.13,"ASTAT",11.1,2,0) 2^F^26.13^.02^^2^F "IX",26.13,26.13,"ASTAT",11.1,2,3) "IX",26.13,26.13,"C",0) 26.13^C^Index the Patient and Flag Name fields^R^^R^IR^I^26.13^^^^^LS "IX",26.13,26.13,"C",1) S ^DGPF(26.13,"C",X(1),X(2),DA)="" "IX",26.13,26.13,"C",2) K ^DGPF(26.13,"C",X(1),X(2),DA) "IX",26.13,26.13,"C",2.5) K ^DGPF(26.13,"C") "IX",26.13,26.13,"C",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"C",11.1,1,0) 1^F^26.13^.01^^1^F "IX",26.13,26.13,"C",11.1,1,3) "IX",26.13,26.13,"C",11.1,2,0) 2^F^26.13^.02^^2^F "IX",26.13,26.13,"C",11.1,2,3) "IX",26.13,26.13,"D",0) 26.13^D^Index the Patient Name and the Status fields^R^^R^IR^I^26.13^^^^^LS "IX",26.13,26.13,"D",1) S ^DGPF(26.13,"D",X(1),X(2),DA)="" "IX",26.13,26.13,"D",2) K ^DGPF(26.13,"D",X(1),X(2),DA) "IX",26.13,26.13,"D",2.5) K ^DGPF(26.13,"D") "IX",26.13,26.13,"D",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"D",11.1,1,0) 1^F^26.13^.01^^1^F "IX",26.13,26.13,"D",11.1,2,0) 2^F^26.13^.03^^2^F "IX",26.14,26.14,"APPRO",0) 26.14^APPRO^This is a regular index on the APPROVED BY and PRF ASSIGNMENT fields.^R^^R^IR^I^26.14^^^^^S "IX",26.14,26.14,"APPRO",1) S ^DGPF(26.14,"APPRO",X(1),X(2),DA)="" "IX",26.14,26.14,"APPRO",2) K ^DGPF(26.14,"APPRO",X(1),X(2),DA) "IX",26.14,26.14,"APPRO",2.5) K ^DGPF(26.14,"APPRO") "IX",26.14,26.14,"APPRO",11.1,0) ^.114IA^2^2 "IX",26.14,26.14,"APPRO",11.1,1,0) 1^F^26.14^.05^^1^F "IX",26.14,26.14,"APPRO",11.1,1,3) "IX",26.14,26.14,"APPRO",11.1,2,0) 2^F^26.14^.01^^2^F "IX",26.14,26.14,"APPRO",11.1,2,3) "IX",26.14,26.14,"C",0) 26.14^C^This is a regular index on the PRF ASSIGNMENT & DATE/TIME FIELDS.^R^^R^IR^I^26.14^^^^^LS "IX",26.14,26.14,"C",1) S ^DGPF(26.14,"C",X(1),X(2),DA)="" "IX",26.14,26.14,"C",2) K ^DGPF(26.14,"C",X(1),X(2),DA) "IX",26.14,26.14,"C",2.5) K ^DGPF(26.14,"C") "IX",26.14,26.14,"C",11.1,0) ^.114IA^2^2 "IX",26.14,26.14,"C",11.1,1,0) 1^F^26.14^.01^^1^F "IX",26.14,26.14,"C",11.1,2,0) 2^F^26.14^.02^^2^F "IX",26.14,26.14,"D",0) 26.14^D^This is a regular index on the DATE/TIME & APPROVED BY fields.^R^^R^IR^I^26.14^^^^^LS "IX",26.14,26.14,"D",1) S ^DGPF(26.14,"D",X(1),X(2),DA)="" "IX",26.14,26.14,"D",2) K ^DGPF(26.14,"D",X(1),X(2),DA) "IX",26.14,26.14,"D",2.5) K ^DGPF(26.14,"D") "IX",26.14,26.14,"D",11.1,0) ^.114IA^2^2 "IX",26.14,26.14,"D",11.1,1,0) 1^F^26.14^.02^^1^F "IX",26.14,26.14,"D",11.1,2,0) 2^F^26.14^.05^^2^F "IX",26.15,26.15,"AINACT",0) 26.15^AINACT^Trigger for Status change to all Assignments.^MU^^F^I^I^26.15^^^^^A "IX",26.15,26.15,"AINACT",.1,0) ^^3^3^3030228^ "IX",26.15,26.15,"AINACT",.1,1,0) The trigger process will Inactivate ALL active Patient Record Flag "IX",26.15,26.15,"AINACT",.1,2,0) Assignment records in the PRF ASSIGNMENT (#26.13) file associated with "IX",26.15,26.15,"AINACT",.1,3,0) this flag. "IX",26.15,26.15,"AINACT",1) I X(1)=0,X1(1)=1 D INACT^DGPFDD(DA,X(1),26.15,DUZ) "IX",26.15,26.15,"AINACT",2) Q "IX",26.15,26.15,"AINACT",11.1,0) ^.114IA^1^1 "IX",26.15,26.15,"AINACT",11.1,1,0) 1^F^26.15^.02^^^F "IX",26.15,26.15,"ASTAT",0) 26.15^ASTAT^This is a sort only index of the STATUS & NAME fields.^R^^R^IR^I^26.15^^^^^S "IX",26.15,26.15,"ASTAT",1) S ^DGPF(26.15,"ASTAT",X(1),$E(X(2),1,30),DA)="" "IX",26.15,26.15,"ASTAT",2) K ^DGPF(26.15,"ASTAT",X(1),$E(X(2),1,30),DA) "IX",26.15,26.15,"ASTAT",2.5) K ^DGPF(26.15,"ASTAT") "IX",26.15,26.15,"ASTAT",11.1,0) ^.114IA^2^2 "IX",26.15,26.15,"ASTAT",11.1,1,0) 1^F^26.15^.02^^1^F "IX",26.15,26.15,"ASTAT",11.1,1,3) "IX",26.15,26.15,"ASTAT",11.1,2,0) 2^F^26.15^.01^30^2^F "IX",26.15,26.15,"ASTAT",11.1,2,3) "IX",26.15,26.15,"ATYPE",0) 26.15^ATYPE^This is a sort only index of the TYPE & NAME fields.^R^^R^IR^I^26.15^^^^^S "IX",26.15,26.15,"ATYPE",1) S ^DGPF(26.15,"ATYPE",X(1),$E(X(2),1,30),DA)="" "IX",26.15,26.15,"ATYPE",2) K ^DGPF(26.15,"ATYPE",X(1),$E(X(2),1,30),DA) "IX",26.15,26.15,"ATYPE",2.5) K ^DGPF(26.15,"ATYPE") "IX",26.15,26.15,"ATYPE",11.1,0) ^.114IA^2^2 "IX",26.15,26.15,"ATYPE",11.1,1,0) 1^F^26.15^.03^^1^F "IX",26.15,26.15,"ATYPE",11.1,1,3) "IX",26.15,26.15,"ATYPE",11.1,2,0) 2^F^26.15^.01^30^2^F "IX",26.15,26.15,"ATYPE",11.1,2,3) "IX",26.17,26.17,"ASTAT",0) 26.17^ASTAT^This index cross references the Date/Time and Status fields^R^^R^IR^I^26.17^^^^^S "IX",26.17,26.17,"ASTAT",1) S ^DGPF(26.17,"ASTAT",X(1),X(2),DA)="" "IX",26.17,26.17,"ASTAT",2) K ^DGPF(26.17,"ASTAT",X(1),X(2),DA) "IX",26.17,26.17,"ASTAT",2.5) K ^DGPF(26.17,"ASTAT") "IX",26.17,26.17,"ASTAT",11.1,0) ^.114IA^2^2 "IX",26.17,26.17,"ASTAT",11.1,1,0) 1^F^26.17^.03^^1^F "IX",26.17,26.17,"ASTAT",11.1,1,3) "IX",26.17,26.17,"ASTAT",11.1,2,0) 2^F^26.17^.04^^2^F "IX",26.17,26.17,"ASTAT",11.1,2,3) "KRN",3.8,292,-1) 0^1 "KRN",3.8,292,0) DGPF BEHAVIORAL FLAG REVIEW^PU^n^^^^ "KRN",3.8,292,2,0) ^3.801^2^2^3030428^^^^ "KRN",3.8,292,2,1,0) This is the default mail group for receiving Patient Record Flag "KRN",3.8,292,2,2,0) Assignment Review notifications. "KRN",3.8,292,3) "KRN",3.8,293,-1) 0^2 "KRN",3.8,293,0) DGPF HL7 TRANSMISSION ERRORS^PU^n^^^^ "KRN",3.8,293,2,0) ^^2^2^3030428^ "KRN",3.8,293,2,1,0) This mail group is used to notify Patient Record Flag administrators of "KRN",3.8,293,2,2,0) transmission errors that occur during the processing of HL7 messages. "KRN",3.8,293,3) "KRN",19,10750,-1) 0^1 "KRN",19,10750,0) DGPF RECORD FLAG ASSIGNMENT^Record Flag Assignment^^R^^DGPF PRF ACCESS^^^^^^REGISTRATION^^1 "KRN",19,10750,1,0) ^^10^10^3030708^ "KRN",19,10750,1,1,0) This option provides a List Manager user interface for assigning Patient "KRN",19,10750,1,2,0) Record Flags to patients. Additionally, this option provides the "KRN",19,10750,1,3,0) ability to review and manage Patient Record Flag assignments. The "KRN",19,10750,1,4,0) following actions are provided within the patient Record Flag Assignment "KRN",19,10750,1,5,0) option. "KRN",19,10750,1,6,0) - Assign a Patient Record Flag to a patient. "KRN",19,10750,1,7,0) - Display the details of a patient's record flag assignments including "KRN",19,10750,1,8,0) the history of the assignment. "KRN",19,10750,1,9,0) - Review/Edit a patient's record flag assignment. "KRN",19,10750,1,10,0) - Change the site ownership of a patient's record flag assignment. "KRN",19,10750,20) I '$$ON^DGPFPARM() W !,">>> Patient Record Flag Software is not active!",*7 S XQUIT=1 "KRN",19,10750,25) EN^DGPFLMA "KRN",19,10750,"U") RECORD FLAG ASSIGNMENT "KRN",19,10755,-1) 0^9 "KRN",19,10755,0) DGPF RECORD FLAG REPORTS MENU^Record Flag Reports Menu^^M^^DGPF PRF ACCESS^^^^^^REGISTRATION^^^ "KRN",19,10755,1,0) ^19.06^1^1^3030520^^ "KRN",19,10755,1,1,0) This menu contains patient record flag report functions. "KRN",19,10755,10,0) ^19.01IP^5^4 "KRN",19,10755,10,2,0) 10756^FAR^2 "KRN",19,10755,10,2,"^") DGPF FLAG ASSIGNMENT REPORT "KRN",19,10755,10,5,0) 10761^ADR^5 "KRN",19,10755,10,5,"^") DGPF ASSIGNMENT DUE REVIEW RPT "KRN",19,10755,15) "KRN",19,10755,20) "KRN",19,10755,99) 59309,43060 "KRN",19,10755,99.1) 59297,35293 "KRN",19,10755,"U") RECORD FLAG REPORTS MENU "KRN",19,10756,-1) 0^6 "KRN",19,10756,0) DGPF FLAG ASSIGNMENT REPORT^Flag Assignment Report^^R^^DGPF PRF ACCESS^^^^^y^REGISTRATION^^^ "KRN",19,10756,1,0) ^19.06^2^2^3030603^^ "KRN",19,10756,1,1,0) This option enables a user to display or print all of the patient "KRN",19,10756,1,2,0) assignments for Category I and/or Category II Patient Record Flags. "KRN",19,10756,15) "KRN",19,10756,25) EN^DGPFRFA "KRN",19,10756,99) 59168,40517 "KRN",19,10756,200.9) ^y "KRN",19,10756,"U") FLAG ASSIGNMENT REPORT "KRN",19,10759,-1) 0^4 "KRN",19,10759,0) DGPF BACKGROUND PROCESSING^Patient Record Flag Background^^R^^^^^^^^REGISTRATION "KRN",19,10759,1,0) ^^6^6^3030708^ "KRN",19,10759,1,1,0) This option should be scheduled to run once a day. The following "KRN",19,10759,1,2,0) functions are processed by this background option: "KRN",19,10759,1,3,0) 1. Send review notification messages for pending Patient Record Flag "KRN",19,10759,1,4,0) Assignment reviews. "KRN",19,10759,1,5,0) 2. Auto retransmitting of rejected HL7 Patient Record Flag Assignment "KRN",19,10759,1,6,0) messages. "KRN",19,10759,25) EN^DGPFBGR "KRN",19,10759,200.9) y^y "KRN",19,10759,"U") PATIENT RECORD FLAG BACKGROUND "KRN",19,10761,-1) 0^11 "KRN",19,10761,0) DGPF ASSIGNMENT DUE REVIEW RPT^Assignments Due For Review Report^^R^^DGPF PRF ACCESS^^^^^y^REGISTRATION^^^ "KRN",19,10761,1,0) ^19.06^3^3^3030520^^^^ "KRN",19,10761,1,1,0) This option will be used to display or print all Category I or Category II "KRN",19,10761,1,2,0) Patient Record Flag Assignments that are due for review within a given "KRN",19,10761,1,3,0) date range. "KRN",19,10761,15) "KRN",19,10761,25) EN^DGPFRFR "KRN",19,10761,99) 59182,54062 "KRN",19,10761,200.9) ^y "KRN",19,10761,"U") ASSIGNMENTS DUE FOR REVIEW REP "KRN",19,10805,-1) 0^10 "KRN",19,10805,0) DGPF RECORD FLAGS MAIN MENU^Patient Record Flags Main Menu^^M^^DGPF PRF ACCESS^^^^^^ "KRN",19,10805,1,0) ^19.06^2^2^3030508^^^^ "KRN",19,10805,1,1,0) This menu option contains all menus and options needed to assign, "KRN",19,10805,1,2,0) manage, and report patient record flag information. "KRN",19,10805,10,0) ^19.01IP^4^4 "KRN",19,10805,10,1,0) 10750^FA^20 "KRN",19,10805,10,1,"^") DGPF RECORD FLAG ASSIGNMENT "KRN",19,10805,10,2,0) 10755^RM^10 "KRN",19,10805,10,2,"^") DGPF RECORD FLAG REPORTS MENU "KRN",19,10805,10,3,0) 10878^FM^30 "KRN",19,10805,10,3,"^") DGPF RECORD FLAG MANAGEMENT "KRN",19,10805,10,4,0) 10885^IRM^40 "KRN",19,10805,10,4,"^") DGPF PRF SYSTEM CONFIGURATION "KRN",19,10805,99) 59297,36398 "KRN",19,10805,99.1) 59414,37253 "KRN",19,10805,"U") PATIENT RECORD FLAGS MAIN MENU "KRN",19,10878,-1) 0^3 "KRN",19,10878,0) DGPF RECORD FLAG MANAGEMENT^Record Flag Management^^R^^DGPF PRF ACCESS^^^^^^ "KRN",19,10878,1,0) ^^5^5^3030522^ "KRN",19,10878,1,1,0) This option will provide users with the ability to: "KRN",19,10878,1,2,0) - Create Category II (Local) Patient Record Flags "KRN",19,10878,1,3,0) - Edit Category II (Local) Patient Record Flags "KRN",19,10878,1,4,0) - List Category I (National) and Category II (Local) Patient Record Flags "KRN",19,10878,1,5,0) - Display details of Category I and Category II Patient Record Flags "KRN",19,10878,25) EN^DGPFLF "KRN",19,10878,"U") RECORD FLAG MANAGEMENT "KRN",19,10885,-1) 0^8 "KRN",19,10885,0) DGPF PRF SYSTEM CONFIGURATION^PRF System Configuration^^R^^DGPF PRF CONFIG^^^^^^REGISTRATION "KRN",19,10885,1,0) ^19.06^2^2^3030527^^^ "KRN",19,10885,1,1,0) This option enables IRM staff to enable or disable the Patient Record "KRN",19,10885,1,2,0) Flag HL7 interfaces. "KRN",19,10885,25) EN^DGPFPARM "KRN",19,10885,"U") PRF SYSTEM CONFIGURATION "KRN",19.1,390,-1) 0^1 "KRN",19.1,390,0) DGPF RECORD FLAG ASSIGNMENT^Patient Record Flag Assignment "KRN",19.1,390,1,0) ^^7^7^3030430^ "KRN",19.1,390,1,1,0) This security key will be used to control user access to the following "KRN",19.1,390,1,2,0) protocol actions within the List Manager, Record Flag Assignment [DGPF "KRN",19.1,390,1,3,0) RECORD FLAG ASSIGNMENT] option: "KRN",19.1,390,1,4,0) "KRN",19.1,390,1,5,0) - AF Assign Flag [DGPF ASSIGN FLAG] "KRN",19.1,390,1,6,0) - EF Edit Flag Assignment [DGPF EDIT ASSIGNMENT] "KRN",19.1,390,1,7,0) - CO Change Assignment Ownership [DGPF CHANGE ASSIGNMENT OWNERSHIP] "KRN",19.1,396,-1) 0^2 "KRN",19.1,396,0) DGPF LOCAL FLAG EDIT^Local Patient Record Flag Edit "KRN",19.1,396,1,0) ^^3^3^3030317^ "KRN",19.1,396,1,1,0) This security key will be used to control user access to the Record Flag "KRN",19.1,396,1,2,0) Management [DGPF RECORD FLAG MANAGEMENT] option action items, AF Add New "KRN",19.1,396,1,3,0) Flag and EF Edit Flag. "KRN",19.1,404,-1) 0^3 "KRN",19.1,404,0) DGPF PRF ACCESS^Patient Record Flag Access "KRN",19.1,404,1,0) ^19.11^4^4^3030429^ "KRN",19.1,404,1,1,0) This security key is used to control access to the Patient Record Flags "KRN",19.1,404,1,2,0) module of the Registration package. Holders of this key will be "KRN",19.1,404,1,3,0) able to display record flag detail, patient assignment detail and generate "KRN",19.1,404,1,4,0) reports. "KRN",19.1,405,-1) 0^4 "KRN",19.1,405,0) DGPF PRF CONFIG^Patient Record Flag Config "KRN",19.1,405,1,0) ^19.11^2^2^3030528^^ "KRN",19.1,405,1,1,0) This security key controls access to the PRF System Configuration [DGPF "KRN",19.1,405,1,2,0) PRF SYSTEM CONFIGURATION] option. "KRN",101,3655,-1) 0^17 "KRN",101,3655,0) DGPF RECORD FLAG ASSIGNMENT MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3655,1,0) ^101.06^2^2^3030321^^^^ "KRN",101,3655,1,1,0) This protocol menu contains all the activities for creating, editing, and "KRN",101,3655,1,2,0) displaying patient record flag assignments. "KRN",101,3655,4) 40^4 "KRN",101,3655,10,0) ^101.01PA^7^6 "KRN",101,3655,10,3,0) 3657^EF^40^ "KRN",101,3655,10,3,"^") DGPF EDIT ASSIGNMENT "KRN",101,3655,10,4,0) 3658^AF^30^ "KRN",101,3655,10,4,"^") DGPF ASSIGN FLAG "KRN",101,3655,10,5,0) 3656^DA^20^ "KRN",101,3655,10,5,"^") DGPF DISPLAY ASSIGNMENT DETAIL "KRN",101,3655,10,6,0) 3659^SP^10^ "KRN",101,3655,10,6,"^") DGPF SELECT PATIENT "KRN",101,3655,10,7,0) 3711^CO^50^ "KRN",101,3655,10,7,"^") DGPF CHANGE ASSIGNMENT OWNERSHIP "KRN",101,3655,15) "KRN",101,3655,24) "KRN",101,3655,26) D SHOW^VALM "KRN",101,3655,28) Select Action: "KRN",101,3655,99) 59235,33096 "KRN",101,3656,-1) 0^3 "KRN",101,3656,0) DGPF DISPLAY ASSIGNMENT DETAIL^Display Assignment Details^^A^^^^^^^^REGISTRATION "KRN",101,3656,1,0) ^^3^3^3030708^ "KRN",101,3656,1,1,0) This action protocol permits the user to view the details of a patient's "KRN",101,3656,1,2,0) flag assignment within the Record Flag Assignment [DGPF RECORD FLAG "KRN",101,3656,1,3,0) ASSIGNMENT] option. "KRN",101,3656,15) "KRN",101,3656,20) D DF^DGPFLMA1 "KRN",101,3656,24) "KRN",101,3656,99) 59225,41879 "KRN",101,3657,-1) 0^4 "KRN",101,3657,0) DGPF EDIT ASSIGNMENT^Edit Flag Assignment^^A^^^^^^^^REGISTRATION "KRN",101,3657,1,0) ^^2^2^3030708^ "KRN",101,3657,1,1,0) This action protocol permits the user to edit a patient's flag assignment "KRN",101,3657,1,2,0) within the Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3657,20) D EF^DGPFLMA3 "KRN",101,3657,24) "KRN",101,3657,99) 59141,46395 "KRN",101,3658,-1) 0^1 "KRN",101,3658,0) DGPF ASSIGN FLAG^Assign Flag^^A^^^^^^^^REGISTRATION "KRN",101,3658,1,0) ^^2^2^3030708^ "KRN",101,3658,1,1,0) This action protocol permits the user to assign a flag to a patient "KRN",101,3658,1,2,0) within the Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3658,20) D AF^DGPFLMA2 "KRN",101,3658,24) "KRN",101,3658,99) 59141,55775 "KRN",101,3659,-1) 0^11 "KRN",101,3659,0) DGPF SELECT PATIENT^Select Patient^^A^^^^^^^^REGISTRATION "KRN",101,3659,1,0) ^^2^2^3030708^ "KRN",101,3659,1,1,0) This action protocol permits the user to select a patient within the "KRN",101,3659,1,2,0) Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3659,20) D SP^DGPFLMA1 S VALMBCK="R" "KRN",101,3659,24) "KRN",101,3659,99) 59204,37588 "KRN",101,3660,-1) 0^6 "KRN",101,3660,0) DGPF PRF ORU/R01 EVENT^^^E^^^^^^^^REGISTRATION "KRN",101,3660,1,0) ^^2^2^3030617^^ "KRN",101,3660,1,1,0) This protocol is the event protocol for Patient Record Flags assignment "KRN",101,3660,1,2,0) transmissions (ORU~R01). "KRN",101,3660,770) PRF-SEND^^ORU^R01^^^^NE^AL^2.3^ "KRN",101,3660,772) D RCV^DGPFHLR "KRN",101,3660,775,0) ^101.0775PA^1^1 "KRN",101,3660,775,1,0) 3661 "KRN",101,3660,775,1,"^") DGPF PRF ORU/R01 SUBSC "KRN",101,3661,-1) 0^7 "KRN",101,3661,0) DGPF PRF ORU/R01 SUBSC^^^S^^^^^^^^REGISTRATION "KRN",101,3661,1,0) ^^2^2^3030307^ "KRN",101,3661,1,1,0) This protocol is the subscriber protocol for Patient Record Flags "KRN",101,3661,1,2,0) assignment transmissions (ORU~R01). "KRN",101,3661,770) ^PRF-RECV^^R01^^^^^^^ACK "KRN",101,3661,771) D RCV^DGPFHLR "KRN",101,3661,773) 1^1 "KRN",101,3661,774) Q "KRN",101,3705,-1) 0^8 "KRN",101,3705,0) DGPF PRF QRY/R02 EVENT^^^E^^^^^^^^REGISTRATION "KRN",101,3705,1,0) ^^2^2^3030307^ "KRN",101,3705,1,1,0) This protocol is the event protocol for the Patient Record Flags query "KRN",101,3705,1,2,0) message (QRY~R02). "KRN",101,3705,770) PRF-QRY^^QRY^R02^^^^^^2.3^ "KRN",101,3705,772) D RCV^DGPFHLR "KRN",101,3705,775,0) ^101.0775PA^1^1 "KRN",101,3705,775,1,0) 3706 "KRN",101,3705,775,1,"^") DGPF PRF ORF/R04 SUBSC "KRN",101,3706,-1) 0^5 "KRN",101,3706,0) DGPF PRF ORF/R04 SUBSC^^^S^^^^^^^^REGISTRATION "KRN",101,3706,1,0) ^^3^3^3030528^ "KRN",101,3706,1,1,0) This protocol is the subscriber protocol for the Patient Record Flags "KRN",101,3706,1,2,0) query message (QRY~R02). The protocol will return an observation results "KRN",101,3706,1,3,0) message (ORF~R04). "KRN",101,3706,770) ^PRF-QRYRESP^^R04^^^^^^^ORF "KRN",101,3706,771) D RCV^DGPFHLR "KRN",101,3706,773) 1^1 "KRN",101,3706,774) Q "KRN",101,3711,-1) 0^2 "KRN",101,3711,0) DGPF CHANGE ASSIGNMENT OWNERSHIP^Change Assignment Ownership^^A^^^^^^^^REGISTRATION "KRN",101,3711,1,0) ^^3^3^3030708^ "KRN",101,3711,1,1,0) This action protocol permits the user to change the site ownership of a "KRN",101,3711,1,2,0) patient's flag assignment within the Record Flag Assignment [DGPF RECORD "KRN",101,3711,1,3,0) FLAG ASSIGNMENT] option. "KRN",101,3711,2,0) ^101.02A^^0 "KRN",101,3711,20) D CO^DGPFLMA4 "KRN",101,3711,24) "KRN",101,3711,99) 59233,70850 "KRN",101,3712,-1) 0^10 "KRN",101,3712,0) DGPF RECORD FLAG MANAGEMENT MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3712,1,0) ^101.06^2^2^3030715^^ "KRN",101,3712,1,1,0) This protocol menu contains all the activities for creating, editing, and "KRN",101,3712,1,2,0) displaying patient record flags. "KRN",101,3712,4) 26^4 "KRN",101,3712,10,0) ^101.01PA^6^5 "KRN",101,3712,10,1,0) 3714^DF^30^ "KRN",101,3712,10,1,"^") DGPF DISPLAY FLAG DETAIL "KRN",101,3712,10,2,0) 3715^CS^20^ "KRN",101,3712,10,2,"^") DGPF SORT FLAG LIST "KRN",101,3712,10,4,0) 3717^AF^40^ "KRN",101,3712,10,4,"^") DGPF ADD FLAG "KRN",101,3712,10,5,0) 3718^EF^50^ "KRN",101,3712,10,5,"^") DGPF EDIT FLAG "KRN",101,3712,10,6,0) 3754^CC^10^ "KRN",101,3712,10,6,"^") DGPF CHANGE CATEGORY "KRN",101,3712,24) "KRN",101,3712,26) D SHOW^VALM "KRN",101,3712,28) Select Action: "KRN",101,3712,99) 59365,51237 "KRN",101,3714,-1) 0^16 "KRN",101,3714,0) DGPF DISPLAY FLAG DETAIL^Display Flag Detail^^A^^^^^^^^REGISTRATION "KRN",101,3714,1,0) ^^3^3^3030708^ "KRN",101,3714,1,1,0) This action protocol permits the user to view the details of a patient "KRN",101,3714,1,2,0) record flag within the Record Flag Management [DGPF RECORD FLAG "KRN",101,3714,1,3,0) MANAGEMENT] option. "KRN",101,3714,20) D DF^DGPFLF2 "KRN",101,3714,99) 59239,42838 "KRN",101,3715,-1) 0^12 "KRN",101,3715,0) DGPF SORT FLAG LIST^Change Sort^^A^^^^^^^^REGISTRATION "KRN",101,3715,1,0) ^101.06^3^3^3030715^^ "KRN",101,3715,1,1,0) This action protocol allows the user to select a sort criteria for the "KRN",101,3715,1,2,0) flag list within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] "KRN",101,3715,1,3,0) option. The list may be sorted by flag name or flag type. "KRN",101,3715,20) D SL^DGPFLF2 S VALMBCK="R" "KRN",101,3715,99) 59277,32695 "KRN",101,3717,-1) 0^13 "KRN",101,3717,0) DGPF ADD FLAG^Add New Record Flag^^A^^^^^^^^REGISTRATION "KRN",101,3717,1,0) ^101.06^2^2^3030710^^ "KRN",101,3717,1,1,0) This action protocol allows a user to add a new Category II (Local) flag "KRN",101,3717,1,2,0) within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] option. "KRN",101,3717,20) D AF^DGPFLF3 "KRN",101,3717,99) 59248,55760 "KRN",101,3718,-1) 0^14 "KRN",101,3718,0) DGPF EDIT FLAG^Edit Record Flag^^A^^^^^^^^REGISTRATION "KRN",101,3718,1,0) ^^2^2^3030708^ "KRN",101,3718,1,1,0) This action protocol allows a user to edit a Category II (Local) flag "KRN",101,3718,1,2,0) within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] option. "KRN",101,3718,20) D EF^DGPFLF4 "KRN",101,3718,24) "KRN",101,3718,99) 59248,55788 "KRN",101,3754,-1) 0^18 "KRN",101,3754,0) DGPF CHANGE CATEGORY^Change Category^^A^^^^^^^^REGISTRATION "KRN",101,3754,1,0) ^^4^4^3030715^ "KRN",101,3754,1,1,0) This action protocol allows the user to change the category of the flag "KRN",101,3754,1,2,0) list being viewed within the Record Flag Management [DGPF RECORD FLAG "KRN",101,3754,1,3,0) MANAGEMENT] option. The user may view either Category I (National) flags "KRN",101,3754,1,4,0) or Category II (Local) flags. "KRN",101,3754,20) D CC^DGPFLF2 S VALMBCK="R" "KRN",101,3754,99) 59365,49525 "KRN",409.61,974,-1) 0^1 "KRN",409.61,974,0) DGPF RECORD FLAG ASSIGNMENT^1^^80^6^15^1^1^Record Flag Assignment^DGPF RECORD FLAG ASSIGNMENT MENU^RECORD FLAG ASSIGNMENT^1^999^1 "KRN",409.61,974,1) ^VALM HIDDEN ACTIONS "KRN",409.61,974,"ARRAY") "KRN",409.61,974,"COL",0) ^409.621^6^6 "KRN",409.61,974,"COL",1,0) FLAG^4^20^Flag "KRN",409.61,974,"COL",2,0) ASSIGN DATE^26^8^Assigned "KRN",409.61,974,"COL",3,0) APPROV BY^36^18^Approved By "KRN",409.61,974,"COL",4,0) REVIEW DATE^56^11^Review Date "KRN",409.61,974,"COL",5,0) STATUS^69^6^Active "KRN",409.61,974,"COL",6,0) LOCAL^76^5^Local "KRN",409.61,974,"COL","B","APPROV BY",3) "KRN",409.61,974,"COL","B","ASSIGN DATE",2) "KRN",409.61,974,"COL","B","FLAG",1) "KRN",409.61,974,"COL","B","LOCAL",6) "KRN",409.61,974,"COL","B","REVIEW DATE",4) "KRN",409.61,974,"COL","B","STATUS",5) "KRN",409.61,974,"EXP") "KRN",409.61,974,"FNL") D EXIT^DGPFLMA "KRN",409.61,974,"HDR") D HDR^DGPFLMA "KRN",409.61,974,"HLP") D HELP^DGPFLMA "KRN",409.61,974,"INIT") D INIT^DGPFLMA "KRN",409.61,979,-1) 0^2 "KRN",409.61,979,0) DGPF ASSIGNMENT DETAIL^2^^80^5^21^1^1^Assignment Detail^^ASSIGNMENT DETAILS^1^^1 "KRN",409.61,979,1) ^VALM HIDDEN ACTIONS "KRN",409.61,979,"ARRAY") ^TMP("DGPFDET",$J) "KRN",409.61,979,"FNL") D EXIT^DGPFLMAD "KRN",409.61,979,"HDR") D HDR^DGPFLMAD "KRN",409.61,979,"HLP") D HELP^DGPFLMAD "KRN",409.61,979,"INIT") D INIT^DGPFLMAD "KRN",409.61,982,-1) 0^3 "KRN",409.61,982,0) DGPF RECORD FLAG MANAGEMENT^1^^80^5^15^1^1^Record Flag^DGPF RECORD FLAG MANAGEMENT MENU^RECORD FLAG MANAGEMENT^1^^1 "KRN",409.61,982,1) ^VALM HIDDEN ACTIONS "KRN",409.61,982,"ARRAY") ^TMP("DGPFLAG",$J) "KRN",409.61,982,"COL",0) ^409.621^3^3 "KRN",409.61,982,"COL",1,0) NAME^6^30^Flag Name "KRN",409.61,982,"COL",2,0) TYPE^38^25^Flag Type "KRN",409.61,982,"COL",3,0) STATUS^65^11^Flag Status "KRN",409.61,982,"COL","B","NAME",1) "KRN",409.61,982,"COL","B","STATUS",3) "KRN",409.61,982,"COL","B","TYPE",2) "KRN",409.61,982,"FNL") D EXIT^DGPFLF "KRN",409.61,982,"HDR") D HDR^DGPFLF "KRN",409.61,982,"HLP") D HELP^DGPFLF "KRN",409.61,982,"INIT") D INIT^DGPFLF "KRN",409.61,983,-1) 0^4 "KRN",409.61,983,0) DGPF FLAG DETAIL^2^^80^4^20^1^1^Flag Detail^^FLAG DETAILS^1^^1 "KRN",409.61,983,1) ^VALM HIDDEN ACTIONS "KRN",409.61,983,"ARRAY") ^TMP("DGPFDET",$J) "KRN",409.61,983,"FNL") D EXIT^DGPFLFD "KRN",409.61,983,"HDR") D HDR^DGPFLFD "KRN",409.61,983,"HLP") D HELP^DGPFLFD "KRN",409.61,983,"INIT") D INIT^DGPFLFD "KRN",409.61,986,-1) 0^5 "KRN",409.61,986,0) DGPF ACTIVE ASSIGNMENTS^2^^80^7^20^0^1^^^Patient Record Flags^1^^1 "KRN",409.61,986,1) ^VALM HIDDEN ACTIONS "KRN",409.61,986,"ARRAY") ^TMP("DGPFACT",$J) "KRN",409.61,986,"FNL") D EXIT^DGPFLMD "KRN",409.61,986,"HDR") D HDR^DGPFLMD "KRN",409.61,986,"HLP") D HELP^DGPFLMD "KRN",409.61,986,"INIT") D INIT^DGPFLMD "KRN",771,88,-1) 0^4 "KRN",771,88,0) PRF-SEND^a^^^^^US "KRN",771,89,-1) 0^3 "KRN",771,89,0) PRF-RECV^a^^^^^US "KRN",771,97,-1) 0^1 "KRN",771,97,0) PRF-QRY^a^^^^^US "KRN",771,98,-1) 0^2 "KRN",771,98,0) PRF-QRYRESP^a^^^^^US "MBREQ") 0 "ORD",3,19.1) 19.1;3;1;;KEY^XPDTA1;;;;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "ORD",11,3.8) 3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%) "ORD",11,3.8,0) MAIL GROUP "ORD",14,771) 771;14;;;HLAP^XPDTA1;HLAPF1^XPDIA1;HLAPE1^XPDIA1;HLAPF2^XPDIA1;;HLAPDEL^XPDIA1(%) "ORD",14,771,0) HL7 APPLICATION PARAMETER "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2941102^2941102 "PKG",5,22,1,"PAH",1,0) 425^3030902^66476 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3030902 "PKG",5,22,1,"PAH",1,1,1,0) Please refer to patch DG*5.3*425 in the National Patch Module for a "PKG",5,22,1,"PAH",1,1,2,0) complete description of this patch. "PRE") DG53P425 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "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") YES "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") 61 "RTN","DG10") 0^19^B17758260 "RTN","DG10",1,0) DG10 ;ALB/MRL,DAK,AEG-LOAD/EDIT PATIENT DATA ; 5/28/03 1:08pm "RTN","DG10",2,0) ;;5.3;Registration;**32,109,139,149,182,326,513,425**;Aug 13, 1993 "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 A1 "RTN","DG10",6,0) . D EN^DGRPD,REG^IVMCQ($G(DFN)) "RTN","DG10",7,0) . D HINQ "RTN","DG10",8,0) ; "RTN","DG10",9,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",10,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",11,0) ; "RTN","DG10",12,0) ;MPI QUERY "RTN","DG10",13,0) ;check to see if CIRN PD/MPI is installed "RTN","DG10",14,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP "RTN","DG10",15,0) K MPIFRTN "RTN","DG10",16,0) D MPIQ^MPIFAPI(DFN) "RTN","DG10",17,0) K MPIFRTN "RTN","DG10",18,0) ; "RTN","DG10",19,0) I +$G(DGNEW) D "RTN","DG10",20,0) . ; query CMOR for Patient Record Flag Assignments if NEW patient and "RTN","DG10",21,0) . ; display results "RTN","DG10",22,0) . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) "RTN","DG10",23,0) ; "RTN","DG10",24,0) SKIP ; "RTN","DG10",25,0) S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A "RTN","DG10",26,0) D HINQ,REG^IVMCQ($G(DFN)) G A1 "RTN","DG10",27,0) ; "RTN","DG10",28,0) HINQ ; "RTN","DG10",29,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",30,0) .N DGROUT "RTN","DG10",31,0) .S DGROUT=X "RTN","DG10",32,0) .I $G(DFN) D "RTN","DG10",33,0) ..N X,Y,DGRP "RTN","DG10",34,0) ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X)) "RTN","DG10",35,0) ..W !," Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED") "RTN","DG10",36,0) ..W ?40," Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED") "RTN","DG10",37,0) .D @("EN^"_DGROUT) K Y Q ;from dgdem0 "RTN","DG10",38,0) Q "RTN","DG10",39,0) ; "RTN","DG10",40,0) ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management "RTN","DG10",41,0) ; to bypass the embossing routines when calling load/edit from IEMM "RTN","DG10",42,0) ; "RTN","DG10",43,0) A1 W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN 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",44,0) ; "RTN","DG10",45,0) H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing." "RTN","DG10",46,0) G A1 "RTN","DG10",47,0) ; "RTN","DG10",48,0) CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP "RTN","DG10",49,0) G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) "RTN","DG10",50,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",51,0) ;G:Y ^DGRP9 "RTN","DG10",52,0) ; "RTN","DG10",53,0) EMBOS W ! D EMBOS^DGQEMA G A "RTN","DG10",54,0) ; "RTN","DG10",55,0) ; "RTN","DG10",56,0) Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q "RTN","DG10",57,0) ; "RTN","DG10",58,0) MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif "RTN","DG10",59,0) ; one is required "RTN","DG10",60,0) I '$D(SDIEMM) DO "RTN","DG10",61,0) .N DGREQF,DIV "RTN","DG10",62,0) .D EN^DGMTR "RTN","DG10",63,0) .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R" "RTN","DG10",64,0) .Q "RTN","DG10",65,0) I $D(SDIEMM) DO "RTN","DG10",66,0) .N DGMTI "RTN","DG10",67,0) .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1) "RTN","DG10",68,0) .I $P(DGMTI,U,4)="R" D I 1 "RTN","DG10",69,0) ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^") "RTN","DG10",70,0) ..I '$$OKTOCONT(DGMTDT) Q "RTN","DG10",71,0) ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC "RTN","DG10",72,0) .E D WARNING "RTN","DG10",73,0) .Q "RTN","DG10",74,0) Q "RTN","DG10",75,0) ; "RTN","DG10",76,0) WARNING ; "RTN","DG10",77,0) ;prints a warning to the screen about means test "RTN","DG10",78,0) ; "RTN","DG10",79,0) W !!,"A means test for this encounter date was not found and may be required!" "RTN","DG10",80,0) W !,"Further investigation will be needed." "RTN","DG10",81,0) W ! "RTN","DG10",82,0) D PAUSE "RTN","DG10",83,0) Q "RTN","DG10",84,0) ; "RTN","DG10",85,0) PAUSE ; "RTN","DG10",86,0) N DIR "RTN","DG10",87,0) S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR "RTN","DG10",88,0) Q "RTN","DG10",89,0) ; "RTN","DG10",90,0) OKTOCONT(Y) ; "RTN","DG10",91,0) ; "RTN","DG10",92,0) N DIR "RTN","DG10",93,0) W !!,"Patient Requires a means Test" "RTN","DG10",94,0) X ^DD("DD") "RTN","DG10",95,0) W !,"Primary Means Test Required from '",Y,"'",! "RTN","DG10",96,0) ; "RTN","DG10",97,0) I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO G OKQ "RTN","DG10",98,0) .W !,$C(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",! "RTN","DG10",99,0) .D PAUSE "RTN","DG10",100,0) .S Y=0 "RTN","DG10",101,0) ; "RTN","DG10",102,0) S DIR("A")="Do you wish to proceed with the means test at this time" "RTN","DG10",103,0) S DIR("B")="YES" "RTN","DG10",104,0) S DIR(0)="Y" "RTN","DG10",105,0) D ^DIR "RTN","DG10",106,0) OKQ Q $S(Y=1:1,1:0) "RTN","DG10",107,0) ; "RTN","DG10",108,0) CP ; If not (autoexempt or MTested) & no CP test this year then "RTN","DG10",109,0) ; prompt for add/edit cp test "RTN","DG10",110,0) N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT "RTN","DG10",111,0) G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG "RTN","DG10",112,0) S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT) "RTN","DG10",113,0) D EN^DGMTCOR "RTN","DG10",114,0) I +$G(DGNOCOPF) S DGMTCOR=0 "RTN","DG10",115,0) I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT) "RTN","DG10",116,0) K DGNOCOPF "RTN","DG10",117,0) QTCP Q "RTN","DG53P425") 0^62^B29268783 "RTN","DG53P425",1,0) DG53P425 ;ALB/RPM - PATCH DG*5.3*425 INSTALL UTILITIES ; 8/21/03 4:52pm "RTN","DG53P425",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DG53P425",3,0) ; "RTN","DG53P425",4,0) ENV ;Main entry point for Environment check point. "RTN","DG53P425",5,0) ; "RTN","DG53P425",6,0) S XPDABORT="" "RTN","DG53P425",7,0) D PROGCHK(.XPDABORT) ;checks programmer variables "RTN","DG53P425",8,0) I XPDABORT="" K XPDABORT "RTN","DG53P425",9,0) Q "RTN","DG53P425",10,0) ; "RTN","DG53P425",11,0) ; "RTN","DG53P425",12,0) PRE ;Main entry point for Pre-init items. "RTN","DG53P425",13,0) ; "RTN","DG53P425",14,0) Q "RTN","DG53P425",15,0) ; "RTN","DG53P425",16,0) ; "RTN","DG53P425",17,0) POST ;Main entry point for Post-init items. "RTN","DG53P425",18,0) ; "RTN","DG53P425",19,0) N DGACTDT ;software activation date "RTN","DG53P425",20,0) ; "RTN","DG53P425",21,0) S DGACTDT="Sep 25, 2003" ;National PRF Software Activation date "RTN","DG53P425",22,0) ; "RTN","DG53P425",23,0) D POST1(DGACTDT) ;create/update PRF PARAMETERS (#26.18) file "RTN","DG53P425",24,0) D POST2 ;load BEHAVIORAL Category I PRF "RTN","DG53P425",25,0) Q "RTN","DG53P425",26,0) ; "RTN","DG53P425",27,0) ; "RTN","DG53P425",28,0) PROGCHK(XPDABORT) ;checks for necessary programmer variables "RTN","DG53P425",29,0) ; "RTN","DG53P425",30,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO "RTN","DG53P425",31,0) .D BMES^XPDUTL("*****") "RTN","DG53P425",32,0) .D MES^XPDUTL("Your programming variables are not set up properly.") "RTN","DG53P425",33,0) .D MES^XPDUTL("Installation aborted.") "RTN","DG53P425",34,0) .D MES^XPDUTL("*****") "RTN","DG53P425",35,0) .S XPDABORT=2 "RTN","DG53P425",36,0) Q "RTN","DG53P425",37,0) ; "RTN","DG53P425",38,0) POST1(DGACTDT) ;create PRF PARAMETERS (#26.18) file entry at IEN "1" "RTN","DG53P425",39,0) ; "RTN","DG53P425",40,0) ; Input: "RTN","DG53P425",41,0) ; DGACTDT - (optional) software activation date in external format "RTN","DG53P425",42,0) ; [default="May 01, 2003" ;used at test sites] "RTN","DG53P425",43,0) ; "RTN","DG53P425",44,0) ; Output: "RTN","DG53P425",45,0) ; none "RTN","DG53P425",46,0) ; "RTN","DG53P425",47,0) N DGACT ;type of file activity (add/update) "RTN","DG53P425",48,0) N DGFDA ;FDA array "RTN","DG53P425",49,0) N DGFLD ;field # "RTN","DG53P425",50,0) N DGERR ;error array "RTN","DG53P425",51,0) N DGIEN ;IEN array "RTN","DG53P425",52,0) N DGIENS "RTN","DG53P425",53,0) N DGPARM ;parameter record "RTN","DG53P425",54,0) ; "RTN","DG53P425",55,0) I $G(DGACTDT)="" S DGACTDT="May 01, 2003" ;date for test sites "RTN","DG53P425",56,0) ; "RTN","DG53P425",57,0) ;existing file entry "RTN","DG53P425",58,0) I $D(^DGPF(26.18,1,0))#2 D "RTN","DG53P425",59,0) . N DGERR "RTN","DG53P425",60,0) . S DGIENS="1," "RTN","DG53P425",61,0) . S DGACT="update" "RTN","DG53P425",62,0) E D "RTN","DG53P425",63,0) . S DGIENS="+1," "RTN","DG53P425",64,0) . S DGACT="add" "RTN","DG53P425",65,0) ; "RTN","DG53P425",66,0) ;retrieve existing record "RTN","DG53P425",67,0) S DGPARM=$G(^DGPF(26.18,1,0)) "RTN","DG53P425",68,0) ; "RTN","DG53P425",69,0) ;provide values for any missing parameters "RTN","DG53P425",70,0) I $P(DGPARM,U,1)="" S DGFDA(26.18,DGIENS,.01)=1 "RTN","DG53P425",71,0) I $P(DGPARM,U,2)="" S DGFDA(26.18,DGIENS,1)=DGACTDT ;activation date "RTN","DG53P425",72,0) I $P(DGPARM,U,3)="" S DGFDA(26.18,DGIENS,2)="ACTIVE" ;ORU HL7 interface "RTN","DG53P425",73,0) I $P(DGPARM,U,4)="" S DGFDA(26.18,DGIENS,3)="DIRECT" ;QRY HL7 interface "RTN","DG53P425",74,0) I $P(DGPARM,U,6)="" S DGFDA(26.18,DGIENS,5)=7 ;HL7 Auto Retrans Days "RTN","DG53P425",75,0) ; "RTN","DG53P425",76,0) ;short-circuit when there are no missing parameters "RTN","DG53P425",77,0) I '$D(DGFDA) D Q "RTN","DG53P425",78,0) . D BMES^XPDUTL("*****") "RTN","DG53P425",79,0) . D MES^XPDUTL(" PRF PARAMETERS (#26.18) file values previously defined...no action taken.") "RTN","DG53P425",80,0) . D MES^XPDUTL("*****") "RTN","DG53P425",81,0) Q:'$D(DGFDA) "RTN","DG53P425",82,0) D UPDATE^DIE("ES","DGFDA","DGIEN","DGERR") "RTN","DG53P425",83,0) ; "RTN","DG53P425",84,0) ;check for errors and inform the installer of update status "RTN","DG53P425",85,0) I '$D(DGERR) D "RTN","DG53P425",86,0) . D BMES^XPDUTL("*****") "RTN","DG53P425",87,0) . D MES^XPDUTL("The '1' entry in the PRF PARAMETERS (#26.18) file was "_DGACT_$S(DGACT="add":"ed",1:"d")_" successfully.") "RTN","DG53P425",88,0) . ; "RTN","DG53P425",89,0) . ;display updated field list and values "RTN","DG53P425",90,0) . I DGACT="update" D "RTN","DG53P425",91,0) . . S DGFLD=0 "RTN","DG53P425",92,0) . . F S DGFLD=$O(DGFDA(26.18,DGIENS,DGFLD)) Q:'DGFLD D "RTN","DG53P425",93,0) . . . D MES^XPDUTL("The "_$$GET1^DID(26.18,DGFLD,"","LABEL")_" (#"_DGFLD_") field was set to '"_DGFDA(26.18,DGIENS,DGFLD)_"'.") "RTN","DG53P425",94,0) . D MES^XPDUTL("*****") "RTN","DG53P425",95,0) E D "RTN","DG53P425",96,0) . D BMES^XPDUTL("*****") "RTN","DG53P425",97,0) . D MES^XPDUTL("The attempt to "_DGACT_" the '1' entry in the PRF PARAMETERS (#26.18) file failed.") "RTN","DG53P425",98,0) . D MES^XPDUTL($G(DGERR("DIERR",1,"TEXT",1))) "RTN","DG53P425",99,0) . D MES^XPDUTL("*****") "RTN","DG53P425",100,0) ; "RTN","DG53P425",101,0) Q "RTN","DG53P425",102,0) ; "RTN","DG53P425",103,0) POST2 ;create BEHAVIORAL Category I PRF "RTN","DG53P425",104,0) ; "RTN","DG53P425",105,0) ;short circuit if flag already exists "RTN","DG53P425",106,0) I $D(^DGPF(26.15,"B","BEHAVIORAL")) D Q "RTN","DG53P425",107,0) . D BMES^XPDUTL("*****") "RTN","DG53P425",108,0) . D MES^XPDUTL(" 'BEHAVIORAL' Category I flag previously defined...no action taken.") "RTN","DG53P425",109,0) . D MES^XPDUTL("*****") "RTN","DG53P425",110,0) ; "RTN","DG53P425",111,0) N DGDESC ;description word-processing array "RTN","DG53P425",112,0) N DGFDA ;FDA array "RTN","DG53P425",113,0) N DGIEN ;IEN array "RTN","DG53P425",114,0) ; "RTN","DG53P425",115,0) ;flag description "RTN","DG53P425",116,0) S DGDESC(1,0)="The purpose of this National Patient Record Flag is to alert VHA medical" "RTN","DG53P425",117,0) S DGDESC(2,0)="staff and employees of patients whose behavior or characteristics may pose" "RTN","DG53P425",118,0) S DGDESC(3,0)="a threat either to their safety, the safety of other patients, or" "RTN","DG53P425",119,0) S DGDESC(4,0)="compromise the delivery of quality health care." "RTN","DG53P425",120,0) S DGDESC(5,0)="Application of National Patient Record Flags is coordinated through the" "RTN","DG53P425",121,0) S DGDESC(6,0)="Chief of Staff." "RTN","DG53P425",122,0) S DGDESC(7,0)="This is a nationally distributed flag." "RTN","DG53P425",123,0) ; "RTN","DG53P425",124,0) ;build FDA array "RTN","DG53P425",125,0) S DGFDA(26.15,"+1,",.01)="BEHAVIORAL" "RTN","DG53P425",126,0) S DGFDA(26.15,"+1,",.02)="ACTIVE" "RTN","DG53P425",127,0) S DGFDA(26.15,"+1,",.03)="BEHAVIORAL" "RTN","DG53P425",128,0) S DGFDA(26.15,"+1,",.04)=730 "RTN","DG53P425",129,0) S DGFDA(26.15,"+1,",.05)=60 "RTN","DG53P425",130,0) S DGFDA(26.15,"+1,",.06)="DGPF BEHAVIORAL FLAG REVIEW" "RTN","DG53P425",131,0) S DGFDA(26.15,"+1,",1)="DGDESC" "RTN","DG53P425",132,0) ; "RTN","DG53P425",133,0) ;ask for IEN = 1 "RTN","DG53P425",134,0) S DGIEN(1)=1 "RTN","DG53P425",135,0) ; "RTN","DG53P425",136,0) ;store record "RTN","DG53P425",137,0) D UPDATE^DIE("E","DGFDA","DGIEN","DGERR") "RTN","DG53P425",138,0) ; "RTN","DG53P425",139,0) ;check for errors and inform the installer of update status "RTN","DG53P425",140,0) D BMES^XPDUTL("*****") "RTN","DG53P425",141,0) I $D(^DGPF(26.15,"B","BEHAVIORAL")),'$D(DGERR) D "RTN","DG53P425",142,0) . D MES^XPDUTL(" 'BEHAVIORAL' Category I Patient Record Flag created successfully.") "RTN","DG53P425",143,0) E D "RTN","DG53P425",144,0) . D MES^XPDUTL(" 'BEHAVIORAL' Category I Patient Record Flag creation failed!") "RTN","DG53P425",145,0) D MES^XPDUTL("*****") "RTN","DG53P425",146,0) Q "RTN","DGPFAA") 0^52^B35630618 "RTN","DGPFAA",1,0) DGPFAA ;ALB/RPM - PRF ASSIGNMENT API'S ; 3/27/03 "RTN","DGPFAA",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAA",3,0) ; "RTN","DGPFAA",4,0) Q ;no direct entry "RTN","DGPFAA",5,0) ; "RTN","DGPFAA",6,0) GETALL(DGDFN,DGIENS,DGSTAT,DGCAT) ;retrieve list of assignment IENs "RTN","DGPFAA",7,0) ;This function returns an array of patient record flag assignment IENs "RTN","DGPFAA",8,0) ;for a given patient. The returned IEN array may optionally be "RTN","DGPFAA",9,0) ;filtered by Active or Inactive status and by flag category. "RTN","DGPFAA",10,0) ; "RTN","DGPFAA",11,0) ; Input: "RTN","DGPFAA",12,0) ; DGDFN - (required) Pointer to patient in PATIENT (#2) file "RTN","DGPFAA",13,0) ; DGIENS - (required) Result array passed by reference "RTN","DGPFAA",14,0) ; DGSTAT - (optional) Status filter (0:Inactive,1:Active,"":Both). "RTN","DGPFAA",15,0) ; Defaults to Both. "RTN","DGPFAA",16,0) ; DGCAT - (optional) Category filter "RTN","DGPFAA",17,0) ; (1:Category I,2:Category II,"":Both). Defaults to Both. "RTN","DGPFAA",18,0) ; "RTN","DGPFAA",19,0) ; Output: "RTN","DGPFAA",20,0) ; Function Value - Count of returned IENs "RTN","DGPFAA",21,0) ; DGIENS - Output array subscripted by the assignment IENs "RTN","DGPFAA",22,0) ; "RTN","DGPFAA",23,0) N DGCNT ;number of returned values "RTN","DGPFAA",24,0) N DGIEN ;single IEN "RTN","DGPFAA",25,0) N DGCKS ;check status flag (1:check, 0:ignore) "RTN","DGPFAA",26,0) N DGFLAG ;pointer to #26.11 or #26.15 "RTN","DGPFAA",27,0) ; "RTN","DGPFAA",28,0) S DGCNT=0 "RTN","DGPFAA",29,0) I $G(DGDFN)>0,$D(^DGPF(26.13,"B",DGDFN)) D "RTN","DGPFAA",30,0) . S DGFLAG="" "RTN","DGPFAA",31,0) . S DGCKS=0 "RTN","DGPFAA",32,0) . S DGSTAT=$G(DGSTAT) "RTN","DGPFAA",33,0) . I DGSTAT=0!(DGSTAT=1) S DGCKS=1 "RTN","DGPFAA",34,0) . S DGCAT=+$G(DGCAT) "RTN","DGPFAA",35,0) . S DGCAT=$S(DGCAT=1:"26.15",DGCAT=2:"26.11",1:0) "RTN","DGPFAA",36,0) . F S DGFLAG=$O(^DGPF(26.13,"C",DGDFN,DGFLAG)) Q:(DGFLAG="") D "RTN","DGPFAA",37,0) . . I DGCAT,DGFLAG'[DGCAT Q "RTN","DGPFAA",38,0) . . S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGFLAG,0)) "RTN","DGPFAA",39,0) . . I DGCKS,'$D(^DGPF(26.13,"D",DGDFN,DGSTAT,DGIEN)) Q "RTN","DGPFAA",40,0) . . S DGCNT=DGCNT+1 "RTN","DGPFAA",41,0) . . S DGIENS(DGIEN)="" "RTN","DGPFAA",42,0) Q DGCNT "RTN","DGPFAA",43,0) ; "RTN","DGPFAA",44,0) GETASGN(DGPFIEN,DGPFA) ;retrieve a single assignment record "RTN","DGPFAA",45,0) ;This function returns a single patient record flag assignment in an "RTN","DGPFAA",46,0) ;array format. "RTN","DGPFAA",47,0) ; "RTN","DGPFAA",48,0) ; Input: "RTN","DGPFAA",49,0) ; DGPFIEN - (required) Pointer to patient record flag assignment in "RTN","DGPFAA",50,0) ; PRF ASSIGNMENT (#26.13) file "RTN","DGPFAA",51,0) ; DGPFA - (required) Result array passed by reference "RTN","DGPFAA",52,0) ; "RTN","DGPFAA",53,0) ; Output: "RTN","DGPFAA",54,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFAA",55,0) ; DGPFA - Output array containing assignment record field "RTN","DGPFAA",56,0) ; values. "RTN","DGPFAA",57,0) ; Subscript Field# Data "RTN","DGPFAA",58,0) ; -------------- ------- --------------------- "RTN","DGPFAA",59,0) ; "DFN" .01 internal^external "RTN","DGPFAA",60,0) ; "FLAG" .02 internal^external "RTN","DGPFAA",61,0) ; "STATUS" .03 internal^external "RTN","DGPFAA",62,0) ; "OWNER" .04 internal^external "RTN","DGPFAA",63,0) ; "ORIGSITE" .05 internal^external "RTN","DGPFAA",64,0) ; "REVIEWDT" .06 internal^external "RTN","DGPFAA",65,0) ; "NARR",line#,0 1 character string "RTN","DGPFAA",66,0) ; "RTN","DGPFAA",67,0) N DGIENS ;IEN string for DIQ "RTN","DGPFAA",68,0) N DGFLDS ;results array for DIQ "RTN","DGPFAA",69,0) N DGERR ;error arrary for DIQ "RTN","DGPFAA",70,0) N DGRSLT "RTN","DGPFAA",71,0) ; "RTN","DGPFAA",72,0) S DGRSLT=0 "RTN","DGPFAA",73,0) I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFAA",74,0) . S DGIENS=DGPFIEN_"," "RTN","DGPFAA",75,0) . D GETS^DIQ(26.13,DGIENS,"*","IEZ","DGFLDS","DGERR") "RTN","DGPFAA",76,0) . Q:$D(DGERR) "RTN","DGPFAA",77,0) . S DGRSLT=1 "RTN","DGPFAA",78,0) . S DGPFA("DFN")=$G(DGFLDS(26.13,DGIENS,.01,"I"))_U_$G(DGFLDS(26.13,DGIENS,.01,"E")) "RTN","DGPFAA",79,0) . S DGPFA("FLAG")=$G(DGFLDS(26.13,DGIENS,.02,"I"))_U_$G(DGFLDS(26.13,DGIENS,.02,"E")) "RTN","DGPFAA",80,0) . S DGPFA("STATUS")=$G(DGFLDS(26.13,DGIENS,.03,"I"))_U_$G(DGFLDS(26.13,DGIENS,.03,"E")) "RTN","DGPFAA",81,0) . S DGPFA("OWNER")=$G(DGFLDS(26.13,DGIENS,.04,"I"))_U_$G(DGFLDS(26.13,DGIENS,.04,"E")) "RTN","DGPFAA",82,0) . S DGPFA("ORIGSITE")=$G(DGFLDS(26.13,DGIENS,.05,"I"))_U_$G(DGFLDS(26.13,DGIENS,.05,"E")) "RTN","DGPFAA",83,0) . S DGPFA("REVIEWDT")=$G(DGFLDS(26.13,DGIENS,.06,"I"))_U_$G(DGFLDS(26.13,DGIENS,.06,"E")) "RTN","DGPFAA",84,0) . ;build assignment narrative word processing array "RTN","DGPFAA",85,0) . M DGPFA("NARR")=DGFLDS(26.13,DGIENS,1) "RTN","DGPFAA",86,0) . K DGPFA("NARR","E"),DGPFA("NARR","I") "RTN","DGPFAA",87,0) Q DGRSLT "RTN","DGPFAA",88,0) ; "RTN","DGPFAA",89,0) FNDASGN(DGPFDFN,DGPFFLG) ;Find Assignment "RTN","DGPFAA",90,0) ; This function finds a patient record flag assignment record. "RTN","DGPFAA",91,0) ; "RTN","DGPFAA",92,0) ; Input: "RTN","DGPFAA",93,0) ; DGDFN - Pointer to patient in the PATIENT (#2) file "RTN","DGPFAA",94,0) ; DGFLAG - Pointer to flag in either the PRF LOCAL FLAG (#26.11) "RTN","DGPFAA",95,0) ; file or the PRF NATIONAL FLAG (#26.15) file "RTN","DGPFAA",96,0) ; "RTN","DGPFAA",97,0) ; Output: "RTN","DGPFAA",98,0) ; Function Value - Returns IEN of existing record on success, 0 on "RTN","DGPFAA",99,0) ; failure "RTN","DGPFAA",100,0) ; "RTN","DGPFAA",101,0) N DGIEN "RTN","DGPFAA",102,0) ; "RTN","DGPFAA",103,0) I $G(DGPFDFN)>0,($G(DGPFFLG)>0) D "RTN","DGPFAA",104,0) . S DGIEN=$O(^DGPF(26.13,"C",DGPFDFN,DGPFFLG,0)) "RTN","DGPFAA",105,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFAA",106,0) ; "RTN","DGPFAA",107,0) STOASGN(DGPFA,DGPFERR) ;store a single PRF ASSIGNMENT (#26.13) file record "RTN","DGPFAA",108,0) ; "RTN","DGPFAA",109,0) ; Input: "RTN","DGPFAA",110,0) ; DGPFA - (required) array of values to be filed (see GETASGN tag "RTN","DGPFAA",111,0) ; above for valid array structure) "RTN","DGPFAA",112,0) ; DGPFERR - (optional) passed by reference to contain error messages "RTN","DGPFAA",113,0) ; "RTN","DGPFAA",114,0) ; Output: "RTN","DGPFAA",115,0) ; Function Value - Returns IEN of record on success, 0 on failure "RTN","DGPFAA",116,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFAA",117,0) ; "RTN","DGPFAA",118,0) N DGSUB "RTN","DGPFAA",119,0) N DGFLD "RTN","DGPFAA",120,0) N DGIEN "RTN","DGPFAA",121,0) N DGIENS "RTN","DGPFAA",122,0) N DGFDA "RTN","DGPFAA",123,0) N DGFDAIEN "RTN","DGPFAA",124,0) N DGERR "RTN","DGPFAA",125,0) F DGSUB="DFN","FLAG","STATUS","OWNER","ORIGSITE" D "RTN","DGPFAA",126,0) . S DGFLD(DGSUB)=$P($G(DGPFA(DGSUB)),U,1) "RTN","DGPFAA",127,0) ; "RTN","DGPFAA",128,0) ;only build DGFLD("REVIEWDT") if "REVIEWDT" is passed "RTN","DGPFAA",129,0) I $D(DGPFA("REVIEWDT"))=1 S DGFLD("REVIEWDT")=$P(DGPFA("REVIEWDT"),U,1) "RTN","DGPFAA",130,0) ; "RTN","DGPFAA",131,0) I $D(DGPFA("NARR")) M DGFLD("NARR")=DGPFA("NARR") "RTN","DGPFAA",132,0) I $$VALID^DGPFUT("DGPFAA1",26.13,.DGFLD,.DGPFERR) D "RTN","DGPFAA",133,0) . S DGIEN=$$FNDASGN^DGPFAA(DGFLD("DFN"),DGFLD("FLAG")) "RTN","DGPFAA",134,0) . I DGIEN S DGIENS=DGIEN_"," "RTN","DGPFAA",135,0) . E S DGIENS="+1," "RTN","DGPFAA",136,0) . S DGFDA(26.13,DGIENS,.01)=DGFLD("DFN") "RTN","DGPFAA",137,0) . S DGFDA(26.13,DGIENS,.02)=DGFLD("FLAG") "RTN","DGPFAA",138,0) . S DGFDA(26.13,DGIENS,.03)=DGFLD("STATUS") "RTN","DGPFAA",139,0) . S DGFDA(26.13,DGIENS,.04)=DGFLD("OWNER") "RTN","DGPFAA",140,0) . S DGFDA(26.13,DGIENS,.05)=DGFLD("ORIGSITE") "RTN","DGPFAA",141,0) . ; "RTN","DGPFAA",142,0) . ;only touch REVIEW DATE (#.06) field if "REVIEWDT" is passed "RTN","DGPFAA",143,0) . I $D(DGFLD("REVIEWDT")) S DGFDA(26.13,DGIENS,.06)=DGFLD("REVIEWDT") "RTN","DGPFAA",144,0) . ; "RTN","DGPFAA",145,0) . S DGFDA(26.13,DGIENS,1)="DGFLD(""NARR"")" "RTN","DGPFAA",146,0) . I DGIEN D "RTN","DGPFAA",147,0) . . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFAA",148,0) . . I $D(DGERR) S DGIEN=0 "RTN","DGPFAA",149,0) . E D "RTN","DGPFAA",150,0) . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFAA",151,0) . . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1)) "RTN","DGPFAA",152,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFAA",153,0) ; "RTN","DGPFAA",154,0) STOALL(DGPFA,DGPFAH,DGPFERR) ;store both the assignment and history record "RTN","DGPFAA",155,0) ;This function acts as a wrapper around the $$STOASGN and $$STOHIST "RTN","DGPFAA",156,0) ;filer calls. "RTN","DGPFAA",157,0) ; "RTN","DGPFAA",158,0) ; Input: "RTN","DGPFAA",159,0) ; DGPFA - (required) array of assignment values to be filed (see "RTN","DGPFAA",160,0) ; $$GETASGN^DGPFAA for valid array structure) "RTN","DGPFAA",161,0) ; DGPFAH - (required) array of assignment history values to be filed "RTN","DGPFAA",162,0) ; (see $$STOHIST^DGPFAAH for valid array structure) "RTN","DGPFAA",163,0) ; DGPFERR - (optional) passed by reference to contain error messages "RTN","DGPFAA",164,0) ; "RTN","DGPFAA",165,0) ; Output: "RTN","DGPFAA",166,0) ; Function Value - Returns circumflex("^") delimited results of "RTN","DGPFAA",167,0) ; $$STOASGN^DGPFAA and $$STOHIST^DGPFAAH calls "RTN","DGPFAA",168,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFAA",169,0) ; "RTN","DGPFAA",170,0) N DGOIEN ;existing assignment file IEN used for "roll-back" "RTN","DGPFAA",171,0) N DGPFOA ;existing assignment data array used for "roll-back" "RTN","DGPFAA",172,0) N DGAIEN ;assignment file IEN "RTN","DGPFAA",173,0) N DGAHIEN ;assignment history file IEN "RTN","DGPFAA",174,0) N DGDFN ;"DFN" value "RTN","DGPFAA",175,0) N DGFLG ;"FLAG" value "RTN","DGPFAA",176,0) ; "RTN","DGPFAA",177,0) S (DGAIEN,DGAHIEN)=0 "RTN","DGPFAA",178,0) S DGDFN=$P($G(DGPFA("DFN")),U,1) "RTN","DGPFAA",179,0) S DGFLG=$P($G(DGPFA("FLAG")),U,1) "RTN","DGPFAA",180,0) S DGOIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG) "RTN","DGPFAA",181,0) D ;drops out of block if can't rollback or assignment filer fails "RTN","DGPFAA",182,0) . I DGOIEN,'$$GETASGN^DGPFAA(DGOIEN,.DGPFOA) Q ;can't rollback, so quit "RTN","DGPFAA",183,0) . ; "RTN","DGPFAA",184,0) . ;store the assignment "RTN","DGPFAA",185,0) . S DGAIEN=$$STOASGN^DGPFAA(.DGPFA,.DGPFERR) "RTN","DGPFAA",186,0) . I $D(DGPFERR) S DGAIEN=0 "RTN","DGPFAA",187,0) . Q:'DGAIEN ;assignment filer failed, so quit "RTN","DGPFAA",188,0) . ; "RTN","DGPFAA",189,0) . ;store the assignment history "RTN","DGPFAA",190,0) . S DGPFAH("ASSIGN")=DGAIEN "RTN","DGPFAA",191,0) . S DGAHIEN=$$STOHIST^DGPFAAH(.DGPFAH,.DGPFERR) "RTN","DGPFAA",192,0) . I $D(DGPFERR) S DGAHIEN=0 "RTN","DGPFAA",193,0) . I DGAHIEN=0 D ;history filer failed, so rollback the assignment "RTN","DGPFAA",194,0) . . I 'DGOIEN,'$D(DGPFOA) S DGPFOA("DFN")="@" "RTN","DGPFAA",195,0) . . I $$ROLLBACK^DGPFAA2(DGAIEN,.DGPFOA) S DGAIEN=0 "RTN","DGPFAA",196,0) Q $S(+$G(DGAHIEN)=0:0,1:DGAIEN_"^"_DGAHIEN) "RTN","DGPFAA1") 0^53^B954394 "RTN","DGPFAA1",1,0) DGPFAA1 ;ALB/RPM - PRF ASSIGNMENT VALIDATION DATA ; 02/06/03 "RTN","DGPFAA1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAA1",3,0) ; "RTN","DGPFAA1",4,0) XREF ;;array node name;field#;required param;word processing?;description "RTN","DGPFAA1",5,0) ;;DFN;.01;1;0;patient IEN "RTN","DGPFAA1",6,0) ;;FLAG;.02;1;0;pointer to 26.11 or 26.15 "RTN","DGPFAA1",7,0) ;;STATUS;.03;1;0;active/inactive "RTN","DGPFAA1",8,0) ;;OWNER;.04;1;0;site that controls the assignment "RTN","DGPFAA1",9,0) ;;ORIGSITE;.05;1;0;site that created the assignment "RTN","DGPFAA1",10,0) ;;REVIEWDT;.06;0;0;review date "RTN","DGPFAA1",11,0) ;;NARR;1;1;1;assignment narrative "RTN","DGPFAA2") 0^54^B42180474 "RTN","DGPFAA2",1,0) DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 4/24/03 3:55pm "RTN","DGPFAA2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAA2",3,0) ; "RTN","DGPFAA2",4,0) ;- no direct entry "RTN","DGPFAA2",5,0) QUIT "RTN","DGPFAA2",6,0) ; "RTN","DGPFAA2",7,0) ADDOK(DGDFN,DGFLG,DGREASON) ;This function will be used to determine if a flag may be added/assigned to a patient. "RTN","DGPFAA2",8,0) ; "RTN","DGPFAA2",9,0) ; Input: "RTN","DGPFAA2",10,0) ; DGDFN - (required) IEN of patient in PATIENT (#2) file "RTN","DGPFAA2",11,0) ; DGFLG - (required) IEN of patient record flag in PRF NATIONAL "RTN","DGPFAA2",12,0) ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file. "RTN","DGPFAA2",13,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFAA2",14,0) ; "RTN","DGPFAA2",15,0) ; Output: "RTN","DGPFAA2",16,0) ; Function Value - returns 1 on success (YES), 0 on failure (NO) "RTN","DGPFAA2",17,0) ; DGREASON - undefined on success, reason why flag can not "RTN","DGPFAA2",18,0) ; be assigned to patient on failure "RTN","DGPFAA2",19,0) ; "RTN","DGPFAA2",20,0) N RESULT ;function result "RTN","DGPFAA2",21,0) N DGFARRY ;contains flag array "RTN","DGPFAA2",22,0) K DGFARRY "RTN","DGPFAA2",23,0) ; "RTN","DGPFAA2",24,0) S RESULT=0 "RTN","DGPFAA2",25,0) ; "RTN","DGPFAA2",26,0) D ;-drops out of block on failure "RTN","DGPFAA2",27,0) . ; "RTN","DGPFAA2",28,0) . ;-- quit if DFN invalid "RTN","DGPFAA2",29,0) . I '(+$G(DGDFN)>0),'$D(^DPT(DGDFN)) S DGREASON="Patient is not valid" Q "RTN","DGPFAA2",30,0) . ; "RTN","DGPFAA2",31,0) . ;-- quit if flag ien invalid "RTN","DGPFAA2",32,0) . I '$$TESTVAL^DGPFUT(26.13,.02,DGFLG) S DGREASON="Record flag is not valid" Q "RTN","DGPFAA2",33,0) . ; "RTN","DGPFAA2",34,0) . ;-- quit if flag already assigned to patient "RTN","DGPFAA2",35,0) . I $$FNDASGN^DGPFAA(DGDFN,DGFLG) S DGREASON="Record flag is already assigned to patient" Q "RTN","DGPFAA2",36,0) . ; "RTN","DGPFAA2",37,0) . ;-- quit if flag STATUS is INACTIVE "RTN","DGPFAA2",38,0) . I $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY) "RTN","DGPFAA2",39,0) . I '+$G(DGFARRY("STAT")) S DGREASON="Status of record flag assignment is 'Inactive'" Q "RTN","DGPFAA2",40,0) . ; "RTN","DGPFAA2",41,0) . ;-- success "RTN","DGPFAA2",42,0) . S RESULT=1 "RTN","DGPFAA2",43,0) ; "RTN","DGPFAA2",44,0) Q RESULT "RTN","DGPFAA2",45,0) ; "RTN","DGPFAA2",46,0) ; "RTN","DGPFAA2",47,0) EDTOK(DGPFA,DGORIG,DGREASON) ;This function will be used to determine if an flag assignment may be edited. "RTN","DGPFAA2",48,0) ; "RTN","DGPFAA2",49,0) ; Input: "RTN","DGPFAA2",50,0) ; DGPFA - (required) array containing the flag assignment values "RTN","DGPFAA2",51,0) ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()] "RTN","DGPFAA2",52,0) ; "RTN","DGPFAA2",53,0) ; Output: "RTN","DGPFAA2",54,0) ; Function Value - returns 1 on success (YES), 0 on failure (NO) "RTN","DGPFAA2",55,0) ; DGREASON - undefined on success, reason why assignment "RTN","DGPFAA2",56,0) ; can not be edited on failure "RTN","DGPFAA2",57,0) ; "RTN","DGPFAA2",58,0) N RESULT ;function result "RTN","DGPFAA2",59,0) N DGFARRY ;contains flag array "RTN","DGPFAA2",60,0) K DGFARRY "RTN","DGPFAA2",61,0) ; "RTN","DGPFAA2",62,0) S RESULT=0 "RTN","DGPFAA2",63,0) ; "RTN","DGPFAA2",64,0) D ;-drops out of block on failure "RTN","DGPFAA2",65,0) . ; "RTN","DGPFAA2",66,0) . ;-- quit if current site is not the owner site "RTN","DGPFAA2",67,0) . I +$G(DGORIG)'>0 S DGORIG=+$$SITE^VASITE() "RTN","DGPFAA2",68,0) . I +$G(DGPFA("OWNER"))'=DGORIG S DGREASON="Not the owner site" Q "RTN","DGPFAA2",69,0) . ; "RTN","DGPFAA2",70,0) . ;-- quit if flag STATUS is INACTIVE "RTN","DGPFAA2",71,0) . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY) "RTN","DGPFAA2",72,0) . I '+$G(DGFARRY("STAT")) S DGREASON="Record flag status is 'Inactive'" Q "RTN","DGPFAA2",73,0) . ; "RTN","DGPFAA2",74,0) . ;-- success "RTN","DGPFAA2",75,0) . S RESULT=1 "RTN","DGPFAA2",76,0) ; "RTN","DGPFAA2",77,0) Q RESULT "RTN","DGPFAA2",78,0) ; "RTN","DGPFAA2",79,0) ACTIONOK(DGPFA,DGACT) ;verify ACTION is appropriate for current STATUS "RTN","DGPFAA2",80,0) ; "RTN","DGPFAA2",81,0) ; Input: "RTN","DGPFAA2",82,0) ; DGPFA - (required) assignment array data from current record "RTN","DGPFAA2",83,0) ; DGACT - Assignment edit action in internal format "RTN","DGPFAA2",84,0) ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE] "RTN","DGPFAA2",85,0) ; "RTN","DGPFAA2",86,0) ; Output: "RTN","DGPFAA2",87,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFAA2",88,0) ; "RTN","DGPFAA2",89,0) N DGRSLT "RTN","DGPFAA2",90,0) N DGSTAT "RTN","DGPFAA2",91,0) ; "RTN","DGPFAA2",92,0) S DGACT=+$G(DGACT) "RTN","DGPFAA2",93,0) S DGSTAT=$P($G(DGPFA("STATUS")),U,1) "RTN","DGPFAA2",94,0) S DGRSLT=0 "RTN","DGPFAA2",95,0) ; "RTN","DGPFAA2",96,0) I $$TESTVAL^DGPFUT(26.14,.03,DGACT),DGSTAT?1N D "RTN","DGPFAA2",97,0) . ; "RTN","DGPFAA2",98,0) . ;Must not CONTINUE inactive assignments "RTN","DGPFAA2",99,0) . I DGACT=2,DGSTAT=0 Q "RTN","DGPFAA2",100,0) . ; "RTN","DGPFAA2",101,0) . ;Must not INACTIVATE inactive assignments "RTN","DGPFAA2",102,0) . I DGACT=3,DGSTAT=0 Q "RTN","DGPFAA2",103,0) . ; "RTN","DGPFAA2",104,0) . ;Must not REACTIVATE active assignments "RTN","DGPFAA2",105,0) . I DGACT=4,DGSTAT=1 Q "RTN","DGPFAA2",106,0) . ; "RTN","DGPFAA2",107,0) . ;success "RTN","DGPFAA2",108,0) . S DGRSLT=1 "RTN","DGPFAA2",109,0) ; "RTN","DGPFAA2",110,0) Q DGRSLT "RTN","DGPFAA2",111,0) ; "RTN","DGPFAA2",112,0) CHGOWN(DGPFA,DGORIG,DGREASON) ;Is site allowed to change ownership of a record flag assignment? "RTN","DGPFAA2",113,0) ; "RTN","DGPFAA2",114,0) ; Input: "RTN","DGPFAA2",115,0) ; DGPFA - (required) array containing the flag assignment values "RTN","DGPFAA2",116,0) ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()] "RTN","DGPFAA2",117,0) ; "RTN","DGPFAA2",118,0) ; Output: "RTN","DGPFAA2",119,0) ; Function Value - returns 1 on success (YES), 0 on failure (NO) "RTN","DGPFAA2",120,0) ; DGREASON - undefined on success, reason why assignment "RTN","DGPFAA2",121,0) ; ownership can not be edited on failure "RTN","DGPFAA2",122,0) ; "RTN","DGPFAA2",123,0) N DGRSLT ;function result "RTN","DGPFAA2",124,0) ; "RTN","DGPFAA2",125,0) S:(+$G(DGORIG)'>0) DGORIG=(+$$SITE^VASITE()) "RTN","DGPFAA2",126,0) S DGRSLT=0 "RTN","DGPFAA2",127,0) ; "RTN","DGPFAA2",128,0) D ;drops out of block on failure "RTN","DGPFAA2",129,0) . ; "RTN","DGPFAA2",130,0) . ;ORIGINATING SITE must be OWNER and flag must be ACTIVE "RTN","DGPFAA2",131,0) . Q:('$$EDTOK(.DGPFA,DGORIG,.DGREASON)) "RTN","DGPFAA2",132,0) . ; "RTN","DGPFAA2",133,0) . ;can't CHANGE OWNERSHIP for an assignment to a LOCAL flag "RTN","DGPFAA2",134,0) . I $P(DGPFA("FLAG"),U)["26.11" D Q "RTN","DGPFAA2",135,0) . .S DGREASON="Can't change ownership of assignments to Category II (Local) flags" "RTN","DGPFAA2",136,0) . . Q "RTN","DGPFAA2",137,0) . ; "RTN","DGPFAA2",138,0) . ;can't CHANGE OWNERSHIP for an INACTIVE assignment "RTN","DGPFAA2",139,0) . I '+$G(DGPFA("STATUS")) D Q "RTN","DGPFAA2",140,0) . . S DGREASON="Record flag assignment status is 'Inactive'" "RTN","DGPFAA2",141,0) . . Q "RTN","DGPFAA2",142,0) . ; "RTN","DGPFAA2",143,0) . ;success "RTN","DGPFAA2",144,0) . S DGRSLT=1 "RTN","DGPFAA2",145,0) ; "RTN","DGPFAA2",146,0) Q DGRSLT "RTN","DGPFAA2",147,0) ; "RTN","DGPFAA2",148,0) HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT) ;Is site allowed to edit assignment? "RTN","DGPFAA2",149,0) ; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits "RTN","DGPFAA2",150,0) ; that originate from PRF HL7 message processing. "RTN","DGPFAA2",151,0) ; "RTN","DGPFAA2",152,0) ; Input: "RTN","DGPFAA2",153,0) ; DGDFN - IEN of patient in PATIENT (#2) file "RTN","DGPFAA2",154,0) ; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15) "RTN","DGPFAA2",155,0) ; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"] "RTN","DGPFAA2",156,0) ; DGORIG - IEN of originating site in INSTITUTION (#4) file "RTN","DGPFAA2",157,0) ; DGACT - Assignment edit action in internal format "RTN","DGPFAA2",158,0) ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE] "RTN","DGPFAA2",159,0) ; "RTN","DGPFAA2",160,0) ; Output: "RTN","DGPFAA2",161,0) ; Function value - 1 if authorized, 0 if not authorized "RTN","DGPFAA2",162,0) ; "RTN","DGPFAA2",163,0) N DGIEN ;pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAA2",164,0) N DGPFA ;assignment data array "RTN","DGPFAA2",165,0) N DGRSLT ;function value "RTN","DGPFAA2",166,0) ; "RTN","DGPFAA2",167,0) S DGACT=+$G(DGACT) "RTN","DGPFAA2",168,0) S DGDFN=+$G(DGDFN) "RTN","DGPFAA2",169,0) S DGFLG=$G(DGFLG) "RTN","DGPFAA2",170,0) S DGORIG=+$G(DGORIG) "RTN","DGPFAA2",171,0) S DGRSLT=0 "RTN","DGPFAA2",172,0) ; "RTN","DGPFAA2",173,0) I DGACT>0,DGDFN>0,DGFLG]"",DGORIG>0 D "RTN","DGPFAA2",174,0) . ; "RTN","DGPFAA2",175,0) . ;retrieve existing assignment data "RTN","DGPFAA2",176,0) . S DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG) "RTN","DGPFAA2",177,0) . Q:('DGIEN) "RTN","DGPFAA2",178,0) . Q:('$$GETASGN^DGPFAA(DGIEN,.DGPFA)) "RTN","DGPFAA2",179,0) . ; "RTN","DGPFAA2",180,0) . ;ORIGINATING SITE must be OWNER and flag must be ACTIVE "RTN","DGPFAA2",181,0) . Q:('$$EDTOK(.DGPFA,DGORIG)) "RTN","DGPFAA2",182,0) . ; "RTN","DGPFAA2",183,0) . ;ACTION must be valid for current assignment STATUS "RTN","DGPFAA2",184,0) . Q:('$$ACTIONOK(.DGPFA,DGACT)) "RTN","DGPFAA2",185,0) . ; "RTN","DGPFAA2",186,0) . ;success "RTN","DGPFAA2",187,0) . S DGRSLT=1 "RTN","DGPFAA2",188,0) ; "RTN","DGPFAA2",189,0) Q DGRSLT "RTN","DGPFAA2",190,0) ; "RTN","DGPFAA2",191,0) STOHL7(DGPFA,DGPFAH,DGERR) ;store a valid assignment from HL7 message "RTN","DGPFAA2",192,0) ; This function files an assignment if the originating site is "RTN","DGPFAA2",193,0) ; authorized to update an existing record and if the action is valid for "RTN","DGPFAA2",194,0) ; the status of an existing record. "RTN","DGPFAA2",195,0) ; "RTN","DGPFAA2",196,0) ; Input: "RTN","DGPFAA2",197,0) ; DGPFA - (required) array of assignment values to be filed (see "RTN","DGPFAA2",198,0) ; $$GETASGN^DGPFAA for valid array structure) "RTN","DGPFAA2",199,0) ; DGPFAH - (required) array of assignment history values to be filed "RTN","DGPFAA2",200,0) ; (see $$STOHIST^DGPFAAH for valid array structure) "RTN","DGPFAA2",201,0) ; "RTN","DGPFAA2",202,0) ; Output: "RTN","DGPFAA2",203,0) ; Function Value - Returns 1 on sucess, 0 on failure "RTN","DGPFAA2",204,0) ; DGERR - Undefined on success, error code on failure "RTN","DGPFAA2",205,0) ; "RTN","DGPFAA2",206,0) N DGDFN "RTN","DGPFAA2",207,0) N DGFLG "RTN","DGPFAA2",208,0) N DGORIG "RTN","DGPFAA2",209,0) N DGACT "RTN","DGPFAA2",210,0) N DGSTOERR "RTN","DGPFAA2",211,0) N DGRSLT "RTN","DGPFAA2",212,0) ; "RTN","DGPFAA2",213,0) S DGDFN=+$G(DGPFA("DFN")) "RTN","DGPFAA2",214,0) S DGFLG=$G(DGPFA("FLAG")) "RTN","DGPFAA2",215,0) S DGORIG=+$G(DGPFA("ORIGSITE")) "RTN","DGPFAA2",216,0) S DGACT=+$G(DGPFAH("ACTION")) "RTN","DGPFAA2",217,0) ; "RTN","DGPFAA2",218,0) S DGRSLT=0 "RTN","DGPFAA2",219,0) I DGDFN,DGFLG,DGORIG]"",DGACT D "RTN","DGPFAA2",220,0) . ; "RTN","DGPFAA2",221,0) . ;new assignment action "RTN","DGPFAA2",222,0) . I DGACT=1,'$$ADDOK(DGDFN,DGFLG) D Q "RTN","DGPFAA2",223,0) . . S DGERR="UU" ;unauthorized update "RTN","DGPFAA2",224,0) . ; "RTN","DGPFAA2",225,0) . ;all other actions "RTN","DGPFAA2",226,0) . I DGACT'=1,'$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT) D Q "RTN","DGPFAA2",227,0) . . S DGERR="UU" ;unauthorized update "RTN","DGPFAA2",228,0) . ; "RTN","DGPFAA2",229,0) . ;file the assignment and history "RTN","DGPFAA2",230,0) . I '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGSTOERR)!($D(DGSTOERR)) D Q "RTN","DGPFAA2",231,0) . . S DGERR="FE" ;filer error "RTN","DGPFAA2",232,0) . S DGRSLT=1 "RTN","DGPFAA2",233,0) Q DGRSLT "RTN","DGPFAA2",234,0) ; "RTN","DGPFAA2",235,0) ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record "RTN","DGPFAA2",236,0) ; "RTN","DGPFAA2",237,0) ; Input: "RTN","DGPFAA2",238,0) ; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT "RTN","DGPFAA2",239,0) ; (#26.13) file "RTN","DGPFAA2",240,0) ; DGPFOA - Assignment data array prior to record modification "RTN","DGPFAA2",241,0) ; "RTN","DGPFAA2",242,0) ; Output: "RTN","DGPFAA2",243,0) ; Function value - 1 on successful rollback, 0 on failure "RTN","DGPFAA2",244,0) ; "RTN","DGPFAA2",245,0) N DGIENS "RTN","DGPFAA2",246,0) N DGFDA "RTN","DGPFAA2",247,0) N DGERR "RTN","DGPFAA2",248,0) N DGRSLT ;function result "RTN","DGPFAA2",249,0) ; "RTN","DGPFAA2",250,0) S DGRSLT=0 "RTN","DGPFAA2",251,0) I +$G(DGAIEN),$D(^DGPF(26.13,DGAIEN)),$D(DGPFOA) D "RTN","DGPFAA2",252,0) . S DGIENS=DGAIEN_"," "RTN","DGPFAA2",253,0) . I $G(DGPFOA("DFN"))="@" D "RTN","DGPFAA2",254,0) . . S DGFDA(26.13,DGIENS,.01)=DGPFOA("DFN") "RTN","DGPFAA2",255,0) . . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFAA2",256,0) . . I '$D(DGERR) S DGRSLT=1 "RTN","DGPFAA2",257,0) . E D "RTN","DGPFAA2",258,0) . . I $$STOASGN^DGPFAA(.DGPFOA,.DGERR),'$D(DGERR) S DGRSLT=1 "RTN","DGPFAA2",259,0) Q DGRSLT "RTN","DGPFAA3") 0^55^B3807769 "RTN","DGPFAA3",1,0) DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03 "RTN","DGPFAA3",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAA3",3,0) ; "RTN","DGPFAA3",4,0) Q ;no direct entry "RTN","DGPFAA3",5,0) ; "RTN","DGPFAA3",6,0) NOTIFYDT(DGFLG,DGRDT) ;calculate the notificaton date "RTN","DGPFAA3",7,0) ; "RTN","DGPFAA3",8,0) ; Input: "RTN","DGPFAA3",9,0) ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or "RTN","DGPFAA3",10,0) ; PRF NATIONAL FLAG (#26.15) file "RTN","DGPFAA3",11,0) ; DGRDT - (required) review date in FM format "RTN","DGPFAA3",12,0) ; "RTN","DGPFAA3",13,0) ; Output: "RTN","DGPFAA3",14,0) ; Function Value - notification date in FM format on success, 0 on "RTN","DGPFAA3",15,0) ; failure. "RTN","DGPFAA3",16,0) ; "RTN","DGPFAA3",17,0) N DGFLGA ;flag file data array "RTN","DGPFAA3",18,0) N DGNDT ;function value "RTN","DGPFAA3",19,0) ; "RTN","DGPFAA3",20,0) S DGNDT=0 "RTN","DGPFAA3",21,0) I $G(DGFLG)]"",+$G(DGRDT)>0 D "RTN","DGPFAA3",22,0) . ; "RTN","DGPFAA3",23,0) . ;Retrieve the flag data array "RTN","DGPFAA3",24,0) . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA) "RTN","DGPFAA3",25,0) . ; "RTN","DGPFAA3",26,0) . ;must have a review frequency "RTN","DGPFAA3",27,0) . Q:(+$G(DGFLGA("REVFREQ"))=0) "RTN","DGPFAA3",28,0) . ; "RTN","DGPFAA3",29,0) . ;determine notification date "RTN","DGPFAA3",30,0) . S DGFLGA("NOTIDAYS")=$G(DGFLGA("NOTIDAYS"),0) "RTN","DGPFAA3",31,0) . S DGRDT=+$$FMTH^XLFDT(DGRDT) "RTN","DGPFAA3",32,0) . S DGNDT=+$$HTFM^XLFDT(DGRDT-DGFLGA("NOTIDAYS")) "RTN","DGPFAA3",33,0) ; "RTN","DGPFAA3",34,0) Q DGNDT "RTN","DGPFAA3",35,0) ; "RTN","DGPFAA3",36,0) GETRDT(DGFLG,DGADT) ;calculate the review date "RTN","DGPFAA3",37,0) ; "RTN","DGPFAA3",38,0) ; Input: "RTN","DGPFAA3",39,0) ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or "RTN","DGPFAA3",40,0) ; PRF NATIONAL FLAG (#26.15) file "RTN","DGPFAA3",41,0) ; DGADT - (required) assignment date in FM format "RTN","DGPFAA3",42,0) ; "RTN","DGPFAA3",43,0) ; Output: "RTN","DGPFAA3",44,0) ; Function Value - review date in FM format on success, 0 on failure "RTN","DGPFAA3",45,0) ; "RTN","DGPFAA3",46,0) N DGFLGA ;flag file data array "RTN","DGPFAA3",47,0) N DGRDT ;function value "RTN","DGPFAA3",48,0) ; "RTN","DGPFAA3",49,0) S DGRDT=0 "RTN","DGPFAA3",50,0) I $G(DGFLG)]"",+$G(DGADT)>0 D "RTN","DGPFAA3",51,0) . ; "RTN","DGPFAA3",52,0) . ;Retrieve the flag data array "RTN","DGPFAA3",53,0) . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA) "RTN","DGPFAA3",54,0) . ; "RTN","DGPFAA3",55,0) . ;must have a review frequency "RTN","DGPFAA3",56,0) . Q:(+$G(DGFLGA("REVFREQ"))=0) "RTN","DGPFAA3",57,0) . ; "RTN","DGPFAA3",58,0) . ;determine review date "RTN","DGPFAA3",59,0) . S DGADT=+$$FMTH^XLFDT(DGADT) "RTN","DGPFAA3",60,0) . S DGRDT=+$$HTFM^XLFDT(DGADT+DGFLGA("REVFREQ")) "RTN","DGPFAA3",61,0) ; "RTN","DGPFAA3",62,0) Q DGRDT "RTN","DGPFAA3",63,0) ; "RTN","DGPFAA3",64,0) LOCK(DGAIEN) ;Lock assignment record. "RTN","DGPFAA3",65,0) ; "RTN","DGPFAA3",66,0) ; This function is used to prevent another process from editing a "RTN","DGPFAA3",67,0) ; patient's record flag assignment. "RTN","DGPFAA3",68,0) ; "RTN","DGPFAA3",69,0) ; Input: "RTN","DGPFAA3",70,0) ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file "RTN","DGPFAA3",71,0) ; "RTN","DGPFAA3",72,0) ; Output: "RTN","DGPFAA3",73,0) ; Function Value - Returns 1 if the lock was successful, 0 otherwise "RTN","DGPFAA3",74,0) ; "RTN","DGPFAA3",75,0) I $G(DGAIEN) L +^DGPF(26.13,DGAIEN):10 "RTN","DGPFAA3",76,0) ; "RTN","DGPFAA3",77,0) Q $T "RTN","DGPFAA3",78,0) ; "RTN","DGPFAA3",79,0) UNLOCK(DGAIEN) ;Unlock assignment record. "RTN","DGPFAA3",80,0) ; "RTN","DGPFAA3",81,0) ; This procedure is used to release the lock created by $$LOCK. "RTN","DGPFAA3",82,0) ; "RTN","DGPFAA3",83,0) ; Input: "RTN","DGPFAA3",84,0) ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file "RTN","DGPFAA3",85,0) ; "RTN","DGPFAA3",86,0) ; Output: None "RTN","DGPFAA3",87,0) ; "RTN","DGPFAA3",88,0) I $G(DGAIEN) L -^DGPF(26.13,DGAIEN) "RTN","DGPFAA3",89,0) ; "RTN","DGPFAA3",90,0) Q "RTN","DGPFAAH") 0^56^B30752743 "RTN","DGPFAAH",1,0) DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/23/03 1:27pm "RTN","DGPFAAH",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAAH",3,0) Q ;no direct entry "RTN","DGPFAAH",4,0) ; "RTN","DGPFAAH",5,0) GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment "RTN","DGPFAAH",6,0) ; "RTN","DGPFAAH",7,0) ; Input: "RTN","DGPFAAH",8,0) ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",9,0) ; DGPFIENS - (required) Result array passed by reference "RTN","DGPFAAH",10,0) ; "RTN","DGPFAAH",11,0) ; Output: "RTN","DGPFAAH",12,0) ; Function Value - Count of returned IENs "RTN","DGPFAAH",13,0) ; DGPFIENS - Output array subscripted by assignment history IENs "RTN","DGPFAAH",14,0) ; "RTN","DGPFAAH",15,0) N DGCNT ;number of returned values "RTN","DGPFAAH",16,0) N DGHIEN ;single history IEN "RTN","DGPFAAH",17,0) ; "RTN","DGPFAAH",18,0) S DGCNT=0 "RTN","DGPFAAH",19,0) I $G(DGPFIEN)>0,$D(^DGPF(26.14,"B",DGPFIEN)) D "RTN","DGPFAAH",20,0) . S DGHIEN=0 "RTN","DGPFAAH",21,0) . F S DGHIEN=$O(^DGPF(26.14,"B",DGPFIEN,DGHIEN)) Q:'DGHIEN D "RTN","DGPFAAH",22,0) . . S DGPFIENS(DGHIEN)="" "RTN","DGPFAAH",23,0) . . S DGCNT=DGCNT+1 "RTN","DGPFAAH",24,0) Q DGCNT "RTN","DGPFAAH",25,0) ; "RTN","DGPFAAH",26,0) GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment "RTN","DGPFAAH",27,0) ; "RTN","DGPFAAH",28,0) ; Input: "RTN","DGPFAAH",29,0) ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",30,0) ; DGPFIENS - (required) Result array passed by reference "RTN","DGPFAAH",31,0) ; "RTN","DGPFAAH",32,0) ; Output: "RTN","DGPFAAH",33,0) ; Function Value - Count of returned IENs "RTN","DGPFAAH",34,0) ; DGPFIENS - Output array subscripted by assignment history date "RTN","DGPFAAH",35,0) ; "RTN","DGPFAAH",36,0) N DGADT ;assignment date "RTN","DGPFAAH",37,0) N DGCNT ;number of returned values "RTN","DGPFAAH",38,0) N DGHIEN ;single history IEN "RTN","DGPFAAH",39,0) ; "RTN","DGPFAAH",40,0) S DGCNT=0 "RTN","DGPFAAH",41,0) I $G(DGPFIEN)>0,$D(^DGPF(26.14,"C",DGPFIEN)) D "RTN","DGPFAAH",42,0) . S DGADT=0 "RTN","DGPFAAH",43,0) . F S DGADT=$O(^DGPF(26.14,"C",DGPFIEN,DGADT)) Q:'DGADT D "RTN","DGPFAAH",44,0) . . S DGHIEN=0 "RTN","DGPFAAH",45,0) . . F S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGADT,DGHIEN)) Q:'DGHIEN D "RTN","DGPFAAH",46,0) . . . S DGPFIENS(DGADT)=DGHIEN "RTN","DGPFAAH",47,0) . . . S DGCNT=DGCNT+1 "RTN","DGPFAAH",48,0) Q DGCNT "RTN","DGPFAAH",49,0) ; "RTN","DGPFAAH",50,0) GETHIST(DGPFIEN,DGPFAH) ;retrieve a single assignment history record "RTN","DGPFAAH",51,0) ; "RTN","DGPFAAH",52,0) ; Input: "RTN","DGPFAAH",53,0) ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT HISTORY "RTN","DGPFAAH",54,0) ; (#26.14) file "RTN","DGPFAAH",55,0) ; DGPFAH - (required) Result array passed by reference "RTN","DGPFAAH",56,0) ; "RTN","DGPFAAH",57,0) ; Output: "RTN","DGPFAAH",58,0) ; Function Value - Return 1 on success, 0 on failure "RTN","DGPFAAH",59,0) ; DGPFAH - Output array containing the field values "RTN","DGPFAAH",60,0) ; Subscript Field# "RTN","DGPFAAH",61,0) ; ----------------- ------ "RTN","DGPFAAH",62,0) ; "ASSIGN" .01 "RTN","DGPFAAH",63,0) ; "ASSIGNDT" .02 "RTN","DGPFAAH",64,0) ; "ACTION" .03 "RTN","DGPFAAH",65,0) ; "ENTERBY" .04 "RTN","DGPFAAH",66,0) ; "APPRVBY" .05 "RTN","DGPFAAH",67,0) ; "COMMENT",line#,0 1 "RTN","DGPFAAH",68,0) ; "RTN","DGPFAAH",69,0) N DGIENS ;IEN string for DIQ "RTN","DGPFAAH",70,0) N DGFLDS ;results array for DIQ "RTN","DGPFAAH",71,0) N DGERR ;error array for DIQ "RTN","DGPFAAH",72,0) N DGRSLT "RTN","DGPFAAH",73,0) S DGRSLT=0 "RTN","DGPFAAH",74,0) I $G(DGPFIEN)>0,$D(^DGPF(26.14,DGPFIEN)) D "RTN","DGPFAAH",75,0) . S DGIENS=DGPFIEN_"," "RTN","DGPFAAH",76,0) . D GETS^DIQ(26.14,DGIENS,"*","IEZ","DGFLDS","DGERR") "RTN","DGPFAAH",77,0) . Q:$D(DGERR) "RTN","DGPFAAH",78,0) . S DGRSLT=1 "RTN","DGPFAAH",79,0) . S DGPFAH("ASSIGN")=$G(DGFLDS(26.14,DGIENS,.01,"I"))_U_$G(DGFLDS(26.14,DGIENS,.01,"E")) "RTN","DGPFAAH",80,0) . S DGPFAH("ASSIGNDT")=$G(DGFLDS(26.14,DGIENS,.02,"I"))_U_$G(DGFLDS(26.14,DGIENS,.02,"E")) "RTN","DGPFAAH",81,0) . S DGPFAH("ACTION")=$G(DGFLDS(26.14,DGIENS,.03,"I"))_U_$G(DGFLDS(26.14,DGIENS,.03,"E")) "RTN","DGPFAAH",82,0) . S DGPFAH("ENTERBY")=$G(DGFLDS(26.14,DGIENS,.04,"I"))_U_$G(DGFLDS(26.14,DGIENS,.04,"E")) "RTN","DGPFAAH",83,0) . S DGPFAH("APPRVBY")=$G(DGFLDS(26.14,DGIENS,.05,"I"))_U_$G(DGFLDS(26.14,DGIENS,.05,"E")) "RTN","DGPFAAH",84,0) . ;build review comments word processing array "RTN","DGPFAAH",85,0) . M DGPFAH("COMMENT")=DGFLDS(26.14,DGIENS,1) "RTN","DGPFAAH",86,0) . K DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I") "RTN","DGPFAAH",87,0) . ; "RTN","DGPFAAH",88,0) Q DGRSLT "RTN","DGPFAAH",89,0) ; "RTN","DGPFAAH",90,0) GETFIRST(DGPFIEN) ;get IEN of the initial assignment "RTN","DGPFAAH",91,0) ;This function returns the IEN of the initial history record for a "RTN","DGPFAAH",92,0) ;given patient record flag assignment. "RTN","DGPFAAH",93,0) ; "RTN","DGPFAAH",94,0) ; Input: "RTN","DGPFAAH",95,0) ; DGPFIEN - (required) IEN of record in PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",96,0) ; "RTN","DGPFAAH",97,0) ; Output: "RTN","DGPFAAH",98,0) ; Function Value - IEN of initial history record on success "RTN","DGPFAAH",99,0) ; 0 on failure "RTN","DGPFAAH",100,0) ; "RTN","DGPFAAH",101,0) N DGHIEN ;history IEN "RTN","DGPFAAH",102,0) N DGEDT ;edit date "RTN","DGPFAAH",103,0) N DGPFAH ;history record data array "RTN","DGPFAAH",104,0) ; "RTN","DGPFAAH",105,0) S DGHIEN=0 "RTN","DGPFAAH",106,0) I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFAAH",107,0) . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0)) "RTN","DGPFAAH",108,0) . I DGEDT>0 D "RTN","DGPFAAH",109,0) . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0)) "RTN","DGPFAAH",110,0) Q $S($G(DGHIEN)>0:DGHIEN,1:0) "RTN","DGPFAAH",111,0) ; "RTN","DGPFAAH",112,0) GETLAST(DGPFIEN) ;determine IEN of last assignment history record "RTN","DGPFAAH",113,0) ;This function returns the IEN of the most recent history record for a "RTN","DGPFAAH",114,0) ;given patient record flag assignment. "RTN","DGPFAAH",115,0) ; "RTN","DGPFAAH",116,0) ; Input: "RTN","DGPFAAH",117,0) ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",118,0) ; "RTN","DGPFAAH",119,0) ; Output: "RTN","DGPFAAH",120,0) ; Function Value - IEN of last history record on success, 0 on failure "RTN","DGPFAAH",121,0) ; "RTN","DGPFAAH",122,0) N DGDAT "RTN","DGPFAAH",123,0) N DGHIEN "RTN","DGPFAAH",124,0) S DGHIEN=0 "RTN","DGPFAAH",125,0) I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFAAH",126,0) . S DGDAT=$O(^DGPF(26.14,"C",DGPFIEN,""),-1) "RTN","DGPFAAH",127,0) . I DGDAT>0 D "RTN","DGPFAAH",128,0) . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGDAT,0)) "RTN","DGPFAAH",129,0) Q $S($G(DGHIEN)>0:DGHIEN,1:0) "RTN","DGPFAAH",130,0) ; "RTN","DGPFAAH",131,0) GETADT(DGPFIEN) ;get the initial assignment date "RTN","DGPFAAH",132,0) ;This function returns the initial assignment date for a given patient "RTN","DGPFAAH",133,0) ;record flag assignment. "RTN","DGPFAAH",134,0) ; "RTN","DGPFAAH",135,0) ; Input: "RTN","DGPFAAH",136,0) ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",137,0) ; "RTN","DGPFAAH",138,0) ; Output: "RTN","DGPFAAH",139,0) ; Function Value - assignment date in internal^external format on "RTN","DGPFAAH",140,0) ; success, 0 on failure "RTN","DGPFAAH",141,0) ; "RTN","DGPFAAH",142,0) N DGHIEN ;history IEN "RTN","DGPFAAH",143,0) N DGEDT ;edit date "RTN","DGPFAAH",144,0) N DGADT ;assignment date "RTN","DGPFAAH",145,0) N DGPFAH ;history record data array "RTN","DGPFAAH",146,0) ; "RTN","DGPFAAH",147,0) S DGADT=0 "RTN","DGPFAAH",148,0) S DGHIEN=0 "RTN","DGPFAAH",149,0) I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFAAH",150,0) . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0)) "RTN","DGPFAAH",151,0) . I DGEDT>0 D "RTN","DGPFAAH",152,0) . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0)) "RTN","DGPFAAH",153,0) . . I DGHIEN>0,$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D "RTN","DGPFAAH",154,0) . . . I $P($G(DGPFAH("ACTION")),U,2)="NEW ASSIGNMENT" D "RTN","DGPFAAH",155,0) . . . . S DGADT=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFAAH",156,0) Q DGADT "RTN","DGPFAAH",157,0) ; "RTN","DGPFAAH",158,0) FNDHIST(DGAIEN,DGADT) ;Find Assignment "RTN","DGPFAAH",159,0) ; This function finds a patient record flag assignment record. "RTN","DGPFAAH",160,0) ; "RTN","DGPFAAH",161,0) ; Input: "RTN","DGPFAAH",162,0) ; DGAIEN - Pointer to assignment in the PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH",163,0) ; DGADT - Assignment date "RTN","DGPFAAH",164,0) ; "RTN","DGPFAAH",165,0) ; Output: "RTN","DGPFAAH",166,0) ; Function Value - Returns IEN of existing record on success, 0 on "RTN","DGPFAAH",167,0) ; failure "RTN","DGPFAAH",168,0) ; "RTN","DGPFAAH",169,0) N DGIEN "RTN","DGPFAAH",170,0) ; "RTN","DGPFAAH",171,0) I $G(DGAIEN)>0,($G(DGADT)>0) D "RTN","DGPFAAH",172,0) . S DGIEN=$O(^DGPF(26.14,"C",DGAIEN,DGADT,0)) "RTN","DGPFAAH",173,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFAAH",174,0) ; "RTN","DGPFAAH",175,0) STOHIST(DGPFAH,DGPFERR) ;file a PRF ASSIGNMENT HISTORY (#26.14) file record "RTN","DGPFAAH",176,0) ; "RTN","DGPFAAH",177,0) ; Input: "RTN","DGPFAAH",178,0) ; DGPFAH - (required) Array of values to be filed (see GETHIST tag "RTN","DGPFAAH",179,0) ; above for valid array structure) "RTN","DGPFAAH",180,0) ; DGPFERR - (optional) Passed by reference to contain error messages "RTN","DGPFAAH",181,0) ; "RTN","DGPFAAH",182,0) ; Output: "RTN","DGPFAAH",183,0) ; Function Value - Returns IEN of record on success, 0 on failure "RTN","DGPFAAH",184,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFAAH",185,0) ; "RTN","DGPFAAH",186,0) N DGSUB "RTN","DGPFAAH",187,0) N DGFLD "RTN","DGPFAAH",188,0) N DGIEN "RTN","DGPFAAH",189,0) N DGIENS "RTN","DGPFAAH",190,0) N DGFDA "RTN","DGPFAAH",191,0) N DGFDAIEN "RTN","DGPFAAH",192,0) N DGERR "RTN","DGPFAAH",193,0) F DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY" D "RTN","DGPFAAH",194,0) . S DGFLD(DGSUB)=$P($G(DGPFAH(DGSUB)),U) "RTN","DGPFAAH",195,0) I $D(DGPFAH("COMMENT")) M DGFLD("COMMENT")=DGPFAH("COMMENT") "RTN","DGPFAAH",196,0) I $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR) D "RTN","DGPFAAH",197,0) . S DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT")) "RTN","DGPFAAH",198,0) . I DGIEN S DGIENS=DGIEN_"," "RTN","DGPFAAH",199,0) . E S DGIENS="+1," "RTN","DGPFAAH",200,0) . S DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN") "RTN","DGPFAAH",201,0) . S DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT") "RTN","DGPFAAH",202,0) . S DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION") "RTN","DGPFAAH",203,0) . S DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY") "RTN","DGPFAAH",204,0) . S DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY") "RTN","DGPFAAH",205,0) . S DGFDA(26.14,DGIENS,1)="DGFLD(""COMMENT"")" "RTN","DGPFAAH",206,0) . I DGIEN D "RTN","DGPFAAH",207,0) . . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFAAH",208,0) . . I $D(DGERR) S DGIEN=0 "RTN","DGPFAAH",209,0) . E D "RTN","DGPFAAH",210,0) . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFAAH",211,0) . . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1)) "RTN","DGPFAAH",212,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFAAH1") 0^57^B1218620 "RTN","DGPFAAH1",1,0) DGPFAAH1 ;ALB/RPM - PRF ASSIGNMENT HISTORY VALIDATION DATA ; 02/06/03 "RTN","DGPFAAH1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAAH1",3,0) ; "RTN","DGPFAAH1",4,0) XREF ;;array node name;field#;required field;word processing?;description "RTN","DGPFAAH1",5,0) ;;ASSIGN;.01;1;0;pointer to 26.13 "RTN","DGPFAAH1",6,0) ;;ASSIGNDT;.02;1;0;date/time of edit activity "RTN","DGPFAAH1",7,0) ;;ACTION;.03;1;0;type of edit performed "RTN","DGPFAAH1",8,0) ;;ENTERBY;.04;1;0;pointer to NEW PERSON file for entering individual "RTN","DGPFAAH1",9,0) ;;APPRVBY;.05;1;0;pointer to NEW PERSON file for approval individual "RTN","DGPFAAH1",10,0) ;;COMMENT;1;0;1;review history comments "RTN","DGPFALF") 0^28^B22618813 "RTN","DGPFALF",1,0) DGPFALF ;ALB/KCL,RBS - PRF LOCAL FLAG API'S ; 4/9/03 12:25pm "RTN","DGPFALF",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFALF",3,0) ; "RTN","DGPFALF",4,0) ;- no direct entry "RTN","DGPFALF",5,0) QUIT "RTN","DGPFALF",6,0) ; "RTN","DGPFALF",7,0) GETLF(DGPFIEN,DGPFLF) ;retrieve a single PRF LOCAL FLAG (#26.11) record "RTN","DGPFALF",8,0) ;This function returns a single flag record from the PRF LOCAL FLAG "RTN","DGPFALF",9,0) ;file and returns it in an array format. "RTN","DGPFALF",10,0) ; "RTN","DGPFALF",11,0) ; Input: "RTN","DGPFALF",12,0) ; DGPFIEN - (required) pointer to local flag record in the "RTN","DGPFALF",13,0) ; PRF LOCAL FLAG (#26.11) file "RTN","DGPFALF",14,0) ; DGPFLF - (required) result array passed by reference "RTN","DGPFALF",15,0) ; "RTN","DGPFALF",16,0) ; Output: "RTN","DGPFALF",17,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFALF",18,0) ; DGPFLF - output array containing local flag record field "RTN","DGPFALF",19,0) ; values. "RTN","DGPFALF",20,0) ; Subscript Field# Data "RTN","DGPFALF",21,0) ; -------------- ------- ------------------- "RTN","DGPFALF",22,0) ; "FLAG" .01 internal^external "RTN","DGPFALF",23,0) ; "STAT" .02 internal^external "RTN","DGPFALF",24,0) ; "TYPE" .03 internal^external "RTN","DGPFALF",25,0) ; "REVFREQ" .04 internal^external "RTN","DGPFALF",26,0) ; "NOTIDAYS" .05 internal^external "RTN","DGPFALF",27,0) ; "REVGRP" .06 internal^external "RTN","DGPFALF",28,0) ; "DESC",line#,0 1 character string "RTN","DGPFALF",29,0) ; "PRININV",line#,0 2 character string "RTN","DGPFALF",30,0) ; "RTN","DGPFALF",31,0) N DGIENS ;IEN string for DIQ "RTN","DGPFALF",32,0) N DGFLDS ;results array for DIQ "RTN","DGPFALF",33,0) N DGERR ;error arrary for DIQ "RTN","DGPFALF",34,0) N DGSUB ;pincipal investigator multiple subscript "RTN","DGPFALF",35,0) N RESULT ;return function value "RTN","DGPFALF",36,0) ; "RTN","DGPFALF",37,0) S RESULT=0 "RTN","DGPFALF",38,0) ; "RTN","DGPFALF",39,0) I $G(DGPFIEN)>0,$D(^DGPF(26.11,DGPFIEN)) D "RTN","DGPFALF",40,0) . S DGIENS=DGPFIEN_"," "RTN","DGPFALF",41,0) . D GETS^DIQ(26.11,DGIENS,"**","IEZ","DGFLDS","DGERR") "RTN","DGPFALF",42,0) . Q:$D(DGERR) "RTN","DGPFALF",43,0) . ; "RTN","DGPFALF",44,0) . ;-- build local flag array "RTN","DGPFALF",45,0) . S DGPFLF("FLAG")=$G(DGFLDS(26.11,DGIENS,.01,"I"))_U_$G(DGFLDS(26.11,DGIENS,.01,"E")) "RTN","DGPFALF",46,0) . S DGPFLF("STAT")=$G(DGFLDS(26.11,DGIENS,.02,"I"))_U_$G(DGFLDS(26.11,DGIENS,.02,"E")) "RTN","DGPFALF",47,0) . S DGPFLF("TYPE")=$G(DGFLDS(26.11,DGIENS,.03,"I"))_U_$G(DGFLDS(26.11,DGIENS,.03,"E")) "RTN","DGPFALF",48,0) . S DGPFLF("REVFREQ")=$G(DGFLDS(26.11,DGIENS,.04,"I"))_U_$G(DGFLDS(26.11,DGIENS,.04,"E")) "RTN","DGPFALF",49,0) . S DGPFLF("NOTIDAYS")=$G(DGFLDS(26.11,DGIENS,.05,"I"))_U_$G(DGFLDS(26.11,DGIENS,.05,"E")) "RTN","DGPFALF",50,0) . S DGPFLF("REVGRP")=$G(DGFLDS(26.11,DGIENS,.06,"I"))_U_$G(DGFLDS(26.11,DGIENS,.06,"E")) "RTN","DGPFALF",51,0) . ;-- flag description word processing array "RTN","DGPFALF",52,0) . M DGPFLF("DESC")=DGFLDS(26.11,DGIENS,1) "RTN","DGPFALF",53,0) . K DGPFLF("DESC","E"),DGPFLF("DESC","I") "RTN","DGPFALF",54,0) . ;-- principal investigator(s) multiple "RTN","DGPFALF",55,0) . S DGSUB="" F S DGSUB=$O(DGFLDS(26.112,DGSUB)) Q:DGSUB="" D "RTN","DGPFALF",56,0) . . S DGPFLF("PRININV",+DGSUB,0)=$G(DGFLDS(26.112,DGSUB,.01,"I"))_U_$G(DGFLDS(26.112,DGSUB,.01,"E")) "RTN","DGPFALF",57,0) . ; "RTN","DGPFALF",58,0) . S RESULT=1 "RTN","DGPFALF",59,0) ; "RTN","DGPFALF",60,0) Q RESULT "RTN","DGPFALF",61,0) ; "RTN","DGPFALF",62,0) FNDFLAG(DGPFFLG) ;Find Flag Name IEN "RTN","DGPFALF",63,0) ; This function finds a flag record IEN using the name field. "RTN","DGPFALF",64,0) ; Input: "RTN","DGPFALF",65,0) ; DGPFFLG - Flag Name field (.01) value "RTN","DGPFALF",66,0) ; "RTN","DGPFALF",67,0) ; Output: "RTN","DGPFALF",68,0) ; Function Value - Returns IEN of existing record on success, 0 on "RTN","DGPFALF",69,0) ; failure "RTN","DGPFALF",70,0) N DGIEN "RTN","DGPFALF",71,0) I $G(DGPFFLG)["" D "RTN","DGPFALF",72,0) . S DGIEN=$O(^DGPF(26.11,"B",DGPFFLG,0)) "RTN","DGPFALF",73,0) ; "RTN","DGPFALF",74,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFALF",75,0) ; "RTN","DGPFALF",76,0) STOFLAG(DGPFLF,DGPFERR) ;store a single PRF LOCAL FLAG (#26.11) file record "RTN","DGPFALF",77,0) ; "RTN","DGPFALF",78,0) ; Input: "RTN","DGPFALF",79,0) ; DGPFLF - (required) array of values to be filed (see GETLF tag "RTN","DGPFALF",80,0) ; above for valid array structure) "RTN","DGPFALF",81,0) ; DGPFERR - (optional) passed by reference to contain error messages "RTN","DGPFALF",82,0) ; "RTN","DGPFALF",83,0) ; Output: "RTN","DGPFALF",84,0) ; Function Value - Returns IEN of record on success, 0 on failure "RTN","DGPFALF",85,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFALF",86,0) ; "RTN","DGPFALF",87,0) N DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR "RTN","DGPFALF",88,0) ; "RTN","DGPFALF",89,0) F DGSUB="FLAG","STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP" D "RTN","DGPFALF",90,0) . S DGFLD(DGSUB)=$P($G(DGPFLF(DGSUB)),U) "RTN","DGPFALF",91,0) I $D(DGPFLF("DESC")) M DGFLD("DESC")=DGPFLF("DESC") "RTN","DGPFALF",92,0) I $D(DGPFLF("PRININV")) M DGFLD("PRININV")=DGPFLF("PRININV") "RTN","DGPFALF",93,0) I $$VALID^DGPFUT("DGPFALF1",26.11,.DGFLD,.DGPFERR) D "RTN","DGPFALF",94,0) . ; "RTN","DGPFALF",95,0) . ;if name change lookup on original name, otherwise lookup on new name "RTN","DGPFALF",96,0) . S DGIEN=$$FNDFLAG^DGPFALF($S($G(DGPFLF("OLDFLAG"))]"":DGPFLF("OLDFLAG"),1:DGFLD("FLAG"))) "RTN","DGPFALF",97,0) . ;the "?+" on an existing record will do LAYGO to lookup and add new "RTN","DGPFALF",98,0) . ; entries. This was needed for adding another entry to the "RTN","DGPFALF",99,0) . ; Principal Investigator(s) multiple (#26.112) "RTN","DGPFALF",100,0) . I DGIEN S DGIENS=DGIEN_"," ;EDIT existing record "RTN","DGPFALF",101,0) . E S DGIENS="+1," ;ADD new record "RTN","DGPFALF",102,0) . S DGFDA(26.11,DGIENS,.01)=DGFLD("FLAG") "RTN","DGPFALF",103,0) . S DGFDA(26.11,DGIENS,.02)=DGFLD("STAT") "RTN","DGPFALF",104,0) . S DGFDA(26.11,DGIENS,.03)=DGFLD("TYPE") "RTN","DGPFALF",105,0) . S DGFDA(26.11,DGIENS,.04)=DGFLD("REVFREQ") "RTN","DGPFALF",106,0) . S DGFDA(26.11,DGIENS,.05)=DGFLD("NOTIDAYS") "RTN","DGPFALF",107,0) . S DGFDA(26.11,DGIENS,.06)=DGFLD("REVGRP") "RTN","DGPFALF",108,0) . S DGFDA(26.11,DGIENS,1)="DGFLD(""DESC"")" "RTN","DGPFALF",109,0) . ;-- principal investigator(s) multiple "RTN","DGPFALF",110,0) . I $D(DGFLD("PRININV")) D PRININV(+DGIEN,.DGFDA) "RTN","DGPFALF",111,0) . ; "RTN","DGPFALF",112,0) . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFALF",113,0) . I '$D(DGERR),'DGIEN S DGIEN=$G(DGFDAIEN(1)) "RTN","DGPFALF",114,0) ; "RTN","DGPFALF",115,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFALF",116,0) ; "RTN","DGPFALF",117,0) PRININV(DGPFIEN,DGFDA) ; setup principal investigator(s) multiple (#26.112) "RTN","DGPFALF",118,0) ; Input: "RTN","DGPFALF",119,0) ; DGPFIEN - value will indicate to EDIT or ADD a New Record "RTN","DGPFALF",120,0) ; IEN# = IEN of existing entry - Edit to existing Record "RTN","DGPFALF",121,0) ; 0 = Add New Record "RTN","DGPFALF",122,0) ; DGFDA - array used by FileMan (passed by reference) "RTN","DGPFALF",123,0) ; "RTN","DGPFALF",124,0) ; Output: "RTN","DGPFALF",125,0) ; DGFDA array subscript entries for "PRININV" "RTN","DGPFALF",126,0) ; "RTN","DGPFALF",127,0) ; The DGFDA FDA_ROOT array needs the "?+" on an existing IEN so "RTN","DGPFALF",128,0) ; that FileMan will do LAYGO to lookup and add new entires. "RTN","DGPFALF",129,0) ; This was needed for adding another entry to an existing "RTN","DGPFALF",130,0) ; Principal Investigator(s) multiple (#26.112) field. "RTN","DGPFALF",131,0) ; "RTN","DGPFALF",132,0) S DGPFIEN=+$G(DGPFIEN) "RTN","DGPFALF",133,0) N DGSUB,DGIENS "RTN","DGPFALF",134,0) ; "RTN","DGPFALF",135,0) S DGSUB=0 F S DGSUB=$O(DGFLD("PRININV",DGSUB)) Q:DGSUB="" D "RTN","DGPFALF",136,0) . I DGPFIEN D ;existing record "RTN","DGPFALF",137,0) . . S DGIENS=DGSUB_","_DGPFIEN_"," ;delete "RTN","DGPFALF",138,0) . . Q:DGFLD("PRININV",DGSUB,0)="@" "RTN","DGPFALF",139,0) . . S DGIENS="?+"_DGIENS ;non-delete uses LAYGO "RTN","DGPFALF",140,0) . E S DGIENS="+"_(DGSUB+1)_",+1," ;new record "RTN","DGPFALF",141,0) . ; "RTN","DGPFALF",142,0) . S DGFDA(26.112,DGIENS,.01)=$P(DGFLD("PRININV",DGSUB,0),U) "RTN","DGPFALF",143,0) ; "RTN","DGPFALF",144,0) Q "RTN","DGPFALF1") 0^29^B9183285 "RTN","DGPFALF1",1,0) DGPFALF1 ;ALB/KCL,RBS - PRF LOCAL FLAG API'S CONTINUED ; 4/21/03 12:53pm "RTN","DGPFALF1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFALF1",3,0) ; "RTN","DGPFALF1",4,0) ;- no direct entry "RTN","DGPFALF1",5,0) QUIT "RTN","DGPFALF1",6,0) ; "RTN","DGPFALF1",7,0) STOALL(DGPFLF,DGPFLH,DGPFERR) ;File both LOCAL FLAG(#26.11) & HISTORY(#26.12) "RTN","DGPFALF1",8,0) ;This function acts as a wrapper around the $$STOFLAG^DGPFALF "RTN","DGPFALF1",9,0) ;and the $$STOHIST^DGPFALH filer calls. "RTN","DGPFALF1",10,0) ; "RTN","DGPFALF1",11,0) ; Input: "RTN","DGPFALF1",12,0) ; DGPFLF - (required) array of Local Flag values to be filed "RTN","DGPFALF1",13,0) ; (see $$GETLF^DGPFALF for valid array structure) "RTN","DGPFALF1",14,0) ; DGPFLH - (required) array of Flag History values to be filed "RTN","DGPFALF1",15,0) ; (see $$GETHIST^DGPFALH for valid array structure) "RTN","DGPFALF1",16,0) ; DGPFERR - (optional) passed by reference to contain error messages "RTN","DGPFALF1",17,0) ; "RTN","DGPFALF1",18,0) ; Output: "RTN","DGPFALF1",19,0) ; Function Value - Returns circumflex("^") delimited results of "RTN","DGPFALF1",20,0) ; $$STOFLAG^DGPFALF and $$STOHIST^DGPFALH calls. "RTN","DGPFALF1",21,0) ; Example: "3^12" "RTN","DGPFALF1",22,0) ; On Success - "IEN of (#26.11)^IEN of (#26.12)" "RTN","DGPFALF1",23,0) ; On Failure - 0 "RTN","DGPFALF1",24,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFALF1",25,0) ; "RTN","DGPFALF1",26,0) N DGOIEN ;existing Local Flag file IEN used for "roll-back" "RTN","DGPFALF1",27,0) N DGPFOLF ;existing Local Flag data array used for "roll-back" "RTN","DGPFALF1",28,0) N DGLIEN ;Local Flag file IEN "RTN","DGPFALF1",29,0) N DGLHIEN ;Local Flag history file IEN "RTN","DGPFALF1",30,0) N DGFLG ;"FLAG" value "RTN","DGPFALF1",31,0) ; "RTN","DGPFALF1",32,0) S (DGLIEN,DGLHIEN)=0 "RTN","DGPFALF1",33,0) S DGFLG=$P($G(DGPFLF("FLAG")),U) "RTN","DGPFALF1",34,0) S DGOIEN=$$FNDFLAG^DGPFALF(DGFLG) "RTN","DGPFALF1",35,0) I 'DGOIEN!(DGOIEN&($$GETLF^DGPFALF(DGOIEN,.DGPFOLF))) D "RTN","DGPFALF1",36,0) . S DGLIEN=$$STOFLAG^DGPFALF(.DGPFLF,.DGPFERR) "RTN","DGPFALF1",37,0) . I $D(DGPFERR) S DGLIEN=0 "RTN","DGPFALF1",38,0) . I DGLIEN D "RTN","DGPFALF1",39,0) . . S DGPFLH("FLAG")=DGLIEN "RTN","DGPFALF1",40,0) . . S DGLHIEN=$$STOHIST^DGPFALH(.DGPFLH,.DGPFERR) "RTN","DGPFALF1",41,0) . . I $D(DGPFERR) S DGLHIEN=0 "RTN","DGPFALF1",42,0) . . I DGLHIEN=0 D ;roll back the Local Flag file setup "RTN","DGPFALF1",43,0) . . . I 'DGOIEN,'$D(DGPFOLF) S DGPFOLF("FLAG")="@" "RTN","DGPFALF1",44,0) . . . I $$ROLLBACK^DGPFALF1(26.11,DGLIEN,.DGPFOLF,"FLAG") S DGLIEN=0 "RTN","DGPFALF1",45,0) Q $S(DGLHIEN=0:0,1:DGLIEN_"^"_DGLHIEN) "RTN","DGPFALF1",46,0) ; "RTN","DGPFALF1",47,0) ROLLBACK(DGFILE,DGFIEN,DGPFOA,DGKEY) ;Rollback a FILE record "RTN","DGPFALF1",48,0) ; Input: "RTN","DGPFALF1",49,0) ; DGFILE - File reference that will be used for rollback "RTN","DGPFALF1",50,0) ; DGFIEN - IEN of record to rollback in DGFILE "RTN","DGPFALF1",51,0) ; DGPFOA - Original array of data prior to record modification "RTN","DGPFALF1",52,0) ; DGKEY - .01 Field Name reference to DELETE whole record "RTN","DGPFALF1",53,0) ; Output: "RTN","DGPFALF1",54,0) ; Function value - 1 on successful Rollback "RTN","DGPFALF1",55,0) ; 0 on failure "RTN","DGPFALF1",56,0) ; "RTN","DGPFALF1",57,0) N DGIENS,DGFDA,DGERR,DGRSLT "RTN","DGPFALF1",58,0) S DGRSLT=0 "RTN","DGPFALF1",59,0) I $D(DGFILE),+$G(DGFIEN),$D(DGPFOA),$D(DGKEY) D "RTN","DGPFALF1",60,0) . Q:'$D(^DGPF(DGFILE)) "RTN","DGPFALF1",61,0) . Q:'$D(^DGPF(DGFILE,DGFIEN)) "RTN","DGPFALF1",62,0) . S DGIENS=DGFIEN_"," "RTN","DGPFALF1",63,0) . I $G(DGPFOA(DGKEY))="@" D "RTN","DGPFALF1",64,0) . . S DGFDA(DGFILE,DGIENS,.01)="@" "RTN","DGPFALF1",65,0) . . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFALF1",66,0) . . I '$D(DGERR) S DGRSLT=1 "RTN","DGPFALF1",67,0) . E D "RTN","DGPFALF1",68,0) . . I $$STOFLAG^DGPFALF(.DGPFOA,.DGERR),'$D(DGERR) S DGRSLT=1 "RTN","DGPFALF1",69,0) Q DGRSLT "RTN","DGPFALF1",70,0) ; "RTN","DGPFALF1",71,0) LOCKLF(DGPFLIEN) ; Lock Flag ien "RTN","DGPFALF1",72,0) ; Input: "RTN","DGPFALF1",73,0) ; DGPFLIEN - IEN of record "RTN","DGPFALF1",74,0) ; Output: "RTN","DGPFALF1",75,0) ; Function Value - Returns 1 on success "RTN","DGPFALF1",76,0) ; 0 on failure "RTN","DGPFALF1",77,0) L +^DGPF(26.11,DGPFLIEN):10 I '$T Q 0 "RTN","DGPFALF1",78,0) Q 1 "RTN","DGPFALF1",79,0) ; "RTN","DGPFALF1",80,0) UNLOCK(DGPFLIEN) ; Un-Lock Flag ien "RTN","DGPFALF1",81,0) ; Input: "RTN","DGPFALF1",82,0) ; DGPFLIEN - IEN of record "RTN","DGPFALF1",83,0) ; Output: "RTN","DGPFALF1",84,0) ; Function Value - Returns 1 on success "RTN","DGPFALF1",85,0) ; 0 on failure "RTN","DGPFALF1",86,0) L -^DGPF(26.11,DGPFLIEN):2 I '$T Q 0 "RTN","DGPFALF1",87,0) Q 1 "RTN","DGPFALF1",88,0) ; "RTN","DGPFALF1",89,0) ; "RTN","DGPFALF1",90,0) ; PRF LOCAL FLAG FILE (#26.11) Field VALIDATION data "RTN","DGPFALF1",91,0) ; don't do the Principal Investigator(s) multiple fields... "RTN","DGPFALF1",92,0) ; they're pointers anyway and won't be Validated. "RTN","DGPFALF1",93,0) ; PRININV;2;0;0;principal investigator(s) (if Research Flag)(pointer) "RTN","DGPFALF1",94,0) ; "RTN","DGPFALF1",95,0) ; *** Only Validate the following fields... "RTN","DGPFALF1",96,0) XREF ;;array node name;field#;required param;word processing?;description "RTN","DGPFALF1",97,0) ;;FLAG;.01;1;0;flag name "RTN","DGPFALF1",98,0) ;;STAT;.02;1;0;active/inactive "RTN","DGPFALF1",99,0) ;;TYPE;.03;1;0;pointer to PRF TYPE FILE (#26.16) "RTN","DGPFALF1",100,0) ;;REVFREQ;.04;1;0;review frequency "RTN","DGPFALF1",101,0) ;;NOTIDAYS;.05;1;0;notification days "RTN","DGPFALF1",102,0) ;;REVGRP;.06;0;pointer to MAIL GROUP FILE (#3.8) "RTN","DGPFALF1",103,0) ;;DESC;1;1;1;description of flag "RTN","DGPFALH") 0^30^B23450364 "RTN","DGPFALH",1,0) DGPFALH ;ALB/RBS - PRF LOCAL FLAG HISTORY API'S ; 3/10/03 3:14pm "RTN","DGPFALH",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFALH",3,0) ; "RTN","DGPFALH",4,0) Q ;no direct entry "RTN","DGPFALH",5,0) ; "RTN","DGPFALH",6,0) GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for a Local Flag "RTN","DGPFALH",7,0) ; "RTN","DGPFALH",8,0) ; Input: "RTN","DGPFALH",9,0) ; DGPFIEN - (required) Pointer to PRF LOCAL FLAG (#26.11) file "RTN","DGPFALH",10,0) ; DGPFIENS - (required) Result array passed by reference "RTN","DGPFALH",11,0) ; "RTN","DGPFALH",12,0) ; Output: "RTN","DGPFALH",13,0) ; Function Value - Count of returned IENs "RTN","DGPFALH",14,0) ; DGPFIENS - Output array subscripted by Local Flag history IENs "RTN","DGPFALH",15,0) ; "RTN","DGPFALH",16,0) N DGCNT ;number of returned values "RTN","DGPFALH",17,0) N DGHIEN ;single history IEN "RTN","DGPFALH",18,0) ; "RTN","DGPFALH",19,0) S DGCNT=0 "RTN","DGPFALH",20,0) I $G(DGPFIEN)>0,$D(^DGPF(26.12,"B",DGPFIEN)) D "RTN","DGPFALH",21,0) . S DGHIEN=0 "RTN","DGPFALH",22,0) . F S DGHIEN=$O(^DGPF(26.12,"B",DGPFIEN,DGHIEN)) Q:'DGHIEN D "RTN","DGPFALH",23,0) . . S DGPFIENS(DGHIEN)="" "RTN","DGPFALH",24,0) . . S DGCNT=DGCNT+1 "RTN","DGPFALH",25,0) Q DGCNT "RTN","DGPFALH",26,0) ; "RTN","DGPFALH",27,0) ; "RTN","DGPFALH",28,0) GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for a Local Flag "RTN","DGPFALH",29,0) ; Retrieve list of history IENs for a Local Flag and place in a local "RTN","DGPFALH",30,0) ; array subscripted by Flag Edit Date/Time. "RTN","DGPFALH",31,0) ; "RTN","DGPFALH",32,0) ; Input: "RTN","DGPFALH",33,0) ; DGPFIEN - (required) Pointer to PRF LOCAL FLAG (#26.11) file "RTN","DGPFALH",34,0) ; DGPFIENS - (required) Result array passed by reference "RTN","DGPFALH",35,0) ; "RTN","DGPFALH",36,0) ; Output: "RTN","DGPFALH",37,0) ; Function Value - Count of returned IENs "RTN","DGPFALH",38,0) ; DGPFIENS - Output array containing Local Flag history IENs, "RTN","DGPFALH",39,0) ; subscripted by Flag Edit Date/Time "RTN","DGPFALH",40,0) ; Ex. DGPFIENS(3030310.1025)=2 "RTN","DGPFALH",41,0) ; "RTN","DGPFALH",42,0) ; "RTN","DGPFALH",43,0) N DGCNT ;number of returned values "RTN","DGPFALH",44,0) N DGDT ;flag edit date/time "RTN","DGPFALH",45,0) N DGHIEN ;single history IEN "RTN","DGPFALH",46,0) ; "RTN","DGPFALH",47,0) S DGCNT=0 "RTN","DGPFALH",48,0) ; "RTN","DGPFALH",49,0) I $G(DGPFIEN)>0,$D(^DGPF(26.12,"C",DGPFIEN)) D "RTN","DGPFALH",50,0) . S DGDT=0 "RTN","DGPFALH",51,0) . F S DGDT=$O(^DGPF(26.12,"C",DGPFIEN,DGDT)) Q:'DGDT D "RTN","DGPFALH",52,0) . . S DGHIEN=0 "RTN","DGPFALH",53,0) . . F S DGHIEN=$O(^DGPF(26.12,"C",DGPFIEN,DGDT,DGHIEN)) Q:'DGHIEN D "RTN","DGPFALH",54,0) . . . S DGPFIENS(DGDT)=DGHIEN "RTN","DGPFALH",55,0) . . . S DGCNT=DGCNT+1 "RTN","DGPFALH",56,0) ; "RTN","DGPFALH",57,0) Q DGCNT "RTN","DGPFALH",58,0) ; "RTN","DGPFALH",59,0) ; "RTN","DGPFALH",60,0) GETHIST(DGPFIEN,DGPFLH) ;retrieve a single Local Flag history record "RTN","DGPFALH",61,0) ; "RTN","DGPFALH",62,0) ; Input: "RTN","DGPFALH",63,0) ; DGPFIEN - (required) IEN for record in PRF LOCAL FLAG HISTORY "RTN","DGPFALH",64,0) ; (#26.12) file "RTN","DGPFALH",65,0) ; DGPFLH - (required) Result array passed by reference "RTN","DGPFALH",66,0) ; "RTN","DGPFALH",67,0) ; Output: "RTN","DGPFALH",68,0) ; Function Value - Return 1 on success, 0 on failure "RTN","DGPFALH",69,0) ; DGPFLH - Output array containing the field values "RTN","DGPFALH",70,0) ; Subscript Field# "RTN","DGPFALH",71,0) ; ----------------- ------ "RTN","DGPFALH",72,0) ; "FLAG" .01 "RTN","DGPFALH",73,0) ; "ENTERDT" .02 "RTN","DGPFALH",74,0) ; "ENTERBY" .03 "RTN","DGPFALH",75,0) ; "REASON",line#,0 .04 "RTN","DGPFALH",76,0) ; "RTN","DGPFALH",77,0) N DGIENS ;IEN string for DIQ "RTN","DGPFALH",78,0) N DGFLDS ;results array for DIQ "RTN","DGPFALH",79,0) N DGERR ;error array for DIQ "RTN","DGPFALH",80,0) N DGRSLT "RTN","DGPFALH",81,0) S DGRSLT=0 "RTN","DGPFALH",82,0) I $G(DGPFIEN)>0,$D(^DGPF(26.12,DGPFIEN)) D "RTN","DGPFALH",83,0) . S DGIENS=DGPFIEN_"," "RTN","DGPFALH",84,0) . D GETS^DIQ(26.12,DGIENS,"*","IEZ","DGFLDS","DGERR") "RTN","DGPFALH",85,0) . Q:$D(DGERR) "RTN","DGPFALH",86,0) . S DGRSLT=1 "RTN","DGPFALH",87,0) . S DGPFLH("FLAG")=$G(DGFLDS(26.12,DGIENS,.01,"I"))_U_$G(DGFLDS(26.12,DGIENS,.01,"E")) "RTN","DGPFALH",88,0) . S DGPFLH("ENTERDT")=$G(DGFLDS(26.12,DGIENS,.02,"I"))_U_$G(DGFLDS(26.12,DGIENS,.02,"E")) "RTN","DGPFALH",89,0) . S DGPFLH("ENTERBY")=$G(DGFLDS(26.12,DGIENS,.03,"I"))_U_$G(DGFLDS(26.12,DGIENS,.03,"E")) "RTN","DGPFALH",90,0) . ;build reason of enter/edit word processing array "RTN","DGPFALH",91,0) . M DGPFLH("REASON")=DGFLDS(26.12,DGIENS,.04) "RTN","DGPFALH",92,0) . K DGPFLH("REASON","E"),DGPFLH("REASON","I") "RTN","DGPFALH",93,0) . ; "RTN","DGPFALH",94,0) Q DGRSLT "RTN","DGPFALH",95,0) ; "RTN","DGPFALH",96,0) ; "RTN","DGPFALH",97,0) GETLAST(DGPFIEN) ;determine IEN of last Local Flag history record "RTN","DGPFALH",98,0) ;This function returns the IEN of the most recent history record for "RTN","DGPFALH",99,0) ;a given Local Flag record. "RTN","DGPFALH",100,0) ; "RTN","DGPFALH",101,0) ; Input: "RTN","DGPFALH",102,0) ; DGPFIEN - (required) IEN of record in PRF LOCAL FLAG(#26.11) file "RTN","DGPFALH",103,0) ; "RTN","DGPFALH",104,0) ; Output: "RTN","DGPFALH",105,0) ; Function Value - IEN of last history record on success "RTN","DGPFALH",106,0) ; - 0 on failure "RTN","DGPFALH",107,0) N DGDAT,DGHIEN "RTN","DGPFALH",108,0) S DGHIEN=0 "RTN","DGPFALH",109,0) I $G(DGPFIEN)>0,$D(^DGPF(26.11,DGPFIEN)) D "RTN","DGPFALH",110,0) . S DGDAT=$O(^DGPF(26.12,"C",DGPFIEN,""),-1) "RTN","DGPFALH",111,0) . I DGDAT>0 D "RTN","DGPFALH",112,0) . . S DGHIEN=$O(^DGPF(26.12,"C",DGPFIEN,DGDAT,0)) "RTN","DGPFALH",113,0) Q $S($G(DGHIEN)>0:DGHIEN,1:0) "RTN","DGPFALH",114,0) ; "RTN","DGPFALH",115,0) ; "RTN","DGPFALH",116,0) GETADT(DGPFIEN) ;get the initial entry date/time "RTN","DGPFALH",117,0) ;This function returns the initia entry date/time for a given Local "RTN","DGPFALH",118,0) ;record flag. "RTN","DGPFALH",119,0) ; "RTN","DGPFALH",120,0) ; Input: "RTN","DGPFALH",121,0) ; DGPFIEN - (required) IEN of record in PRF LOCAL FLAG(#26.11) file "RTN","DGPFALH",122,0) ; "RTN","DGPFALH",123,0) ; Output: "RTN","DGPFALH",124,0) ; Function Value - Entry date/time on success (internal^external) "RTN","DGPFALH",125,0) ; 0 on failure "RTN","DGPFALH",126,0) ; "RTN","DGPFALH",127,0) N DGHIEN ;history IEN "RTN","DGPFALH",128,0) N DGEDT ;edit date "RTN","DGPFALH",129,0) N DGADT ;entry date "RTN","DGPFALH",130,0) N DGPFLH ;history record data array "RTN","DGPFALH",131,0) ; "RTN","DGPFALH",132,0) S DGADT=0 "RTN","DGPFALH",133,0) S DGHIEN=0 "RTN","DGPFALH",134,0) I $G(DGPFIEN)>0,$D(^DGPF(26.11,DGPFIEN)) D "RTN","DGPFALH",135,0) . S DGEDT=$O(^DGPF(26.12,"C",DGPFIEN,0)) "RTN","DGPFALH",136,0) . I DGEDT>0 D "RTN","DGPFALH",137,0) . . S DGHIEN=$O(^DGPF(26.12,"C",DGPFIEN,DGEDT,0)) "RTN","DGPFALH",138,0) . . I DGHIEN>0,$$GETHIST^DGPFALH(DGHIEN,.DGPFLH) D "RTN","DGPFALH",139,0) . . . S DGADT=$G(DGPFLH("ENTERDT")) "RTN","DGPFALH",140,0) Q DGADT "RTN","DGPFALH",141,0) ; "RTN","DGPFALH",142,0) ; "RTN","DGPFALH",143,0) STOHIST(DGPFLH,DGPFERR) ;file a PRF LOCAL FLAG HISTORY (#26.12) file record "RTN","DGPFALH",144,0) ; "RTN","DGPFALH",145,0) ; Input: "RTN","DGPFALH",146,0) ; DGPFLH - (required) Array of values to be filed (see GETHIST tag "RTN","DGPFALH",147,0) ; above for valid array structure) "RTN","DGPFALH",148,0) ; DGPFERR - (optional) Passed by reference to contain error msg's "RTN","DGPFALH",149,0) ; "RTN","DGPFALH",150,0) ; Output: "RTN","DGPFALH",151,0) ; Function Value - Returns IEN of record on success "RTN","DGPFALH",152,0) ; - 0 on failure "RTN","DGPFALH",153,0) ; DGPFERR - Undefined on success, error message on failure "RTN","DGPFALH",154,0) ; "RTN","DGPFALH",155,0) N DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR "RTN","DGPFALH",156,0) ; "RTN","DGPFALH",157,0) F DGSUB="FLAG","ENTERDT","ENTERBY" D "RTN","DGPFALH",158,0) . S DGFLD(DGSUB)=$P($G(DGPFLH(DGSUB)),U) "RTN","DGPFALH",159,0) I $D(DGPFLH("REASON")) M DGFLD("REASON")=DGPFLH("REASON") "RTN","DGPFALH",160,0) I $$VALID^DGPFUT("DGPFALH",26.12,.DGFLD,.DGPFERR) D "RTN","DGPFALH",161,0) . S DGIENS="+1," "RTN","DGPFALH",162,0) . S DGFDA(26.12,DGIENS,.01)=DGFLD("FLAG") "RTN","DGPFALH",163,0) . S DGFDA(26.12,DGIENS,.02)=DGFLD("ENTERDT") "RTN","DGPFALH",164,0) . S DGFDA(26.12,DGIENS,.03)=DGFLD("ENTERBY") "RTN","DGPFALH",165,0) . S DGFDA(26.12,DGIENS,.04)="DGFLD(""REASON"")" "RTN","DGPFALH",166,0) . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFALH",167,0) . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1)) "RTN","DGPFALH",168,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFALH",169,0) ; "RTN","DGPFALH",170,0) ; "RTN","DGPFALH",171,0) ; PRF LOCAL FLAG field VALIDATION DATA "RTN","DGPFALH",172,0) XREF ;;array node name;field#;required param;word processing?;description "RTN","DGPFALH",173,0) ;;FLAG;.01;1;0;flag name "RTN","DGPFALH",174,0) ;;ENTERDT;.02;1;0;pointer to NEW PERSON (#200) file "RTN","DGPFALH",175,0) ;;ENTERBY;.03;1;0;pointer to NEW PERSON (#200) file "RTN","DGPFALH",176,0) ;;REASON;.04;1;1;Reason of Flag enter/edit "RTN","DGPFANF") 0^31^B6427977 "RTN","DGPFANF",1,0) DGPFANF ;ALB/KCL - PRF NATIONAL FLAG API'S ; 4/24/03 4:25pm "RTN","DGPFANF",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFANF",3,0) ; "RTN","DGPFANF",4,0) ;- no direct entry "RTN","DGPFANF",5,0) QUIT "RTN","DGPFANF",6,0) ; "RTN","DGPFANF",7,0) GETNF(DGPFIEN,DGPFNF) ;retrieve a single NATIONAL FLAG record "RTN","DGPFANF",8,0) ;This function returns a single flag record from the PRF NATIONAL FLAG "RTN","DGPFANF",9,0) ;file and returns it in an array format. "RTN","DGPFANF",10,0) ; "RTN","DGPFANF",11,0) ; Input: "RTN","DGPFANF",12,0) ; DGPFIEN - (required) pointer to national flag record in the "RTN","DGPFANF",13,0) ; PRF NATIONAL FLAG (#26.15) file "RTN","DGPFANF",14,0) ; DGPFNF - (required) result array passed by reference "RTN","DGPFANF",15,0) ; "RTN","DGPFANF",16,0) ; Output: "RTN","DGPFANF",17,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFANF",18,0) ; DGPFNF - output array containing national flag record field "RTN","DGPFANF",19,0) ; values. "RTN","DGPFANF",20,0) ; Subscript Field# Data "RTN","DGPFANF",21,0) ; -------------- ------- --------------------- "RTN","DGPFANF",22,0) ; "FLAG" .01 internal^external "RTN","DGPFANF",23,0) ; "STAT" .02 internal^external "RTN","DGPFANF",24,0) ; "TYPE" .03 internal^external "RTN","DGPFANF",25,0) ; "REVFREQ" .04 internal^external "RTN","DGPFANF",26,0) ; "NOTIDAYS" .05 internal^external "RTN","DGPFANF",27,0) ; "REVGRP" .06 internal^external "RTN","DGPFANF",28,0) ; "DESC",line#,0 1 character string "RTN","DGPFANF",29,0) ; "PRININV",line#,0 2 character string "RTN","DGPFANF",30,0) ; "RTN","DGPFANF",31,0) N DGIENS ;IEN string for DIQ "RTN","DGPFANF",32,0) N DGFLDS ;results array for DIQ "RTN","DGPFANF",33,0) N DGERR ;error arrary for DIQ "RTN","DGPFANF",34,0) N DGSUB ;pincipal investigator multiple subscript "RTN","DGPFANF",35,0) N RESULT ;return function value "RTN","DGPFANF",36,0) ; "RTN","DGPFANF",37,0) S RESULT=0 "RTN","DGPFANF",38,0) ; "RTN","DGPFANF",39,0) I $G(DGPFIEN)>0,$D(^DGPF(26.15,DGPFIEN)) D "RTN","DGPFANF",40,0) . S DGIENS=DGPFIEN_"," "RTN","DGPFANF",41,0) . D GETS^DIQ(26.15,DGIENS,"**","IEZ","DGFLDS","DGERR") "RTN","DGPFANF",42,0) . Q:$D(DGERR) "RTN","DGPFANF",43,0) . ; "RTN","DGPFANF",44,0) . ;-- build national flag array "RTN","DGPFANF",45,0) . S DGPFNF("FLAG")=$G(DGFLDS(26.15,DGIENS,.01,"I"))_U_$G(DGFLDS(26.15,DGIENS,.01,"E")) "RTN","DGPFANF",46,0) . S DGPFNF("STAT")=$G(DGFLDS(26.15,DGIENS,.02,"I"))_U_$G(DGFLDS(26.15,DGIENS,.02,"E")) "RTN","DGPFANF",47,0) . S DGPFNF("TYPE")=$G(DGFLDS(26.15,DGIENS,.03,"I"))_U_$G(DGFLDS(26.15,DGIENS,.03,"E")) "RTN","DGPFANF",48,0) . S DGPFNF("REVFREQ")=$G(DGFLDS(26.15,DGIENS,.04,"I"))_U_$G(DGFLDS(26.15,DGIENS,.04,"E")) "RTN","DGPFANF",49,0) . S DGPFNF("NOTIDAYS")=$G(DGFLDS(26.15,DGIENS,.05,"I"))_U_$G(DGFLDS(26.15,DGIENS,.05,"E")) "RTN","DGPFANF",50,0) . S DGPFNF("REVGRP")=$G(DGFLDS(26.15,DGIENS,.06,"I"))_U_$G(DGFLDS(26.15,DGIENS,.06,"E")) "RTN","DGPFANF",51,0) . ;-- flag description word processing array "RTN","DGPFANF",52,0) . M DGPFNF("DESC")=DGFLDS(26.15,DGIENS,1) "RTN","DGPFANF",53,0) . K DGPFNF("DESC","E"),DGPFNF("DESC","I") "RTN","DGPFANF",54,0) . ;-- principal investigator(s) multiple "RTN","DGPFANF",55,0) . S DGSUB="" F S DGSUB=$O(DGFLDS(26.152,DGSUB)) Q:DGSUB="" D "RTN","DGPFANF",56,0) . . S DGPFNF("PRININV",+DGSUB,0)=$G(DGFLDS(26.152,DGSUB,.01,"I"))_U_$G(DGFLDS(26.152,DGSUB,.01,"E")) "RTN","DGPFANF",57,0) . ; "RTN","DGPFANF",58,0) . S RESULT=1 "RTN","DGPFANF",59,0) ; "RTN","DGPFANF",60,0) Q RESULT "RTN","DGPFAPI") 0^27^B34047337 "RTN","DGPFAPI",1,0) DGPFAPI ;ALB/RBS - PRF EXTERNAL USER INTERFACE API'S ; 9/2/03 10:30am "RTN","DGPFAPI",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFAPI",3,0) ; "RTN","DGPFAPI",4,0) ; This routine contains API entry points that are used by packages "RTN","DGPFAPI",5,0) ; and modules that are external to the Patient Record Flags module. "RTN","DGPFAPI",6,0) ; "RTN","DGPFAPI",7,0) Q ;no direct entry "RTN","DGPFAPI",8,0) ; "RTN","DGPFAPI",9,0) GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments "RTN","DGPFAPI",10,0) ; The purpose of this API is to facilitate the retrieval of specific "RTN","DGPFAPI",11,0) ; data that can be used for the displaying of or the reporting of "RTN","DGPFAPI",12,0) ; only ACTIVE Patient Record Flag (PRF) Assignment information for "RTN","DGPFAPI",13,0) ; a patient. "RTN","DGPFAPI",14,0) ; "RTN","DGPFAPI",15,0) ; Usage of this API, DBIA #3860, is by Controlled Subscription. "RTN","DGPFAPI",16,0) ; "RTN","DGPFAPI",17,0) ; Input: "RTN","DGPFAPI",18,0) ; DGDFN - IEN of patient in the PATIENT (#2) file "RTN","DGPFAPI",19,0) ; DGPRF - Closed Root array of return values "RTN","DGPFAPI",20,0) ; [Optional-default DGPFAPI] "RTN","DGPFAPI",21,0) ; "RTN","DGPFAPI",22,0) ; Output: "RTN","DGPFAPI",23,0) ; Function result - "0" = No Active record flags for the patient "RTN","DGPFAPI",24,0) ; - "nn" = Total number of flags returned in array "RTN","DGPFAPI",25,0) ; DGPRF() - Array, passed by closed root reference "RTN","DGPFAPI",26,0) ; - Multiple subscripted array of Active flag information "RTN","DGPFAPI",27,0) ; If the function call is successful, this array will "RTN","DGPFAPI",28,0) ; contain each of the Active flag records. "RTN","DGPFAPI",29,0) ; - Subscript field value = internal value^external value "RTN","DGPFAPI",30,0) ; 2 piece string caret(^) delimited "RTN","DGPFAPI",31,0) ; DGPFAPI() - Default array name if no name passed "RTN","DGPFAPI",32,0) ; "RTN","DGPFAPI",33,0) ; Subscript Field Name Field #/File # "RTN","DGPFAPI",34,0) ; --------- ---------- -------------- "RTN","DGPFAPI",35,0) ; "APPRVBY" Approved By (.05)/(#26.14) "RTN","DGPFAPI",36,0) ; The field value contains the pointer to the NEW PERSON "RTN","DGPFAPI",37,0) ; FILE (#200) of the person approving the assignment of a "RTN","DGPFAPI",38,0) ; patient record flag to a patient. "RTN","DGPFAPI",39,0) ; The field values will be one of the following two explanations: "RTN","DGPFAPI",40,0) ; 1. If calling site IS the Originating Site... "RTN","DGPFAPI",41,0) ; PIECE 1 = IEN pointer to NEW PERSON FILE (#200) "RTN","DGPFAPI",42,0) ; PIECE 2 = Name of Person "RTN","DGPFAPI",43,0) ; 2. If calling site is NOT the Originating Site... "RTN","DGPFAPI",44,0) ; PIECE 1 = .5 "RTN","DGPFAPI",45,0) ; PIECE 2 = "CHIEF OF STAFF" "RTN","DGPFAPI",46,0) ; (Note: The .5 (POSTMASTER) internal field value triggers an "RTN","DGPFAPI",47,0) ; output transform that converts the external value "RTN","DGPFAPI",48,0) ; of "POSTMASTER" to "CHIEF OF STAFF". "RTN","DGPFAPI",49,0) ; "ASSIGNDT" Assign Date/Time (.02)/(#26.14) "RTN","DGPFAPI",50,0) ; The field value contains a FileMan internal^external Date and "RTN","DGPFAPI",51,0) ; Time of the initial assignment of the Patient Record Flag. "RTN","DGPFAPI",52,0) ; "RTN","DGPFAPI",53,0) ; "REVIEWDT" Review Date (.06)/(#26.13) "RTN","DGPFAPI",54,0) ; The field value contains a FileMan internal^external date that "RTN","DGPFAPI",55,0) ; the flag assignment is due for review to determine continuing "RTN","DGPFAPI",56,0) ; appropriateness. "RTN","DGPFAPI",57,0) ; "RTN","DGPFAPI",58,0) ; "FLAG" Flag Name (.02)/(#26.13) "RTN","DGPFAPI",59,0) ; The field value contains the Patient Record Flag name that is "RTN","DGPFAPI",60,0) ; assigned to the patient as a variable pointer. "RTN","DGPFAPI",61,0) ; PIECE 1 = IEN variable pointer to (#26.11) or (#26.15) file "RTN","DGPFAPI",62,0) ; PIECE 2 = Name of Flag "RTN","DGPFAPI",63,0) ; "RTN","DGPFAPI",64,0) ; "FLAGTYPE" Type of Flag (.03)/(#26.11 or #26.15) "RTN","DGPFAPI",65,0) ; The field value contains the Record Flag Type usage "RTN","DGPFAPI",66,0) ; classification. (i.e. BEHAVIORAL,RESEARCH,CLINICAL,OTHER) "RTN","DGPFAPI",67,0) ; PIECE 1 = IEN of the flag Type (pointer to (#26.16) file) "RTN","DGPFAPI",68,0) ; PIECE 2 = Name of flag Type "RTN","DGPFAPI",69,0) ; "RTN","DGPFAPI",70,0) ; "CATEGORY" National or Local Flag (#26.15) or (#26.11) "RTN","DGPFAPI",71,0) ; The field value contains the type of category the flag "RTN","DGPFAPI",72,0) ; represents. "RTN","DGPFAPI",73,0) ; I (NATIONAL) = (#26.15) PRF NATIONAL "RTN","DGPFAPI",74,0) ; II (LOCAL) = (#26.11) PRF LOCAL "RTN","DGPFAPI",75,0) ; PIECE 1 = I (NATIONAL) or II (LOCAL) "RTN","DGPFAPI",76,0) ; PIECE 2 = (same value as PIECE 1) "RTN","DGPFAPI",77,0) ; "RTN","DGPFAPI",78,0) ; "OWNER" Owner Site (.04)/(#26.13) "RTN","DGPFAPI",79,0) ; The field value contains the Site that owns the patient's "RTN","DGPFAPI",80,0) ; Record Flag Assignment. Only the Owner Site may edit a patients "RTN","DGPFAPI",81,0) ; flag assignment. "RTN","DGPFAPI",82,0) ; PIECE 1 = IEN of the site (pointer to INSTITUTION FILE (#4)) "RTN","DGPFAPI",83,0) ; PIECE 2 = Name of Institution "RTN","DGPFAPI",84,0) ; "RTN","DGPFAPI",85,0) ; "ORIGSITE" Originating Site (.05)/(#26.13) "RTN","DGPFAPI",86,0) ; The field value contains the Site that first entered the Patient "RTN","DGPFAPI",87,0) ; Record Flag on this patient. "RTN","DGPFAPI",88,0) ; PIECE 1 = IEN of the site (pointer to INSTITUTION FILE (#4)) "RTN","DGPFAPI",89,0) ; PIECE 2 = Name of Institution "RTN","DGPFAPI",90,0) ; "RTN","DGPFAPI",91,0) ; "NARR" Assignment Narrative (1)/(#26.13) "RTN","DGPFAPI",92,0) ; (word-processing, multiple nodes) "RTN","DGPFAPI",93,0) ; The field value contains the reason narrative for this patients "RTN","DGPFAPI",94,0) ; assignment of a Patient Record Flag. "RTN","DGPFAPI",95,0) ; The format is in a word-processing value that may contain "RTN","DGPFAPI",96,0) ; multiple nodes of text. Each node of text will be less "RTN","DGPFAPI",97,0) ; than 80 characters in length. "RTN","DGPFAPI",98,0) ; The format is as follows: "RTN","DGPFAPI",99,0) ; TARGET_ROOT(nn,"NARR",line#,0)=text "RTN","DGPFAPI",100,0) ; where: "RTN","DGPFAPI",101,0) ; nn = a unique number for each Flag "RTN","DGPFAPI",102,0) ; line# = a unique number starting at 1 for each wp line "RTN","DGPFAPI",103,0) ; of narrative text "RTN","DGPFAPI",104,0) ; 0 = standard subscript format for the nodes of a "RTN","DGPFAPI",105,0) ; FileMan Word Processing field "RTN","DGPFAPI",106,0) ; "RTN","DGPFAPI",107,0) N DGPFTCNT ;return results, "0"=no flags, "nn"=number of flags "RTN","DGPFAPI",108,0) N DGPFIENS ;array of all active flag assignment IEN's "RTN","DGPFAPI",109,0) N DGPFIEN ;ien of record flag assignment in (#26.13) file "RTN","DGPFAPI",110,0) N DGPFA ;flag assignment array "RTN","DGPFAPI",111,0) N DGPFAH ;flag assignment history array "RTN","DGPFAPI",112,0) N DGPFLAG ;flag record array "RTN","DGPFAPI",113,0) N DGCAT ;flag category "RTN","DGPFAPI",114,0) ; "RTN","DGPFAPI",115,0) Q:'$G(DGDFN) 0 ;Quit, null parameter "RTN","DGPFAPI",116,0) Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0 ;Quit, no Active assign's "RTN","DGPFAPI",117,0) ; "RTN","DGPFAPI",118,0) S DGPRF=$G(DGPRF) "RTN","DGPFAPI",119,0) I DGPRF']"" S DGPRF="DGPFAPI" ;setup default array name "RTN","DGPFAPI",120,0) S (DGPFIEN,DGCAT)="",DGPFTCNT=0 "RTN","DGPFAPI",121,0) ; "RTN","DGPFAPI",122,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFAPI",123,0) F S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN="" D "RTN","DGPFAPI",124,0) . K DGPFA,DGPFAH,DGPFLAG "RTN","DGPFAPI",125,0) . ; "RTN","DGPFAPI",126,0) . ; retrieve single assignment record fields "RTN","DGPFAPI",127,0) . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA) "RTN","DGPFAPI",128,0) . ; "RTN","DGPFAPI",129,0) . ; no patient DFN match "RTN","DGPFAPI",130,0) . I DGDFN'=$P(DGPFA("DFN"),U) Q "RTN","DGPFAPI",131,0) . ; "RTN","DGPFAPI",132,0) . ; get initial assignment history "RTN","DGPFAPI",133,0) . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH) "RTN","DGPFAPI",134,0) . ; "RTN","DGPFAPI",135,0) . ; get record flag record "RTN","DGPFAPI",136,0) . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG) "RTN","DGPFAPI",137,0) . ; "RTN","DGPFAPI",138,0) . S DGPFTCNT=DGPFTCNT+1 "RTN","DGPFAPI",139,0) . ; "RTN","DGPFAPI",140,0) . ; approved by user "RTN","DGPFAPI",141,0) . S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFAH("APPRVBY")) "RTN","DGPFAPI",142,0) . ; "RTN","DGPFAPI",143,0) . ; initial assignment date/time "RTN","DGPFAPI",144,0) . S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFAPI",145,0) . ; "RTN","DGPFAPI",146,0) . ; next review due date "RTN","DGPFAPI",147,0) . S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT")) "RTN","DGPFAPI",148,0) . ; "RTN","DGPFAPI",149,0) . ; record flag name "RTN","DGPFAPI",150,0) . S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG")) "RTN","DGPFAPI",151,0) . ; "RTN","DGPFAPI",152,0) . ; record flag type "RTN","DGPFAPI",153,0) . S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE")) "RTN","DGPFAPI",154,0) . ; "RTN","DGPFAPI",155,0) . ; category of flag - I (NATIONAL) or II (LOCAL) "RTN","DGPFAPI",156,0) . S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)") "RTN","DGPFAPI",157,0) . S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT "RTN","DGPFAPI",158,0) . ; "RTN","DGPFAPI",159,0) . ; owner site "RTN","DGPFAPI",160,0) . S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER")) "RTN","DGPFAPI",161,0) . ; "RTN","DGPFAPI",162,0) . ; originating site "RTN","DGPFAPI",163,0) . S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE")) "RTN","DGPFAPI",164,0) . ; "RTN","DGPFAPI",165,0) . ; narrative "RTN","DGPFAPI",166,0) . I '$D(DGPFA("NARR",1,0)) D Q ;should never happen - but - "RTN","DGPFAPI",167,0) . . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text" "RTN","DGPFAPI",168,0) . ; "RTN","DGPFAPI",169,0) . M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR") "RTN","DGPFAPI",170,0) ; "RTN","DGPFAPI",171,0) ; Re-Sort Active flags by category & alpha flag name "RTN","DGPFAPI",172,0) I +$G(DGPFTCNT)>1 D SORT^DGPFUT2(.@DGPRF) "RTN","DGPFAPI",173,0) ; "RTN","DGPFAPI",174,0) Q DGPFTCNT "RTN","DGPFAPI",175,0) ; "RTN","DGPFAPI",176,0) PRFQRY(DGDFN) ;query the CMOR for all patient record flag assignments "RTN","DGPFAPI",177,0) ; This function queries a given patient's Coordinated Master of Record "RTN","DGPFAPI",178,0) ; (CMOR) site to retrieve all patient record flag assignments for the "RTN","DGPFAPI",179,0) ; patient. The function will only succeed when the QRY HL7 interface "RTN","DGPFAPI",180,0) ; is enabled, the patient has a national Integrated Control Number "RTN","DGPFAPI",181,0) ; (ICN), the patient's CMOR is not the local site and the HL7 query "RTN","DGPFAPI",182,0) ; receives an ACK from the CMOR site. "RTN","DGPFAPI",183,0) ; "RTN","DGPFAPI",184,0) ; Input: "RTN","DGPFAPI",185,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",186,0) ; "RTN","DGPFAPI",187,0) ; Output: "RTN","DGPFAPI",188,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFAPI",189,0) ; "RTN","DGPFAPI",190,0) N DGRSLT "RTN","DGPFAPI",191,0) N DGQRY "RTN","DGPFAPI",192,0) ; "RTN","DGPFAPI",193,0) S DGRSLT=0 "RTN","DGPFAPI",194,0) ; "RTN","DGPFAPI",195,0) S DGQRY=+$$QRYON^DGPFPARM() "RTN","DGPFAPI",196,0) I DGQRY D "RTN","DGPFAPI",197,0) . S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,DGQRY) "RTN","DGPFAPI",198,0) ; "RTN","DGPFAPI",199,0) Q DGRSLT "RTN","DGPFAPI",200,0) ; "RTN","DGPFAPI",201,0) DISPPRF(DGDFN) ;display active patient record flag assignments "RTN","DGPFAPI",202,0) ; This procedure performs a lookup for active patient record flag "RTN","DGPFAPI",203,0) ; assignments for a given patient and formats the assignment data for "RTN","DGPFAPI",204,0) ; roll-and-scroll display. "RTN","DGPFAPI",205,0) ; "RTN","DGPFAPI",206,0) ; Input: "RTN","DGPFAPI",207,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",208,0) ; "RTN","DGPFAPI",209,0) ; Output: "RTN","DGPFAPI",210,0) ; none "RTN","DGPFAPI",211,0) ; "RTN","DGPFAPI",212,0) Q:'$D(XQY0) "RTN","DGPFAPI",213,0) Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT" "RTN","DGPFAPI",214,0) ; "RTN","DGPFAPI",215,0) ;protect Kernel IO variables "RTN","DGPFAPI",216,0) N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON "RTN","DGPFAPI",217,0) N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON "RTN","DGPFAPI",218,0) ; "RTN","DGPFAPI",219,0) ;protect ListMan variables "RTN","DGPFAPI",220,0) N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON "RTN","DGPFAPI",221,0) N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST "RTN","DGPFAPI",222,0) N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD "RTN","DGPFAPI",223,0) ; "RTN","DGPFAPI",224,0) ;protect Unwinder variables "RTN","DGPFAPI",225,0) N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX "RTN","DGPFAPI",226,0) N XQORM "RTN","DGPFAPI",227,0) ; "RTN","DGPFAPI",228,0) ; protect original Listman VALM DATA global "RTN","DGPFAPI",229,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",230,0) M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J) "RTN","DGPFAPI",231,0) ; "RTN","DGPFAPI",232,0) D DISPPRF^DGPFUT1(DGDFN) "RTN","DGPFAPI",233,0) ; "RTN","DGPFAPI",234,0) ; restore original Listman VALM DATA global "RTN","DGPFAPI",235,0) M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",236,0) ; "RTN","DGPFAPI",237,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",238,0) Q "RTN","DGPFBGR") 0^43^B44753141 "RTN","DGPFBGR",1,0) DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 4/28/03 3:24pm "RTN","DGPFBGR",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFBGR",3,0) ; "RTN","DGPFBGR",4,0) Q ;no direct entry "RTN","DGPFBGR",5,0) ; "RTN","DGPFBGR",6,0) EN ;entry point for PRF background processing "RTN","DGPFBGR",7,0) ; "RTN","DGPFBGR",8,0) Q:'$$ON^DGPFPARM() ;software must be active "RTN","DGPFBGR",9,0) ; "RTN","DGPFBGR",10,0) D NOTIFY($$NOW^XLFDT()) ;send review notification "RTN","DGPFBGR",11,0) D REXMIT^DGPFHLRT ;retransmit rejected HL7 update messages "RTN","DGPFBGR",12,0) Q "RTN","DGPFBGR",13,0) ; "RTN","DGPFBGR",14,0) NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag "RTN","DGPFBGR",15,0) ;Assignment reviews. "RTN","DGPFBGR",16,0) ; "RTN","DGPFBGR",17,0) ; Input: "RTN","DGPFBGR",18,0) ; DGDATE - (optional) notification date requested in FM format, "RTN","DGPFBGR",19,0) ; defaults to now ($$NOW^XLFDT()) "RTN","DGPFBGR",20,0) ; "RTN","DGPFBGR",21,0) ; Output: "RTN","DGPFBGR",22,0) ; none "RTN","DGPFBGR",23,0) ; "RTN","DGPFBGR",24,0) N DGAIEN ;pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFBGR",25,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFBGR",26,0) N DGDEM ;patient demographics array "RTN","DGPFBGR",27,0) N DGDOB ;patient date of birth "RTN","DGPFBGR",28,0) N DGFLG ;flag data array "RTN","DGPFBGR",29,0) N DGLIST ;closed root array list of patient IENs in a mail group "RTN","DGPFBGR",30,0) N DGMSGTXT ;closed root of mail message text "RTN","DGPFBGR",31,0) N DGNAME ;patient name "RTN","DGPFBGR",32,0) N DGNDT ;notification date "RTN","DGPFBGR",33,0) N DGPFA ;assignment data array "RTN","DGPFBGR",34,0) N DGMGROUP ;review mail group "RTN","DGPFBGR",35,0) N DGSSN ;patient social security number "RTN","DGPFBGR",36,0) ; "RTN","DGPFBGR",37,0) S DGLIST=$NA(^TMP("DGPFREV",$J)) "RTN","DGPFBGR",38,0) K @DGLIST "RTN","DGPFBGR",39,0) ; "RTN","DGPFBGR",40,0) S DGMSGTXT=$NA(^TMP("DGPFMSG",$J)) "RTN","DGPFBGR",41,0) K @DGMSGTXT "RTN","DGPFBGR",42,0) ; "RTN","DGPFBGR",43,0) I '+$G(DGDATE) S DGDATE=$$NOW^XLFDT() "RTN","DGPFBGR",44,0) ; "RTN","DGPFBGR",45,0) S DGNDT=0 "RTN","DGPFBGR",46,0) F S DGNDT=$O(^DGPF(26.13,"ANDAT",DGNDT)) Q:('DGNDT!(DGNDT>DGDATE)) D "RTN","DGPFBGR",47,0) . S DGAIEN=0 "RTN","DGPFBGR",48,0) . F S DGAIEN=$O(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)) Q:'DGAIEN D "RTN","DGPFBGR",49,0) . . N DGPFA,DGDEM,DGFLG "RTN","DGPFBGR",50,0) . . ; "RTN","DGPFBGR",51,0) . . ;get assignment record "RTN","DGPFBGR",52,0) . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFBGR",53,0) . . ; "RTN","DGPFBGR",54,0) . . ;retrieve pointer to patient record in PATIENT (#2) file "RTN","DGPFBGR",55,0) . . S DGDFN=$P($G(DGPFA("DFN")),U,1) "RTN","DGPFBGR",56,0) . . Q:'DGDFN "RTN","DGPFBGR",57,0) . . ; "RTN","DGPFBGR",58,0) . . ;retrieve patient demographics "RTN","DGPFBGR",59,0) . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM) "RTN","DGPFBGR",60,0) . . S DGNAME=$G(DGDEM("NAME")) "RTN","DGPFBGR",61,0) . . S DGSSN=$G(DGDEM("SSN")) "RTN","DGPFBGR",62,0) . . S DGDOB=$G(DGDEM("DOB")) "RTN","DGPFBGR",63,0) . . ; "RTN","DGPFBGR",64,0) . . ;retrieve review date "RTN","DGPFBGR",65,0) . . S DGREVDT=$P($G(DGPFA("REVIEWDT")),U,1) "RTN","DGPFBGR",66,0) . . Q:'DGREVDT "RTN","DGPFBGR",67,0) . . ; "RTN","DGPFBGR",68,0) . . ;get flag review criteria, notice days and review mail group "RTN","DGPFBGR",69,0) . . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U,1),.DGFLG) "RTN","DGPFBGR",70,0) . . ; "RTN","DGPFBGR",71,0) . . ;retrieve review mail group "RTN","DGPFBGR",72,0) . . S DGMGROUP=$P($G(DGFLG("REVGRP")),U,2) "RTN","DGPFBGR",73,0) . . Q:(DGMGROUP']"") "RTN","DGPFBGR",74,0) . . ; "RTN","DGPFBGR",75,0) . . ;build list "RTN","DGPFBGR",76,0) . . S @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$P(DGPFA("FLAG"),U,2)_U_DGREVDT "RTN","DGPFBGR",77,0) . . ; "RTN","DGPFBGR",78,0) . . ;remove notification index entry "RTN","DGPFBGR",79,0) . . K ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN) "RTN","DGPFBGR",80,0) ; "RTN","DGPFBGR",81,0) ;build and send the message for each mail group "RTN","DGPFBGR",82,0) S DGMGROUP="" "RTN","DGPFBGR",83,0) F S DGMGROUP=$O(@DGLIST@(DGMGROUP)) Q:(DGMGROUP="") D "RTN","DGPFBGR",84,0) . I $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT) D SEND(DGMGROUP,DGMSGTXT) "RTN","DGPFBGR",85,0) . K @DGMSGTXT "RTN","DGPFBGR",86,0) ; "RTN","DGPFBGR",87,0) ;cleanup "RTN","DGPFBGR",88,0) K @DGLIST "RTN","DGPFBGR",89,0) ; "RTN","DGPFBGR",90,0) Q "RTN","DGPFBGR",91,0) ; "RTN","DGPFBGR",92,0) BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;buld MailMan message array "RTN","DGPFBGR",93,0) ; "RTN","DGPFBGR",94,0) ; Input: "RTN","DGPFBGR",95,0) ; DGMGROUP - mail group name "RTN","DGPFBGR",96,0) ; DGLIST - closed root array of assignment IENs by mail group "RTN","DGPFBGR",97,0) ; "RTN","DGPFBGR",98,0) ; Output: "RTN","DGPFBGR",99,0) ; DGXMTXT - array of MailMan text lines "RTN","DGPFBGR",100,0) ; "RTN","DGPFBGR",101,0) N DGDOB ;formatted date of birth "RTN","DGPFBGR",102,0) N DGFLAG ;formatted flag name "RTN","DGPFBGR",103,0) N DGLIN ;line counter "RTN","DGPFBGR",104,0) N DGNAME ;formatted patient name "RTN","DGPFBGR",105,0) N DGMAX ;maximum line length "RTN","DGPFBGR",106,0) N DGREC ;contents of a single node of the DGLIST array "RTN","DGPFBGR",107,0) N DGREVDT ;review date "RTN","DGPFBGR",108,0) N DGSITE ;results of VASITE call "RTN","DGPFBGR",109,0) N DGSSN ;formatted social security number "RTN","DGPFBGR",110,0) ; "RTN","DGPFBGR",111,0) S DGLIN=0 "RTN","DGPFBGR",112,0) S DGMAX=78 "RTN","DGPFBGR",113,0) S DGSITE=$$SITE^VASITE() "RTN","DGPFBGR",114,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",115,0) D ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",116,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",117,0) D ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",118,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",119,0) D ADDLINE($$LJ^XLFSTR("Patient Name",22," ")_$$LJ^XLFSTR("SSN",11," ")_$$LJ^XLFSTR("DOB",10," ")_$$LJ^XLFSTR("Flag Name",22," ")_"Review Date",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",120,0) D ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",121,0) ; "RTN","DGPFBGR",122,0) S DGAIEN=0,DGCNT=0 "RTN","DGPFBGR",123,0) F S DGAIEN=$O(@DGLIST@(DGMGROUP,DGAIEN)) Q:'DGAIEN D "RTN","DGPFBGR",124,0) . ;record description: patient_name^SSN^DOB^flag_name^review_date "RTN","DGPFBGR",125,0) . S DGREC=@DGLIST@(DGMGROUP,DGAIEN) "RTN","DGPFBGR",126,0) . ; "RTN","DGPFBGR",127,0) . ;format the fields "RTN","DGPFBGR",128,0) . S DGNAME=$$LJ^XLFSTR($E($P(DGREC,U,1),1,20),22," ") "RTN","DGPFBGR",129,0) . S DGSSN=$$LJ^XLFSTR($P(DGREC,U,2),11," ") "RTN","DGPFBGR",130,0) . S DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($P(DGREC,U,3),"5D"),10," ") "RTN","DGPFBGR",131,0) . S DGFLAG=$$LJ^XLFSTR($E($P(DGREC,U,4),1,20),22," ") "RTN","DGPFBGR",132,0) . S DGREVDT=$$FMTE^XLFDT($P(DGREC,U,5),"5D") "RTN","DGPFBGR",133,0) . ; "RTN","DGPFBGR",134,0) . ;add the line "RTN","DGPFBGR",135,0) . D ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",136,0) . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",137,0) . ; "RTN","DGPFBGR",138,0) . ;success "RTN","DGPFBGR",139,0) . S DGCNT=DGCNT+1 "RTN","DGPFBGR",140,0) ; "RTN","DGPFBGR",141,0) Q DGCNT "RTN","DGPFBGR",142,0) ; "RTN","DGPFBGR",143,0) ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array "RTN","DGPFBGR",144,0) ; "RTN","DGPFBGR",145,0) ; Input: "RTN","DGPFBGR",146,0) ; DGTEXT - text string "RTN","DGPFBGR",147,0) ; DGINDENT - number of spaces to insert at start of line "RTN","DGPFBGR",148,0) ; DGMAXLEN - maximum desired line length (default: 60) "RTN","DGPFBGR",149,0) ; DGCNT - line number passed by reference "RTN","DGPFBGR",150,0) ; "RTN","DGPFBGR",151,0) ; Output: "RTN","DGPFBGR",152,0) ; DGXMTXT - array of text strings "RTN","DGPFBGR",153,0) ; "RTN","DGPFBGR",154,0) N DGAVAIL ;available space for text "RTN","DGPFBGR",155,0) N DGLINE ;truncated text "RTN","DGPFBGR",156,0) N DGLOC ;location of space character "RTN","DGPFBGR",157,0) N DGPAD ;space indent "RTN","DGPFBGR",158,0) ; "RTN","DGPFBGR",159,0) S DGTEXT=$G(DGTEXT) "RTN","DGPFBGR",160,0) S DGINDENT=+$G(DGINDENT) "RTN","DGPFBGR",161,0) S DGMAXLEN=+$G(DGMAXLEN) "RTN","DGPFBGR",162,0) S:'DGMAXLEN DGMAXLEN=60 "RTN","DGPFBGR",163,0) I DGINDENT>(DGMAXLEN-1) S DGINDENT=0 "RTN","DGPFBGR",164,0) S DGCNT=$G(DGCNT,0) ;default to 0 "RTN","DGPFBGR",165,0) ; "RTN","DGPFBGR",166,0) S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT) "RTN","DGPFBGR",167,0) ; "RTN","DGPFBGR",168,0) ;determine availaible space for text "RTN","DGPFBGR",169,0) S DGAVAIL=(DGMAXLEN-DGINDENT) "RTN","DGPFBGR",170,0) F D Q:('$L(DGTEXT)) "RTN","DGPFBGR",171,0) . ; "RTN","DGPFBGR",172,0) . ;find potential line break "RTN","DGPFBGR",173,0) . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ") "RTN","DGPFBGR",174,0) . ; "RTN","DGPFBGR",175,0) . ;break a line that is too long when it has potential line breaks "RTN","DGPFBGR",176,0) . I $L(DGTEXT)>DGAVAIL,DGLOC D "RTN","DGPFBGR",177,0) . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1)) "RTN","DGPFBGR",178,0) . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," ")) "RTN","DGPFBGR",179,0) . E D "RTN","DGPFBGR",180,0) . . S DGLINE=DGTEXT,DGTEXT="" "RTN","DGPFBGR",181,0) . ; "RTN","DGPFBGR",182,0) . S DGCNT=DGCNT+1 "RTN","DGPFBGR",183,0) . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE "RTN","DGPFBGR",184,0) Q "RTN","DGPFBGR",185,0) ; "RTN","DGPFBGR",186,0) SEND(DGGROUP,DGXMTXT) ;send the MailMan message "RTN","DGPFBGR",187,0) ; "RTN","DGPFBGR",188,0) ; Input: "RTN","DGPFBGR",189,0) ; DGGROUP - mail group name "RTN","DGPFBGR",190,0) ; DGXMTXT - name of message text array in closed format "RTN","DGPFBGR",191,0) ; "RTN","DGPFBGR",192,0) ; Output: "RTN","DGPFBGR",193,0) ; none "RTN","DGPFBGR",194,0) ; "RTN","DGPFBGR",195,0) N DIFROM ;protect FM package "RTN","DGPFBGR",196,0) N XMDUZ ;sender "RTN","DGPFBGR",197,0) N XMSUB ;message subject "RTN","DGPFBGR",198,0) N XMTEXT ;name of message text array in open format "RTN","DGPFBGR",199,0) N XMY ;recipient array "RTN","DGPFBGR",200,0) N XMZ ;returned message number "RTN","DGPFBGR",201,0) ; "RTN","DGPFBGR",202,0) S XMDUZ="Patient Record Flag Module" "RTN","DGPFBGR",203,0) S XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION" "RTN","DGPFBGR",204,0) S XMTEXT=$$OREF^DILF(DGXMTXT) "RTN","DGPFBGR",205,0) S XMY("G."_DGGROUP)="" "RTN","DGPFBGR",206,0) D ^XMD "RTN","DGPFBGR",207,0) Q "RTN","DGPFDD") 0^10^B5388550 "RTN","DGPFDD",1,0) DGPFDD ;ALB/RPM - PRF DATA DICTIONARY UTILITIES ; 02/04/03 "RTN","DGPFDD",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFDD",3,0) ; "RTN","DGPFDD",4,0) Q ;No direct entry "RTN","DGPFDD",5,0) ; "RTN","DGPFDD",6,0) INACT(DGIEN,DGSTAT,DGFILE,DGUSER) ;Inactivate flag trigger "RTN","DGPFDD",7,0) ; This procedure is used as a trigger that is fired when the "RTN","DGPFDD",8,0) ; STATUS (#.02) field of a record in either the PRF LOCAL FLAG (#26.11) "RTN","DGPFDD",9,0) ; file or PRF NATIONAL FLAG (#26.15) file is changed from Active to "RTN","DGPFDD",10,0) ; Inactive. The trigger will inactivate all Patient Record "RTN","DGPFDD",11,0) ; Flag assignments associated with the inactivated Flag. "RTN","DGPFDD",12,0) ; "RTN","DGPFDD",13,0) ; Input: "RTN","DGPFDD",14,0) ; DGIEN - IEN of entry in PRF LOCAL FLAG file or PRF NATIONAL "RTN","DGPFDD",15,0) ; FLAG file "RTN","DGPFDD",16,0) ; DGSTAT - Flag Status "RTN","DGPFDD",17,0) ; DGFILE - PRF LOCAL FLAG file number (26.11) or PRF NATIONAL "RTN","DGPFDD",18,0) ; FLAG file number (26.15) "RTN","DGPFDD",19,0) ; DGUSER - IEN of user in NEW PERSON file "RTN","DGPFDD",20,0) ; "RTN","DGPFDD",21,0) ; Output: none "RTN","DGPFDD",22,0) ; "RTN","DGPFDD",23,0) N DGAIEN ;assignment record IEN "RTN","DGPFDD",24,0) N DGSUB ;variable ptr index subscript "RTN","DGPFDD",25,0) ; "RTN","DGPFDD",26,0) Q:('$G(DGIEN)) "RTN","DGPFDD",27,0) Q:($G(DGSTAT)'=0) "RTN","DGPFDD",28,0) Q:(($G(DGFILE)'=26.11)&($G(DGFILE)'=26.15)) "RTN","DGPFDD",29,0) Q:('$G(DGUSER)) "RTN","DGPFDD",30,0) ; "RTN","DGPFDD",31,0) S DGSUB=DGIEN_";DGPF("_DGFILE_"," "RTN","DGPFDD",32,0) S DGAIEN=0 "RTN","DGPFDD",33,0) F S DGAIEN=$O(^DGPF(26.13,"ASTAT",1,DGSUB,DGAIEN)) Q:'DGAIEN D "RTN","DGPFDD",34,0) . N DGPFA ;assignment data array "RTN","DGPFDD",35,0) . N DGPFAH ;assignment history data array "RTN","DGPFDD",36,0) . I $$GETASGN^DGPFAA(DGAIEN,.DGPFA) D "RTN","DGPFDD",37,0) . . Q:($P($G(DGPFA("STATUS")),U,1)=0) "RTN","DGPFDD",38,0) . . S DGPFA("STATUS")=0 "RTN","DGPFDD",39,0) . . S DGPFA("REVIEWDT")="" "RTN","DGPFDD",40,0) . . S DGPFAH("ACTION")=3 "RTN","DGPFDD",41,0) . . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() "RTN","DGPFDD",42,0) . . S DGPFAH("ENTERBY")=DGUSER "RTN","DGPFDD",43,0) . . S DGPFAH("APPRVBY")=DGUSER "RTN","DGPFDD",44,0) . . S DGPFAH("COMMENT",1,0)="Assignment Inactivated automatically due to Flag Inactivation." "RTN","DGPFDD",45,0) . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH) "RTN","DGPFDD",46,0) Q "RTN","DGPFDD",47,0) ; "RTN","DGPFDD",48,0) PIHELP ;Executable help for PRINCIPAL INVESTIGATOR(S) (#.01) sub-field of "RTN","DGPFDD",49,0) ;PRINCIPLE INVESTIGATOR(S) (#2) multiple field of PRF LOCAL FLAG "RTN","DGPFDD",50,0) ;(#26.11) file. "RTN","DGPFDD",51,0) ; "RTN","DGPFDD",52,0) ;This sub-routine displays individuals selected as a principal "RTN","DGPFDD",53,0) ;investigator for a research type patient record flag. "RTN","DGPFDD",54,0) ; "RTN","DGPFDD",55,0) ; Input: "RTN","DGPFDD",56,0) ; DGLKUP - (required) array of principal investigators subscripted "RTN","DGPFDD",57,0) ; by the pointer to the NEW PERSON (#200) file and the "RTN","DGPFDD",58,0) ; pointer to the PRF LOCAL FLAG (#26.11) file. "RTN","DGPFDD",59,0) ; Example: DGLKUP(11744,6)="" "RTN","DGPFDD",60,0) ; "RTN","DGPFDD",61,0) ; Output: "RTN","DGPFDD",62,0) ; none "RTN","DGPFDD",63,0) ; "RTN","DGPFDD",64,0) Q:'$D(DGLKUP) "RTN","DGPFDD",65,0) ; "RTN","DGPFDD",66,0) N DGCNT "RTN","DGPFDD",67,0) N DGIEN "RTN","DGPFDD",68,0) N DGNAMES "RTN","DGPFDD",69,0) ; "RTN","DGPFDD",70,0) S DGIEN=0,DGCNT=0 "RTN","DGPFDD",71,0) F S DGIEN=$O(DGLKUP(DGIEN)) Q:'DGIEN D "RTN","DGPFDD",72,0) . S DGCNT=DGCNT+1 "RTN","DGPFDD",73,0) . S DGNAMES(DGCNT)=$$EXTERNAL^DILFD(26.112,.01,"F",DGIEN) "RTN","DGPFDD",74,0) S DGNAMES(DGCNT+1)="" ;add a blank line "RTN","DGPFDD",75,0) D EN^DDIOL(.DGNAMES) "RTN","DGPFDD",76,0) Q "RTN","DGPFDD",77,0) ; "RTN","DGPFDD",78,0) COS(DGAPRV) ;transform POSTMASTER to CHIEF OF STAFF "RTN","DGPFDD",79,0) ;This output transform converts the internal field value of .5 "RTN","DGPFDD",80,0) ;(POSTMASTER) to CHIEF OF STAFF. "RTN","DGPFDD",81,0) ; "RTN","DGPFDD",82,0) ; Supported DBIA #10060 - This supported DBIA permits FileMan reads "RTN","DGPFDD",83,0) ; on all fields of the NEW PERSON (#200) file. "RTN","DGPFDD",84,0) ; "RTN","DGPFDD",85,0) ; Input: "RTN","DGPFDD",86,0) ; DGAPRV - internal value of PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFDD",87,0) ; APPROVED BY (#.05) field "RTN","DGPFDD",88,0) ; "RTN","DGPFDD",89,0) ; Output: "RTN","DGPFDD",90,0) ; Function Value - Returns "CHIEF OF STAFF" when input value is .5 or "RTN","DGPFDD",91,0) ; external value from NAME (.01) field of the NEW "RTN","DGPFDD",92,0) ; PERSON (#200) file on success. "RTN","DGPFDD",93,0) ; Returns null ("") on failure. "RTN","DGPFDD",94,0) ; "RTN","DGPFDD",95,0) N DGERR "RTN","DGPFDD",96,0) ; "RTN","DGPFDD",97,0) Q:(+$G(DGAPRV)'>0) "" "RTN","DGPFDD",98,0) ; "RTN","DGPFDD",99,0) Q $S(DGAPRV=.5:"CHIEF OF STAFF",1:$$GET1^DIQ(200,DGAPRV_",",.01,"","","DGERR")) "RTN","DGPFHLL") 0^9^B8636516 "RTN","DGPFHLL",1,0) DGPFHLL ;ALB/RPM - PRF HL7 TRANSMISSION LOG API'S ; 3/6/03 "RTN","DGPFHLL",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLL",3,0) ; "RTN","DGPFHLL",4,0) Q "RTN","DGPFHLL",5,0) ; "RTN","DGPFHLL",6,0) GETLOG(DGLIEN,DGPFL) ;retrieve a transmission log record "RTN","DGPFHLL",7,0) ; "RTN","DGPFHLL",8,0) ; Input: "RTN","DGPFHLL",9,0) ; DGLIEN - IEN for PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFHLL",10,0) ; "RTN","DGPFHLL",11,0) ; Output: "RTN","DGPFHLL",12,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLL",13,0) ; DGPFL - array of transmission data fields "RTN","DGPFHLL",14,0) ; Subscript Field# "RTN","DGPFHLL",15,0) ; ----------------- ------ "RTN","DGPFHLL",16,0) ; "MSGID" .01 "RTN","DGPFHLL",17,0) ; "ASGNHIST" .02 "RTN","DGPFHLL",18,0) ; "TRANSDT" .03 "RTN","DGPFHLL",19,0) ; "MSGSTAT" .04 "RTN","DGPFHLL",20,0) ; "SITE" .05 "RTN","DGPFHLL",21,0) ; "ACKDT" .06 "RTN","DGPFHLL",22,0) ; "RTN","DGPFHLL",23,0) N DGIENS ;IEN string for DIQ "RTN","DGPFHLL",24,0) N DGFLDS ;results array for DIQ "RTN","DGPFHLL",25,0) N DGERR ;error arrary for DIQ "RTN","DGPFHLL",26,0) N DGRSLT "RTN","DGPFHLL",27,0) ; "RTN","DGPFHLL",28,0) S DGRSLT=0 "RTN","DGPFHLL",29,0) I $G(DGLIEN)>0,$D(^DGPF(26.17,DGLIEN)) D "RTN","DGPFHLL",30,0) . S DGIENS=DGLIEN_"," "RTN","DGPFHLL",31,0) . D GETS^DIQ(26.17,DGIENS,"*","IEZ","DGFLDS","DGERR") "RTN","DGPFHLL",32,0) . Q:$D(DGERR) "RTN","DGPFHLL",33,0) . S DGRSLT=1 "RTN","DGPFHLL",34,0) . S DGPFL("MSGID")=$G(DGFLDS(26.17,DGIENS,.01,"I"))_U_$G(DGFLDS(26.17,DGIENS,.01,"E")) "RTN","DGPFHLL",35,0) . S DGPFL("ASGNHIST")=$G(DGFLDS(26.17,DGIENS,.02,"I"))_U_$G(DGFLDS(26.17,DGIENS,.02,"E")) "RTN","DGPFHLL",36,0) . S DGPFL("TRANSDT")=$G(DGFLDS(26.17,DGIENS,.03,"I"))_U_$G(DGFLDS(26.17,DGIENS,.03,"E")) "RTN","DGPFHLL",37,0) . S DGPFL("MSGSTAT")=$G(DGFLDS(26.17,DGIENS,.04,"I"))_U_$G(DGFLDS(26.17,DGIENS,.04,"E")) "RTN","DGPFHLL",38,0) . S DGPFL("SITE")=$G(DGFLDS(26.17,DGIENS,.05,"I"))_U_$G(DGFLDS(26.17,DGIENS,.05,"E")) "RTN","DGPFHLL",39,0) . S DGPFL("ACKDT")=$G(DGFLDS(26.17,DGIENS,.06,"I"))_U_$G(DGFLDS(26.17,DGIENS,.06,"E")) "RTN","DGPFHLL",40,0) ; "RTN","DGPFHLL",41,0) Q DGRSLT "RTN","DGPFHLL",42,0) ; "RTN","DGPFHLL",43,0) FNDLOG(DGMSGID) ;find and return the record number for a given HL7 Message ID "RTN","DGPFHLL",44,0) ; "RTN","DGPFHLL",45,0) ; Input: "RTN","DGPFHLL",46,0) ; DGMSGID - HL7 Message ID "RTN","DGPFHLL",47,0) ; "RTN","DGPFHLL",48,0) ; Output: "RTN","DGPFHLL",49,0) ; Function value - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file on "RTN","DGPFHLL",50,0) ; success, 0 on failure "RTN","DGPFHLL",51,0) ; "RTN","DGPFHLL",52,0) N DGIEN "RTN","DGPFHLL",53,0) ; "RTN","DGPFHLL",54,0) I +$G(DGMSGID) D "RTN","DGPFHLL",55,0) . S DGIEN=$O(^DGPF(26.17,"B",DGMSGID,0)) "RTN","DGPFHLL",56,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFHLL",57,0) ; "RTN","DGPFHLL",58,0) STOXMIT(DGHIEN,DGMSGID,DGINST,DGERR) ;store the transmission log data "RTN","DGPFHLL",59,0) ; "RTN","DGPFHLL",60,0) ; Input: "RTN","DGPFHLL",61,0) ; DGHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFHLL",62,0) ; DGMSGID - message ID from VistA HL7 "RTN","DGPFHLL",63,0) ; DGINST - pointer to the INSTITUTION (#4) file "RTN","DGPFHLL",64,0) ; "RTN","DGPFHLL",65,0) ; Output: "RTN","DGPFHLL",66,0) ; DGERR - undefined on success, error message on failure "RTN","DGPFHLL",67,0) ; "RTN","DGPFHLL",68,0) N DGFDA ;fda array "RTN","DGPFHLL",69,0) N DGFDAIEN ;ien array from DIE "RTN","DGPFHLL",70,0) ; "RTN","DGPFHLL",71,0) I +$G(DGHIEN),$D(^DGPF(26.14,DGHIEN)),$D(DGMSGID),+$G(DGINST),$D(^DIC(4,DGINST)) D "RTN","DGPFHLL",72,0) . N DGFDAIEN "RTN","DGPFHLL",73,0) . Q:$$FNDLOG^DGPFHLL(DGMSGID) "RTN","DGPFHLL",74,0) . S DGFDA(26.17,"+1,",.01)=DGMSGID "RTN","DGPFHLL",75,0) . S DGFDA(26.17,"+1,",.02)=DGHIEN "RTN","DGPFHLL",76,0) . S DGFDA(26.17,"+1,",.03)=$$NOW^XLFDT() "RTN","DGPFHLL",77,0) . S DGFDA(26.17,"+1,",.04)="T" "RTN","DGPFHLL",78,0) . S DGFDA(26.17,"+1,",.05)=DGINST "RTN","DGPFHLL",79,0) . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFHLL",80,0) Q "RTN","DGPFHLL",81,0) ; "RTN","DGPFHLL",82,0) STOSTAT(DGLIEN,DGSTAT) ;update the HL7 transmission status "RTN","DGPFHLL",83,0) ; "RTN","DGPFHLL",84,0) ; Input: "RTN","DGPFHLL",85,0) ; DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFHLL",86,0) ; DGSTAT - internal Status value ("T","A","RJ","M","RT") "RTN","DGPFHLL",87,0) ; "RTN","DGPFHLL",88,0) ; Output: "RTN","DGPFHLL",89,0) ; none "RTN","DGPFHLL",90,0) ; "RTN","DGPFHLL",91,0) N DGERR ;filer errors "RTN","DGPFHLL",92,0) N DGFDA ;fda array "RTN","DGPFHLL",93,0) N DGLIENS ;iens string "RTN","DGPFHLL",94,0) ; "RTN","DGPFHLL",95,0) I +$G(DGLIEN),$D(^DGPF(26.17,DGLIEN)),$G(DGSTAT)]"" D "RTN","DGPFHLL",96,0) . Q:'$$TESTVAL^DGPFUT(26.17,.04,DGSTAT) "RTN","DGPFHLL",97,0) . S DGLIENS=DGLIEN_"," "RTN","DGPFHLL",98,0) . S DGFDA(26.17,DGLIENS,.04)=DGSTAT "RTN","DGPFHLL",99,0) . S DGFDA(26.17,DGLIENS,.06)=$$NOW^XLFDT() "RTN","DGPFHLL",100,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFHLL",101,0) Q "RTN","DGPFHLQ") 0^33^B44034534 "RTN","DGPFHLQ",1,0) DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03 "RTN","DGPFHLQ",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLQ",3,0) ; "RTN","DGPFHLQ",4,0) BLDQRY(DGDFN,DGICN,DGROOT,DGHL) ;Build QRY~R02 Message/Segments "RTN","DGPFHLQ",5,0) ; "RTN","DGPFHLQ",6,0) ; Input: "RTN","DGPFHLQ",7,0) ; DGDFN - (required) Pointer to patient in PATIENT (#2) file "RTN","DGPFHLQ",8,0) ; DGICN - (required) Patient's Integrated Control Number "RTN","DGPFHLQ",9,0) ; DGROOT - (required) Closed root array or global name for segment "RTN","DGPFHLQ",10,0) ; storage. "RTN","DGPFHLQ",11,0) ; DGHL - (required) VistA HL7 environment array "RTN","DGPFHLQ",12,0) ; "RTN","DGPFHLQ",13,0) ; Output: "RTN","DGPFHLQ",14,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLQ",15,0) ; DGROOT - array of HL7 segments on success "RTN","DGPFHLQ",16,0) ; "RTN","DGPFHLQ",17,0) N DGCNT ;segment counter "RTN","DGPFHLQ",18,0) N DGDEM ;pt. demographics array "RTN","DGPFHLQ",19,0) N DGQRD ;formatted QRD segment "RTN","DGPFHLQ",20,0) N DGQRF ;formatted QRF segment "RTN","DGPFHLQ",21,0) N DGRSLT ;function value "RTN","DGPFHLQ",22,0) N DGSTR ;field string "RTN","DGPFHLQ",23,0) ; "RTN","DGPFHLQ",24,0) S DGRSLT=0 "RTN","DGPFHLQ",25,0) S DGCNT=0 "RTN","DGPFHLQ",26,0) ; "RTN","DGPFHLQ",27,0) I +$G(DGDFN),+$G(DGICN),$G(DGROOT)]"" D "RTN","DGPFHLQ",28,0) . ; "RTN","DGPFHLQ",29,0) . ;get patient demographics "RTN","DGPFHLQ",30,0) . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM) "RTN","DGPFHLQ",31,0) . ; "RTN","DGPFHLQ",32,0) . ;build QRD "RTN","DGPFHLQ",33,0) . S DGSTR="1,2,3,4,7,8,9,10" "RTN","DGPFHLQ",34,0) . S DGQRD=$$QRD^DGPFHLQ1(DGDFN,DGICN,DGSTR,.DGHL) "RTN","DGPFHLQ",35,0) . Q:(DGQRD="") "RTN","DGPFHLQ",36,0) . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRD "RTN","DGPFHLQ",37,0) . ; "RTN","DGPFHLQ",38,0) . ;build QRF "RTN","DGPFHLQ",39,0) . S DGSTR="1,4,5" "RTN","DGPFHLQ",40,0) . S DGQRF=$$QRF^DGPFHLQ2($G(DGDEM("SSN")),$G(DGDEM("DOB")),DGSTR,.DGHL) "RTN","DGPFHLQ",41,0) . Q:(DGQRF="") "RTN","DGPFHLQ",42,0) . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGQRF "RTN","DGPFHLQ",43,0) . ; "RTN","DGPFHLQ",44,0) . S DGRSLT=1 "RTN","DGPFHLQ",45,0) Q DGRSLT "RTN","DGPFHLQ",46,0) ; "RTN","DGPFHLQ",47,0) BLDORF(DGROOT,DGHL,DGDFN,DGQRY,DGSEGERR,DGQRYERR) ;Build ORF~R04 Message/Segments "RTN","DGPFHLQ",48,0) ; "RTN","DGPFHLQ",49,0) ; Input: "RTN","DGPFHLQ",50,0) ; DGROOT - (required) Segment array "RTN","DGPFHLQ",51,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLQ",52,0) ; DGDFN - (required) Pointer to patient in PATIENT (#2) file "RTN","DGPFHLQ",53,0) ; DGQRY - (required) Array of parsed QRY data "RTN","DGPFHLQ",54,0) ; DGSEGERR - (optional) Array of errors encountered during QRY parsing "RTN","DGPFHLQ",55,0) ; DGQRYERR - (optional) Error encountered during ICN to DFN conversion "RTN","DGPFHLQ",56,0) ; "RTN","DGPFHLQ",57,0) ; Output: "RTN","DGPFHLQ",58,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLQ",59,0) ; "RTN","DGPFHLQ",60,0) N DGACK ;acknowledgment code (i.e. AA, AE) "RTN","DGPFHLQ",61,0) N DGAIENS ;array of assignment IENS "RTN","DGPFHLQ",62,0) N DGCNT ;segment counter "RTN","DGPFHLQ",63,0) N DGI ;generic index "RTN","DGPFHLQ",64,0) N DGOBROOT ;temporary storage of OBR/OBX segments "RTN","DGPFHLQ",65,0) N DGRSLT ;function value "RTN","DGPFHLQ",66,0) N DGSEGSTR ;formatted segment string "RTN","DGPFHLQ",67,0) N DGSTR ;comma-delimited list of fields to include "RTN","DGPFHLQ",68,0) ; "RTN","DGPFHLQ",69,0) S DGRSLT=0 "RTN","DGPFHLQ",70,0) S DGOBROOT=$NA(^TMP("DGPF OB",$J)) "RTN","DGPFHLQ",71,0) K @DGOBROOT "RTN","DGPFHLQ",72,0) ; "RTN","DGPFHLQ",73,0) I $G(DGROOT)]"",+$G(DGDFN)>0,$D(DGQRY) D "RTN","DGPFHLQ",74,0) . S DGCNT=0 "RTN","DGPFHLQ",75,0) . S DGACK=$S($D(DGSEGERR):"AE",$D(DGQRYERR):"AE",1:"AA") "RTN","DGPFHLQ",76,0) . ; "RTN","DGPFHLQ",77,0) . ;build OBR/OBX segments for any Category I record flag assignments "RTN","DGPFHLQ",78,0) . I DGACK="AA",$$GETALL^DGPFAA(DGDFN,.DGAIENS,"",1) D "RTN","DGPFHLQ",79,0) . . ; "RTN","DGPFHLQ",80,0) . . ;build and temporarily store OBR/OBX segments "RTN","DGPFHLQ",81,0) . . Q:$$BLDALLOB(DGOBROOT,.DGAIENS,.DGHL) "RTN","DGPFHLQ",82,0) . . ; "RTN","DGPFHLQ",83,0) . . ;if we get here then the data retrieval failed "RTN","DGPFHLQ",84,0) . . S DGQRYERR="FE" "RTN","DGPFHLQ",85,0) . . S DGACK="AE" "RTN","DGPFHLQ",86,0) . . K @DGOBROOT "RTN","DGPFHLQ",87,0) . ; "RTN","DGPFHLQ",88,0) . ;build MSA segment "RTN","DGPFHLQ",89,0) . S DGSTR=$S($D(DGQRYERR):"1,2,6",1:"1,2") "RTN","DGPFHLQ",90,0) . S DGSEGSTR=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGQRYERR,DGSTR,.DGHL) "RTN","DGPFHLQ",91,0) . Q:(DGSEGSTR="") "RTN","DGPFHLQ",92,0) . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR "RTN","DGPFHLQ",93,0) . ; "RTN","DGPFHLQ",94,0) . ;build ERR segments for any segment parsing errors "RTN","DGPFHLQ",95,0) . I $D(DGSEGERR),'$$BLDERR^DGPFHLU4(DGROOT,.DGSEGERR,.DGHL,.DGCNT) Q "RTN","DGPFHLQ",96,0) . ; "RTN","DGPFHLQ",97,0) . ;build QRD segment "RTN","DGPFHLQ",98,0) . S DGSTR="1,2,3,4,7,8,9,10" "RTN","DGPFHLQ",99,0) . S DGSEGSTR=$$QRD^DGPFHLQ1($G(DGQRY("QID")),$G(DGQRY("ICN")),DGSTR,.DGHL) "RTN","DGPFHLQ",100,0) . Q:(DGSEGSTR="") "RTN","DGPFHLQ",101,0) . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR "RTN","DGPFHLQ",102,0) . ; "RTN","DGPFHLQ",103,0) . ;move any OBR/OBX segments into the message "RTN","DGPFHLQ",104,0) . S DGI=0 "RTN","DGPFHLQ",105,0) . F S DGI=$O(@DGOBROOT@(DGI)) Q:'DGI D "RTN","DGPFHLQ",106,0) . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=@DGOBROOT@(DGI) "RTN","DGPFHLQ",107,0) . ; "RTN","DGPFHLQ",108,0) . ;success "RTN","DGPFHLQ",109,0) . S DGRSLT=1 "RTN","DGPFHLQ",110,0) ; "RTN","DGPFHLQ",111,0) ;cleanup "RTN","DGPFHLQ",112,0) K @DGOBROOT "RTN","DGPFHLQ",113,0) ; "RTN","DGPFHLQ",114,0) Q DGRSLT "RTN","DGPFHLQ",115,0) ; "RTN","DGPFHLQ",116,0) BLDALLOB(DGROOT,DGAIENS,DGHL) ;build all OBRs and OBXs for a patient "RTN","DGPFHLQ",117,0) ; "RTN","DGPFHLQ",118,0) ; Input: "RTN","DGPFHLQ",119,0) ; DGROOT - (required) Closed root array or global name for segment "RTN","DGPFHLQ",120,0) ; storage. "RTN","DGPFHLQ",121,0) ; DGAIENS - (required) Array of pointers to PRF ASSIGNMENT (#26.13) file "RTN","DGPFHLQ",122,0) ; DGHL - (required) VistA HL7 environment array "RTN","DGPFHLQ",123,0) ; "RTN","DGPFHLQ",124,0) ; Output: "RTN","DGPFHLQ",125,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLQ",126,0) ; DGROOT - array of HL7 segments on success "RTN","DGPFHLQ",127,0) ; "RTN","DGPFHLQ",128,0) N DGAIEN ;single assignment IEN "RTN","DGPFHLQ",129,0) N DGCNT ;segment counter "RTN","DGPFHLQ",130,0) N DGHIEN ;single assignment history IEN "RTN","DGPFHLQ",131,0) N DGHIENS ;array of assignment history IENs "RTN","DGPFHLQ",132,0) N DGOBRSET ;OBR segment Set ID "RTN","DGPFHLQ",133,0) N DGOBXOK ;OBX segment creation flag "RTN","DGPFHLQ",134,0) N DGOBXSET ;OBX segment Set ID "RTN","DGPFHLQ",135,0) N DGPFA ;assignment data array "RTN","DGPFHLQ",136,0) N DGPFAH ;assignment history data array "RTN","DGPFHLQ",137,0) N DGRSLT ;function value "RTN","DGPFHLQ",138,0) N DGSEGSTR ;formatted segment string "RTN","DGPFHLQ",139,0) N DGSTR ;comma-delimited list of fields to include "RTN","DGPFHLQ",140,0) N DGTROOT ;closed root name of text array value "RTN","DGPFHLQ",141,0) ; "RTN","DGPFHLQ",142,0) S DGCNT=0 "RTN","DGPFHLQ",143,0) S DGRSLT=0 "RTN","DGPFHLQ",144,0) I $G(DGROOT)]"",$D(DGAIENS) D "RTN","DGPFHLQ",145,0) . S DGAIEN=0 "RTN","DGPFHLQ",146,0) . S DGOBRSET=0 "RTN","DGPFHLQ",147,0) . F S DGAIEN=$O(DGAIENS(DGAIEN)) Q:'DGAIEN D "RTN","DGPFHLQ",148,0) . . N DGHIENS ;array of assignment history IENS "RTN","DGPFHLQ",149,0) . . N DGPFA ;assignment data array "RTN","DGPFHLQ",150,0) . . ; "RTN","DGPFHLQ",151,0) . . ;get assignment details "RTN","DGPFHLQ",152,0) . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFHLQ",153,0) . . ; "RTN","DGPFHLQ",154,0) . . ;get last assignment history for narrative observation date "RTN","DGPFHLQ",155,0) . . Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGAIEN),.DGPFAH) "RTN","DGPFHLQ",156,0) . . ; "RTN","DGPFHLQ",157,0) . . ;build OBR segment for this assignment "RTN","DGPFHLQ",158,0) . . S DGSTR="1,4,7,20,21" "RTN","DGPFHLQ",159,0) . . S DGOBRSET=DGOBRSET+1 "RTN","DGPFHLQ",160,0) . . S DGSEGSTR=$$OBR^DGPFHLU1(DGOBRSET,.DGPFA,.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLQ",161,0) . . Q:(DGSEGSTR="") "RTN","DGPFHLQ",162,0) . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR "RTN","DGPFHLQ",163,0) . . ; "RTN","DGPFHLQ",164,0) . . ;build narrative OBX segment for this assignment "RTN","DGPFHLQ",165,0) . . S DGOBXSET=0 "RTN","DGPFHLQ",166,0) . . S DGTROOT="DGPFA(""NARR"")" "RTN","DGPFHLQ",167,0) . . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET) "RTN","DGPFHLQ",168,0) . . ; "RTN","DGPFHLQ",169,0) . . ;get a list of all assignment histories "RTN","DGPFHLQ",170,0) . . Q:'$$GETALL^DGPFAAH(DGAIEN,.DGHIENS) "RTN","DGPFHLQ",171,0) . . ; "RTN","DGPFHLQ",172,0) . . ;loop through each assignment history entry "RTN","DGPFHLQ",173,0) . . S DGHIEN=0 "RTN","DGPFHLQ",174,0) . . F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:'DGHIEN D Q:'DGOBXOK "RTN","DGPFHLQ",175,0) . . . N DGPFAH "RTN","DGPFHLQ",176,0) . . . S DGOBXOK=0 "RTN","DGPFHLQ",177,0) . . . ; "RTN","DGPFHLQ",178,0) . . . ;get single assignment history record "RTN","DGPFHLQ",179,0) . . . Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) "RTN","DGPFHLQ",180,0) . . . ; "RTN","DGPFHLQ",181,0) . . . ;build status OBX segment for this history record "RTN","DGPFHLQ",182,0) . . . S DGSTR="1,2,3,5,11,14" "RTN","DGPFHLQ",183,0) . . . S DGOBXSET=DGOBXSET+1 "RTN","DGPFHLQ",184,0) . . . S DGSEGSTR=$$OBX^DGPFHLU2(DGOBXSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLQ",185,0) . . . Q:(DGSEGSTR="") "RTN","DGPFHLQ",186,0) . . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGSEGSTR "RTN","DGPFHLQ",187,0) . . . ; "RTN","DGPFHLQ",188,0) . . . ;build review comment OBX segments for this history record "RTN","DGPFHLQ",189,0) . . . S DGTROOT="DGPFAH(""COMMENT"")" "RTN","DGPFHLQ",190,0) . . . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGCNT,.DGOBXSET) "RTN","DGPFHLQ",191,0) . . . S DGOBXOK=1 "RTN","DGPFHLQ",192,0) . . Q:'DGOBXOK "RTN","DGPFHLQ",193,0) . . S DGRSLT=1 "RTN","DGPFHLQ",194,0) Q DGRSLT "RTN","DGPFHLQ1") 0^34^B9671329 "RTN","DGPFHLQ1",1,0) DGPFHLQ1 ;ALB/RPM - PRF HL7 BUILD QRD SEGMENT ; 02/02/03 "RTN","DGPFHLQ1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLQ1",3,0) ; "RTN","DGPFHLQ1",4,0) ; "RTN","DGPFHLQ1",5,0) QRD(DGQID,DGWHO,DGFLD,DGHL) ;QRD HL7 segment API "RTN","DGPFHLQ1",6,0) ;This function wraps the data retrieval and segment creation APIs and "RTN","DGPFHLQ1",7,0) ;returns a formatted QRD segment. "RTN","DGPFHLQ1",8,0) ; "RTN","DGPFHLQ1",9,0) ; Input: "RTN","DGPFHLQ1",10,0) ; DGQID - (required) Query ID (DFN) "RTN","DGPFHLQ1",11,0) ; DGWHO - (required) Who Subject Filter (Integrated Control Number) "RTN","DGPFHLQ1",12,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLQ1",13,0) ; to include. Defaults to all required fields (1-4,7-10). "RTN","DGPFHLQ1",14,0) ; DGHL - VistA HL7 environment array "RTN","DGPFHLQ1",15,0) ; "RTN","DGPFHLQ1",16,0) ; Output: "RTN","DGPFHLQ1",17,0) ; Function Value - QRD segment on success, "" on failure "RTN","DGPFHLQ1",18,0) ; "RTN","DGPFHLQ1",19,0) N DGQRD "RTN","DGPFHLQ1",20,0) N DGVAL "RTN","DGPFHLQ1",21,0) ; "RTN","DGPFHLQ1",22,0) S DGQRD="" "RTN","DGPFHLQ1",23,0) I $G(DGQID)>0,$G(DGWHO)]"" D "RTN","DGPFHLQ1",24,0) . S DGFLD=$$CKSTR^DGPFHLUT("1,2,3,4,7,8,9,10",DGFLD) ;validate fields "RTN","DGPFHLQ1",25,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLQ1",26,0) . I $$QRDVAL(DGFLD,DGQID,DGWHO,.DGVAL) D "RTN","DGPFHLQ1",27,0) . . S DGQRD=$$BLDSEG^DGPFHLUT("QRD",.DGVAL,.DGHL) "RTN","DGPFHLQ1",28,0) Q DGQRD "RTN","DGPFHLQ1",29,0) ; "RTN","DGPFHLQ1",30,0) QRDVAL(DGFLD,DGQID,DGWHO,DGVAL) ;build QRD value array "RTN","DGPFHLQ1",31,0) ; "RTN","DGPFHLQ1",32,0) ; Input: "RTN","DGPFHLQ1",33,0) ; DGFLD - Fields string "RTN","DGPFHLQ1",34,0) ; DGQID - Query ID (DFN) "RTN","DGPFHLQ1",35,0) ; DGWHO - Who Subject filter (ICN) "RTN","DGPFHLQ1",36,0) ; "RTN","DGPFHLQ1",37,0) ; Output: "RTN","DGPFHLQ1",38,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLQ1",39,0) ; DGVAL - QRD field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLQ1",40,0) ; SUB3:component, SUB4:sub-component "RTN","DGPFHLQ1",41,0) ; "RTN","DGPFHLQ1",42,0) N DGRSLT "RTN","DGPFHLQ1",43,0) ; "RTN","DGPFHLQ1",44,0) S DGRSLT=0 "RTN","DGPFHLQ1",45,0) I $G(DGQID)>0,$G(DGWHO)]"",$G(DGFLD)]"" D "RTN","DGPFHLQ1",46,0) . ; "RTN","DGPFHLQ1",47,0) . ; seq 1 (required) Query Date/Time "RTN","DGPFHLQ1",48,0) . I DGFLD[",1," D Q:(+DGVAL(1)'>0) "RTN","DGPFHLQ1",49,0) . . S DGVAL(1)=$$FMTHL7^XLFDT($$NOW^XLFDT()) "RTN","DGPFHLQ1",50,0) . ; "RTN","DGPFHLQ1",51,0) . ; seq 2 (required) Query Format Code "RTN","DGPFHLQ1",52,0) . I DGFLD[",2," D "RTN","DGPFHLQ1",53,0) . . S DGVAL(2)="R" ;always "R"ecord "RTN","DGPFHLQ1",54,0) . ; "RTN","DGPFHLQ1",55,0) . ; seq 3 (required) Query Priority "RTN","DGPFHLQ1",56,0) . I DGFLD[",3," D "RTN","DGPFHLQ1",57,0) . . S DGVAL(3)="I" ;always "I"mmediate "RTN","DGPFHLQ1",58,0) . ; "RTN","DGPFHLQ1",59,0) . ; seq 4 (required) Query ID "RTN","DGPFHLQ1",60,0) . I DGFLD[",4," D "RTN","DGPFHLQ1",61,0) . . S DGVAL(4)=DGQID "RTN","DGPFHLQ1",62,0) . ; "RTN","DGPFHLQ1",63,0) . ; seq 5 (optional) Deferred Response Type "RTN","DGPFHLQ1",64,0) . I DGFLD[",5," D "RTN","DGPFHLQ1",65,0) . . S DGVAL(5)="" "RTN","DGPFHLQ1",66,0) . ; "RTN","DGPFHLQ1",67,0) . ; seq 6 (optional) Deferred Response Date/Time "RTN","DGPFHLQ1",68,0) . I DGFLD[",6," D "RTN","DGPFHLQ1",69,0) . . S DGVAL(6)="" "RTN","DGPFHLQ1",70,0) . ; "RTN","DGPFHLQ1",71,0) . ; seq 7 (required) Quantity Limited Request "RTN","DGPFHLQ1",72,0) . I DGFLD[",7," D "RTN","DGPFHLQ1",73,0) . . S DGVAL(7,1,1)=10 "RTN","DGPFHLQ1",74,0) . . S DGVAL(7,1,2)="RD" ;records "RTN","DGPFHLQ1",75,0) . ; "RTN","DGPFHLQ1",76,0) . ; seq 8 (required) Who Subject Filter "RTN","DGPFHLQ1",77,0) . I DGFLD[",8," D "RTN","DGPFHLQ1",78,0) . . S DGVAL(8,1,1)=DGWHO "RTN","DGPFHLQ1",79,0) . . S DGVAL(8,1,9,1)="USVHA" "RTN","DGPFHLQ1",80,0) . . S DGVAL(8,1,9,2)="" "RTN","DGPFHLQ1",81,0) . . S DGVAL(8,1,9,3)="L" "RTN","DGPFHLQ1",82,0) . ; "RTN","DGPFHLQ1",83,0) . ; seq 9 (required) What Subject Filter "RTN","DGPFHLQ1",84,0) . I DGFLD[",9," D "RTN","DGPFHLQ1",85,0) . . S DGVAL(9,1,1)="OTH" "RTN","DGPFHLQ1",86,0) . . S DGVAL(9,1,2)="Other" "RTN","DGPFHLQ1",87,0) . . S DGVAL(9,1,3)="HL0048" "RTN","DGPFHLQ1",88,0) . ; "RTN","DGPFHLQ1",89,0) . ; seq 10 (required) What Dept. Data Code "RTN","DGPFHLQ1",90,0) . I DGFLD[",10," D "RTN","DGPFHLQ1",91,0) . . S DGVAL(10,1,1)="PRFA" "RTN","DGPFHLQ1",92,0) . . S DGVAL(10,1,2)="Patient Record Flag Assignments" "RTN","DGPFHLQ1",93,0) . . S DGVAL(10,1,3)="L" "RTN","DGPFHLQ1",94,0) . ; "RTN","DGPFHLQ1",95,0) . ; seq 11 (optional) What Data Code Value Qual. "RTN","DGPFHLQ1",96,0) . I DGFLD[",11," D "RTN","DGPFHLQ1",97,0) . . S DGVAL(11)="" "RTN","DGPFHLQ1",98,0) . ; "RTN","DGPFHLQ1",99,0) . ; seq 12 (optional) Query Results Level "RTN","DGPFHLQ1",100,0) . I DGFLD[",12," D "RTN","DGPFHLQ1",101,0) . . S DGVAL(12)="" "RTN","DGPFHLQ1",102,0) . ; "RTN","DGPFHLQ1",103,0) . S DGRSLT=1 "RTN","DGPFHLQ1",104,0) I 'DGRSLT K DGVAL "RTN","DGPFHLQ1",105,0) Q DGRSLT "RTN","DGPFHLQ2") 0^35^B6044251 "RTN","DGPFHLQ2",1,0) DGPFHLQ2 ;ALB/RPM - PRF HL7 BUILD QRF SEGMENT ; 02/02/03 "RTN","DGPFHLQ2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLQ2",3,0) ; "RTN","DGPFHLQ2",4,0) ; "RTN","DGPFHLQ2",5,0) QRF(DGSSN,DGDOB,DGFLD,DGHL) ;QRF HL7 segment API "RTN","DGPFHLQ2",6,0) ;This function wraps the data retrieval and segment crateion APIs and "RTN","DGPFHLQ2",7,0) ;returns a formatted QRF segment. "RTN","DGPFHLQ2",8,0) ; "RTN","DGPFHLQ2",9,0) ; Input: "RTN","DGPFHLQ2",10,0) ; DGSSN - (required) Patient's Social Security Number "RTN","DGPFHLQ2",11,0) ; DGDOB - (required) Patient's Date of Birth in FileMan format "RTN","DGPFHLQ2",12,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLQ2",13,0) ; to include. Defaults to all required fields (1). "RTN","DGPFHLQ2",14,0) ; DGHL - VistA HL7 environment array "RTN","DGPFHLQ2",15,0) ; "RTN","DGPFHLQ2",16,0) ; Output : "RTN","DGPFHLQ2",17,0) ; Function Value - QRF segment on success, "" on failure "RTN","DGPFHLQ2",18,0) ; "RTN","DGPFHLQ2",19,0) N DGQRF "RTN","DGPFHLQ2",20,0) N DGVAL "RTN","DGPFHLQ2",21,0) ; "RTN","DGPFHLQ2",22,0) S DGQRF="" "RTN","DGPFHLQ2",23,0) I $G(DGSSN),$G(DGDOB) D "RTN","DGPFHLQ2",24,0) . S DGFLD=$$CKSTR^DGPFHLUT("1",DGFLD) ;validate field string "RTN","DGPFHLQ2",25,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLQ2",26,0) . I $$QRFVAL(DGFLD,DGSSN,DGDOB,.DGVAL) D "RTN","DGPFHLQ2",27,0) . . S DGQRF=$$BLDSEG^DGPFHLUT("QRF",.DGVAL,.DGHL) "RTN","DGPFHLQ2",28,0) Q DGQRF "RTN","DGPFHLQ2",29,0) ; "RTN","DGPFHLQ2",30,0) QRFVAL(DGFLD,DGSSN,DGDOB,DGVAL) ;build QRF field value array "RTN","DGPFHLQ2",31,0) ; "RTN","DGPFHLQ2",32,0) ; Input: "RTN","DGPFHLQ2",33,0) ; DGFLD - (required) Fields string "RTN","DGPFHLQ2",34,0) ; DGSSN - (required) Patient's Social Security Number "RTN","DGPFHLQ2",35,0) ; DGDOB - (required) Patient's Date of Birth "RTN","DGPFHLQ2",36,0) ; "RTN","DGPFHLQ2",37,0) ; Output: "RTN","DGPFHLQ2",38,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLQ2",39,0) ; DGVAL - QRF field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLQ2",40,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLQ2",41,0) ; "RTN","DGPFHLQ2",42,0) N DGRSLT "RTN","DGPFHLQ2",43,0) ; "RTN","DGPFHLQ2",44,0) S DGRSLT=0 "RTN","DGPFHLQ2",45,0) I $G(DGFLD)]"",$G(DGSSN),$G(DGDOB) D "RTN","DGPFHLQ2",46,0) . ; "RTN","DGPFHLQ2",47,0) . ; seq 1 (required) Where Subj Filter "RTN","DGPFHLQ2",48,0) . I DGFLD[",1," D "RTN","DGPFHLQ2",49,0) . . S DGVAL(1)="PRF" "RTN","DGPFHLQ2",50,0) . ; "RTN","DGPFHLQ2",51,0) . ; seq 2 (optional) When Data Start Date/Time "RTN","DGPFHLQ2",52,0) . I DGFLD[",2," D "RTN","DGPFHLQ2",53,0) . . S DGVAL(2)="" "RTN","DGPFHLQ2",54,0) . ; "RTN","DGPFHLQ2",55,0) . ; seq 3 (optional) When Data End Date/Time "RTN","DGPFHLQ2",56,0) . I DGFLD[",3," D "RTN","DGPFHLQ2",57,0) . . S DGVAL(3)="" "RTN","DGPFHLQ2",58,0) . ; "RTN","DGPFHLQ2",59,0) . ; seq 4 (optional) What User Qualifier "RTN","DGPFHLQ2",60,0) . I DGFLD[",4," D "RTN","DGPFHLQ2",61,0) . . S DGVAL(4)=DGSSN "RTN","DGPFHLQ2",62,0) . ; "RTN","DGPFHLQ2",63,0) . ; seq 5 (optional) Other Query Subj Filter "RTN","DGPFHLQ2",64,0) . I DGFLD[",5," D "RTN","DGPFHLQ2",65,0) . . S DGVAL(5)=$$FMTHL7^XLFDT(DGDOB) "RTN","DGPFHLQ2",66,0) . ; "RTN","DGPFHLQ2",67,0) . ;- seq 6 (optional) Which Date/Time Qualifier "RTN","DGPFHLQ2",68,0) . I DGFLD[",6," D "RTN","DGPFHLQ2",69,0) . . S DGVAL(6)="" "RTN","DGPFHLQ2",70,0) . ; "RTN","DGPFHLQ2",71,0) . ; seq 7 (optional) Which Date/Time Status Qualifier "RTN","DGPFHLQ2",72,0) . I DGFLD[",7," D "RTN","DGPFHLQ2",73,0) . . S DGVAL(7)="" "RTN","DGPFHLQ2",74,0) . ; "RTN","DGPFHLQ2",75,0) . ; seq 8 (optional) Date/Time Selection Qualifier "RTN","DGPFHLQ2",76,0) . I DGFLD[",8," D "RTN","DGPFHLQ2",77,0) . . S DGVAL(8)="" "RTN","DGPFHLQ2",78,0) . ; "RTN","DGPFHLQ2",79,0) . ; seq 9 (optional) When Quantity/Timing Qualifier "RTN","DGPFHLQ2",80,0) . I DGFLD[",9," D "RTN","DGPFHLQ2",81,0) . . S DGVAL(9)="" "RTN","DGPFHLQ2",82,0) . ; "RTN","DGPFHLQ2",83,0) . S DGRSLT=1 "RTN","DGPFHLQ2",84,0) I 'DGRSLT K DGVAL "RTN","DGPFHLQ2",85,0) Q DGRSLT "RTN","DGPFHLQ3") 0^36^B25817891 "RTN","DGPFHLQ3",1,0) DGPFHLQ3 ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 3/13/03 "RTN","DGPFHLQ3",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLQ3",3,0) ; "RTN","DGPFHLQ3",4,0) PARSQRY(DGWRK,DGHL,DGQRY,DGPFERR) ;Parse QRY~R02 Message/Segments "RTN","DGPFHLQ3",5,0) ; "RTN","DGPFHLQ3",6,0) ; Input: "RTN","DGPFHLQ3",7,0) ; DGWRK - Closed root global reference "RTN","DGPFHLQ3",8,0) ; DGHL - VistA HL7 environment array "RTN","DGPFHLQ3",9,0) ; "RTN","DGPFHLQ3",10,0) ; Output: "RTN","DGPFHLQ3",11,0) ; DGQRY - Patient lookup components array "RTN","DGPFHLQ3",12,0) ; DGPFERR - Undefined on success, ERR segment data array on failure "RTN","DGPFHLQ3",13,0) ; Format: DGPFERR(seg_id,sequence,fld_pos)=error_code "RTN","DGPFHLQ3",14,0) ; "RTN","DGPFHLQ3",15,0) N DGRSLT ;result from CHK^DIE "RTN","DGPFHLQ3",16,0) N DGFS ;field separator "RTN","DGPFHLQ3",17,0) N DGCS ;component separator "RTN","DGPFHLQ3",18,0) N DGRS ;repetition separator "RTN","DGPFHLQ3",19,0) N DGSS ;sub-component separator "RTN","DGPFHLQ3",20,0) N DGCURLIN ;current segment line "RTN","DGPFHLQ3",21,0) N DGSEG ;segment field data array "RTN","DGPFHLQ3",22,0) N DGERR ;error processing array "RTN","DGPFHLQ3",23,0) ; "RTN","DGPFHLQ3",24,0) S DGFS=DGHL("FS") "RTN","DGPFHLQ3",25,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLQ3",26,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLQ3",27,0) S DGSS=$E(DGHL("ECH"),4) "RTN","DGPFHLQ3",28,0) S DGCURLIN=0 "RTN","DGPFHLQ3",29,0) ; "RTN","DGPFHLQ3",30,0) ;loop through the message segments and retrieve the field data "RTN","DGPFHLQ3",31,0) F D Q:'DGCURLIN "RTN","DGPFHLQ3",32,0) . N DGSEG "RTN","DGPFHLQ3",33,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLQ3",34,0) . Q:'DGCURLIN "RTN","DGPFHLQ3",35,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGQRY,.DGPFERR)") "RTN","DGPFHLQ3",36,0) Q "RTN","DGPFHLQ3",37,0) ; "RTN","DGPFHLQ3",38,0) PARSORF(DGWRK,DGHL,DGORF,DGMSG) ;Parse ORF~R04 Message/Segments "RTN","DGPFHLQ3",39,0) ; "RTN","DGPFHLQ3",40,0) ; Input: "RTN","DGPFHLQ3",41,0) ; DGWRK - Closed root work global reference "RTN","DGPFHLQ3",42,0) ; DGHL - HL7 environment array "RTN","DGPFHLQ3",43,0) ; "RTN","DGPFHLQ3",44,0) ; Output: "RTN","DGPFHLQ3",45,0) ; DGORF - array of ORF results "RTN","DGPFHLQ3",46,0) ; OBRsetID,assigndt,"ACTION" "RTN","DGPFHLQ3",47,0) ; OBRsetID,assigndt,"COMMENT",line# "RTN","DGPFHLQ3",48,0) ; OBRsetID,"FLAG" "RTN","DGPFHLQ3",49,0) ; OBRsetID,"NARR",line# "RTN","DGPFHLQ3",50,0) ; OBRsetID,"OWNER" "RTN","DGPFHLQ3",51,0) ; "ACKCODE" - acknowledgment code ("AA","AE","AR") "RTN","DGPFHLQ3",52,0) ; "ICN" - patient's Integrated Control Number "RTN","DGPFHLQ3",53,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLQ3",54,0) ; "MSGID" - "RTN","DGPFHLQ3",55,0) ; "QID" - query ID (DFN) "RTN","DGPFHLQ3",56,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLQ3",57,0) ; "SNDFAC" - sending facility "RTN","DGPFHLQ3",58,0) ; "RTN","DGPFHLQ3",59,0) ; DGMSG - undefined on success, array of MailMan text on failure "RTN","DGPFHLQ3",60,0) ; "RTN","DGPFHLQ3",61,0) N DGFS "RTN","DGPFHLQ3",62,0) N DGCS "RTN","DGPFHLQ3",63,0) N DGRS "RTN","DGPFHLQ3",64,0) N DGSS "RTN","DGPFHLQ3",65,0) N DGCURLIN "RTN","DGPFHLQ3",66,0) ; "RTN","DGPFHLQ3",67,0) S DGFS=DGHL("FS") "RTN","DGPFHLQ3",68,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLQ3",69,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLQ3",70,0) S DGSS=$E(DGHL("ECH"),4) "RTN","DGPFHLQ3",71,0) S DGCURLIN=0 "RTN","DGPFHLQ3",72,0) ; "RTN","DGPFHLQ3",73,0) ;loop through the message segments and retrieve the field data "RTN","DGPFHLQ3",74,0) F D Q:'DGCURLIN "RTN","DGPFHLQ3",75,0) . N DGSEG "RTN","DGPFHLQ3",76,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLQ3",77,0) . Q:'DGCURLIN "RTN","DGPFHLQ3",78,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGMSG)") "RTN","DGPFHLQ3",79,0) Q "RTN","DGPFHLQ3",80,0) ; "RTN","DGPFHLQ3",81,0) MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ3",82,0) ; "RTN","DGPFHLQ3",83,0) ; Input: "RTN","DGPFHLQ3",84,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",85,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",86,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",87,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",88,0) ; "RTN","DGPFHLQ3",89,0) ; Output: "RTN","DGPFHLQ3",90,0) ; DGORF - array of ORF results "RTN","DGPFHLQ3",91,0) ; "SNDFAC" - sending facility "RTN","DGPFHLQ3",92,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLQ3",93,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLQ3",94,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",95,0) ; "RTN","DGPFHLQ3",96,0) D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR) "RTN","DGPFHLQ3",97,0) Q "RTN","DGPFHLQ3",98,0) ; "RTN","DGPFHLQ3",99,0) MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ3",100,0) ; "RTN","DGPFHLQ3",101,0) ; Input: "RTN","DGPFHLQ3",102,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",103,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",104,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",105,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",106,0) ; "RTN","DGPFHLQ3",107,0) ; Output: "RTN","DGPFHLQ3",108,0) ; DGORF - array of ORF results "RTN","DGPFHLQ3",109,0) ; "ACKCODE" - Acknowledgment code "RTN","DGPFHLQ3",110,0) ; "MSGID" - Message Control ID of the message being ACK'ed "RTN","DGPFHLQ3",111,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",112,0) ; "RTN","DGPFHLQ3",113,0) D MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR) "RTN","DGPFHLQ3",114,0) Q "RTN","DGPFHLQ3",115,0) ; "RTN","DGPFHLQ3",116,0) ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ3",117,0) ; "RTN","DGPFHLQ3",118,0) ; Input: "RTN","DGPFHLQ3",119,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",120,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",121,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",122,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",123,0) ; "RTN","DGPFHLQ3",124,0) ; Output: "RTN","DGPFHLQ3",125,0) ; DGORF - array of ORF results "RTN","DGPFHLQ3",126,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",127,0) ; "RTN","DGPFHLQ3",128,0) D ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGORF,.DGERR) "RTN","DGPFHLQ3",129,0) Q "RTN","DGPFHLQ3",130,0) ; "RTN","DGPFHLQ3",131,0) QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ3",132,0) ; "RTN","DGPFHLQ3",133,0) ; Input: "RTN","DGPFHLQ3",134,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",135,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",136,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",137,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",138,0) ; "RTN","DGPFHLQ3",139,0) ; Output: "RTN","DGPFHLQ3",140,0) ; DGQRY("ICN") - Patient's Integrated Control Number "RTN","DGPFHLQ3",141,0) ; DGQRY("QID") - Query ID "RTN","DGPFHLQ3",142,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",143,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",144,0) ; "RTN","DGPFHLQ3",145,0) S DGQRY("QID")=$G(DGSEG(4)) "RTN","DGPFHLQ3",146,0) S DGQRY("ICN")=+$P($G(DGSEG(8)),DGCS,1) "RTN","DGPFHLQ3",147,0) I DGQRY("ICN")="" D "RTN","DGPFHLQ3",148,0) . S DGERR("QRD",1,8)="NM" "RTN","DGPFHLQ3",149,0) Q "RTN","DGPFHLQ3",150,0) ; "RTN","DGPFHLQ3",151,0) QRF(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ3",152,0) ; "RTN","DGPFHLQ3",153,0) ; Input: "RTN","DGPFHLQ3",154,0) ; DGSEG - PID segment field array "RTN","DGPFHLQ3",155,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",156,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",157,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",158,0) ; "RTN","DGPFHLQ3",159,0) ; Output: "RTN","DGPFHLQ3",160,0) ; DGQRY("SSN") - Patient's Social Security Number "RTN","DGPFHLQ3",161,0) ; DGQRY("DOB") - Patient's Date of Birth "RTN","DGPFHLQ3",162,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",163,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",164,0) ; "RTN","DGPFHLQ3",165,0) S DGQRY("SSN")=$G(DGSEG(4)) "RTN","DGPFHLQ3",166,0) I DGQRY("SSN")="" S DGERR("QRF",1,4)="NM" ;no match "RTN","DGPFHLQ3",167,0) ; "RTN","DGPFHLQ3",168,0) S DGQRY("DOB")=+$$HL7TFM^XLFDT($G(DGSEG(5))) "RTN","DGPFHLQ3",169,0) I DGQRY("DOB")'>0 S DGERR("QRF",1,5)="NM" ;no match "RTN","DGPFHLQ3",170,0) Q "RTN","DGPFHLQ3",171,0) ; "RTN","DGPFHLQ3",172,0) OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ3",173,0) ; "RTN","DGPFHLQ3",174,0) ; Input: "RTN","DGPFHLQ3",175,0) ; DGSEG - OBR segment field array "RTN","DGPFHLQ3",176,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",177,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",178,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",179,0) ; "RTN","DGPFHLQ3",180,0) ; Output: "RTN","DGPFHLQ3",181,0) ; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13 "RTN","DGPFHLQ3",182,0) ; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13 "RTN","DGPFHLQ3",183,0) ; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13 "RTN","DGPFHLQ3",184,0) ; DGORF("SETID") - OBR segment Set ID "RTN","DGPFHLQ3",185,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",186,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",187,0) N DGSETID ;OBR segment Set ID "RTN","DGPFHLQ3",188,0) ; "RTN","DGPFHLQ3",189,0) S (DGORF("SETID"),DGSETID)=+$G(DGSEG(1)) "RTN","DGPFHLQ3",190,0) I DGSETID>0 D "RTN","DGPFHLQ3",191,0) . S DGORF(DGSETID,"FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15," "RTN","DGPFHLQ3",192,0) . S DGORF(DGSETID,"OWNER")=$$IEN^XUAF4($G(DGSEG(20))) "RTN","DGPFHLQ3",193,0) . S DGORF(DGSETID,"ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21))) "RTN","DGPFHLQ3",194,0) Q "RTN","DGPFHLQ3",195,0) ; "RTN","DGPFHLQ3",196,0) OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ3",197,0) ; "RTN","DGPFHLQ3",198,0) ; Input: "RTN","DGPFHLQ3",199,0) ; DGSEG - OBX segment field array "RTN","DGPFHLQ3",200,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",201,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",202,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",203,0) ; "RTN","DGPFHLQ3",204,0) ; Output: "RTN","DGPFHLQ3",205,0) ; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field, "RTN","DGPFHLQ3",206,0) ; file #26.13 "RTN","DGPFHLQ3",207,0) ; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field, "RTN","DGPFHLQ3",208,0) ; file #26.14 "RTN","DGPFHLQ3",209,0) ; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field, "RTN","DGPFHLQ3",210,0) ; file #26.14 "RTN","DGPFHLQ3",211,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",212,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",213,0) ; "RTN","DGPFHLQ3",214,0) N DGADT ;assignment date "RTN","DGPFHLQ3",215,0) N DGI "RTN","DGPFHLQ3",216,0) N DGLINE ;text line counter "RTN","DGPFHLQ3",217,0) N DGRSLT "RTN","DGPFHLQ3",218,0) N DGSETID ;OBR segment Set ID "RTN","DGPFHLQ3",219,0) ; "RTN","DGPFHLQ3",220,0) S DGSETID=+$G(DGORF("SETID")) "RTN","DGPFHLQ3",221,0) Q:(DGSETID'>0) "RTN","DGPFHLQ3",222,0) ; "RTN","DGPFHLQ3",223,0) ; Narrative Observation Identifier "RTN","DGPFHLQ3",224,0) I $P(DGSEG(3),DGCS,1)="N" D "RTN","DGPFHLQ3",225,0) . S DGLINE=$O(DGORF(DGSETID,"NARR",""),-1) "RTN","DGPFHLQ3",226,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLQ3",227,0) . . S DGORF(DGSETID,"NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLQ3",228,0) ; "RTN","DGPFHLQ3",229,0) ; Status Observation Identifier "RTN","DGPFHLQ3",230,0) I $P(DGSEG(3),DGCS,1)="S" D "RTN","DGPFHLQ3",231,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14)) "RTN","DGPFHLQ3",232,0) . Q:(+DGADT'>0) "RTN","DGPFHLQ3",233,0) . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT) "RTN","DGPFHLQ3",234,0) . S DGORF(DGSETID,DGADT,"ACTION")=+DGRSLT "RTN","DGPFHLQ3",235,0) ; "RTN","DGPFHLQ3",236,0) ; Comment Observation Identifier "RTN","DGPFHLQ3",237,0) I $P(DGSEG(3),DGCS,1)="C" D "RTN","DGPFHLQ3",238,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14)) "RTN","DGPFHLQ3",239,0) . Q:(+DGADT'>0) "RTN","DGPFHLQ3",240,0) . S DGLINE=$O(DGORF(DGSETID,DGADT,"COMMENT",""),-1) "RTN","DGPFHLQ3",241,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLQ3",242,0) . . S DGORF(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLQ3",243,0) Q "RTN","DGPFHLR") 0^7^B30149519 "RTN","DGPFHLR",1,0) DGPFHLR ;ALB/RPM - PRF HL7 RECEIVE DRIVERS ; 6/17/03 1:38pm "RTN","DGPFHLR",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLR",3,0) ; "RTN","DGPFHLR",4,0) RCV ;Receive all message types and route to message specific receiver "RTN","DGPFHLR",5,0) ; "RTN","DGPFHLR",6,0) ;This procedure is the main driver entry point for receiving all "RTN","DGPFHLR",7,0) ;message types (ORU, ACK, QRY and ORF) for patient record flag "RTN","DGPFHLR",8,0) ;assignment sharing. "RTN","DGPFHLR",9,0) ; "RTN","DGPFHLR",10,0) ;All procedures and functions assume that all VistA HL7 environment "RTN","DGPFHLR",11,0) ;variables are properly initialized and will produce a fatal error if "RTN","DGPFHLR",12,0) ;they are missing. "RTN","DGPFHLR",13,0) ; "RTN","DGPFHLR",14,0) ;The received message is copied to a temporary work global for "RTN","DGPFHLR",15,0) ;processing. The message type is determined from the MSH segment and "RTN","DGPFHLR",16,0) ;a receive processing procedure specific to the message type is called. "RTN","DGPFHLR",17,0) ;(Ex. ORU~R01 message calls procedure: RCVORU). The specific receive "RTN","DGPFHLR",18,0) ;processing procedure calls a message specific parse procedure to "RTN","DGPFHLR",19,0) ;validate the message data and return data arrays for storage. If no "RTN","DGPFHLR",20,0) ;parse errors are reported during validation, then the data arrays are "RTN","DGPFHLR",21,0) ;stored by the receive processing procedure. Control, along with any "RTN","DGPFHLR",22,0) ;parse validation errors, is then passed to the message specific send "RTN","DGPFHLR",23,0) ;processing procedures to build and transmit the acknowledgment and "RTN","DGPFHLR",24,0) ;query results messages. "RTN","DGPFHLR",25,0) ; "RTN","DGPFHLR",26,0) ; The message specific procedures are as follows: "RTN","DGPFHLR",27,0) ; "RTN","DGPFHLR",28,0) ; Message Receive Procedure Parse Procedure Send Procedure "RTN","DGPFHLR",29,0) ; ------- ----------------- ---------------- -------------- "RTN","DGPFHLR",30,0) ; ORU~R01 RCVORU^DGPFHLR PARSORU^DGPFHLU SNDACK^DGPFHLS "RTN","DGPFHLR",31,0) ; ACK~R01 RCVACK^DGPFHLR PARSACK^DGPFHLU4 N/A "RTN","DGPFHLR",32,0) ; QRY~R02 RCVQRY^DGPFHLR PARSQRY^DGPFHLQ3 SNDORF^DGPFHLS "RTN","DGPFHLR",33,0) ; ORF~R04 RCVORF^DGPFHLR PARSORF^DGPFHLQ3 N/A "RTN","DGPFHLR",34,0) ; "RTN","DGPFHLR",35,0) N DGCNT "RTN","DGPFHLR",36,0) N DGMSGTYP "RTN","DGPFHLR",37,0) N DGSEG "RTN","DGPFHLR",38,0) N DGSEGCNT "RTN","DGPFHLR",39,0) N DGWRK "RTN","DGPFHLR",40,0) ; "RTN","DGPFHLR",41,0) S DGWRK=$NA(^TMP("DGPFHL7",$J)) "RTN","DGPFHLR",42,0) K @DGWRK "RTN","DGPFHLR",43,0) ; "RTN","DGPFHLR",44,0) ;load work global with segments "RTN","DGPFHLR",45,0) F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","DGPFHLR",46,0) . S DGCNT=0 "RTN","DGPFHLR",47,0) . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE "RTN","DGPFHLR",48,0) . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D "RTN","DGPFHLR",49,0) . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT) "RTN","DGPFHLR",50,0) ; "RTN","DGPFHLR",51,0) ;get message type from "MSH" "RTN","DGPFHLR",52,0) I $$NXTSEG^DGPFHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D "RTN","DGPFHLR",53,0) . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1) "RTN","DGPFHLR",54,0) . ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET "RTN","DGPFHLR",55,0) . I DGMSGTYP=HL("MTN") D @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)") "RTN","DGPFHLR",56,0) ; "RTN","DGPFHLR",57,0) ;cleanup "RTN","DGPFHLR",58,0) K @DGWRK "RTN","DGPFHLR",59,0) Q "RTN","DGPFHLR",60,0) ; "RTN","DGPFHLR",61,0) RCVORU(DGWRK,DGMIEN,DGHL) ;Receive ORU Message Types (ORU~R01) "RTN","DGPFHLR",62,0) ; "RTN","DGPFHLR",63,0) ; Input: "RTN","DGPFHLR",64,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",65,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",66,0) ; DGHL - HL environment array "RTN","DGPFHLR",67,0) ; "RTN","DGPFHLR",68,0) ; Output: "RTN","DGPFHLR",69,0) ; none "RTN","DGPFHLR",70,0) ; "RTN","DGPFHLR",71,0) N DGPFA "RTN","DGPFHLR",72,0) N DGPFAH "RTN","DGPFHLR",73,0) N DGSEGERR "RTN","DGPFHLR",74,0) N DGSTOERR "RTN","DGPFHLR",75,0) N DGACKTYP "RTN","DGPFHLR",76,0) ; "RTN","DGPFHLR",77,0) D PARSORU^DGPFHLU(DGWRK,.DGHL,.DGPFA,.DGPFAH,.DGSEGERR) "RTN","DGPFHLR",78,0) ; "RTN","DGPFHLR",79,0) D ;drop out of block on failure "RTN","DGPFHLR",80,0) . S DGACKTYP="AE" "RTN","DGPFHLR",81,0) . Q:$D(DGSEGERR) "RTN","DGPFHLR",82,0) . Q:'$$STOHL7^DGPFAA2(.DGPFA,.DGPFAH,.DGSTOERR) "RTN","DGPFHLR",83,0) . S DGACKTYP="AA" "RTN","DGPFHLR",84,0) ; "RTN","DGPFHLR",85,0) D SNDACK^DGPFHLS(DGACKTYP,DGMIEN,.DGHL,.DGSEGERR,.DGSTOERR) "RTN","DGPFHLR",86,0) Q "RTN","DGPFHLR",87,0) ; "RTN","DGPFHLR",88,0) RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01) "RTN","DGPFHLR",89,0) ; "RTN","DGPFHLR",90,0) ; Input: "RTN","DGPFHLR",91,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",92,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",93,0) ; DGHL - HL environment array "RTN","DGPFHLR",94,0) ; "RTN","DGPFHLR",95,0) ; Output: "RTN","DGPFHLR",96,0) ; none "RTN","DGPFHLR",97,0) ; "RTN","DGPFHLR",98,0) N DGACK ;ACK data array "RTN","DGPFHLR",99,0) N DGERR ;error array "RTN","DGPFHLR",100,0) N DGLIEN ;HL7 transmission log IEN "RTN","DGPFHLR",101,0) N DGPFL ;HL7 transmssion log data array "RTN","DGPFHLR",102,0) ; "RTN","DGPFHLR",103,0) D PARSACK^DGPFHLU4(DGWRK,.DGHL,.DGACK,.DGERR) "RTN","DGPFHLR",104,0) I +$G(DGACK("MSGID")) D "RTN","DGPFHLR",105,0) . S DGLIEN=$$FNDLOG^DGPFHLL(DGACK("MSGID")) "RTN","DGPFHLR",106,0) . Q:'DGLIEN "RTN","DGPFHLR",107,0) . I $G(DGACK("ACKCODE"))="AA" D "RTN","DGPFHLR",108,0) . . D STOSTAT^DGPFHLL(DGLIEN,"A") "RTN","DGPFHLR",109,0) . E D "RTN","DGPFHLR",110,0) . . D PROCERR^DGPFHLU5(DGLIEN,.DGACK,.DGERR) "RTN","DGPFHLR",111,0) . . D STOSTAT^DGPFHLL(DGLIEN,"RJ") "RTN","DGPFHLR",112,0) Q "RTN","DGPFHLR",113,0) ; "RTN","DGPFHLR",114,0) RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02) "RTN","DGPFHLR",115,0) ; "RTN","DGPFHLR",116,0) ; Input: "RTN","DGPFHLR",117,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",118,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",119,0) ; DGHL - HL environment array "RTN","DGPFHLR",120,0) ; "RTN","DGPFHLR",121,0) ; Output: "RTN","DGPFHLR",122,0) ; none "RTN","DGPFHLR",123,0) ; "RTN","DGPFHLR",124,0) N DGDFN "RTN","DGPFHLR",125,0) N DGQRY "RTN","DGPFHLR",126,0) N DGQRYERR "RTN","DGPFHLR",127,0) N DGSEGERR "RTN","DGPFHLR",128,0) ; "RTN","DGPFHLR",129,0) D PARSQRY^DGPFHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR) "RTN","DGPFHLR",130,0) S DGDFN=$$GETDFN^DGPFUT2(DGQRY("ICN"),DGQRY("DOB"),DGQRY("SSN")) "RTN","DGPFHLR",131,0) I DGDFN'>0 S DGQRYERR="NM" "RTN","DGPFHLR",132,0) D SNDORF^DGPFHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR) "RTN","DGPFHLR",133,0) Q "RTN","DGPFHLR",134,0) ; "RTN","DGPFHLR",135,0) RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R04) "RTN","DGPFHLR",136,0) ; "RTN","DGPFHLR",137,0) ; Input: "RTN","DGPFHLR",138,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",139,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",140,0) ; DGHL - HL environment array "RTN","DGPFHLR",141,0) ; "RTN","DGPFHLR",142,0) ; Output: "RTN","DGPFHLR",143,0) ; none "RTN","DGPFHLR",144,0) ; "RTN","DGPFHLR",145,0) N DGACTDT ;activity date ("ASSIGNDT") "RTN","DGPFHLR",146,0) N DGERR ;parse error array "RTN","DGPFHLR",147,0) N DGORF ;ORF data array "RTN","DGPFHLR",148,0) N DGPFA ;assignment data array "RTN","DGPFHLR",149,0) N DGPFAH ;assignment history data array "RTN","DGPFHLR",150,0) N DGSET ;OBR set ID "RTN","DGPFHLR",151,0) N DGSTOERR ;STOHL7 filer errors "RTN","DGPFHLR",152,0) ; "RTN","DGPFHLR",153,0) D PARSORF^DGPFHLQ3(DGWRK,.DGHL,.DGORF,.DGERR) "RTN","DGPFHLR",154,0) ; "RTN","DGPFHLR",155,0) Q:'$D(DGORF) "RTN","DGPFHLR",156,0) Q:(+$G(DGORF("QID"))'>0) "RTN","DGPFHLR",157,0) Q:'$D(^DPT(DGORF("QID"),0)) "RTN","DGPFHLR",158,0) ; "RTN","DGPFHLR",159,0) S DGSET=0 "RTN","DGPFHLR",160,0) F S DGSET=$O(DGORF(DGSET)) Q:'DGSET D "RTN","DGPFHLR",161,0) . N DGAERR ;assignment filer errors "RTN","DGPFHLR",162,0) . N DGPFA ;assignment data array "RTN","DGPFHLR",163,0) . ; "RTN","DGPFHLR",164,0) . Q:($G(DGORF(DGSET,"FLAG"))']"") "RTN","DGPFHLR",165,0) . S DGPFA("DFN")=DGORF("QID") "RTN","DGPFHLR",166,0) . S DGPFA("FLAG")=DGORF(DGSET,"FLAG") "RTN","DGPFHLR",167,0) . ; "RTN","DGPFHLR",168,0) . ;set STATUS to null as a placeholder, actual value is determined by "RTN","DGPFHLR",169,0) . ;$$STATUS^DGPFUT call below "RTN","DGPFHLR",170,0) . S DGPFA("STATUS")="" "RTN","DGPFHLR",171,0) . S DGPFA("OWNER")=$G(DGORF(DGSET,"OWNER")) "RTN","DGPFHLR",172,0) . S DGPFA("ORIGSITE")=$G(DGORF(DGSET,"ORIGSITE")) "RTN","DGPFHLR",173,0) . M DGPFA("NARR")=DGORF(DGSET,"NARR") "RTN","DGPFHLR",174,0) . S DGACTDT=0 "RTN","DGPFHLR",175,0) . F S DGACTDT=$O(DGORF(DGSET,DGACTDT)) Q:'DGACTDT D "RTN","DGPFHLR",176,0) . . N DGAHERR ;assignment history filer errors "RTN","DGPFHLR",177,0) . . N DGPFAH ;assignment history data array "RTN","DGPFHLR",178,0) . . ; "RTN","DGPFHLR",179,0) . . S DGPFAH("ASSIGNDT")=DGACTDT "RTN","DGPFHLR",180,0) . . S DGPFAH("ACTION")=$G(DGORF(DGSET,DGACTDT,"ACTION")) "RTN","DGPFHLR",181,0) . . S DGPFAH("ENTERBY")=.5 ;always be POSTMASTER (DUZ=.5) "RTN","DGPFHLR",182,0) . . S DGPFAH("APPRVBY")=.5 ;always be POSTMASTER (DUZ=.5) "RTN","DGPFHLR",183,0) . . M DGPFAH("COMMENT")=DGORF(DGSET,DGACTDT,"COMMENT") "RTN","DGPFHLR",184,0) . . ; "RTN","DGPFHLR",185,0) . . ;calculate the assignment STATUS from the ACTION "RTN","DGPFHLR",186,0) . . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION")) "RTN","DGPFHLR",187,0) . . I $$STOHL7^DGPFAA2(.DGPFA,.DGPFAH,.DGSTOERR) "RTN","DGPFHLR",188,0) Q "RTN","DGPFHLRT") 0^66^B8257718 "RTN","DGPFHLRT",1,0) DGPFHLRT ;ALB/RPM - PRF HL7 MESSAGE RETRANSMIT ; 6/19/03 "RTN","DGPFHLRT",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLRT",3,0) ;This routine provides procedures for retransmitting rejected PRF "RTN","DGPFHLRT",4,0) ;ORU~R01 HL7 messages. "RTN","DGPFHLRT",5,0) ; "RTN","DGPFHLRT",6,0) Q ;no direct entry "RTN","DGPFHLRT",7,0) ; "RTN","DGPFHLRT",8,0) REXMIT ;Retransmit all rejected PRF ORU~R01 messages "RTN","DGPFHLRT",9,0) ;This procedure scans all entries in the ASTAT index of the PRF HL7 "RTN","DGPFHLRT",10,0) ;TRANSMISSION LOG (#26.17) file, looking for transmissions with a "RTN","DGPFHLRT",11,0) ;status of REJECT and that were rejected prior to the start of the "RTN","DGPFHLRT",12,0) ;scan "RTN","DGPFHLRT",13,0) ; "RTN","DGPFHLRT",14,0) Q:'$$ORUON^DGPFPARM() ;ORU interface must be active "RTN","DGPFHLRT",15,0) ; "RTN","DGPFHLRT",16,0) N DGCODAT ;cutoff date for scan "RTN","DGPFHLRT",17,0) N DGDAT ;original transmission date "RTN","DGPFHLRT",18,0) N DGERR ;error array "RTN","DGPFHLRT",19,0) N DGFAC ;destination station number "RTN","DGPFHLRT",20,0) N DGFDA ;FDA array "RTN","DGPFHLRT",21,0) N DGLIEN ;pointer to PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFHLRT",22,0) N DGPARAM ;target root for PRF PARAMETERS (#26.18) file date fields "RTN","DGPFHLRT",23,0) N DGPERIOD ;auto retransmit delay period "RTN","DGPFHLRT",24,0) N DGPFAH ;assignment history data array "RTN","DGPFHLRT",25,0) N DGPFL ;HL7 transmission log data array "RTN","DGPFHLRT",26,0) N DGSTAT ;transmission status "RTN","DGPFHLRT",27,0) N DGTOT ;total rexmit'd messages "RTN","DGPFHLRT",28,0) ; "RTN","DGPFHLRT",29,0) ;retrieve date/time of last scanned entry and retransmit period "RTN","DGPFHLRT",30,0) D GETS^DIQ(26.18,"1,","4;5","I","DGPARAM","DGERR") "RTN","DGPFHLRT",31,0) Q:$D(DGERR) "RTN","DGPFHLRT",32,0) S DGDAT=$G(DGPARAM(26.18,"1,",4,"I")) "RTN","DGPFHLRT",33,0) S DGPERIOD=$S(DGDAT>0:+$G(DGPARAM(26.18,"1,",5,"I")),1:0) "RTN","DGPFHLRT",34,0) S DGTOT=0 "RTN","DGPFHLRT",35,0) ; "RTN","DGPFHLRT",36,0) ;calculate cutoff date "RTN","DGPFHLRT",37,0) S DGCODAT=$$FMADD^XLFDT($$NOW^XLFDT(),-DGPERIOD) "RTN","DGPFHLRT",38,0) ; "RTN","DGPFHLRT",39,0) ;loop through date/times "RTN","DGPFHLRT",40,0) F S DGDAT=$O(^DGPF(26.17,"ASTAT",DGDAT)) Q:'DGDAT!(DGDAT>DGCODAT) D "RTN","DGPFHLRT",41,0) . ; "RTN","DGPFHLRT",42,0) . ;loop through status "RTN","DGPFHLRT",43,0) . S DGSTAT="" "RTN","DGPFHLRT",44,0) . F S DGSTAT=$O(^DGPF(26.17,"ASTAT",DGDAT,DGSTAT)) Q:DGSTAT="" I DGSTAT="RJ" D "RTN","DGPFHLRT",45,0) . . ; "RTN","DGPFHLRT",46,0) . . ;loop through log file IEN "RTN","DGPFHLRT",47,0) . . S DGLIEN=0 "RTN","DGPFHLRT",48,0) . . F S DGLIEN=$O(^DGPF(26.17,"ASTAT",DGDAT,DGSTAT,DGLIEN)) Q:'DGLIEN D "RTN","DGPFHLRT",49,0) . . . ; "RTN","DGPFHLRT",50,0) . . . ;retrieve assignment history file IEN "RTN","DGPFHLRT",51,0) . . . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFHLRT",52,0) . . . Q:'+DGPFL("ASGNHIST") "RTN","DGPFHLRT",53,0) . . . ; "RTN","DGPFHLRT",54,0) . . . ;retrieve institution and convert to station# "RTN","DGPFHLRT",55,0) . . . S DGFAC(1)=$$STA^XUAF4(+DGPFL("SITE")) "RTN","DGPFHLRT",56,0) . . . Q:'DGFAC(1) "RTN","DGPFHLRT",57,0) . . . ; "RTN","DGPFHLRT",58,0) . . . ;retrieve assignment file IEN "RTN","DGPFHLRT",59,0) . . . Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFHLRT",60,0) . . . Q:'+DGPFAH("ASSIGN") "RTN","DGPFHLRT",61,0) . . . ; "RTN","DGPFHLRT",62,0) . . . ;build and transmit the new message "RTN","DGPFHLRT",63,0) . . . Q:'$$SNDORU^DGPFHLS(+DGPFAH("ASSIGN"),+DGPFL("ASGNHIST"),.DGFAC) "RTN","DGPFHLRT",64,0) . . . ; "RTN","DGPFHLRT",65,0) . . . ;update HL7 transmission log "RTN","DGPFHLRT",66,0) . . . D STOSTAT^DGPFHLL(DGLIEN,"RT") "RTN","DGPFHLRT",67,0) . . . ; "RTN","DGPFHLRT",68,0) . . . ;update total count "RTN","DGPFHLRT",69,0) . . . S DGTOT=DGTOT+1 "RTN","DGPFHLRT",70,0) ; "RTN","DGPFHLRT",71,0) ;update PRF HL7 REXMIT TASK DATE/TIME (#4) field "RTN","DGPFHLRT",72,0) S DGFDA(26.18,"1,",4)=$O(^DGPF(26.17,"ASTAT",DGDAT),-1) "RTN","DGPFHLRT",73,0) D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFHLRT",74,0) ; "RTN","DGPFHLRT",75,0) Q "RTN","DGPFHLS") 0^8^B29645251 "RTN","DGPFHLS",1,0) DGPFHLS ;ALB/RPM - PRF HL7 SEND DRIVERS ; 5/13/03 3:20pm "RTN","DGPFHLS",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLS",3,0) ; "RTN","DGPFHLS",4,0) SNDORU(DGPFIEN,DGPFHIEN,DGFAC) ;Send ORU Message Types (ORU~R01) "RTN","DGPFHLS",5,0) ;This function builds and transmits a single ORU message to all sites "RTN","DGPFHLS",6,0) ;in the associated patient's TREATING FACILITY LIST (#391.91) file. "RTN","DGPFHLS",7,0) ;The optional input parameter DGFAC overrides selection of sites "RTN","DGPFHLS",8,0) ;from the TREATING FACILITY LIST file. "RTN","DGPFHLS",9,0) ; "RTN","DGPFHLS",10,0) ; Supported DBIA #2990: This supported DBIA is used to access the "RTN","DGPFHLS",11,0) ; Registration API to generate a list of "RTN","DGPFHLS",12,0) ; treating facilities for a given patient. "RTN","DGPFHLS",13,0) ; Input: "RTN","DGPFHLS",14,0) ; DGPFIEN - (required) IEN of assignment in PRF ASSIGNMENT (#26.13) "RTN","DGPFHLS",15,0) ; file to transmit "RTN","DGPFHLS",16,0) ; DGPFHIEN - (optional) IEN of assignment history in PRF ASSIGNMENT "RTN","DGPFHLS",17,0) ; HISTORY (#26.14) file to include in ORU. "RTN","DGPFHLS",18,0) ; [default = $$GETLAST^DGPFAAH(DGPFIEN)] "RTN","DGPFHLS",19,0) ; DGFAC - (optional) array of message destination facilities "RTN","DGPFHLS",20,0) ; passed by reference "RTN","DGPFHLS",21,0) ; format: DGFAC(#)=station# "RTN","DGPFHLS",22,0) ; "RTN","DGPFHLS",23,0) ; Output: "RTN","DGPFHLS",24,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLS",25,0) ; "RTN","DGPFHLS",26,0) N HLEID ;event protocol ID "RTN","DGPFHLS",27,0) N DGHL ;VistA HL7 environment array "RTN","DGPFHLS",28,0) N DGHLROOT ;message array location "RTN","DGPFHLS",29,0) N DGPFA ;assignment data array "RTN","DGPFHLS",30,0) N DGPFAH ;assignment history data array "RTN","DGPFHLS",31,0) N DGRSLT ;function value "RTN","DGPFHLS",32,0) ; "RTN","DGPFHLS",33,0) S DGRSLT=0 "RTN","DGPFHLS",34,0) S DGHLROOT=$NA(^TMP("PRFORU",$J)) "RTN","DGPFHLS",35,0) K @DGHLROOT "RTN","DGPFHLS",36,0) ; "RTN","DGPFHLS",37,0) I $$ORUON^DGPFPARM(),+$G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFHLS",38,0) . ; "RTN","DGPFHLS",39,0) . ;retrieve assignment record "RTN","DGPFHLS",40,0) . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA) "RTN","DGPFHLS",41,0) . ; "RTN","DGPFHLS",42,0) . ;retrieve assignment history record "RTN","DGPFHLS",43,0) . S DGPFHIEN=$S($G(DGPFHIEN)>0:DGPFHIEN,1:$$GETLAST^DGPFAAH(DGPFIEN)) "RTN","DGPFHLS",44,0) . Q:'$$GETHIST^DGPFAAH(DGPFHIEN,.DGPFAH) "RTN","DGPFHLS",45,0) . ; "RTN","DGPFHLS",46,0) . ;initialize VistA HL7 environment "RTN","DGPFHLS",47,0) . S HLEID=$$INIT^DGPFHLUT("DGPF PRF ORU/R01 EVENT",.DGHL) "RTN","DGPFHLS",48,0) . Q:'HLEID "RTN","DGPFHLS",49,0) . ; "RTN","DGPFHLS",50,0) . ;build ORU segments array "RTN","DGPFHLS",51,0) . Q:'$$BLDORU^DGPFHLU(.DGPFA,.DGPFAH,.DGHL,DGHLROOT) "RTN","DGPFHLS",52,0) . ; "RTN","DGPFHLS",53,0) . ;retrieve treating facilities when no destination is provided "RTN","DGPFHLS",54,0) . I '$D(DGFAC) D TFL^VAFCTFU1(.DGFAC,+$G(DGPFA("DFN"))) "RTN","DGPFHLS",55,0) . Q:'$D(DGFAC) "RTN","DGPFHLS",56,0) . ; "RTN","DGPFHLS",57,0) . ;transmit and log messages "RTN","DGPFHLS",58,0) . Q:'$$XMIT^DGPFHLU6(DGPFHIEN,HLEID,.DGFAC,DGHLROOT,.DGHL) "RTN","DGPFHLS",59,0) . ; "RTN","DGPFHLS",60,0) . ;success "RTN","DGPFHLS",61,0) . S DGRSLT=1 "RTN","DGPFHLS",62,0) ; "RTN","DGPFHLS",63,0) ;cleanup "RTN","DGPFHLS",64,0) K @DGHLROOT "RTN","DGPFHLS",65,0) Q DGRSLT "RTN","DGPFHLS",66,0) ; "RTN","DGPFHLS",67,0) SNDACK(DGACKTYP,DGMIEN,DGHL,DGSEGERR,DGSTOERR) ;Send ACK Message Type (ACK~R01) "RTN","DGPFHLS",68,0) ;This procedure assumes the the VistA HL7 environment is providing the "RTN","DGPFHLS",69,0) ;environment variables and will produce a fatal error if they are "RTN","DGPFHLS",70,0) ;missing. "RTN","DGPFHLS",71,0) ; "RTN","DGPFHLS",72,0) ; Input: "RTN","DGPFHLS",73,0) ; DGACKTYP - (required) ACK message type ("AA","AE") "RTN","DGPFHLS",74,0) ; DGMIEN - (required) IEN of message entry in file #773 "RTN","DGPFHLS",75,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLS",76,0) ; DGSEGERR - (optional) Errors found during parsing "RTN","DGPFHLS",77,0) ; DGSTOERR - (optional) Errors during data storage "RTN","DGPFHLS",78,0) ; "RTN","DGPFHLS",79,0) ; Output: "RTN","DGPFHLS",80,0) ; none "RTN","DGPFHLS",81,0) ; "RTN","DGPFHLS",82,0) N DGHLROOT "RTN","DGPFHLS",83,0) N DGHLERR "RTN","DGPFHLS",84,0) ; "RTN","DGPFHLS",85,0) Q:($G(DGACKTYP)']"") "RTN","DGPFHLS",86,0) Q:('+$G(DGMIEN)) "RTN","DGPFHLS",87,0) ; "RTN","DGPFHLS",88,0) S DGHLROOT=$NA(^TMP("HLA",$J)) "RTN","DGPFHLS",89,0) K @DGHLROOT "RTN","DGPFHLS",90,0) ; "RTN","DGPFHLS",91,0) ;build ACK segments array "RTN","DGPFHLS",92,0) I $$BLDACK^DGPFHLU4(DGACKTYP,DGHLROOT,.DGHL,.DGSEGERR,.DGSTOERR) D "RTN","DGPFHLS",93,0) . ; "RTN","DGPFHLS",94,0) . ;generate the message "RTN","DGPFHLS",95,0) . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR) "RTN","DGPFHLS",96,0) ; "RTN","DGPFHLS",97,0) ;cleanup "RTN","DGPFHLS",98,0) K @DGHLROOT "RTN","DGPFHLS",99,0) Q "RTN","DGPFHLS",100,0) ; "RTN","DGPFHLS",101,0) SNDQRY(DGDFN,DGMODE) ;Send QRY Message Types (QRY~R02) "RTN","DGPFHLS",102,0) ; "RTN","DGPFHLS",103,0) ; Input: "RTN","DGPFHLS",104,0) ; DGDFN - (required) pointer to patient in PATIENT (#2) file "RTN","DGPFHLS",105,0) ; DGMODE - (optional) type of HL7 connection to use ("1" - direct "RTN","DGPFHLS",106,0) ; connection, "2" - deferred connection [default]) "RTN","DGPFHLS",107,0) ; "RTN","DGPFHLS",108,0) ; Output: "RTN","DGPFHLS",109,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLS",110,0) ; "RTN","DGPFHLS",111,0) N DGCMOR "RTN","DGPFHLS",112,0) N DGHLROOT "RTN","DGPFHLS",113,0) N DGHLLNK "RTN","DGPFHLS",114,0) N DGHL "RTN","DGPFHLS",115,0) N DGICN "RTN","DGPFHLS",116,0) N DGMSG "RTN","DGPFHLS",117,0) N DGRSLT "RTN","DGPFHLS",118,0) N HLL "RTN","DGPFHLS",119,0) N HLEID "RTN","DGPFHLS",120,0) N HLRSLT "RTN","DGPFHLS",121,0) ; "RTN","DGPFHLS",122,0) ;the following HL* variables are created by DIRECT^HLMA "RTN","DGPFHLS",123,0) N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN "RTN","DGPFHLS",124,0) N HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ "RTN","DGPFHLS",125,0) N HLQUIT "RTN","DGPFHLS",126,0) ; "RTN","DGPFHLS",127,0) S DGMODE=+$G(DGMODE) "RTN","DGPFHLS",128,0) S DGRSLT=0 "RTN","DGPFHLS",129,0) S DGHLROOT=$NA(^TMP("HLS",$J)) "RTN","DGPFHLS",130,0) K @DGHLROOT "RTN","DGPFHLS",131,0) ; "RTN","DGPFHLS",132,0) I $$QRYON^DGPFPARM(),+$G(DGDFN)>0,$D(^DPT(DGDFN,0)) D "RTN","DGPFHLS",133,0) . ; "RTN","DGPFHLS",134,0) . ;ICN must be national and CMOR must not be local site "RTN","DGPFHLS",135,0) . Q:'$$MPIOK^DGPFUT(DGDFN,.DGICN,.DGCMOR) "RTN","DGPFHLS",136,0) . ; "RTN","DGPFHLS",137,0) . ;retrieve CMOR's HL Logical Link and build HLL array "RTN","DGPFHLS",138,0) . S DGHLLNK=$$GETLINK^DGPFHLUT(DGCMOR) "RTN","DGPFHLS",139,0) . Q:(DGHLLNK=0) "RTN","DGPFHLS",140,0) . S HLL("LINKS",1)="DGPF PRF ORF/R04 SUBSC"_U_DGHLLNK "RTN","DGPFHLS",141,0) . ; "RTN","DGPFHLS",142,0) . ;initialize VistA HL7 environment "RTN","DGPFHLS",143,0) . S HLEID=$$INIT^DGPFHLUT("DGPF PRF QRY/R02 EVENT",.DGHL) "RTN","DGPFHLS",144,0) . Q:'HLEID "RTN","DGPFHLS",145,0) . ; "RTN","DGPFHLS",146,0) . ;build QRY segments array "RTN","DGPFHLS",147,0) . Q:'$$BLDQRY^DGPFHLQ(DGDFN,DGICN,DGHLROOT,.DGHL) "RTN","DGPFHLS",148,0) . ; "RTN","DGPFHLS",149,0) . ;display busy message to interactive users when direct-connect "RTN","DGPFHLS",150,0) . I DGMODE=1,$E($G(IOST),1,2)="C-" D "RTN","DGPFHLS",151,0) . . S DGMSG(1)="Attempting to connect to CMOR site to search for Patient" "RTN","DGPFHLS",152,0) . . S DGMSG(2)="Record Flag Assignments. This request may take some" "RTN","DGPFHLS",153,0) . . S DGMSG(3)="time, please be patient ..." "RTN","DGPFHLS",154,0) . . D EN^DDIOL(.DGMSG) "RTN","DGPFHLS",155,0) . ; "RTN","DGPFHLS",156,0) . ;generate HL7 message "RTN","DGPFHLS",157,0) . I DGMODE=1 D ;generate direct-connect HL7 message "RTN","DGPFHLS",158,0) . . D DIRECT^HLMA(HLEID,"GM",1,.HLRSLT,"","") "RTN","DGPFHLS",159,0) . . Q:$P(HLRSLT,U,2)]"" "RTN","DGPFHLS",160,0) . . I HLMTIEN D RCV^DGPFHLR "RTN","DGPFHLS",161,0) . . ;success "RTN","DGPFHLS",162,0) . . S DGRSLT=1 "RTN","DGPFHLS",163,0) . ; "RTN","DGPFHLS",164,0) . E D ;generate deferred HL7 message "RTN","DGPFHLS",165,0) . . D GENERATE^HLMA(HLEID,"GM",1,.HLRSLT,"","") "RTN","DGPFHLS",166,0) . . Q:$P(HLRSLT,U,2)]"" "RTN","DGPFHLS",167,0) . . ;success "RTN","DGPFHLS",168,0) . . S DGRSLT=1 "RTN","DGPFHLS",169,0) ; "RTN","DGPFHLS",170,0) ;cleanup "RTN","DGPFHLS",171,0) K @DGHLROOT "RTN","DGPFHLS",172,0) Q DGRSLT "RTN","DGPFHLS",173,0) ; "RTN","DGPFHLS",174,0) SNDORF(DGQRY,DGMIEN,DGHL,DGDFN,DGSEGERR,DGQRYERR) ;Send ORF Message Type (ORF~R04) "RTN","DGPFHLS",175,0) ;This procedure assumes the the VistA HL7 environment is providing the "RTN","DGPFHLS",176,0) ;environment variables and will produce a fatal error if they are "RTN","DGPFHLS",177,0) ;missing. "RTN","DGPFHLS",178,0) ; "RTN","DGPFHLS",179,0) ; Input: "RTN","DGPFHLS",180,0) ; DGQRY - (required) Array of QRY parsing results "RTN","DGPFHLS",181,0) ; DGMIEN - (required) IEN of message entry in file #773 "RTN","DGPFHLS",182,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLS",183,0) ; DGDFN - (required) Pointer to patient in PATIENT (#2) file "RTN","DGPFHLS",184,0) ; DGSEGERR - (optional) Errors found during parsing "RTN","DGPFHLS",185,0) ; DGQRYERR - (optional) Errors found during query "RTN","DGPFHLS",186,0) ; "RTN","DGPFHLS",187,0) ; Output: "RTN","DGPFHLS",188,0) ; none "RTN","DGPFHLS",189,0) ; "RTN","DGPFHLS",190,0) N DGHLROOT "RTN","DGPFHLS",191,0) N DGHLERR "RTN","DGPFHLS",192,0) ; "RTN","DGPFHLS",193,0) Q:('$D(DGQRY)) "RTN","DGPFHLS",194,0) Q:('+$G(DGMIEN)) "RTN","DGPFHLS",195,0) ; "RTN","DGPFHLS",196,0) S DGHLROOT=$NA(^TMP("HLA",$J)) "RTN","DGPFHLS",197,0) K @DGHLROOT "RTN","DGPFHLS",198,0) ; "RTN","DGPFHLS",199,0) ;build ORF segments array "RTN","DGPFHLS",200,0) I $$BLDORF^DGPFHLQ(DGHLROOT,.DGHL,DGDFN,.DGQRY,.DGSEGERR,.DGQRYERR) D "RTN","DGPFHLS",201,0) . ; "RTN","DGPFHLS",202,0) . ;generate the message "RTN","DGPFHLS",203,0) . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR) "RTN","DGPFHLS",204,0) ; "RTN","DGPFHLS",205,0) ;cleanup "RTN","DGPFHLS",206,0) K @DGHLROOT "RTN","DGPFHLS",207,0) Q "RTN","DGPFHLU") 0^1^B25993743 "RTN","DGPFHLU",1,0) DGPFHLU ;ALB/RPM - PRF HL7 ORU/ACK PROCESSING ; 6/17/03 1:27pm "RTN","DGPFHLU",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU",3,0) ; "RTN","DGPFHLU",4,0) BLDORU(DGPFA,DGPFAH,DGHL,DGROOT) ;Build ORU~R01 Message/Segments "RTN","DGPFHLU",5,0) ; "RTN","DGPFHLU",6,0) ; Input: "RTN","DGPFHLU",7,0) ; DGPFA - (required) Assignment data array "RTN","DGPFHLU",8,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU",9,0) ; DGHL - (required) HL7 Kernel array passed by reference "RTN","DGPFHLU",10,0) ; DGROOT - (required) Closed root array or global name for segment "RTN","DGPFHLU",11,0) ; storage "RTN","DGPFHLU",12,0) ; "RTN","DGPFHLU",13,0) ; Output: "RTN","DGPFHLU",14,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLU",15,0) ; DGROOT - array of HL7 segments "RTN","DGPFHLU",16,0) ; "RTN","DGPFHLU",17,0) N DGRSLT ;function value "RTN","DGPFHLU",18,0) N DGSEG ;segment counter "RTN","DGPFHLU",19,0) N DGSEGSTR ;formatted segment string "RTN","DGPFHLU",20,0) N DGSET ;set id "RTN","DGPFHLU",21,0) N DGSTR ;field string "RTN","DGPFHLU",22,0) N DGTROOT ;text root "RTN","DGPFHLU",23,0) ; "RTN","DGPFHLU",24,0) S DGRSLT=0 "RTN","DGPFHLU",25,0) S DGSEG=0 "RTN","DGPFHLU",26,0) ; "RTN","DGPFHLU",27,0) I $D(DGPFA),$D(DGPFAH),$G(DGROOT)]"" D "RTN","DGPFHLU",28,0) . ; "RTN","DGPFHLU",29,0) . ;build PID "RTN","DGPFHLU",30,0) . S DGSTR="1,2,3,5,7,8,19" "RTN","DGPFHLU",31,0) . S DGSEGSTR=$$EN^VAFHLPID(+DGPFA("DFN"),DGSTR,1,1) "RTN","DGPFHLU",32,0) . Q:(DGSEGSTR="") "RTN","DGPFHLU",33,0) . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",34,0) . ; "RTN","DGPFHLU",35,0) . ;build OBR "RTN","DGPFHLU",36,0) . S DGSET=1 "RTN","DGPFHLU",37,0) . S DGSTR="1,4,7,20" "RTN","DGPFHLU",38,0) . S DGSEGSTR=$$OBR^DGPFHLU1(DGSET,.DGPFA,.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLU",39,0) . Q:(DGSEGSTR="") "RTN","DGPFHLU",40,0) . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",41,0) . ; "RTN","DGPFHLU",42,0) . ;start OBX segments "RTN","DGPFHLU",43,0) . S DGSET=0 "RTN","DGPFHLU",44,0) . ; "RTN","DGPFHLU",45,0) . ;build narrative OBX segments "RTN","DGPFHLU",46,0) . S DGTROOT="DGPFA(""NARR"")" "RTN","DGPFHLU",47,0) . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGSEG,.DGSET) "RTN","DGPFHLU",48,0) . ; "RTN","DGPFHLU",49,0) . ;build status OBX segment "RTN","DGPFHLU",50,0) . S DGSTR="1,2,3,5,11,14" "RTN","DGPFHLU",51,0) . S DGSET=DGSET+1 "RTN","DGPFHLU",52,0) . S DGSEGSTR=$$OBX^DGPFHLU2(DGSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLU",53,0) . Q:(DGSEGSTR="") "RTN","DGPFHLU",54,0) . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",55,0) . ; "RTN","DGPFHLU",56,0) . ;build review comment OBX segments "RTN","DGPFHLU",57,0) . S DGTROOT="DGPFAH(""COMMENT"")" "RTN","DGPFHLU",58,0) . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGSEG,.DGSET) "RTN","DGPFHLU",59,0) . ; "RTN","DGPFHLU",60,0) . ;success "RTN","DGPFHLU",61,0) . S DGRSLT=1 "RTN","DGPFHLU",62,0) ; "RTN","DGPFHLU",63,0) Q DGRSLT "RTN","DGPFHLU",64,0) ; "RTN","DGPFHLU",65,0) PARSORU(DGWRK,DGHL,DGPFA,DGPFAH,DGPFERR) ;Parse ORU~R01 Message/Segments "RTN","DGPFHLU",66,0) ; "RTN","DGPFHLU",67,0) ; Input: "RTN","DGPFHLU",68,0) ; DGWRK - Closed root work global reference "RTN","DGPFHLU",69,0) ; DGHL - HL7 environment array "RTN","DGPFHLU",70,0) ; "RTN","DGPFHLU",71,0) ; Output: "RTN","DGPFHLU",72,0) ; DGPFA - Assignment data array "RTN","DGPFHLU",73,0) ; DGPFAH - Assignment history data array "RTN","DGPFHLU",74,0) ; DGPFERR - Undefined on success, ERR segment data array on failure "RTN","DGPFHLU",75,0) ; Format: DGPFERR(seg_id,sequence,fld_pos)=error_code "RTN","DGPFHLU",76,0) ; "RTN","DGPFHLU",77,0) N DGFS ;field separator "RTN","DGPFHLU",78,0) N DGCS ;component separator "RTN","DGPFHLU",79,0) N DGRS ;repetition separator "RTN","DGPFHLU",80,0) N DGCURLIN ;current segment line "RTN","DGPFHLU",81,0) N DGSEG ;segment field data array "RTN","DGPFHLU",82,0) N DGERR ;error processing array "RTN","DGPFHLU",83,0) ; "RTN","DGPFHLU",84,0) S DGFS=DGHL("FS") "RTN","DGPFHLU",85,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLU",86,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLU",87,0) S DGCURLIN=0 "RTN","DGPFHLU",88,0) ; "RTN","DGPFHLU",89,0) ;loop through the message segments and retrieve the field data "RTN","DGPFHLU",90,0) F D Q:'DGCURLIN "RTN","DGPFHLU",91,0) . N DGSEG "RTN","DGPFHLU",92,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLU",93,0) . Q:'DGCURLIN "RTN","DGPFHLU",94,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,.DGPFA,.DGPFAH,.DGPFERR)") "RTN","DGPFHLU",95,0) ; "RTN","DGPFHLU",96,0) ;the ENTERBY and APPRVBY will always be POSTMASTER (DUZ=.5) "RTN","DGPFHLU",97,0) S DGPFAH("ENTERBY")=.5 ;ENTERED BY (.04) field, file 26.14 "RTN","DGPFHLU",98,0) S DGPFAH("APPRVBY")=.5 ;APPROVED BY (.05) field, file 26.14 "RTN","DGPFHLU",99,0) Q "RTN","DGPFHLU",100,0) ; "RTN","DGPFHLU",101,0) MSH(DGSEG,DGCS,DGRS,DGPFA,DGPFAH,DGERR) ; "RTN","DGPFHLU",102,0) ; "RTN","DGPFHLU",103,0) ; Input: "RTN","DGPFHLU",104,0) ; DGSEG - MSH segment field array "RTN","DGPFHLU",105,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",106,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",107,0) ; "RTN","DGPFHLU",108,0) ; Output: "RTN","DGPFHLU",109,0) ; DGPFA("ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13 "RTN","DGPFHLU",110,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",111,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",112,0) ; "RTN","DGPFHLU",113,0) S DGPFA("ORIGSITE")=$$IEN^XUAF4($P(DGSEG(4),DGCS,1)) "RTN","DGPFHLU",114,0) I (DGPFA("ORIGSITE")="")!('$$TESTVAL^DGPFUT(26.13,.05,DGPFA("ORIGSITE"))) D "RTN","DGPFHLU",115,0) . S DGERR("MSH",1,4)="IOR" "RTN","DGPFHLU",116,0) Q "RTN","DGPFHLU",117,0) ; "RTN","DGPFHLU",118,0) PID(DGSEG,DGCS,DGRS,DGPFA,DGPFAH,DGERR) ; "RTN","DGPFHLU",119,0) ; "RTN","DGPFHLU",120,0) ; Input: "RTN","DGPFHLU",121,0) ; DGSEG - PID segment field array "RTN","DGPFHLU",122,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",123,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",124,0) ; "RTN","DGPFHLU",125,0) ; Output: "RTN","DGPFHLU",126,0) ; DGPFA("DFN") - PATIENT NAME (.01) field, file #26.13 "RTN","DGPFHLU",127,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",128,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",129,0) ; "RTN","DGPFHLU",130,0) N DGICN "RTN","DGPFHLU",131,0) N DGDOB "RTN","DGPFHLU",132,0) N DGSSN "RTN","DGPFHLU",133,0) ; "RTN","DGPFHLU",134,0) S DGICN=+$P(DGSEG(3),DGCS,1) "RTN","DGPFHLU",135,0) S DGDOB=+$$HL7TFM^XLFDT(DGSEG(7)) "RTN","DGPFHLU",136,0) S DGSSN=DGSEG(19) "RTN","DGPFHLU",137,0) S DGPFA("DFN")=$$GETDFN^DGPFUT2(DGICN,DGDOB,DGSSN) "RTN","DGPFHLU",138,0) I 'DGPFA("DFN") D "RTN","DGPFHLU",139,0) . S DGERR("PID",DGSEG(1),3)="NM" ;no match "RTN","DGPFHLU",140,0) Q "RTN","DGPFHLU",141,0) ; "RTN","DGPFHLU",142,0) OBR(DGSEG,DGCS,DGRS,DGPFA,DGPFAH,DGERR) ; "RTN","DGPFHLU",143,0) ; "RTN","DGPFHLU",144,0) ; Input: "RTN","DGPFHLU",145,0) ; DGSEG - OBR segment field array "RTN","DGPFHLU",146,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",147,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",148,0) ; "RTN","DGPFHLU",149,0) ; Output: "RTN","DGPFHLU",150,0) ; DGPFA("FLAG") - FLAG NAME (.02) field, file #26.13 "RTN","DGPFHLU",151,0) ; DGPFA("OWNER") - OWNER SITE (.04) field, file #26.13 "RTN","DGPFHLU",152,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",153,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",154,0) ; "RTN","DGPFHLU",155,0) S DGPFA("FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15," "RTN","DGPFHLU",156,0) I '$$TESTVAL^DGPFUT(26.13,.02,DGPFA("FLAG")) D "RTN","DGPFHLU",157,0) . S DGERR("OBR",DGSEG(1),4)="IF" ;invalid flag "RTN","DGPFHLU",158,0) S DGPFA("OWNER")=$$IEN^XUAF4(DGSEG(20)) "RTN","DGPFHLU",159,0) I (DGPFA("OWNER")="")!('$$TESTVAL^DGPFUT(26.13,.04,DGPFA("OWNER"))) D "RTN","DGPFHLU",160,0) . S DGERR("OBR",DGSEG(1),20)="IOW" ;invalid owner site "RTN","DGPFHLU",161,0) Q "RTN","DGPFHLU",162,0) ; "RTN","DGPFHLU",163,0) OBX(DGSEG,DGCS,DGRS,DGPFA,DGPFAH,DGERR) ; "RTN","DGPFHLU",164,0) ; "RTN","DGPFHLU",165,0) ; Input: "RTN","DGPFHLU",166,0) ; DGSEG - OBX segment field array "RTN","DGPFHLU",167,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",168,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",169,0) ; "RTN","DGPFHLU",170,0) ; Output: "RTN","DGPFHLU",171,0) ; DGPFA("STATUS") - STATUS (.03) field, file #26.13 "RTN","DGPFHLU",172,0) ; DGPFA("NARR") - ASSIGNMENT NARRATIVE (1) field, file #26.13 "RTN","DGPFHLU",173,0) ; DGPFAH("ASSIGNDT") - DATE/TIME (.02) field, file #26.14 "RTN","DGPFHLU",174,0) ; DGPFAH("ACTION") - ACTION (.03) field, file #26.14 "RTN","DGPFHLU",175,0) ; DGPFAH("COMMENT") - HISTORY COMMENTS (1) field, file #26.14 "RTN","DGPFHLU",176,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",177,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",178,0) ; "RTN","DGPFHLU",179,0) N DGI "RTN","DGPFHLU",180,0) N DGLINE "RTN","DGPFHLU",181,0) N DGRSLT "RTN","DGPFHLU",182,0) ; "RTN","DGPFHLU",183,0) ;validate Observation ID value - quit if invalid "RTN","DGPFHLU",184,0) I '$F("NSC",$P(DGSEG(3),DGCS,1)) D Q "RTN","DGPFHLU",185,0) . S DGERR("OBX",DGSEG(1),3)="IID" "RTN","DGPFHLU",186,0) ; "RTN","DGPFHLU",187,0) ; Narrative Observation Identifier "RTN","DGPFHLU",188,0) I $P(DGSEG(3),DGCS,1)="N" D "RTN","DGPFHLU",189,0) . S DGLINE=$O(DGPFA("NARR",""),-1) "RTN","DGPFHLU",190,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLU",191,0) . . S DGPFA("NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLU",192,0) ; "RTN","DGPFHLU",193,0) ; Status Observation Identifier "RTN","DGPFHLU",194,0) I $P(DGSEG(3),DGCS,1)="S" D "RTN","DGPFHLU",195,0) . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT) "RTN","DGPFHLU",196,0) . S DGPFAH("ACTION")=+DGRSLT "RTN","DGPFHLU",197,0) . S DGPFAH("ASSIGNDT")=$$HL7TFM^XLFDT(DGSEG(14)) "RTN","DGPFHLU",198,0) . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION")) "RTN","DGPFHLU",199,0) ; "RTN","DGPFHLU",200,0) ; Comment Observation Identifier "RTN","DGPFHLU",201,0) I $P(DGSEG(3),DGCS,1)="C" D "RTN","DGPFHLU",202,0) . S DGLINE=$O(DGPFAH("COMMENT",""),-1) "RTN","DGPFHLU",203,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLU",204,0) . . S DGPFAH("COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLU",205,0) Q "RTN","DGPFHLU",206,0) ; "RTN","DGPFHLU1") 0^2^B28767858 "RTN","DGPFHLU1",1,0) DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/03 "RTN","DGPFHLU1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU1",3,0) ; "RTN","DGPFHLU1",4,0) Q "RTN","DGPFHLU1",5,0) ; "RTN","DGPFHLU1",6,0) OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API "RTN","DGPFHLU1",7,0) ;This function wraps the data retrieval and segment creation APIs and "RTN","DGPFHLU1",8,0) ;returns a formatted OBR segment. "RTN","DGPFHLU1",9,0) ; "RTN","DGPFHLU1",10,0) ; Input: "RTN","DGPFHLU1",11,0) ; DGSET - (required) OBR segment Set ID "RTN","DGPFHLU1",12,0) ; DGPFA - (required) Assignment data array "RTN","DGPFHLU1",13,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU1",14,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLU1",15,0) ; to include. Defaults to all required fields (4). "RTN","DGPFHLU1",16,0) ; DGHL - HL7 environment array "RTN","DGPFHLU1",17,0) ; "RTN","DGPFHLU1",18,0) ; Output: "RTN","DGPFHLU1",19,0) ; Function Value - OBR segment on success, "" on failure "RTN","DGPFHLU1",20,0) ; "RTN","DGPFHLU1",21,0) N DGOBR "RTN","DGPFHLU1",22,0) N DGVAL "RTN","DGPFHLU1",23,0) ; "RTN","DGPFHLU1",24,0) S DGOBR="" "RTN","DGPFHLU1",25,0) I $G(DGSET)>0,$D(DGPFA),$D(DGPFAH) D "RTN","DGPFHLU1",26,0) . S DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD) ;validate the field string "RTN","DGPFHLU1",27,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLU1",28,0) . I $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL) D "RTN","DGPFHLU1",29,0) . . S DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL) "RTN","DGPFHLU1",30,0) Q DGOBR "RTN","DGPFHLU1",31,0) ; "RTN","DGPFHLU1",32,0) OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array "RTN","DGPFHLU1",33,0) ; "RTN","DGPFHLU1",34,0) ; Input: "RTN","DGPFHLU1",35,0) ; DGFLD - (required) Fields string "RTN","DGPFHLU1",36,0) ; DGSET - (required) OBR segment Set ID "RTN","DGPFHLU1",37,0) ; DGPFA - (required) Assignment data array "RTN","DGPFHLU1",38,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU1",39,0) ; "RTN","DGPFHLU1",40,0) ; Output: "RTN","DGPFHLU1",41,0) ; Function Value - 1 on sucess, 0 on failure "RTN","DGPFHLU1",42,0) ; DGVAL - OBR field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLU1",43,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLU1",44,0) ; "RTN","DGPFHLU1",45,0) N DGRSLT ;function value "RTN","DGPFHLU1",46,0) N DGADT ;assignment date "RTN","DGPFHLU1",47,0) N DGORIG ;originating site "RTN","DGPFHLU1",48,0) N DGOWN ;assignment owner "RTN","DGPFHLU1",49,0) ; "RTN","DGPFHLU1",50,0) S DGRSLT=0 "RTN","DGPFHLU1",51,0) I $G(DGFLD)]"",+$G(DGSET)>0,+$G(DGPFA("FLAG"))>0,+$G(DGPFAH("ASSIGN"))>0 D "RTN","DGPFHLU1",52,0) . ; "RTN","DGPFHLU1",53,0) . ; seq 1 Set ID "RTN","DGPFHLU1",54,0) . I DGFLD[",1," D "RTN","DGPFHLU1",55,0) . . S DGVAL(1)=DGSET "RTN","DGPFHLU1",56,0) . ; "RTN","DGPFHLU1",57,0) . ; seq 2 Placer Order Number "RTN","DGPFHLU1",58,0) . I DGFLD[",2," D "RTN","DGPFHLU1",59,0) . ; "RTN","DGPFHLU1",60,0) . ; seq 3 Filler Order Number "RTN","DGPFHLU1",61,0) . I DGFLD[",3," D "RTN","DGPFHLU1",62,0) . ; "RTN","DGPFHLU1",63,0) . ; seq 4 Universal Service ID "RTN","DGPFHLU1",64,0) . I DGFLD[",4," D ;required field "RTN","DGPFHLU1",65,0) . . S DGVAL(4,1,1)=+DGPFA("FLAG") ;flag record# only, not IEN "RTN","DGPFHLU1",66,0) . . S DGVAL(4,1,2)=$P(DGPFA("FLAG"),U,2) ;flag name "RTN","DGPFHLU1",67,0) . . S DGVAL(4,1,3)="VA085" ;table name "RTN","DGPFHLU1",68,0) . ; "RTN","DGPFHLU1",69,0) . ; seq 5 Priority "RTN","DGPFHLU1",70,0) . I DGFLD[",5," D "RTN","DGPFHLU1",71,0) . ; "RTN","DGPFHLU1",72,0) . ; seq 6 Requested Date/time "RTN","DGPFHLU1",73,0) . I DGFLD[",6," D "RTN","DGPFHLU1",74,0) . ; "RTN","DGPFHLU1",75,0) . ; seq 7 Observation Date/Time "RTN","DGPFHLU1",76,0) . I DGFLD[",7," D "RTN","DGPFHLU1",77,0) . . S DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN"))) "RTN","DGPFHLU1",78,0) . . S DGVAL(7)=$S(DGADT>0:DGADT,1:"") "RTN","DGPFHLU1",79,0) . ; "RTN","DGPFHLU1",80,0) . ; seq 8 Observation End Date/Time "RTN","DGPFHLU1",81,0) . I DGFLD[",8," D "RTN","DGPFHLU1",82,0) . ; "RTN","DGPFHLU1",83,0) . ; seq 9 Collection volume "RTN","DGPFHLU1",84,0) . I DGFLD[",9," D "RTN","DGPFHLU1",85,0) . ; "RTN","DGPFHLU1",86,0) . ; seq 10 Collector Identifier "RTN","DGPFHLU1",87,0) . I DGFLD[",10," D "RTN","DGPFHLU1",88,0) . ; "RTN","DGPFHLU1",89,0) . ; seq 11 Specimen Action Code "RTN","DGPFHLU1",90,0) . I DGFLD[",11," D "RTN","DGPFHLU1",91,0) . ; "RTN","DGPFHLU1",92,0) . ; seq 12 Danger Code "RTN","DGPFHLU1",93,0) . I DGFLD[",12," D "RTN","DGPFHLU1",94,0) . ; "RTN","DGPFHLU1",95,0) . ; seq 13 Relevant Clinical Info "RTN","DGPFHLU1",96,0) . I DGFLD[",13," D "RTN","DGPFHLU1",97,0) . ; "RTN","DGPFHLU1",98,0) . ; seq 14 Specimen Received Date/Time "RTN","DGPFHLU1",99,0) . I DGFLD[",14," D "RTN","DGPFHLU1",100,0) . ; "RTN","DGPFHLU1",101,0) . ; seq 15 Specimen Source "RTN","DGPFHLU1",102,0) . I DGFLD[",15," D "RTN","DGPFHLU1",103,0) . ; "RTN","DGPFHLU1",104,0) . ; seq 16 Ordering Provider "RTN","DGPFHLU1",105,0) . I DGFLD[",16," D "RTN","DGPFHLU1",106,0) . ; "RTN","DGPFHLU1",107,0) . ; seq 17 Order Callback Phone Number "RTN","DGPFHLU1",108,0) . I DGFLD[",17," D "RTN","DGPFHLU1",109,0) . ; "RTN","DGPFHLU1",110,0) . ; seq 18 Placer field 1 "RTN","DGPFHLU1",111,0) . I DGFLD[",18," D "RTN","DGPFHLU1",112,0) . ; "RTN","DGPFHLU1",113,0) . ; seq 19 Placer field 2 "RTN","DGPFHLU1",114,0) . I DGFLD[",19," D "RTN","DGPFHLU1",115,0) . ; "RTN","DGPFHLU1",116,0) . ; seq 20 Filler field 1 "RTN","DGPFHLU1",117,0) . I DGFLD[",20," D "RTN","DGPFHLU1",118,0) . . S DGOWN=+$G(DGPFA("OWNER")) "RTN","DGPFHLU1",119,0) . . S DGVAL(20)=$S(DGOWN>0:$$STA^XUAF4(DGOWN),1:"") "RTN","DGPFHLU1",120,0) . ; "RTN","DGPFHLU1",121,0) . ; seq 21 Filler Field 2 "RTN","DGPFHLU1",122,0) . I DGFLD[",21," D "RTN","DGPFHLU1",123,0) . . S DGORIG=+$G(DGPFA("ORIGSITE")) "RTN","DGPFHLU1",124,0) . . S DGVAL(21)=$S(DGORIG>0:$$STA^XUAF4(DGORIG),1:"") "RTN","DGPFHLU1",125,0) . ; "RTN","DGPFHLU1",126,0) . ; seq 22 Results Rpt/Status Chng - Date/Time "RTN","DGPFHLU1",127,0) . I DGFLD[",22," D "RTN","DGPFHLU1",128,0) . ; "RTN","DGPFHLU1",129,0) . ; seq 23 Charge to Practice "RTN","DGPFHLU1",130,0) . I DGFLD[",23," D "RTN","DGPFHLU1",131,0) . ; "RTN","DGPFHLU1",132,0) . ; seq 24 Diagnostic Serv Sect ID "RTN","DGPFHLU1",133,0) . I DGFLD[",24," D "RTN","DGPFHLU1",134,0) . ; "RTN","DGPFHLU1",135,0) . ; seq 25 Result Status "RTN","DGPFHLU1",136,0) . I DGFLD[",25," D "RTN","DGPFHLU1",137,0) . ; "RTN","DGPFHLU1",138,0) . ; seq 26 Parent Result "RTN","DGPFHLU1",139,0) . I DGFLD[",26," D "RTN","DGPFHLU1",140,0) . ; "RTN","DGPFHLU1",141,0) . ; seq 27 Quantity/Timing "RTN","DGPFHLU1",142,0) . I DGFLD[",27," D "RTN","DGPFHLU1",143,0) . ; "RTN","DGPFHLU1",144,0) . ; seq 28 Result Copies To "RTN","DGPFHLU1",145,0) . I DGFLD[",28," D "RTN","DGPFHLU1",146,0) . ; "RTN","DGPFHLU1",147,0) . ; seq 29 Parent "RTN","DGPFHLU1",148,0) . I DGFLD[",29," D "RTN","DGPFHLU1",149,0) . ; "RTN","DGPFHLU1",150,0) . ; seq 30 Transportation Mode "RTN","DGPFHLU1",151,0) . I DGFLD[",30," D "RTN","DGPFHLU1",152,0) . ; "RTN","DGPFHLU1",153,0) . ; seq 31 Reason for Study "RTN","DGPFHLU1",154,0) . I DGFLD[",31," D "RTN","DGPFHLU1",155,0) . ; "RTN","DGPFHLU1",156,0) . ; seq 32 Principal Result Interpreter "RTN","DGPFHLU1",157,0) . I DGFLD[",32," D "RTN","DGPFHLU1",158,0) . ; "RTN","DGPFHLU1",159,0) . ; seq 33 Assistant Result Interpreter "RTN","DGPFHLU1",160,0) . I DGFLD[",33," D "RTN","DGPFHLU1",161,0) . ; "RTN","DGPFHLU1",162,0) . ; seq 34 Technician "RTN","DGPFHLU1",163,0) . I DGFLD[",34," D "RTN","DGPFHLU1",164,0) . ; "RTN","DGPFHLU1",165,0) . ; seq 35 Transcription "RTN","DGPFHLU1",166,0) . I DGFLD[",35," D "RTN","DGPFHLU1",167,0) . ; "RTN","DGPFHLU1",168,0) . ; seq 36 Scheduled Date/Time "RTN","DGPFHLU1",169,0) . I DGFLD[",36," D "RTN","DGPFHLU1",170,0) . ; "RTN","DGPFHLU1",171,0) . ; seq 37 Number of Sample Containers "RTN","DGPFHLU1",172,0) . I DGFLD[",37," D "RTN","DGPFHLU1",173,0) . ; "RTN","DGPFHLU1",174,0) . ; seq 38 Transport Logistics of Collected Sample "RTN","DGPFHLU1",175,0) . I DGFLD[",38," D "RTN","DGPFHLU1",176,0) . ; "RTN","DGPFHLU1",177,0) . ; seq 39 Collector's Comment "RTN","DGPFHLU1",178,0) . I DGFLD[",39," D "RTN","DGPFHLU1",179,0) . ; "RTN","DGPFHLU1",180,0) . ; seq 40 Transport Arrangement Responsibility "RTN","DGPFHLU1",181,0) . I DGFLD[",40," D "RTN","DGPFHLU1",182,0) . ; "RTN","DGPFHLU1",183,0) . ; seq 41 Transport Arranged "RTN","DGPFHLU1",184,0) . I DGFLD[",41," D "RTN","DGPFHLU1",185,0) . ; "RTN","DGPFHLU1",186,0) . ; seq 42 Escort Required "RTN","DGPFHLU1",187,0) . I DGFLD[",42," D "RTN","DGPFHLU1",188,0) . ; "RTN","DGPFHLU1",189,0) . ; seq 43 Planned Patient Transport Comment "RTN","DGPFHLU1",190,0) . I DGFLD[",43," D "RTN","DGPFHLU1",191,0) . ; "RTN","DGPFHLU1",192,0) . S DGRSLT=1 "RTN","DGPFHLU1",193,0) I 'DGRSLT K DGVAL "RTN","DGPFHLU1",194,0) Q DGRSLT "RTN","DGPFHLU2") 0^3^B22238545 "RTN","DGPFHLU2",1,0) DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03 "RTN","DGPFHLU2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU2",3,0) ; "RTN","DGPFHLU2",4,0) Q "RTN","DGPFHLU2",5,0) ; "RTN","DGPFHLU2",6,0) OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API "RTN","DGPFHLU2",7,0) ;This function wraps the data retrieval and segment creation APIs and "RTN","DGPFHLU2",8,0) ;returns a formatted OBX segment. "RTN","DGPFHLU2",9,0) ; "RTN","DGPFHLU2",10,0) ; Input: "RTN","DGPFHLU2",11,0) ; DGSET - (required) OBX segment Set ID "RTN","DGPFHLU2",12,0) ; DGID - (required) Observation identifier code "RTN","DGPFHLU2",13,0) ; DGSUBID - (optional) Observation Sub-ID "RTN","DGPFHLU2",14,0) ; DGVALUE - (required) Observation value "RTN","DGPFHLU2",15,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU2",16,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLU2",17,0) ; to include. Defaults to all required fields (3,11). "RTN","DGPFHLU2",18,0) ; DGHL - HL7 environment array "RTN","DGPFHLU2",19,0) ; "RTN","DGPFHLU2",20,0) ; Output: "RTN","DGPFHLU2",21,0) ; Function Value - OBX segment on success, "" on failure "RTN","DGPFHLU2",22,0) ; "RTN","DGPFHLU2",23,0) N DGOBX "RTN","DGPFHLU2",24,0) N DGVAL "RTN","DGPFHLU2",25,0) ; "RTN","DGPFHLU2",26,0) S DGOBX="" "RTN","DGPFHLU2",27,0) I $G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D "RTN","DGPFHLU2",28,0) . S DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD) ;required fields "RTN","DGPFHLU2",29,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLU2",30,0) . I $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL) D "RTN","DGPFHLU2",31,0) . . S DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL) "RTN","DGPFHLU2",32,0) Q DGOBX "RTN","DGPFHLU2",33,0) ; "RTN","DGPFHLU2",34,0) OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array "RTN","DGPFHLU2",35,0) ; "RTN","DGPFHLU2",36,0) ; Input: "RTN","DGPFHLU2",37,0) ; DGFLD - (required) Fields string "RTN","DGPFHLU2",38,0) ; DGSET - (required) OBX segment Set ID "RTN","DGPFHLU2",39,0) ; DGID - (required) Observation identifier code "RTN","DGPFHLU2",40,0) ; DGSUBID - (optional) Observation Sub-ID "RTN","DGPFHLU2",41,0) ; DGVALUE - (required) Observation value "RTN","DGPFHLU2",42,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU2",43,0) ; "RTN","DGPFHLU2",44,0) ; Output: "RTN","DGPFHLU2",45,0) ; Function Value - 1 on sucess, 0 on failure "RTN","DGPFHLU2",46,0) ; DGVAL - OBX field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLU2",47,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLU2",48,0) ; "RTN","DGPFHLU2",49,0) N DGRSLT ;function value "RTN","DGPFHLU2",50,0) N DGTYPE ;observation value type "RTN","DGPFHLU2",51,0) N DGIDSTR ;observation identifier string "RTN","DGPFHLU2",52,0) N DGDAT ;observation date "RTN","DGPFHLU2",53,0) ; "RTN","DGPFHLU2",54,0) S DGRSLT=0 "RTN","DGPFHLU2",55,0) I $G(DGFLD)]"",+$G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D "RTN","DGPFHLU2",56,0) . ; "RTN","DGPFHLU2",57,0) . ; seq 1 Set ID "RTN","DGPFHLU2",58,0) . I DGFLD[",1," D "RTN","DGPFHLU2",59,0) . . S DGVAL(1)=DGSET "RTN","DGPFHLU2",60,0) . ; "RTN","DGPFHLU2",61,0) . ; seq 2 Value Type "RTN","DGPFHLU2",62,0) . I DGFLD[",2," D "RTN","DGPFHLU2",63,0) . . S DGTYPE=$S(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"") "RTN","DGPFHLU2",64,0) . . Q:(DGTYPE']"") "RTN","DGPFHLU2",65,0) . . S DGVAL(2)=DGTYPE "RTN","DGPFHLU2",66,0) . ; "RTN","DGPFHLU2",67,0) . ; seq 3 Observation Identifier "RTN","DGPFHLU2",68,0) . I DGFLD[",3," D Q:'$D(DGVAL(3)) ;required field "RTN","DGPFHLU2",69,0) . . S DGIDSTR=$S(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"") "RTN","DGPFHLU2",70,0) . . Q:(DGIDSTR']"") "RTN","DGPFHLU2",71,0) . . S DGVAL(3,1,1)=DGID "RTN","DGPFHLU2",72,0) . . S DGVAL(3,1,2)=DGIDSTR "RTN","DGPFHLU2",73,0) . . S DGVAL(3,1,3)="L" "RTN","DGPFHLU2",74,0) . ; "RTN","DGPFHLU2",75,0) . ; seq 4 Observation Sub-ID (optional) "RTN","DGPFHLU2",76,0) . I DGFLD[",4," D "RTN","DGPFHLU2",77,0) . . S DGVAL(4)=$S(+$G(DGSUBID)>0:DGSUBID,1:"") "RTN","DGPFHLU2",78,0) . ; "RTN","DGPFHLU2",79,0) . ; seq 5 Observation Value "RTN","DGPFHLU2",80,0) . I DGFLD[",5," D "RTN","DGPFHLU2",81,0) . . S DGVAL(5)=DGVALUE "RTN","DGPFHLU2",82,0) . ; "RTN","DGPFHLU2",83,0) . ; seq 6 Units "RTN","DGPFHLU2",84,0) . I DGFLD[",6," D "RTN","DGPFHLU2",85,0) . . S DGVAL(6)="" "RTN","DGPFHLU2",86,0) . ; "RTN","DGPFHLU2",87,0) . ; seq 7 Reference Range "RTN","DGPFHLU2",88,0) . I DGFLD[",7," D "RTN","DGPFHLU2",89,0) . . S DGVAL(7)="" "RTN","DGPFHLU2",90,0) . ; "RTN","DGPFHLU2",91,0) . ; seq 8 Abnormal Flags "RTN","DGPFHLU2",92,0) . I DGFLD[",8," D "RTN","DGPFHLU2",93,0) . . S DGVAL(8)="" "RTN","DGPFHLU2",94,0) . ; "RTN","DGPFHLU2",95,0) . ; seq 9 Probability "RTN","DGPFHLU2",96,0) . I DGFLD[",9," D "RTN","DGPFHLU2",97,0) . . S DGVAL(9)="" "RTN","DGPFHLU2",98,0) . ; "RTN","DGPFHLU2",99,0) . ; seq 10 Nature of Abnormal Test "RTN","DGPFHLU2",100,0) . I DGFLD[",10," D "RTN","DGPFHLU2",101,0) . . S DGVAL(10)="" "RTN","DGPFHLU2",102,0) . ; "RTN","DGPFHLU2",103,0) . ; seq 11 Observ Result Status "RTN","DGPFHLU2",104,0) . I DGFLD[",11," D "RTN","DGPFHLU2",105,0) . . S DGVAL(11)="F" "RTN","DGPFHLU2",106,0) . ; "RTN","DGPFHLU2",107,0) . ; seq 12 Date last Obs Normal Values "RTN","DGPFHLU2",108,0) . I DGFLD[",12," D "RTN","DGPFHLU2",109,0) . . S DGVAL(12)="" "RTN","DGPFHLU2",110,0) . ; "RTN","DGPFHLU2",111,0) . ; seq 13 User Defined Access Checks "RTN","DGPFHLU2",112,0) . I DGFLD[",13," D "RTN","DGPFHLU2",113,0) . . S DGVAL(13)="" "RTN","DGPFHLU2",114,0) . ; "RTN","DGPFHLU2",115,0) . ; seq 14 Date/Time of the Observation "RTN","DGPFHLU2",116,0) . I DGFLD[",14," D "RTN","DGPFHLU2",117,0) . . S DGDAT=$$FMTHL7^XLFDT(+$G(DGPFAH("ASSIGNDT"))) "RTN","DGPFHLU2",118,0) . . S DGVAL(14)=$S(DGDAT>0:DGDAT,1:"") "RTN","DGPFHLU2",119,0) . ; "RTN","DGPFHLU2",120,0) . ; seq 15 Producer's ID "RTN","DGPFHLU2",121,0) . I DGFLD[",15," D "RTN","DGPFHLU2",122,0) . . S DGVAL(15)="" "RTN","DGPFHLU2",123,0) . ; "RTN","DGPFHLU2",124,0) . ; seq 16 Responsible Observer "RTN","DGPFHLU2",125,0) . I DGFLD[",16," D "RTN","DGPFHLU2",126,0) . . S DGVAL(16)="" "RTN","DGPFHLU2",127,0) . ; "RTN","DGPFHLU2",128,0) . ; seq 17 Observation Method "RTN","DGPFHLU2",129,0) . I DGFLD[",17," D "RTN","DGPFHLU2",130,0) . . S DGVAL(17)="" "RTN","DGPFHLU2",131,0) . ; "RTN","DGPFHLU2",132,0) . S DGRSLT=1 "RTN","DGPFHLU2",133,0) I 'DGRSLT K DGVAL "RTN","DGPFHLU2",134,0) Q DGRSLT "RTN","DGPFHLU2",135,0) ; "RTN","DGPFHLU2",136,0) BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments "RTN","DGPFHLU2",137,0) ; "RTN","DGPFHLU2",138,0) ; Input: "RTN","DGPFHLU2",139,0) ; DGROOT - (required) Closed root array or global name for segment "RTN","DGPFHLU2",140,0) ; storage "RTN","DGPFHLU2",141,0) ; DGTXTA - (required) Closed root array containing text "RTN","DGPFHLU2",142,0) ; DGID - (required) OBX segment Observation ID "RTN","DGPFHLU2",143,0) ; DGPFAH - (required) Assignment history data array "RTN","DGPFHLU2",144,0) ; DGHL - (required) VistA HL7 environment array "RTN","DGPFHLU2",145,0) ; DGSEG - (optional) Previous segment # in DGROOT "RTN","DGPFHLU2",146,0) ; DGSET - (optional) Previous OBX Set ID "RTN","DGPFHLU2",147,0) ; "RTN","DGPFHLU2",148,0) ; Output: "RTN","DGPFHLU2",149,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLU2",150,0) ; "RTN","DGPFHLU2",151,0) N DGI ;generic counter "RTN","DGPFHLU2",152,0) N DGOBX ;formatted OBX segment "RTN","DGPFHLU2",153,0) N DGOBXTX ;array of pre-processed text lines "RTN","DGPFHLU2",154,0) N DGRSLT ;function value "RTN","DGPFHLU2",155,0) N DGSTR ;list of OBX segment fields to include "RTN","DGPFHLU2",156,0) ; "RTN","DGPFHLU2",157,0) S DGRSLT=0 "RTN","DGPFHLU2",158,0) S DGSTR="1,2,3,5,11,14" "RTN","DGPFHLU2",159,0) I $G(DGROOT)]"",$G(DGTXTA)]"",$G(DGID)?1A,$D(DGPFAH) D "RTN","DGPFHLU2",160,0) . Q:'$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX) "RTN","DGPFHLU2",161,0) . S DGSEG=$G(DGSEG,0) "RTN","DGPFHLU2",162,0) . S DGSET=$G(DGSET,0) "RTN","DGPFHLU2",163,0) . S DGI=0 "RTN","DGPFHLU2",164,0) . F S DGI=$O(DGOBXTX(DGI)) Q:'DGI D Q:(DGOBX="") "RTN","DGPFHLU2",165,0) . . S DGSET=DGSET+1 "RTN","DGPFHLU2",166,0) . . S DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLU2",167,0) . . Q:(DGOBX="") "RTN","DGPFHLU2",168,0) . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGOBX "RTN","DGPFHLU2",169,0) . Q:(DGOBX)="" "RTN","DGPFHLU2",170,0) . ; "RTN","DGPFHLU2",171,0) . ;success "RTN","DGPFHLU2",172,0) . S DGRSLT=1 "RTN","DGPFHLU2",173,0) ; "RTN","DGPFHLU2",174,0) Q DGRSLT "RTN","DGPFHLU3") 0^4^B34322832 "RTN","DGPFHLU3",1,0) DGPFHLU3 ;ALB/RPM - PRF HL7 BUILD MSA/ERR SEGMENTS ; 3/03/03 "RTN","DGPFHLU3",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU3",3,0) ; "RTN","DGPFHLU3",4,0) Q "RTN","DGPFHLU3",5,0) ; "RTN","DGPFHLU3",6,0) MSA(DGACK,DGID,DGERR,DGFLD,DGHL) ;MSA Segment API "RTN","DGPFHLU3",7,0) ;This function wraps the data retrieval and segment creation APIs and "RTN","DGPFHLU3",8,0) ;returns a formatted MSA segment. "RTN","DGPFHLU3",9,0) ; "RTN","DGPFHLU3",10,0) ; Input: "RTN","DGPFHLU3",11,0) ; DGACK - (required) MSA segment Acknowledgment code "RTN","DGPFHLU3",12,0) ; DGID - (required) Message Control ID "RTN","DGPFHLU3",13,0) ; DGERR - (optional) Error condition "RTN","DGPFHLU3",14,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLU3",15,0) ; to include. Defaults to all required fields (1,2). "RTN","DGPFHLU3",16,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLU3",17,0) ; "RTN","DGPFHLU3",18,0) ; Output: "RTN","DGPFHLU3",19,0) ; Function Value - MSA segment on success, "" on failure "RTN","DGPFHLU3",20,0) ; "RTN","DGPFHLU3",21,0) N DGMSA "RTN","DGPFHLU3",22,0) N DGVAL "RTN","DGPFHLU3",23,0) ; "RTN","DGPFHLU3",24,0) S DGMSA="" "RTN","DGPFHLU3",25,0) I $G(DGACK)]"",+$G(DGID) D "RTN","DGPFHLU3",26,0) . S DGERR=$G(DGERR) "RTN","DGPFHLU3",27,0) . S DGFLD=$$CKSTR^DGPFHLUT("1,2",DGFLD) ;validate field string "RTN","DGPFHLU3",28,0) . I DGERR]"" S DGFLD=DGFLD_",6" "RTN","DGPFHLU3",29,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLU3",30,0) . I $$MSAVAL(DGFLD,DGACK,DGID,"","","",DGERR,.DGVAL) D "RTN","DGPFHLU3",31,0) . . S DGMSA=$$BLDSEG^DGPFHLUT("MSA",.DGVAL,.DGHL) "RTN","DGPFHLU3",32,0) Q DGMSA "RTN","DGPFHLU3",33,0) ; "RTN","DGPFHLU3",34,0) MSAVAL(DGFLD,DGACK,DGID,DGTEXT,DGESN,DGDAT,DGERR,DGVAL) ;build MSA value array "RTN","DGPFHLU3",35,0) ; "RTN","DGPFHLU3",36,0) ; Input: "RTN","DGPFHLU3",37,0) ; DGFLD - (required) fields string "RTN","DGPFHLU3",38,0) ; DGACK - (required) MSA segment Acknowledgment code "RTN","DGPFHLU3",39,0) ; DGID - (required) Message Control ID "RTN","DGPFHLU3",40,0) ; DGTEXT - (optional) Text message "RTN","DGPFHLU3",41,0) ; DGESN - (optional) Expected sequence number "RTN","DGPFHLU3",42,0) ; DGDAT - (optional) Delayed acknowledgment type "RTN","DGPFHLU3",43,0) ; DGERR - (optional) Error condition "RTN","DGPFHLU3",44,0) ; "RTN","DGPFHLU3",45,0) ; Output: "RTN","DGPFHLU3",46,0) ; Function Value - 1 on sucess, 0 on failure "RTN","DGPFHLU3",47,0) ; DGVAL - MSA field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLU3",48,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLU3",49,0) ; "RTN","DGPFHLU3",50,0) N DGRSLT ;function value "RTN","DGPFHLU3",51,0) N DGACKS ;array of valid ACK codes "RTN","DGPFHLU3",52,0) N DGCOD ;ACK code string "RTN","DGPFHLU3",53,0) N DGERRSTR ;Error condition string "RTN","DGPFHLU3",54,0) N DGTBL ;VA086 Error code array "RTN","DGPFHLU3",55,0) ; "RTN","DGPFHLU3",56,0) S DGRSLT=0 "RTN","DGPFHLU3",57,0) I $G(DGFLD)]"",$G(DGACK)]"",+$G(DGID) D "RTN","DGPFHLU3",58,0) . F DGCOD="AA","AE","AR","CA","CE","CR" S DGACKS(DGCOD)="" "RTN","DGPFHLU3",59,0) . ; "RTN","DGPFHLU3",60,0) . ; seq 1 Acknowledgment Code "RTN","DGPFHLU3",61,0) . I DGFLD[",1," D "RTN","DGPFHLU3",62,0) . . S DGVAL(1)=$S($D(DGACKS(DGACK)):DGACK,1:"") "RTN","DGPFHLU3",63,0) . Q:(DGVAL(1)="") ;required field "RTN","DGPFHLU3",64,0) . ; "RTN","DGPFHLU3",65,0) . ; seq 2 Message Control ID "RTN","DGPFHLU3",66,0) . I DGFLD[",2," D "RTN","DGPFHLU3",67,0) . . S DGVAL(2)=DGID "RTN","DGPFHLU3",68,0) . Q:(DGVAL(2)="") ;required field "RTN","DGPFHLU3",69,0) . ; "RTN","DGPFHLU3",70,0) . ; seq 3 Text Message "RTN","DGPFHLU3",71,0) . I DGFLD[",3," D "RTN","DGPFHLU3",72,0) . . S DGVAL(3)=$G(DGTEXT) "RTN","DGPFHLU3",73,0) . ; "RTN","DGPFHLU3",74,0) . ; seq 4 Expected Sequence Number "RTN","DGPFHLU3",75,0) . I DGFLD[",4," D "RTN","DGPFHLU3",76,0) . . S DGVAL(4)=$G(DGESN) "RTN","DGPFHLU3",77,0) . ; "RTN","DGPFHLU3",78,0) . ; seq 5 Delayed Acknowledgment Type "RTN","DGPFHLU3",79,0) . I DGFLD[",5," D "RTN","DGPFHLU3",80,0) . . S DGDAT=$G(DGDAT) "RTN","DGPFHLU3",81,0) . . S DGVAL(5)=$S(DGDAT="D":DGDAT,DGDAT="F":DGDAT,1:"") "RTN","DGPFHLU3",82,0) . ; "RTN","DGPFHLU3",83,0) . ; seq 6 Error Condition "RTN","DGPFHLU3",84,0) . I DGFLD[",6," D "RTN","DGPFHLU3",85,0) . . D BLDVA086^DGPFHLU3(.DGTBL) "RTN","DGPFHLU3",86,0) . . I $G(DGERR)]"",$D(DGTBL(DGERR))#2 D "RTN","DGPFHLU3",87,0) . . . S DGVAL(6,1,1)=DGERR "RTN","DGPFHLU3",88,0) . . . S DGVAL(6,1,2)=DGTBL(DGERR) "RTN","DGPFHLU3",89,0) . . . S DGVAL(6,1,3)="VA086" "RTN","DGPFHLU3",90,0) . S DGRSLT=1 "RTN","DGPFHLU3",91,0) I 'DGRSLT K DGVAL "RTN","DGPFHLU3",92,0) Q DGRSLT "RTN","DGPFHLU3",93,0) ; "RTN","DGPFHLU3",94,0) ERR(DGSEG,DGSEQ,DGPOS,DGCOD,DGFLD,DGHL) ;ERR segment API "RTN","DGPFHLU3",95,0) ; "RTN","DGPFHLU3",96,0) ; Input: "RTN","DGPFHLU3",97,0) ; DGSEG - (required) Segment ID "RTN","DGPFHLU3",98,0) ; DGSEQ - (required) Sequence "RTN","DGPFHLU3",99,0) ; DGPOS - (required) Field position "RTN","DGPFHLU3",100,0) ; DGCOD - (required) Error code from table VA086 "RTN","DGPFHLU3",101,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLU3",102,0) ; to include. Defaults to all required fields (1). "RTN","DGPFHLU3",103,0) ; DGHL - (required) HL7 Environment array "RTN","DGPFHLU3",104,0) ; "RTN","DGPFHLU3",105,0) ; Output: "RTN","DGPFHLU3",106,0) ; Function value - ERR segment on success, "" on failure "RTN","DGPFHLU3",107,0) ; "RTN","DGPFHLU3",108,0) N DGERR "RTN","DGPFHLU3",109,0) N DGVAL "RTN","DGPFHLU3",110,0) ; "RTN","DGPFHLU3",111,0) S DGERR="" "RTN","DGPFHLU3",112,0) I $G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"",$G(DGHL("ECH"))]"" D "RTN","DGPFHLU3",113,0) . S DGFLD=$$CKSTR^DGPFHLUT("1",DGFLD) ;validate field string "RTN","DGPFHLU3",114,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLU3",115,0) . I $$ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,.DGVAL) D "RTN","DGPFHLU3",116,0) . . S DGERR=$$BLDSEG^DGPFHLUT("ERR",.DGVAL,.DGHL) "RTN","DGPFHLU3",117,0) Q DGERR "RTN","DGPFHLU3",118,0) ; "RTN","DGPFHLU3",119,0) ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,DGVAL) ;build ERR value array "RTN","DGPFHLU3",120,0) ; "RTN","DGPFHLU3",121,0) ; Input: "RTN","DGPFHLU3",122,0) ; DGFLD - (required) Field string "RTN","DGPFHLU3",123,0) ; DGSEG - (required) Segment ID "RTN","DGPFHLU3",124,0) ; DGSEQ - (required) Sequence "RTN","DGPFHLU3",125,0) ; DGPOS - (required) Field position "RTN","DGPFHLU3",126,0) ; DGCOD - (required) Error code from table VA086 "RTN","DGPFHLU3",127,0) ; "RTN","DGPFHLU3",128,0) ; Output: "RTN","DGPFHLU3",129,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLU3",130,0) ; DGVAL - ERR field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLU3",131,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLU3",132,0) N DGRSLT "RTN","DGPFHLU3",133,0) N DGTBL "RTN","DGPFHLU3",134,0) ; "RTN","DGPFHLU3",135,0) S DGRSLT=0 "RTN","DGPFHLU3",136,0) I $G(DGFLD)]"",$G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"" D "RTN","DGPFHLU3",137,0) . I DGFLD[",1," D "RTN","DGPFHLU3",138,0) . . D BLDVA086^DGPFHLU3(.DGTBL) "RTN","DGPFHLU3",139,0) . . I $D(DGTBL(DGCOD))#2 D "RTN","DGPFHLU3",140,0) . . . S DGVAL(1,1,1)=DGSEG "RTN","DGPFHLU3",141,0) . . . S DGVAL(1,1,2)=DGSEQ "RTN","DGPFHLU3",142,0) . . . S DGVAL(1,1,3)=DGPOS "RTN","DGPFHLU3",143,0) . . . S DGVAL(1,1,4,1)=DGCOD "RTN","DGPFHLU3",144,0) . . . S DGVAL(1,1,4,2)=DGTBL(DGCOD) "RTN","DGPFHLU3",145,0) . . . S DGVAL(1,1,4,3)="VA086" "RTN","DGPFHLU3",146,0) . S DGRSLT=1 "RTN","DGPFHLU3",147,0) Q DGRSLT "RTN","DGPFHLU3",148,0) ; "RTN","DGPFHLU3",149,0) BLDVA086(DGTBL) ;build error code/text array for table VA086 "RTN","DGPFHLU3",150,0) ; "RTN","DGPFHLU3",151,0) ; Input: "RTN","DGPFHLU3",152,0) ; none "RTN","DGPFHLU3",153,0) ; "RTN","DGPFHLU3",154,0) ; Output: "RTN","DGPFHLU3",155,0) ; DGTBL - error code array subscripted by code containing error text "RTN","DGPFHLU3",156,0) ; "RTN","DGPFHLU3",157,0) N DGI "RTN","DGPFHLU3",158,0) N DGLINE "RTN","DGPFHLU3",159,0) N DGCOD "RTN","DGPFHLU3",160,0) N DGTXT "RTN","DGPFHLU3",161,0) N DGDESC "RTN","DGPFHLU3",162,0) ; "RTN","DGPFHLU3",163,0) F DGI=1:1 S DGLINE=$T(ERRTBL+DGI) Q:DGLINE="" D "RTN","DGPFHLU3",164,0) . S DGCOD=$P(DGLINE,";",3) "RTN","DGPFHLU3",165,0) . S DGTXT=$P(DGLINE,";",4) "RTN","DGPFHLU3",166,0) . S DGDESC=$P(DGLINE,";",5) "RTN","DGPFHLU3",167,0) . S DGTBL(DGCOD)=DGTXT "RTN","DGPFHLU3",168,0) . S DGTBL(DGCOD,"DESC")=DGDESC "RTN","DGPFHLU3",169,0) Q "RTN","DGPFHLU3",170,0) ; "RTN","DGPFHLU3",171,0) ERRTBL ;VA086 Error Code Table;error code;error text "RTN","DGPFHLU3",172,0) ;;FE;Filer Error;An error occurred at the remote site when attempting to add, update or retrieve assignment data. "RTN","DGPFHLU3",173,0) ;;IF;Invalid Patient Record Flag;The transmitted Patient Record Flag is not defined at the remote site. "RTN","DGPFHLU3",174,0) ;;IID;Invalid Observation ID;The transmitted observation ID is not "N"arrative, "S"tatus or "C"omment. "RTN","DGPFHLU3",175,0) ;;IOR;Invalid Originating Site;The originating site of the transmission is not defined at the remote site. "RTN","DGPFHLU3",176,0) ;;IOW;Invalid Owner Site;The transmitted owning site is not defined at the remote site. "RTN","DGPFHLU3",177,0) ;;NM;No Match;No patient was found that correlates to the transmitted ICN, DOB and SSN. "RTN","DGPFHLU3",178,0) ;;UU;Unauthorized Update;The originating site of the transmission is not defined as the owning site of the assignment or an invalid action was transmitted (i.e. Reactivate an already active assignment). "RTN","DGPFHLU4") 0^5^B16669354 "RTN","DGPFHLU4",1,0) DGPFHLU4 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 3/04/03 "RTN","DGPFHLU4",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU4",3,0) ; "RTN","DGPFHLU4",4,0) BLDACK(DGACK,DGROOT,DGHL,DGSEGERR,DGSTOERR) ;Build ACK Message/Segments "RTN","DGPFHLU4",5,0) ; "RTN","DGPFHLU4",6,0) ; Input: "RTN","DGPFHLU4",7,0) ; DGACK - (required) Acknowledment code "RTN","DGPFHLU4",8,0) ; DGROOT - (required) Segment array name "RTN","DGPFHLU4",9,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLU4",10,0) ; DGSEGERR - (optional) defined only if errors during parsing "RTN","DGPFHLU4",11,0) ; DGSTOERR - (optional) defined only if errors during filing "RTN","DGPFHLU4",12,0) ; "RTN","DGPFHLU4",13,0) ; Output: "RTN","DGPFHLU4",14,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLU4",15,0) ; ^TMP("HLA",$J) - Array of ACK segments "RTN","DGPFHLU4",16,0) ; "RTN","DGPFHLU4",17,0) N DGCNT ;segment counter "RTN","DGPFHLU4",18,0) N DGMSA ;formatted MSA segment "RTN","DGPFHLU4",19,0) N DGRSLT ;function value "RTN","DGPFHLU4",20,0) ; "RTN","DGPFHLU4",21,0) S DGRSLT=0 "RTN","DGPFHLU4",22,0) I $G(DGACK)]"",$G(DGROOT)]"" D "RTN","DGPFHLU4",23,0) . S DGCNT=0 "RTN","DGPFHLU4",24,0) . ; "RTN","DGPFHLU4",25,0) . ;build MSA segment "RTN","DGPFHLU4",26,0) . S DGMSA=$$MSA^DGPFHLU3(DGACK,DGHL("MID"),.DGSTOERR,"1,2",.DGHL) "RTN","DGPFHLU4",27,0) . Q:(DGMSA="") "RTN","DGPFHLU4",28,0) . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGMSA "RTN","DGPFHLU4",29,0) . ; "RTN","DGPFHLU4",30,0) . ;build ERR segments "RTN","DGPFHLU4",31,0) . Q:($D(DGSEGERR)&('$$BLDERR(DGROOT,.DGSEGERR,.DGHL,.DGCNT))) "RTN","DGPFHLU4",32,0) . ; "RTN","DGPFHLU4",33,0) . ;success "RTN","DGPFHLU4",34,0) . S DGRSLT=1 "RTN","DGPFHLU4",35,0) Q DGRSLT "RTN","DGPFHLU4",36,0) ; "RTN","DGPFHLU4",37,0) PARSACK(DGWRK,DGHL,DGACK,DGMSG) ;Parse ACK Message/Segments "RTN","DGPFHLU4",38,0) ; "RTN","DGPFHLU4",39,0) ; Input: "RTN","DGPFHLU4",40,0) ; DGWRK - Closed root work global reference "RTN","DGPFHLU4",41,0) ; DGHL - HL7 environment array "RTN","DGPFHLU4",42,0) ; "RTN","DGPFHLU4",43,0) ; Output: "RTN","DGPFHLU4",44,0) ; DGACK - array of ACK results "RTN","DGPFHLU4",45,0) ; DGMSG - undefined on success, array of MailMan text on failure "RTN","DGPFHLU4",46,0) ; "RTN","DGPFHLU4",47,0) N DGFS "RTN","DGPFHLU4",48,0) N DGCS "RTN","DGPFHLU4",49,0) N DGRS "RTN","DGPFHLU4",50,0) N DGSS "RTN","DGPFHLU4",51,0) N DGCURLIN "RTN","DGPFHLU4",52,0) ; "RTN","DGPFHLU4",53,0) S DGFS=DGHL("FS") "RTN","DGPFHLU4",54,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLU4",55,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLU4",56,0) S DGSS=$E(DGHL("ECH"),4) "RTN","DGPFHLU4",57,0) S DGCURLIN=0 "RTN","DGPFHLU4",58,0) ; "RTN","DGPFHLU4",59,0) ;loop through the message segments and retrieve the field data "RTN","DGPFHLU4",60,0) F D Q:'DGCURLIN "RTN","DGPFHLU4",61,0) . N DGSEG "RTN","DGPFHLU4",62,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLU4",63,0) . Q:'DGCURLIN "RTN","DGPFHLU4",64,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,.DGACK,.DGMSG)") "RTN","DGPFHLU4",65,0) Q "RTN","DGPFHLU4",66,0) ; "RTN","DGPFHLU4",67,0) MSH(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ; "RTN","DGPFHLU4",68,0) ; "RTN","DGPFHLU4",69,0) ; Input: "RTN","DGPFHLU4",70,0) ; DGSEG - MSH segment field array "RTN","DGPFHLU4",71,0) ; DGCS - HL7 component separator "RTN","DGPFHLU4",72,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU4",73,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLU4",74,0) ; "RTN","DGPFHLU4",75,0) ; Output: "RTN","DGPFHLU4",76,0) ; DGACK - array of ACK results "RTN","DGPFHLU4",77,0) ; "SNDFAC" - sending facility "RTN","DGPFHLU4",78,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLU4",79,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLU4",80,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU4",81,0) ; "RTN","DGPFHLU4",82,0) S DGACK("SNDFAC")=$P($G(DGSEG(4)),DGCS,1) "RTN","DGPFHLU4",83,0) S DGACK("RCVFAC")=$P($G(DGSEG(6)),DGCS,1) "RTN","DGPFHLU4",84,0) S DGACK("MSGDTM")=$$HL7TFM^XLFDT($G(DGSEG(7))) "RTN","DGPFHLU4",85,0) Q "RTN","DGPFHLU4",86,0) ; "RTN","DGPFHLU4",87,0) MSA(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ; "RTN","DGPFHLU4",88,0) ; "RTN","DGPFHLU4",89,0) ; Input: "RTN","DGPFHLU4",90,0) ; DGSEG - MSH segment field array "RTN","DGPFHLU4",91,0) ; DGCS - HL7 component separator "RTN","DGPFHLU4",92,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU4",93,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLU4",94,0) ; "RTN","DGPFHLU4",95,0) ; Output: "RTN","DGPFHLU4",96,0) ; DGACK - array of ACK results "RTN","DGPFHLU4",97,0) ; "ACKCODE" - Acknowledgment code "RTN","DGPFHLU4",98,0) ; "MSGID" - Message Control ID of the message being ACK'ed "RTN","DGPFHLU4",99,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU4",100,0) ; "RTN","DGPFHLU4",101,0) N DGCNT "RTN","DGPFHLU4",102,0) ; "RTN","DGPFHLU4",103,0) S DGACK("ACKCODE")=$G(DGSEG(1)) "RTN","DGPFHLU4",104,0) S DGACK("MSGID")=$G(DGSEG(2)) "RTN","DGPFHLU4",105,0) I DGACK("ACKCODE")'="AA",$G(DGSEG(6))]"" D "RTN","DGPFHLU4",106,0) . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1 "RTN","DGPFHLU4",107,0) . S DGERR(DGCNT)=$P(DGSEG(6),DGCS,1) "RTN","DGPFHLU4",108,0) Q "RTN","DGPFHLU4",109,0) ; "RTN","DGPFHLU4",110,0) ERR(DGSEG,DGCS,DGRS,DGSS,DGACK,DGERR) ; "RTN","DGPFHLU4",111,0) ; "RTN","DGPFHLU4",112,0) ; Input: "RTN","DGPFHLU4",113,0) ; DGSEG - MSH segment field array "RTN","DGPFHLU4",114,0) ; DGCS - HL7 component separator "RTN","DGPFHLU4",115,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU4",116,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLU4",117,0) ; "RTN","DGPFHLU4",118,0) ; Output: "RTN","DGPFHLU4",119,0) ; DGACK - array of ACK results "RTN","DGPFHLU4",120,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU4",121,0) ; "RTN","DGPFHLU4",122,0) N DGCNT "RTN","DGPFHLU4",123,0) N DGCOD "RTN","DGPFHLU4",124,0) ; "RTN","DGPFHLU4",125,0) I $G(DGSEG(1))]"" D "RTN","DGPFHLU4",126,0) . S DGCOD=$P($P(DGSEG(1),DGCS,4),DGSS,1) "RTN","DGPFHLU4",127,0) . I DGCOD]"" D "RTN","DGPFHLU4",128,0) . . S DGCNT=$O(DGERR(""),-1),DGCNT=DGCNT+1 "RTN","DGPFHLU4",129,0) . . S DGERR(DGCNT)=DGCOD "RTN","DGPFHLU4",130,0) Q "RTN","DGPFHLU4",131,0) ; "RTN","DGPFHLU4",132,0) BLDERR(DGROOT,DGSEGERR,DGHL,DGCNT) ;build all ERR segments "RTN","DGPFHLU4",133,0) ;This function builds a formatted ERR segment for each entry in the "RTN","DGPFHLU4",134,0) ;segment error array (DGSEGERR). "RTN","DGPFHLU4",135,0) ; "RTN","DGPFHLU4",136,0) ; Input: "RTN","DGPFHLU4",137,0) ; DGROOT - (required) Closed root array or global name for segment "RTN","DGPFHLU4",138,0) ; storage "RTN","DGPFHLU4",139,0) ; DGSEGERR - (required) Array of segment errors "RTN","DGPFHLU4",140,0) ; Format: DGSEGERR(segment name,sequence,field)=error code "RTN","DGPFHLU4",141,0) ; DGHL - (required) VistA HL7 environment array "RTN","DGPFHLU4",142,0) ; DGCNT - (optional) Previous segment # in DGROOT "RTN","DGPFHLU4",143,0) ; "RTN","DGPFHLU4",144,0) ; Output: "RTN","DGPFHLU4",145,0) ; Function Value - 1 on success, 0 on failure "RTN","DGPFHLU4",146,0) ; "RTN","DGPFHLU4",147,0) N DGCOD ;error code "RTN","DGPFHLU4",148,0) N DGERR ;formatted ERR segment "RTN","DGPFHLU4",149,0) N DGPOS ;field positions containing error "RTN","DGPFHLU4",150,0) N DGSEG ;segment name containing error "RTN","DGPFHLU4",151,0) N DGSEQ ;sequence of segment containing error "RTN","DGPFHLU4",152,0) N DGRSLT ;function value "RTN","DGPFHLU4",153,0) ; "RTN","DGPFHLU4",154,0) S DGRSLT=0 "RTN","DGPFHLU4",155,0) I $G(DGROOT)]"",$D(DGSEGERR) D "RTN","DGPFHLU4",156,0) . S DGCNT=$G(DGCNT,0) "RTN","DGPFHLU4",157,0) . S DGSEG="" "RTN","DGPFHLU4",158,0) . F S DGSEG=$O(DGSEGERR(DGSEG)) Q:(DGSEG="") D Q:(DGERR="") "RTN","DGPFHLU4",159,0) . . S DGSEQ=0 "RTN","DGPFHLU4",160,0) . . F S DGSEQ=$O(DGSEGERR(DGSEG,DGSEQ)) Q:'DGSEQ D Q:(DGERR="") "RTN","DGPFHLU4",161,0) . . . S DGPOS=0 "RTN","DGPFHLU4",162,0) . . . F S DGPOS=$O(DGSEGERR(DGSEG,DGSEQ,DGPOS)) Q:'DGPOS D Q:(DGERR="") "RTN","DGPFHLU4",163,0) . . . . S DGCOD=DGSEGERR(DGSEG,DGSEQ,DGPOS) "RTN","DGPFHLU4",164,0) . . . . S DGERR=$$ERR^DGPFHLU3(DGSEG,DGSEQ,DGPOS,DGCOD,"1",.DGHL) "RTN","DGPFHLU4",165,0) . . . . Q:(DGERR="") "RTN","DGPFHLU4",166,0) . . . . S DGCNT=DGCNT+1,@DGROOT@(DGCNT)=DGERR "RTN","DGPFHLU4",167,0) . Q:(DGERR="") "RTN","DGPFHLU4",168,0) . S DGRSLT=1 "RTN","DGPFHLU4",169,0) Q DGRSLT "RTN","DGPFHLU5") 0^32^B32860836 "RTN","DGPFHLU5",1,0) DGPFHLU5 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/20/03 11:30am "RTN","DGPFHLU5",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU5",3,0) ; "RTN","DGPFHLU5",4,0) Q "RTN","DGPFHLU5",5,0) ; "RTN","DGPFHLU5",6,0) PROCERR(DGLIEN,DGACK,DGERR) ;process errors returned from ACK "RTN","DGPFHLU5",7,0) ; "RTN","DGPFHLU5",8,0) ; Input: "RTN","DGPFHLU5",9,0) ; DGLIEN - IEN of PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFHLU5",10,0) ; DGACK - array of ACK parse data "RTN","DGPFHLU5",11,0) ; DGERR - array of parsed errors (ex: DGERR(1)="UU") "RTN","DGPFHLU5",12,0) ; "RTN","DGPFHLU5",13,0) ; Output: none "RTN","DGPFHLU5",14,0) ; "RTN","DGPFHLU5",15,0) N DGPFA ;assignment array "RTN","DGPFHLU5",16,0) N DGPFAH ;assignment history array "RTN","DGPFHLU5",17,0) N DGPFL ;HL7 transmission log array "RTN","DGPFHLU5",18,0) N DGTBL ;error code array "RTN","DGPFHLU5",19,0) N DGXMTXT ;mailman msg text array "RTN","DGPFHLU5",20,0) ; "RTN","DGPFHLU5",21,0) I +$G(DGLIEN),$D(DGACK),$D(DGERR) D "RTN","DGPFHLU5",22,0) . ; "RTN","DGPFHLU5",23,0) . ;retrieve the HL7 transmission log values "RTN","DGPFHLU5",24,0) . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFHLU5",25,0) . ; "RTN","DGPFHLU5",26,0) . ;retrieve assignment history values "RTN","DGPFHLU5",27,0) . Q:'$$GETHIST^DGPFAAH(+$G(DGPFL("ASGNHIST")),.DGPFAH) "RTN","DGPFHLU5",28,0) . ; "RTN","DGPFHLU5",29,0) . ;retrieve assignment values "RTN","DGPFHLU5",30,0) . Q:'$$GETASGN^DGPFAA(+$G(DGPFAH("ASSIGN")),.DGPFA) "RTN","DGPFHLU5",31,0) . ; "RTN","DGPFHLU5",32,0) . S DGXMTXT=$NA(^TMP("DGPFERR",$J)) "RTN","DGPFHLU5",33,0) . K @DGXMTXT "RTN","DGPFHLU5",34,0) . ; "RTN","DGPFHLU5",35,0) . ;load error code table "RTN","DGPFHLU5",36,0) . D BLDVA086^DGPFHLU3(.DGTBL) "RTN","DGPFHLU5",37,0) . ; "RTN","DGPFHLU5",38,0) . ;create message text array "RTN","DGPFHLU5",39,0) . D BLDMSG(.DGPFA,.DGACK,.DGERR,.DGTBL,DGXMTXT) "RTN","DGPFHLU5",40,0) . ; "RTN","DGPFHLU5",41,0) . ;send the notification message "RTN","DGPFHLU5",42,0) . D SEND(DGXMTXT) "RTN","DGPFHLU5",43,0) . ; "RTN","DGPFHLU5",44,0) . ;cleanup "RTN","DGPFHLU5",45,0) . K @DGXMTXT "RTN","DGPFHLU5",46,0) Q "RTN","DGPFHLU5",47,0) ; "RTN","DGPFHLU5",48,0) BLDMSG(DGPFA,DGACK,DGERR,DGTBL,DGXMTXT) ;buld MailMan message array "RTN","DGPFHLU5",49,0) ; "RTN","DGPFHLU5",50,0) ; Supported DBIA #2171: The supported DBIA is uses to access Kernel "RTN","DGPFHLU5",51,0) ; APIs for retrieving Station numbers and names "RTN","DGPFHLU5",52,0) ; from the INSTITUTION (#4) file. "RTN","DGPFHLU5",53,0) ; Supported DBIA #2701: The supported DBIA is used to access MPI APIs "RTN","DGPFHLU5",54,0) ; for retrieving an ICN for a given DFN. "RTN","DGPFHLU5",55,0) ; "RTN","DGPFHLU5",56,0) ; Input: "RTN","DGPFHLU5",57,0) ; DGPFA - assignment data array "RTN","DGPFHLU5",58,0) ; DGACK - array of ACK data "RTN","DGPFHLU5",59,0) ; DGERR - array of parsed errors (ex: DGERR(1)="UU") "RTN","DGPFHLU5",60,0) ; DGTBL - VA086 error code table array "RTN","DGPFHLU5",61,0) ; "RTN","DGPFHLU5",62,0) ; Output: "RTN","DGPFHLU5",63,0) ; DGXMTXT - array of MailMan text lines "RTN","DGPFHLU5",64,0) ; "RTN","DGPFHLU5",65,0) N DGCNT ;error count "RTN","DGPFHLU5",66,0) N DGCOD ;error code "RTN","DGPFHLU5",67,0) N DGDEM ;patient demographics array "RTN","DGPFHLU5",68,0) N DGDFN ;pointer to PATIENT (#2) file "RTN","DGPFHLU5",69,0) N DGFAC ;facility data array from XUAF4 call "RTN","DGPFHLU5",70,0) N DGICN ;integrated control number "RTN","DGPFHLU5",71,0) N DGLIN ;line counter "RTN","DGPFHLU5",72,0) N DGMAX ;maximum line length "RTN","DGPFHLU5",73,0) N DGSITE ;results of VASITE call "RTN","DGPFHLU5",74,0) N DGSNDSTA ;sending station number "RTN","DGPFHLU5",75,0) N DGSNDNAM ;sending station name "RTN","DGPFHLU5",76,0) ; "RTN","DGPFHLU5",77,0) S DGDFN=+$G(DGPFA("DFN")) "RTN","DGPFHLU5",78,0) Q:(DGDFN'>0) "RTN","DGPFHLU5",79,0) ; "RTN","DGPFHLU5",80,0) ;retrieve patient demographics "RTN","DGPFHLU5",81,0) Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM) "RTN","DGPFHLU5",82,0) S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFHLU5",83,0) S DGICN=$S(+DGICN>0:DGICN,1:$P(DGICN,U,2)) "RTN","DGPFHLU5",84,0) ; "RTN","DGPFHLU5",85,0) S DGLIN=0 "RTN","DGPFHLU5",86,0) S DGMAX=65 "RTN","DGPFHLU5",87,0) S DGSITE=$$SITE^VASITE() "RTN","DGPFHLU5",88,0) S DGSNDSTA=$G(DGACK("SNDFAC")) "RTN","DGPFHLU5",89,0) D F4^XUAF4(DGSNDSTA,.DGFAC,"","") "RTN","DGPFHLU5",90,0) S DGSNDNAM=$S(DGFAC>0:$G(DGFAC("NAME")),1:"") "RTN","DGPFHLU5",91,0) ; "RTN","DGPFHLU5",92,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",93,0) D ADDLINE("* * * * P R F H L 7 E R R O R E N C O U N T E R E D * * * *",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",94,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",95,0) D ADDLINE("A facility could not process the following Patient Record Flag assignment on "_$$FMTE^XLFDT($G(DGACK("MSGDTM")))_".",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",96,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",97,0) D ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",98,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",99,0) D ADDLINE("Flag Name: "_$P($G(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",100,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",101,0) D ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",102,0) D ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",103,0) D ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",104,0) D ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",105,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",106,0) S DGCNT=0 "RTN","DGPFHLU5",107,0) F S DGCNT=$O(DGERR(DGCNT)) Q:'DGCNT D "RTN","DGPFHLU5",108,0) . S DGCOD=DGERR(DGCNT) "RTN","DGPFHLU5",109,0) . I DGCOD]"",$D(DGTBL(DGCOD,"DESC")) D "RTN","DGPFHLU5",110,0) . . D ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",111,0) . . D ADDLINE(DGTBL(DGCOD,"DESC"),12,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",112,0) . . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",113,0) Q "RTN","DGPFHLU5",114,0) ; "RTN","DGPFHLU5",115,0) ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array "RTN","DGPFHLU5",116,0) ; "RTN","DGPFHLU5",117,0) ; Input: "RTN","DGPFHLU5",118,0) ; DGTEXT - text string "RTN","DGPFHLU5",119,0) ; DGINDENT - number of spaces to insert at start of line "RTN","DGPFHLU5",120,0) ; DGMAXLEN - maximum desired line length (default: 60) "RTN","DGPFHLU5",121,0) ; DGCNT - line number passed by reference "RTN","DGPFHLU5",122,0) ; "RTN","DGPFHLU5",123,0) ; Output: "RTN","DGPFHLU5",124,0) ; DGXMTXT - array of text strings "RTN","DGPFHLU5",125,0) ; "RTN","DGPFHLU5",126,0) N DGAVAIL ;available space for text "RTN","DGPFHLU5",127,0) N DGLINE ;truncated text "RTN","DGPFHLU5",128,0) N DGLOC ;location of space character "RTN","DGPFHLU5",129,0) N DGPAD ;space indent "RTN","DGPFHLU5",130,0) ; "RTN","DGPFHLU5",131,0) S DGTEXT=$G(DGTEXT) "RTN","DGPFHLU5",132,0) S DGINDENT=+$G(DGINDENT) "RTN","DGPFHLU5",133,0) S DGMAXLEN=+$G(DGMAXLEN) "RTN","DGPFHLU5",134,0) S:'DGMAXLEN DGMAXLEN=60 "RTN","DGPFHLU5",135,0) I DGINDENT>(DGMAXLEN-1) S DGINDENT=0 "RTN","DGPFHLU5",136,0) S DGCNT=$G(DGCNT,0) ;default to 0 "RTN","DGPFHLU5",137,0) ; "RTN","DGPFHLU5",138,0) S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT) "RTN","DGPFHLU5",139,0) ; "RTN","DGPFHLU5",140,0) ;determine availaible space for text "RTN","DGPFHLU5",141,0) S DGAVAIL=(DGMAXLEN-DGINDENT) "RTN","DGPFHLU5",142,0) F D Q:('$L(DGTEXT)) "RTN","DGPFHLU5",143,0) . ; "RTN","DGPFHLU5",144,0) . ;find potential line break "RTN","DGPFHLU5",145,0) . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ") "RTN","DGPFHLU5",146,0) . ; "RTN","DGPFHLU5",147,0) . ;break a line that is too long when it has potential line breaks "RTN","DGPFHLU5",148,0) . I $L(DGTEXT)>DGAVAIL,DGLOC D "RTN","DGPFHLU5",149,0) . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1)) "RTN","DGPFHLU5",150,0) . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," ")) "RTN","DGPFHLU5",151,0) . E D "RTN","DGPFHLU5",152,0) . . S DGLINE=DGTEXT,DGTEXT="" "RTN","DGPFHLU5",153,0) . ; "RTN","DGPFHLU5",154,0) . S DGCNT=DGCNT+1 "RTN","DGPFHLU5",155,0) . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE "RTN","DGPFHLU5",156,0) Q "RTN","DGPFHLU5",157,0) ; "RTN","DGPFHLU5",158,0) SEND(DGXMTXT) ;send the MailMan message "RTN","DGPFHLU5",159,0) ; "RTN","DGPFHLU5",160,0) ; Input: "RTN","DGPFHLU5",161,0) ; DGXMTXT - name of message text array in closed format "RTN","DGPFHLU5",162,0) ; "RTN","DGPFHLU5",163,0) ; Output: "RTN","DGPFHLU5",164,0) ; none "RTN","DGPFHLU5",165,0) ; "RTN","DGPFHLU5",166,0) N DIFROM ;protect FM package "RTN","DGPFHLU5",167,0) N XMDUZ ;sender "RTN","DGPFHLU5",168,0) N XMSUB ;message subject "RTN","DGPFHLU5",169,0) N XMTEXT ;name of message text array in open format "RTN","DGPFHLU5",170,0) N XMY ;recipient array "RTN","DGPFHLU5",171,0) N XMZ ;returned message number "RTN","DGPFHLU5",172,0) ; "RTN","DGPFHLU5",173,0) S XMDUZ="Patient Record Flag Module" "RTN","DGPFHLU5",174,0) S XMSUB="PRF MESSAGE TRANSMISSION ERROR" "RTN","DGPFHLU5",175,0) S XMTEXT=$$OREF^DILF(DGXMTXT) "RTN","DGPFHLU5",176,0) S XMY("G.DGPF HL7 TRANSMISSION ERRORS")="" "RTN","DGPFHLU5",177,0) D ^XMD "RTN","DGPFHLU5",178,0) Q "RTN","DGPFHLU6") 0^65^B6178112 "RTN","DGPFHLU6",1,0) DGPFHLU6 ;ALB/RPM - PRF HL7 ORU~R01 UTILITIES ; 5/21/03 "RTN","DGPFHLU6",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLU6",3,0) ; "RTN","DGPFHLU6",4,0) Q ;no direct entry "RTN","DGPFHLU6",5,0) ; "RTN","DGPFHLU6",6,0) XMIT(DGPFHIEN,HLEID,DGFAC,DGHLROOT,DGHL) ;transmit ORU messages "RTN","DGPFHLU6",7,0) ;This function loops through an array of treating facilities. For "RTN","DGPFHLU6",8,0) ;each treating facility: the HL7 logical link is determined, the ORU "RTN","DGPFHLU6",9,0) ;message contained in the DGHLROOT input parameter is transmitted and "RTN","DGPFHLU6",10,0) ;an entry is created in the PRF HL7 TRANSMISSION LOG (#26.17) file. "RTN","DGPFHLU6",11,0) ; "RTN","DGPFHLU6",12,0) ; Supported DBIA #2171: This supported DBIA is used to access the "RTN","DGPFHLU6",13,0) ; Kernel API to convert a station number "RTN","DGPFHLU6",14,0) ; to an INSTITUTION (#4) file IEN. "RTN","DGPFHLU6",15,0) ; "RTN","DGPFHLU6",16,0) ; Input: "RTN","DGPFHLU6",17,0) ; DGPFHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFHLU6",18,0) ; HLEID - event protocol ID "RTN","DGPFHLU6",19,0) ; DGFAC - treating facilities array "RTN","DGPFHLU6",20,0) ; DGHLROOT - name of array containing formatted ORU message "RTN","DGPFHLU6",21,0) ; DGHL - VistA HL7 environment array "RTN","DGPFHLU6",22,0) ; "RTN","DGPFHLU6",23,0) ; Output: "RTN","DGPFHLU6",24,0) ; Function value - returns 1 on sucess, 0 on failure "RTN","DGPFHLU6",25,0) ; "RTN","DGPFHLU6",26,0) N DGHLLNK ;single logical link "RTN","DGPFHLU6",27,0) N DGHLS ;name of HL7 "HLS" array "RTN","DGPFHLU6",28,0) N DGI ;generic counter "RTN","DGPFHLU6",29,0) N DGINST ;pointer to INSTITUTION (#4) file "RTN","DGPFHLU6",30,0) N DGLOGERR ;error array from transmit log filer "RTN","DGPFHLU6",31,0) N DGLINST ;pointer to INSTITUTION (#4) file for local site "RTN","DGPFHLU6",32,0) N DGRSLT ;function value "RTN","DGPFHLU6",33,0) N HLL ;logical links array "RTN","DGPFHLU6",34,0) N HLRSLT ;message IEN on successful transmit "RTN","DGPFHLU6",35,0) ; "RTN","DGPFHLU6",36,0) S DGHLS=$NA(^TMP("HLS",$J)) "RTN","DGPFHLU6",37,0) S DGLINST=$P($$SITE^VASITE(),U,1) "RTN","DGPFHLU6",38,0) S DGRSLT=0 "RTN","DGPFHLU6",39,0) ; "RTN","DGPFHLU6",40,0) S DGI=0 "RTN","DGPFHLU6",41,0) F S DGI=$O(DGFAC(DGI)) Q:'DGI D "RTN","DGPFHLU6",42,0) . N HLRSLT "RTN","DGPFHLU6",43,0) . N DGLOGERR "RTN","DGPFHLU6",44,0) . ; "RTN","DGPFHLU6",45,0) . ;convert the station number to INSTITUTION (#4) file IEN "RTN","DGPFHLU6",46,0) . S DGINST=+$$IEN^XUAF4($P(DGFAC(DGI),U,1)) "RTN","DGPFHLU6",47,0) . Q:'DGINST!(DGINST=DGLINST) "RTN","DGPFHLU6",48,0) . ; "RTN","DGPFHLU6",49,0) . ;get the HL7 LOGICAL LINK associated with the institution "RTN","DGPFHLU6",50,0) . S DGHLLNK=$$GETLINK^DGPFHLUT(DGINST) "RTN","DGPFHLU6",51,0) . Q:DGHLLNK=0 "RTN","DGPFHLU6",52,0) . ; "RTN","DGPFHLU6",53,0) . ;copy formatted message to HL7 "HLS" array "RTN","DGPFHLU6",54,0) . K @DGHLS "RTN","DGPFHLU6",55,0) . M @DGHLS=@DGHLROOT "RTN","DGPFHLU6",56,0) . ; "RTN","DGPFHLU6",57,0) . ;build HLL logical link "RTN","DGPFHLU6",58,0) . S HLL("LINKS",1)="DGPF PRF ORU/R01 SUBSC"_U_DGHLLNK "RTN","DGPFHLU6",59,0) . ; "RTN","DGPFHLU6",60,0) . ;generate the message "RTN","DGPFHLU6",61,0) . D GENERATE^HLMA(HLEID,"GM",1,.HLRSLT,"","") "RTN","DGPFHLU6",62,0) . Q:$P(HLRSLT,U,2)]"" "RTN","DGPFHLU6",63,0) . ; "RTN","DGPFHLU6",64,0) . ;store the message ID and destination site in the HL7 transmission log "RTN","DGPFHLU6",65,0) . D STOXMIT^DGPFHLL(DGPFHIEN,$P(HLRSLT,U),DGINST,.DGLOGERR) "RTN","DGPFHLU6",66,0) . Q:$D(DGLOGERR) "RTN","DGPFHLU6",67,0) . ; "RTN","DGPFHLU6",68,0) . ;success "RTN","DGPFHLU6",69,0) . S DGRSLT=1 "RTN","DGPFHLU6",70,0) ; "RTN","DGPFHLU6",71,0) Q DGRSLT "RTN","DGPFHLUT") 0^6^B30959687 "RTN","DGPFHLUT",1,0) DGPFHLUT ;ALB/RPM - PRF HL7 UTILITIES ; 1/13/03 "RTN","DGPFHLUT",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFHLUT",3,0) ;This routine contains generic utilities used when building "RTN","DGPFHLUT",4,0) ;or processing received patient record flag HL7 messages. "RTN","DGPFHLUT",5,0) ; "RTN","DGPFHLUT",6,0) Q ;no supported direct entry "RTN","DGPFHLUT",7,0) ; "RTN","DGPFHLUT",8,0) INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper "RTN","DGPFHLUT",9,0) ; "RTN","DGPFHLUT",10,0) ; Supported DBIA #2161: The supported DBIA is used to access the "RTN","DGPFHLUT",11,0) ; VistA HL7 API to initialize the HL7 environ- "RTN","DGPFHLUT",12,0) ; ment variables. "RTN","DGPFHLUT",13,0) ; "RTN","DGPFHLUT",14,0) ; Input: "RTN","DGPFHLUT",15,0) ; DGPROT - Event protocol name "RTN","DGPFHLUT",16,0) ; "RTN","DGPFHLUT",17,0) ; Output: "RTN","DGPFHLUT",18,0) ; Function value - HLEID on success;0 on failure "RTN","DGPFHLUT",19,0) ; DGHL - HL array from INIT^HLFNC2 Kernel call "RTN","DGPFHLUT",20,0) ; "RTN","DGPFHLUT",21,0) N DGHLEID "RTN","DGPFHLUT",22,0) S DGHLEID=0 "RTN","DGPFHLUT",23,0) S DGHLEID=$$HLEID(DGPROT) "RTN","DGPFHLUT",24,0) I DGHLEID D "RTN","DGPFHLUT",25,0) . D INIT^HLFNC2(DGHLEID,.DGHL) "RTN","DGPFHLUT",26,0) . I $O(DGHL(""))="" S DGHLEID=0 "RTN","DGPFHLUT",27,0) Q DGHLEID "RTN","DGPFHLUT",28,0) ; "RTN","DGPFHLUT",29,0) HLEID(DGPROT) ;return IEN of HL7 protocol "RTN","DGPFHLUT",30,0) ; "RTN","DGPFHLUT",31,0) ; Input: "RTN","DGPFHLUT",32,0) ; DGPROT - Protocol name "RTN","DGPFHLUT",33,0) ; "RTN","DGPFHLUT",34,0) ; Output: "RTN","DGPFHLUT",35,0) ; Function value - IEN of protocol on success, 0 on failure "RTN","DGPFHLUT",36,0) ; "RTN","DGPFHLUT",37,0) I $G(DGPROT)="" Q 0 "RTN","DGPFHLUT",38,0) Q +$O(^ORD(101,"B",DGPROT,0)) "RTN","DGPFHLUT",39,0) ; "RTN","DGPFHLUT",40,0) GETLINK(DGINST) ;retrieve a single link for a given institution "RTN","DGPFHLUT",41,0) ; "RTN","DGPFHLUT",42,0) ; Supported DBIA #2271: The supported DBIA is used to access the "RTN","DGPFHLUT",43,0) ; VistA HL7 API to retrieve logical links "RTN","DGPFHLUT",44,0) ; given a pointer to the INSTITUTION (#4) file. "RTN","DGPFHLUT",45,0) ; "RTN","DGPFHLUT",46,0) ; Input: "RTN","DGPFHLUT",47,0) ; DGINST - IEN of site in INSTITUTION (#4) file "RTN","DGPFHLUT",48,0) ; "RTN","DGPFHLUT",49,0) ; Output: "RTN","DGPFHLUT",50,0) ; Function Value - HL Logical link on success, 0 on failure "RTN","DGPFHLUT",51,0) ; "RTN","DGPFHLUT",52,0) N DGLINKS "RTN","DGPFHLUT",53,0) N DGLNK "RTN","DGPFHLUT",54,0) N DGRSLT "RTN","DGPFHLUT",55,0) ; "RTN","DGPFHLUT",56,0) S DGRSLT=0 "RTN","DGPFHLUT",57,0) I $G(DGINST)>0 D "RTN","DGPFHLUT",58,0) . D LINK^HLUTIL3(DGINST,.DGLINKS) "RTN","DGPFHLUT",59,0) . S DGLNK=$O(DGLINKS(0)) "RTN","DGPFHLUT",60,0) . S DGRSLT=$S(DGLNK>0:DGLINKS(DGLNK),1:0) "RTN","DGPFHLUT",61,0) Q DGRSLT "RTN","DGPFHLUT",62,0) ; "RTN","DGPFHLUT",63,0) BLDTEXT(DGWP,DGHL,DGARR) ;Build HL7 word proc text array "RTN","DGPFHLUT",64,0) ; "RTN","DGPFHLUT",65,0) ; Supported DBIA #10104: The supported DBIA is used to access KERNEL "RTN","DGPFHLUT",66,0) ; string functions. "RTN","DGPFHLUT",67,0) ; "RTN","DGPFHLUT",68,0) ; Input: "RTN","DGPFHLUT",69,0) ; DGWP - Word processing closed root "RTN","DGPFHLUT",70,0) ; DGHL - HL7 environment array "RTN","DGPFHLUT",71,0) ; "RTN","DGPFHLUT",72,0) ; Output: "RTN","DGPFHLUT",73,0) ; Function Value - count of segment array elements on success, "RTN","DGPFHLUT",74,0) ; 0 on failure "RTN","DGPFHLUT",75,0) ; DGARR - array of segment text data "RTN","DGPFHLUT",76,0) ; "RTN","DGPFHLUT",77,0) N DGLIN ;word processing line iterator "RTN","DGPFHLUT",78,0) N DGCNT ;text segment counter "RTN","DGPFHLUT",79,0) N DGTXT ;word processing text "RTN","DGPFHLUT",80,0) N DGBLK ;blank line counter "RTN","DGPFHLUT",81,0) N DGREP ;HL7 repetition character "RTN","DGPFHLUT",82,0) ; "RTN","DGPFHLUT",83,0) S DGLIN=0 "RTN","DGPFHLUT",84,0) S DGCNT=0 "RTN","DGPFHLUT",85,0) S DGBLK=0 "RTN","DGPFHLUT",86,0) S DGREP=$E(DGHL("ECH"),2) "RTN","DGPFHLUT",87,0) ; "RTN","DGPFHLUT",88,0) F S DGLIN=$O(@DGWP@(DGLIN)) Q:'DGLIN D "RTN","DGPFHLUT",89,0) . S DGTXT=$G(@DGWP@(DGLIN,0)) "RTN","DGPFHLUT",90,0) . S DGTXT=$$STRIPTS^DGPFHLUT(DGTXT) ;strip trailing spaces "RTN","DGPFHLUT",91,0) . I DGTXT?1.PC!(DGTXT="") S DGBLK=DGBLK+1 Q "RTN","DGPFHLUT",92,0) . S DGCNT=DGCNT+1 "RTN","DGPFHLUT",93,0) . I DGBLK D "RTN","DGPFHLUT",94,0) . . S DGARR(DGCNT)=$$REPEAT^XLFSTR(DGREP,DGBLK)_DGTXT "RTN","DGPFHLUT",95,0) . . S DGBLK=0 "RTN","DGPFHLUT",96,0) . E S DGARR(DGCNT)=DGTXT "RTN","DGPFHLUT",97,0) Q DGCNT "RTN","DGPFHLUT",98,0) ; "RTN","DGPFHLUT",99,0) NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment "RTN","DGPFHLUT",100,0) ; This function retrieves the next segment in the work global, returns "RTN","DGPFHLUT",101,0) ; an array of field values and the segment's work global index. If "RTN","DGPFHLUT",102,0) ; the next segment does not exist, then the function returns a zero. "RTN","DGPFHLUT",103,0) ; "RTN","DGPFHLUT",104,0) ; Input: "RTN","DGPFHLUT",105,0) ; DGROOT - close root name of work global "RTN","DGPFHLUT",106,0) ; DGCURR - index of current segment "RTN","DGPFHLUT",107,0) ; DGFS - HL7 field separator character "RTN","DGPFHLUT",108,0) ; "RTN","DGPFHLUT",109,0) ; Output: "RTN","DGPFHLUT",110,0) ; Function Value - index of the next segment on success, 0 on failure "RTN","DGPFHLUT",111,0) ; DGFLD - array of segment field values "RTN","DGPFHLUT",112,0) ; "RTN","DGPFHLUT",113,0) N NXTSEG "RTN","DGPFHLUT",114,0) ; "RTN","DGPFHLUT",115,0) S DGCURR=DGCURR+1 "RTN","DGPFHLUT",116,0) S NXTSEG=$G(@DGROOT@(DGCURR,0)) "RTN","DGPFHLUT",117,0) I NXTSEG]"" D "RTN","DGPFHLUT",118,0) . D GETFLDS(NXTSEG,DGFS,.DGFLD) "RTN","DGPFHLUT",119,0) E D "RTN","DGPFHLUT",120,0) . S DGCURR=0 "RTN","DGPFHLUT",121,0) Q DGCURR "RTN","DGPFHLUT",122,0) ; "RTN","DGPFHLUT",123,0) GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array "RTN","DGPFHLUT",124,0) ;This procedure parses a single HL7 segment and builds an array "RTN","DGPFHLUT",125,0) ;subscripted by the field number that contains the data for that field. "RTN","DGPFHLUT",126,0) ;An additional subscript node, "TYPE" is created containing the segment "RTN","DGPFHLUT",127,0) ;type. "RTN","DGPFHLUT",128,0) ; "RTN","DGPFHLUT",129,0) ; Input: "RTN","DGPFHLUT",130,0) ; DGSEG - HL7 segment to parse "RTN","DGPFHLUT",131,0) ; DGFS - HL7 field separator "RTN","DGPFHLUT",132,0) ; "RTN","DGPFHLUT",133,0) ; Output: "RTN","DGPFHLUT",134,0) ; DGFLD - array of segment field values subscripted by field # "RTN","DGPFHLUT",135,0) ; Example: DGFLD(2)="DOE,JOHN" "RTN","DGPFHLUT",136,0) ; "RTN","DGPFHLUT",137,0) N DGI "RTN","DGPFHLUT",138,0) ; "RTN","DGPFHLUT",139,0) S DGFLD("TYPE")=$P(DGSEG,DGFS) "RTN","DGPFHLUT",140,0) F DGI=2:1:$L(DGSEG,DGFS) D "RTN","DGPFHLUT",141,0) . S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI) "RTN","DGPFHLUT",142,0) Q "RTN","DGPFHLUT",143,0) ; "RTN","DGPFHLUT",144,0) STRIPTS(DGSTR) ;Strip trailing spaces from a line of text "RTN","DGPFHLUT",145,0) ; "RTN","DGPFHLUT",146,0) ; Input: "RTN","DGPFHLUT",147,0) ; DGSTR - Text string "RTN","DGPFHLUT",148,0) ; "RTN","DGPFHLUT",149,0) ; Output: "RTN","DGPFHLUT",150,0) ; Function Value - Input text string with trailing spaces removed "RTN","DGPFHLUT",151,0) ; "RTN","DGPFHLUT",152,0) N SPACE "RTN","DGPFHLUT",153,0) S SPACE=$C(32) "RTN","DGPFHLUT",154,0) F Q:$E(DGSTR,$L(DGSTR))'=SPACE S DGSTR=$E(DGSTR,1,$L(DGSTR)-1) "RTN","DGPFHLUT",155,0) Q DGSTR "RTN","DGPFHLUT",156,0) ; "RTN","DGPFHLUT",157,0) BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder "RTN","DGPFHLUT",158,0) ; "RTN","DGPFHLUT",159,0) ; Input: "RTN","DGPFHLUT",160,0) ; DGTYP - segment type "RTN","DGPFHLUT",161,0) ; DGVAL - field data array [SUB1:field, SUB2:repetition, "RTN","DGPFHLUT",162,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLUT",163,0) ; DGHL - HL7 environment array "RTN","DGPFHLUT",164,0) ; "RTN","DGPFHLUT",165,0) ; Output: "RTN","DGPFHLUT",166,0) ; Function Value - Formatted HL7 segment on success, "" on failure "RTN","DGPFHLUT",167,0) ; "RTN","DGPFHLUT",168,0) N DGCMP ;component subscript "RTN","DGPFHLUT",169,0) N DGCMPVAL ;component value "RTN","DGPFHLUT",170,0) N DGFLD ;field subscript "RTN","DGPFHLUT",171,0) N DGFLDVAL ;field value "RTN","DGPFHLUT",172,0) N DGREP ;repetition subscript "RTN","DGPFHLUT",173,0) N DGREPVAL ;repetition value "RTN","DGPFHLUT",174,0) N DGSUB ;sub-component subscript "RTN","DGPFHLUT",175,0) N DGSUBVAL ;suc-component value "RTN","DGPFHLUT",176,0) N DGFS ;field separator "RTN","DGPFHLUT",177,0) N DGCS ;component separator "RTN","DGPFHLUT",178,0) N DGRS ;repetition separator "RTN","DGPFHLUT",179,0) N DGSS ;sub-component separator "RTN","DGPFHLUT",180,0) N DGSEG "RTN","DGPFHLUT",181,0) N DGSEP "RTN","DGPFHLUT",182,0) ; "RTN","DGPFHLUT",183,0) Q:($G(DGTYP)']"") "" "RTN","DGPFHLUT",184,0) ; "RTN","DGPFHLUT",185,0) S DGSEG=DGTYP "RTN","DGPFHLUT",186,0) S DGFS=DGHL("FS") "RTN","DGPFHLUT",187,0) S DGCS=$E(DGHL("ECH")) "RTN","DGPFHLUT",188,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLUT",189,0) S DGSS=$E(DGHL("ECH"),4) "RTN","DGPFHLUT",190,0) ; "RTN","DGPFHLUT",191,0) F DGFLD=1:1:$O(DGVAL(""),-1) D "RTN","DGPFHLUT",192,0) . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS "RTN","DGPFHLUT",193,0) . D ADD(DGFLDVAL,DGSEP,.DGSEG) "RTN","DGPFHLUT",194,0) . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D "RTN","DGPFHLUT",195,0) . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP)) "RTN","DGPFHLUT",196,0) . . S DGSEP=$S(DGREP=1:"",1:DGRS) "RTN","DGPFHLUT",197,0) . . D ADD(DGREPVAL,DGSEP,.DGSEG) "RTN","DGPFHLUT",198,0) . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D "RTN","DGPFHLUT",199,0) . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP)) "RTN","DGPFHLUT",200,0) . . . S DGSEP=$S(DGCMP=1:"",1:DGCS) "RTN","DGPFHLUT",201,0) . . . D ADD(DGCMPVAL,DGSEP,.DGSEG) "RTN","DGPFHLUT",202,0) . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D "RTN","DGPFHLUT",203,0) . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB)) "RTN","DGPFHLUT",204,0) . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS) "RTN","DGPFHLUT",205,0) . . . . D ADD(DGSUBVAL,DGSEP,.DGSEG) "RTN","DGPFHLUT",206,0) Q DGSEG "RTN","DGPFHLUT",207,0) ; "RTN","DGPFHLUT",208,0) ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment "RTN","DGPFHLUT",209,0) ; "RTN","DGPFHLUT",210,0) ; Input: "RTN","DGPFHLUT",211,0) ; DGVAL - value to append "RTN","DGPFHLUT",212,0) ; DGSEP - HL7 separator "RTN","DGPFHLUT",213,0) ; "RTN","DGPFHLUT",214,0) ; Output: "RTN","DGPFHLUT",215,0) ; DGSEG - segment passed by reference "RTN","DGPFHLUT",216,0) ; "RTN","DGPFHLUT",217,0) S DGSEP=$G(DGSEP) "RTN","DGPFHLUT",218,0) S DGVAL=$G(DGVAL) "RTN","DGPFHLUT",219,0) S DGSEG=DGSEG_DGSEP_DGVAL "RTN","DGPFHLUT",220,0) Q "RTN","DGPFHLUT",221,0) ; "RTN","DGPFHLUT",222,0) CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string "RTN","DGPFHLUT",223,0) ; "RTN","DGPFHLUT",224,0) ; Input: "RTN","DGPFHLUT",225,0) ; DGFLDS - (required) comma delimited string of required fields "RTN","DGPFHLUT",226,0) ; DGSTR - (optional) comma delimited string of fields to include "RTN","DGPFHLUT",227,0) ; in an HL7 segment. "RTN","DGPFHLUT",228,0) ; "RTN","DGPFHLUT",229,0) ; Output: "RTN","DGPFHLUT",230,0) ; Function Value - validated string of fields "RTN","DGPFHLUT",231,0) ; "RTN","DGPFHLUT",232,0) N DGI ;generic index "RTN","DGPFHLUT",233,0) N DGREQ ;required field "RTN","DGPFHLUT",234,0) ; "RTN","DGPFHLUT",235,0) Q:($G(DGFLDS)']"") "" "RTN","DGPFHLUT",236,0) S DGSTR=$G(DGSTR) "RTN","DGPFHLUT",237,0) F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ="" D "RTN","DGPFHLUT",238,0) . I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ "RTN","DGPFHLUT",239,0) Q DGSTR "RTN","DGPFLF") 0^37^B2708557 "RTN","DGPFLF",1,0) DGPFLF ;ALB/KCL - PRF FLAG MANAGEMENT LM SCREEN ; 3/10/03 "RTN","DGPFLF",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF",3,0) ; "RTN","DGPFLF",4,0) ;- no direct entry "RTN","DGPFLF",5,0) QUIT "RTN","DGPFLF",6,0) ; "RTN","DGPFLF",7,0) EN ;Main entry point for DGPF RECORD FLAG MANAGEMENT option. "RTN","DGPFLF",8,0) ; "RTN","DGPFLF",9,0) ; Input: None "RTN","DGPFLF",10,0) ; Output: None "RTN","DGPFLF",11,0) ; "RTN","DGPFLF",12,0) ;- invoke DGPF RECORD FLAG MANAGEMENT list template "RTN","DGPFLF",13,0) D EN^VALM("DGPF RECORD FLAG MANAGEMENT") "RTN","DGPFLF",14,0) Q "RTN","DGPFLF",15,0) ; "RTN","DGPFLF",16,0) ; "RTN","DGPFLF",17,0) HDR ;Header Code "RTN","DGPFLF",18,0) ; "RTN","DGPFLF",19,0) N DGHDR "RTN","DGPFLF",20,0) S VALMHDR(1)="Flag Category: "_$S(DGCAT=1:"I (National)",DGCAT=2:"II (Local)",1:"Unknown") "RTN","DGPFLF",21,0) S DGHDR="Sorted By: "_$S(DGSRTBY="N":"Flag Name",DGSRTBY="T":"Flag Type",1:"Unknown") "RTN","DGPFLF",22,0) S VALMHDR(1)=$$SETSTR^VALM1(DGHDR,VALMHDR(1),57,$L(DGHDR)) "RTN","DGPFLF",23,0) Q "RTN","DGPFLF",24,0) ; "RTN","DGPFLF",25,0) ; "RTN","DGPFLF",26,0) INIT ;Init variables and list array "RTN","DGPFLF",27,0) ; "RTN","DGPFLF",28,0) ;- init flag categorey to list (default=National) "RTN","DGPFLF",29,0) S DGCAT=1 "RTN","DGPFLF",30,0) ; "RTN","DGPFLF",31,0) ;init list sort by criteria (default=Flag Name) "RTN","DGPFLF",32,0) S DGSRTBY="N" "RTN","DGPFLF",33,0) ; "RTN","DGPFLF",34,0) ;build record flag list area "RTN","DGPFLF",35,0) D BLD "RTN","DGPFLF",36,0) ; "RTN","DGPFLF",37,0) Q "RTN","DGPFLF",38,0) ; "RTN","DGPFLF",39,0) ; "RTN","DGPFLF",40,0) BLD ;Build record flag screen (list area) "RTN","DGPFLF",41,0) ; "RTN","DGPFLF",42,0) D CLEAN^VALM10 "RTN","DGPFLF",43,0) K DGARY,VALMHDR "RTN","DGPFLF",44,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLF",45,0) ; "RTN","DGPFLF",46,0) ;- init array that will contain list of items to display "RTN","DGPFLF",47,0) S DGARY="DGPFLAG" "RTN","DGPFLF",48,0) K ^TMP(DGARY,$J) "RTN","DGPFLF",49,0) ; "RTN","DGPFLF",50,0) ;init # of lines in list "RTN","DGPFLF",51,0) S VALMCNT=0 "RTN","DGPFLF",52,0) ; "RTN","DGPFLF",53,0) ;build header area "RTN","DGPFLF",54,0) D HDR "RTN","DGPFLF",55,0) ; "RTN","DGPFLF",56,0) ;build list area for flag screen "RTN","DGPFLF",57,0) D EN^DGPFLF1(DGARY,DGCAT,DGSRTBY,.VALMCNT) "RTN","DGPFLF",58,0) ; "RTN","DGPFLF",59,0) Q "RTN","DGPFLF",60,0) ; "RTN","DGPFLF",61,0) ; "RTN","DGPFLF",62,0) HELP ;Help Code "RTN","DGPFLF",63,0) ; "RTN","DGPFLF",64,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLF",65,0) Q "RTN","DGPFLF",66,0) ; "RTN","DGPFLF",67,0) ; "RTN","DGPFLF",68,0) EXIT ;Exit Code "RTN","DGPFLF",69,0) ; "RTN","DGPFLF",70,0) D CLEAN^VALM10 "RTN","DGPFLF",71,0) D CLEAR^VALM1 "RTN","DGPFLF",72,0) K DGCAT "RTN","DGPFLF",73,0) K DGSRTBY "RTN","DGPFLF",74,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLF",75,0) K ^TMP(DGARY,$J) "RTN","DGPFLF",76,0) K ^TMP(DGARY,"IDX",$J) "RTN","DGPFLF",77,0) K DGARY "RTN","DGPFLF",78,0) Q "RTN","DGPFLF",79,0) ; "RTN","DGPFLF",80,0) ; "RTN","DGPFLF",81,0) EXPND ;Expand Code "RTN","DGPFLF",82,0) Q "RTN","DGPFLF1") 0^38^B31012393 "RTN","DGPFLF1",1,0) DGPFLF1 ;ALB/KCL - PRF FLAG MANAGEMENT BUILD LIST AREA ; 3/11/03 "RTN","DGPFLF1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF1",3,0) ; "RTN","DGPFLF1",4,0) ;no direct entry "RTN","DGPFLF1",5,0) QUIT "RTN","DGPFLF1",6,0) ; "RTN","DGPFLF1",7,0) EN(DGARY,DGCAT,DGSRTBY,DGCNT) ;Entry point to build list area for PRF Flags. "RTN","DGPFLF1",8,0) ; "RTN","DGPFLF1",9,0) ; The following variables are 'system wide variables' in the "RTN","DGPFLF1",10,0) ; DGPF RECORD FLAG MANAGEMENT List Manager application: "RTN","DGPFLF1",11,0) ; Input: "RTN","DGPFLF1",12,0) ; DGARY - global array subscript "RTN","DGPFLF1",13,0) ; DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF1",14,0) ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF1",15,0) ; "RTN","DGPFLF1",16,0) ; Output: "RTN","DGPFLF1",17,0) ; DGCNT - number of lines in the list "RTN","DGPFLF1",18,0) ; "RTN","DGPFLF1",19,0) ;display wait msg "RTN","DGPFLF1",20,0) D WAIT^DICD "RTN","DGPFLF1",21,0) ; "RTN","DGPFLF1",22,0) ;retrieve all flags for the category specified "RTN","DGPFLF1",23,0) D GET(DGARY,DGCAT,DGSRTBY) "RTN","DGPFLF1",24,0) ; "RTN","DGPFLF1",25,0) ;build list area for flag screen "RTN","DGPFLF1",26,0) D BLD(DGSRTBY,.DGCNT) "RTN","DGPFLF1",27,0) ; "RTN","DGPFLF1",28,0) ;if no entries in list, display message in list area "RTN","DGPFLF1",29,0) I 'DGCNT D "RTN","DGPFLF1",30,0) . D SET^DGPFLMU1(DGARY,1,"",1,,,.DGCNT) "RTN","DGPFLF1",31,0) . D SET^DGPFLMU1(DGARY,2,"There are currently no flags on file to display.",4,$G(IOINHI),$G(IOINORM),.DGCNT) "RTN","DGPFLF1",32,0) ; "RTN","DGPFLF1",33,0) Q "RTN","DGPFLF1",34,0) ; "RTN","DGPFLF1",35,0) ; "RTN","DGPFLF1",36,0) GET(DGARY,DGCAT,DGSRTBY) ;Get flag entries for display. "RTN","DGPFLF1",37,0) ; "RTN","DGPFLF1",38,0) ; Input: "RTN","DGPFLF1",39,0) ; DGARY - global array subscript "RTN","DGPFLF1",40,0) ; DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF1",41,0) ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF1",42,0) ; "RTN","DGPFLF1",43,0) ; Output: None "RTN","DGPFLF1",44,0) ; "RTN","DGPFLF1",45,0) N DGFILE ;file root of LOCAL or NATIONAL flag file "RTN","DGPFLF1",46,0) N DGFLAG ;local array used to hold flag record "RTN","DGPFLF1",47,0) N DGIEN ;ien of record in LOCAL or NATIONAL flag file "RTN","DGPFLF1",48,0) N DGVPTR ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file "RTN","DGPFLF1",49,0) N DGRSULT "RTN","DGPFLF1",50,0) ; "RTN","DGPFLF1",51,0) ;determine LOCAL or NATIONAL flag file "RTN","DGPFLF1",52,0) S DGFILE=$S(DGCAT=1:"^DGPF(26.15)",DGCAT=2:"^DGPF(26.11)",1:0) "RTN","DGPFLF1",53,0) ; "RTN","DGPFLF1",54,0) ;loop through each ien of flag file determined by value of DGFILE "RTN","DGPFLF1",55,0) S DGIEN=0 F S DGIEN=$O(@DGFILE@(DGIEN)) Q:'DGIEN D "RTN","DGPFLF1",56,0) . K DGFLAG "RTN","DGPFLF1",57,0) . ;- if national, get flag into DGFLAG array "RTN","DGPFLF1",58,0) . I DGCAT=1 D Q:'$G(DGRSULT) "RTN","DGPFLF1",59,0) . . S DGRSULT=$$GETNF^DGPFANF(DGIEN,.DGFLAG) "RTN","DGPFLF1",60,0) . . S:DGRSULT DGVPTR=DGIEN_";DGPF(26.15," "RTN","DGPFLF1",61,0) . ; "RTN","DGPFLF1",62,0) . ;- if local, get flag into DGFLAG array "RTN","DGPFLF1",63,0) . I DGCAT=2 D Q:'$G(DGRSULT) "RTN","DGPFLF1",64,0) . . S DGRSULT=$$GETLF^DGPFALF(DGIEN,.DGFLAG) "RTN","DGPFLF1",65,0) . . S:DGRSULT DGVPTR=DGIEN_";DGPF(26.11," "RTN","DGPFLF1",66,0) . ; "RTN","DGPFLF1",67,0) . ;- set flag entry into sorted output array "RTN","DGPFLF1",68,0) . D SORT(DGVPTR,DGSRTBY,DGIEN,.DGFLAG) "RTN","DGPFLF1",69,0) ; "RTN","DGPFLF1",70,0) Q "RTN","DGPFLF1",71,0) ; "RTN","DGPFLF1",72,0) ; "RTN","DGPFLF1",73,0) SORT(DGVPTR,DGSRTBY,DGIEN,DGFLAG) ;Set flag data into sorted output array based on the sort criteria passed. "RTN","DGPFLF1",74,0) ; "RTN","DGPFLF1",75,0) ; Input: "RTN","DGPFLF1",76,0) ; DGVPTR - IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file "RTN","DGPFLF1",77,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFLF1",78,0) ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF1",79,0) ; DGIEN - ien of record in LOCAL or NATIONAL flag file "RTN","DGPFLF1",80,0) ; DGFLAG - local array containing flag record "RTN","DGPFLF1",81,0) ; "RTN","DGPFLF1",82,0) ; Output: "RTN","DGPFLF1",83,0) ; Temporary global with following structure - "RTN","DGPFLF1",84,0) ; Flag list sorted by flag name: "RTN","DGPFLF1",85,0) ; ^TMP("DGPFSORT",$J,,,)=^^^ "RTN","DGPFLF1",86,0) ; OR "RTN","DGPFLF1",87,0) ; Flag list sorted by flag type: "RTN","DGPFLF1",88,0) ; ^TMP("DGPFSORT",$J,,,)=^^^ "RTN","DGPFLF1",89,0) ; "RTN","DGPFLF1",90,0) I DGSRTBY="N" D ;flag name "RTN","DGPFLF1",91,0) . S ^TMP("DGPFSORT",$J,$P($G(DGFLAG("STAT")),U),$P($G(DGFLAG("FLAG")),U,2),DGIEN)=DGVPTR_U_$P($G(DGFLAG("FLAG")),U,2)_U_$P($G(DGFLAG("TYPE")),U,2)_U_$P($G(DGFLAG("STAT")),U,2) "RTN","DGPFLF1",92,0) E D ;else flag type "RTN","DGPFLF1",93,0) . S ^TMP("DGPFSORT",$J,$P($G(DGFLAG("STAT")),U),$P($G(DGFLAG("TYPE")),U,2),DGIEN)=DGVPTR_U_$P($G(DGFLAG("FLAG")),U,2)_U_$P($G(DGFLAG("TYPE")),U,2)_U_$P($G(DGFLAG("STAT")),U,2) "RTN","DGPFLF1",94,0) ; "RTN","DGPFLF1",95,0) Q "RTN","DGPFLF1",96,0) ; "RTN","DGPFLF1",97,0) ; "RTN","DGPFLF1",98,0) BLD(DGSRTBY,DGCNT) ;Build list area for flag screen. "RTN","DGPFLF1",99,0) ; "RTN","DGPFLF1",100,0) ; Input: "RTN","DGPFLF1",101,0) ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF1",102,0) ; "RTN","DGPFLF1",103,0) ; Output: "RTN","DGPFLF1",104,0) ; DGCNT - number of lines in the list "RTN","DGPFLF1",105,0) ; "RTN","DGPFLF1",106,0) N DGFIEN ;^tmp global subscript (flag ien) "RTN","DGPFLF1",107,0) N DGLINE ;line counter "RTN","DGPFLF1",108,0) N DGNAME ;flag name "RTN","DGPFLF1",109,0) N DGNUM ;list selction number "RTN","DGPFLF1",110,0) N DGSI ;flag status internal value "RTN","DGPFLF1",111,0) N DGSTAT ;flag status "RTN","DGPFLF1",112,0) N DGSUB ;^tmp global subscript (flag name or type) "RTN","DGPFLF1",113,0) N DGTYPE ;flag type "RTN","DGPFLF1",114,0) N DGVPTR ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file "RTN","DGPFLF1",115,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFLF1",116,0) N DGTEMP ;sort array root "RTN","DGPFLF1",117,0) ; "RTN","DGPFLF1",118,0) ;init line counter and selection number "RTN","DGPFLF1",119,0) S (DGLINE,DGNUM)=0 "RTN","DGPFLF1",120,0) ;- loop through ^TMP global by status, active (1) then inactive (0) "RTN","DGPFLF1",121,0) F DGSI=1,0 D "RTN","DGPFLF1",122,0) . ;- loop through sort selection by flag name or flag type "RTN","DGPFLF1",123,0) . S DGSUB=$S(DGSRTBY="N":"",1:0) "RTN","DGPFLF1",124,0) . F S DGSUB=$O(^TMP("DGPFSORT",$J,DGSI,DGSUB)) Q:DGSUB="" D "RTN","DGPFLF1",125,0) . . ;- loop through flag file ien's "RTN","DGPFLF1",126,0) . . S DGFIEN=0 "RTN","DGPFLF1",127,0) . . F S DGFIEN=$O(^TMP("DGPFSORT",$J,DGSI,DGSUB,DGFIEN)) Q:'DGFIEN D "RTN","DGPFLF1",128,0) . . . ;-- get flag data fields from entry in ^TMP global "RTN","DGPFLF1",129,0) . . . S DGTEMP=$NA(^TMP("DGPFSORT",$J)) "RTN","DGPFLF1",130,0) . . . S DGVPTR=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U) ;flag IEN "RTN","DGPFLF1",131,0) . . . S DGNAME=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,2) ;flag name "RTN","DGPFLF1",132,0) . . . S DGTYPE=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,3) ;flag type "RTN","DGPFLF1",133,0) . . . S DGSTAT=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,4) ;flag status "RTN","DGPFLF1",134,0) . . . ; "RTN","DGPFLF1",135,0) . . . ;-- increment selection number "RTN","DGPFLF1",136,0) . . . S DGNUM=DGNUM+1 "RTN","DGPFLF1",137,0) . . . ; "RTN","DGPFLF1",138,0) . . . ;-- increment line counter "RTN","DGPFLF1",139,0) . . . S DGLINE=DGLINE+1 "RTN","DGPFLF1",140,0) . . . ; "RTN","DGPFLF1",141,0) . . . ;-- set line into list area "RTN","DGPFLF1",142,0) . . . D SET(DGARY,DGLINE,DGNUM,1,,,DGVPTR,DGNUM,.DGCNT) "RTN","DGPFLF1",143,0) . . . D SET(DGARY,DGLINE,DGNAME,6,,,DGVPTR,DGNUM,.DGCNT) "RTN","DGPFLF1",144,0) . . . D SET(DGARY,DGLINE,DGTYPE,38,,,DGVPTR,DGNUM,.DGCNT) "RTN","DGPFLF1",145,0) . . . D SET(DGARY,DGLINE,DGSTAT,65,,,DGVPTR,DGNUM,.DGCNT) "RTN","DGPFLF1",146,0) ; "RTN","DGPFLF1",147,0) Q "RTN","DGPFLF1",148,0) ; "RTN","DGPFLF1",149,0) ; "RTN","DGPFLF1",150,0) SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGVPTR,DGNUM,DGCNT) ;This procedure will set the lines of flag details in the LM display area. "RTN","DGPFLF1",151,0) ; "RTN","DGPFLF1",152,0) ; Input: "RTN","DGPFLF1",153,0) ; DGARY - global array subscript "RTN","DGPFLF1",154,0) ; DGLINE - line number "RTN","DGPFLF1",155,0) ; DGTEXT - text "RTN","DGPFLF1",156,0) ; DGVPTR - (optional) IEN of record in PRF NATIONAL FLAG or PRF LOCAL "RTN","DGPFLF1",157,0) ; FLAG file [ex: "1;DGPF(26.15,"] "RTN","DGPFLF1",158,0) ; DGNUM - (optional) selection number "RTN","DGPFLF1",159,0) ; DGCOL - starting column "RTN","DGPFLF1",160,0) ; DGON - highlighting on "RTN","DGPFLF1",161,0) ; DGOFF - highlighting off "RTN","DGPFLF1",162,0) ; "RTN","DGPFLF1",163,0) ; Output: "RTN","DGPFLF1",164,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLF1",165,0) ; "RTN","DGPFLF1",166,0) N DGX "RTN","DGPFLF1",167,0) S:DGLINE>DGCNT DGCNT=DGLINE "RTN","DGPFLF1",168,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLF1",169,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLF1",170,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLF1",171,0) ; "RTN","DGPFLF1",172,0) ;associate flag ien with list item for flag selection "RTN","DGPFLF1",173,0) S:($G(DGVPTR)]"")&($G(DGNUM)) ^TMP(DGARY,$J,"IDX",DGLINE,DGNUM)="" "RTN","DGPFLF1",174,0) S:($G(DGVPTR)]"")&($G(DGNUM)) ^TMP(DGARY,$J,"IDX",DGNUM)=DGVPTR "RTN","DGPFLF1",175,0) Q "RTN","DGPFLF2") 0^39^B7086828 "RTN","DGPFLF2",1,0) DGPFLF2 ;ALB/KCL - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS ; 3/18/03 "RTN","DGPFLF2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF2",3,0) ; "RTN","DGPFLF2",4,0) ;no direct entry "RTN","DGPFLF2",5,0) QUIT "RTN","DGPFLF2",6,0) ; "RTN","DGPFLF2",7,0) ; "RTN","DGPFLF2",8,0) SL ;Entry point for DGPF SORT FLAG LIST action protocol. "RTN","DGPFLF2",9,0) ; "RTN","DGPFLF2",10,0) ; Input: "RTN","DGPFLF2",11,0) ; DGSRTBY - flag list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF2",12,0) ; "RTN","DGPFLF2",13,0) ; Output: "RTN","DGPFLF2",14,0) ; DGSRTBY - flag list sort by criteria (N=Flag Name, T=Flage Type) "RTN","DGPFLF2",15,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLF2",16,0) ; "RTN","DGPFLF2",17,0) N DGCODE,DGFG "RTN","DGPFLF2",18,0) ; "RTN","DGPFLF2",19,0) ;set screen to full scrolling region "RTN","DGPFLF2",20,0) D FULL^VALM1 "RTN","DGPFLF2",21,0) ; "RTN","DGPFLF2",22,0) D "RTN","DGPFLF2",23,0) . ;- prompt for sort criteria "RTN","DGPFLF2",24,0) . W ! "RTN","DGPFLF2",25,0) . S DGFG=DGSRTBY ;save original sort to default to "RTN","DGPFLF2",26,0) . S DGCODE="Y" ;DIC(0)="Y" for Yes/No answering "RTN","DGPFLF2",27,0) . S DGSRTBY=$$ANSWER^DGPFUT("Would you like to sort the list by '"_$S($G(DGFG)="N":"Flag Type",1:"Flag Name")_"'","Yes",DGCODE) "RTN","DGPFLF2",28,0) . I $G(DGSRTBY)'=1 S DGSRTBY=DGFG Q ;no sort change "RTN","DGPFLF2",29,0) . S DGSRTBY=$S($G(DGFG)="N":"T",1:"N") ;change sort (flip / flop) "RTN","DGPFLF2",30,0) . ; "RTN","DGPFLF2",31,0) . ;- re-build list for selected sort criteria "RTN","DGPFLF2",32,0) . D BLD^DGPFLF "RTN","DGPFLF2",33,0) ; "RTN","DGPFLF2",34,0) ;return to LM (refresh screen) "RTN","DGPFLF2",35,0) S VALMBCK="R" "RTN","DGPFLF2",36,0) Q "RTN","DGPFLF2",37,0) ; "RTN","DGPFLF2",38,0) ; "RTN","DGPFLF2",39,0) CC ;Entry point for DGPF CHANGE CATEGORY action protocol. "RTN","DGPFLF2",40,0) ; "RTN","DGPFLF2",41,0) ; Input: "RTN","DGPFLF2",42,0) ; DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF2",43,0) ; "RTN","DGPFLF2",44,0) ; Output: "RTN","DGPFLF2",45,0) ; DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF2",46,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLF2",47,0) ; "RTN","DGPFLF2",48,0) N DGCODE "RTN","DGPFLF2",49,0) N DGFG "RTN","DGPFLF2",50,0) ; "RTN","DGPFLF2",51,0) ;set screen to full scrolling region "RTN","DGPFLF2",52,0) D FULL^VALM1 "RTN","DGPFLF2",53,0) ; "RTN","DGPFLF2",54,0) ;change category "RTN","DGPFLF2",55,0) S DGCAT=$S($G(DGCAT)=1:2,1:1) "RTN","DGPFLF2",56,0) ; "RTN","DGPFLF2",57,0) ;re-build list for category change "RTN","DGPFLF2",58,0) D BLD^DGPFLF "RTN","DGPFLF2",59,0) ; "RTN","DGPFLF2",60,0) ;return to LM (refresh screen) "RTN","DGPFLF2",61,0) S VALMBCK="R" "RTN","DGPFLF2",62,0) Q "RTN","DGPFLF2",63,0) ; "RTN","DGPFLF2",64,0) ; "RTN","DGPFLF2",65,0) DF ;Entry point for DGPF DISPLAY FLAG DETAIL action protocol. "RTN","DGPFLF2",66,0) ; "RTN","DGPFLF2",67,0) ; Input: "RTN","DGPFLF2",68,0) ; "RTN","DGPFLF2",69,0) ; Output: "RTN","DGPFLF2",70,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLF2",71,0) ; "RTN","DGPFLF2",72,0) N SEL ;user selection "RTN","DGPFLF2",73,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLF2",74,0) N DGPFIEN ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file "RTN","DGPFLF2",75,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFLF2",76,0) ; "RTN","DGPFLF2",77,0) ;set screen to full scroll region "RTN","DGPFLF2",78,0) D FULL^VALM1 "RTN","DGPFLF2",79,0) ; "RTN","DGPFLF2",80,0) ;is action selection allowed? "RTN","DGPFLF2",81,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLF2",82,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLF2",83,0) . W !?6,"There are no record flags to display." "RTN","DGPFLF2",84,0) . D PAUSE^VALM1 "RTN","DGPFLF2",85,0) . S VALMBCK="R" "RTN","DGPFLF2",86,0) ; "RTN","DGPFLF2",87,0) ;ask user to select a single flag for displaying details "RTN","DGPFLF2",88,0) S (SEL,DGPFIEN,VALMBCK)="" "RTN","DGPFLF2",89,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLF2",90,0) ; "RTN","DGPFLF2",91,0) ;process user selection "RTN","DGPFLF2",92,0) S SEL=$O(VALMY("")) "RTN","DGPFLF2",93,0) I SEL,$D(@VALMAR@("IDX",SEL)) D "RTN","DGPFLF2",94,0) . S DGPFIEN=$P($G(@VALMAR@("IDX",SEL)),U) "RTN","DGPFLF2",95,0) . ;- display flag details "RTN","DGPFLF2",96,0) . N VALMHDR "RTN","DGPFLF2",97,0) . D EN^DGPFLFD "RTN","DGPFLF2",98,0) ; "RTN","DGPFLF2",99,0) ;return to LM (refresh screen) "RTN","DGPFLF2",100,0) S VALMBCK="R" "RTN","DGPFLF2",101,0) Q "RTN","DGPFLF3") 0^42^B51672864 "RTN","DGPFLF3",1,0) DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 7/31/03 3:03pm "RTN","DGPFLF3",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF3",3,0) ; "RTN","DGPFLF3",4,0) ;no direct entry "RTN","DGPFLF3",5,0) QUIT "RTN","DGPFLF3",6,0) ; "RTN","DGPFLF3",7,0) ; "RTN","DGPFLF3",8,0) AF ;Entry point for DGPF ADD FLAG action protocol. "RTN","DGPFLF3",9,0) ; "RTN","DGPFLF3",10,0) ; Input: DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF3",11,0) ; "RTN","DGPFLF3",12,0) ; Output: New File entry in PRF LOCAL FLAG FILE (#26.11) "RTN","DGPFLF3",13,0) ; New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12) "RTN","DGPFLF3",14,0) ; Set variable VALMBCK to 'R' = refresh screen "RTN","DGPFLF3",15,0) ; "RTN","DGPFLF3",16,0) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call "RTN","DGPFLF3",17,0) N DGASK ;return value from call to ^DIR - $$ANSWER^DGPFUT call "RTN","DGPFLF3",18,0) N DGCKWP ;check if word-processing is OK "RTN","DGPFLF3",19,0) N DGPFLF ;array containing flag record field values "RTN","DGPFLF3",20,0) N DGPFLH ;array containing flag history record field values "RTN","DGPFLF3",21,0) N DGABORT ;abort flag "RTN","DGPFLF3",22,0) N DGRESULT ;result of $$STOALL^DGPFALF1 api call "RTN","DGPFLF3",23,0) N DGRDAY ;review frequency var "RTN","DGPFLF3",24,0) N DGNDAY ;notification days var "RTN","DGPFLF3",25,0) N DGERR ;if error returned from $$STOALL^DGPFALF1 api call "RTN","DGPFLF3",26,0) N DGOK ;ok flag to enter record flag entry & flag description "RTN","DGPFLF3",27,0) N DGMSG ;user message "RTN","DGPFLF3",28,0) N DGCNT,DGLINE,DGQ ;counters and quit flag "RTN","DGPFLF3",29,0) ; "RTN","DGPFLF3",30,0) S DGOK=1,(DGCNT,DGLINE,DGQ,DGABORT)=0 "RTN","DGPFLF3",31,0) S DGMSG="W !?2,"">>> '""_$P($G(XQORNOD(0)),U,3)_""' action not allowed for Category II (Local) Flags."",*7" "RTN","DGPFLF3",32,0) ; "RTN","DGPFLF3",33,0) ;set screen to full scrolling region "RTN","DGPFLF3",34,0) D FULL^VALM1 "RTN","DGPFLF3",35,0) W ! "RTN","DGPFLF3",36,0) ;check of Category var - Only Local Flags can be created "RTN","DGPFLF3",37,0) I DGCAT=1 D "RTN","DGPFLF3",38,0) . W !?2,">>> '",$P($G(XQORNOD(0)),U,3),"' action not allowed for Category I (National) Flags.",*7 "RTN","DGPFLF3",39,0) . W !?7,"Only Category II (Local) Flags may be created at the local site.",*7 "RTN","DGPFLF3",40,0) . S DGOK=0 "RTN","DGPFLF3",41,0) . D PAUSE^VALM1 "RTN","DGPFLF3",42,0) ; "RTN","DGPFLF3",43,0) ;check of security key "RTN","DGPFLF3",44,0) I DGOK,'$D(^XUSEC("DGPF LOCAL FLAG EDIT",DUZ)) D "RTN","DGPFLF3",45,0) . X DGMSG "RTN","DGPFLF3",46,0) . W !?7,"You do not have the appropriate Security Key.",*7 "RTN","DGPFLF3",47,0) . S DGOK=0 "RTN","DGPFLF3",48,0) . D PAUSE^VALM1 "RTN","DGPFLF3",49,0) ; "RTN","DGPFLF3",50,0) ;user prompts "RTN","DGPFLF3",51,0) D:DGOK "RTN","DGPFLF3",52,0) . ;-- init flag record and history arrays "RTN","DGPFLF3",53,0) . ; The DGPFLF array will contain 2 "^" pieces (internal^external) "RTN","DGPFLF3",54,0) . ; for a final full screen display before filing. "RTN","DGPFLF3",55,0) . K DGPFLF,DGPFLH "RTN","DGPFLF3",56,0) . ; "RTN","DGPFLF3",57,0) . ;-- prompt for flag name, quit if one not entered "RTN","DGPFLF3",58,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name","","26.11,.01^^I $D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""") "RTN","DGPFLF3",59,0) . I DGASK=-1!(DGASK=0) S DGABORT=1 Q "RTN","DGPFLF3",60,0) . S DGPFLF("FLAG")=DGASK_U_DGASK "RTN","DGPFLF3",61,0) . ; "RTN","DGPFLF3",62,0) . ;-- prompt for status of the flag, quit if one not entered "RTN","DGPFLF3",63,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02") "RTN","DGPFLF3",64,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",65,0) . S DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK) "RTN","DGPFLF3",66,0) . ; "RTN","DGPFLF3",67,0) . ;-- prompt for flag type, quit if one not entered "RTN","DGPFLF3",68,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03") "RTN","DGPFLF3",69,0) . I DGASK'>0 S DGABORT=1 Q "RTN","DGPFLF3",70,0) . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK) "RTN","DGPFLF3",71,0) . ; "RTN","DGPFLF3",72,0) . ;-- prompt for principal investigator(s) name for RESEARCH flag type "RTN","DGPFLF3",73,0) . I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(0,.DGPFLF) D Q:DGABORT "RTN","DGPFLF3",74,0) . . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1 "RTN","DGPFLF3",75,0) . ; "RTN","DGPFLF3",76,0) . ;-- prompt for review frequency, quit if user aborts "RTN","DGPFLF3",77,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X") "RTN","DGPFLF3",78,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",79,0) . S DGPFLF("REVFREQ")=DGASK_U_DGASK "RTN","DGPFLF3",80,0) . S DGRDAY=DGASK "RTN","DGPFLF3",81,0) . I DGASK=0 D "RTN","DGPFLF3",82,0) . . ;-- if review frequency=0, don't ask notification/review group "RTN","DGPFLF3",83,0) . . ; reset both fields "RTN","DGPFLF3",84,0) . . S DGPFLF("NOTIDAYS")=0_U_0 "RTN","DGPFLF3",85,0) . . S DGPFLF("REVGRP")=""_U_"" "RTN","DGPFLF3",86,0) . . ; "RTN","DGPFLF3",87,0) . E D Q:DGABORT ;continue to prompt user and check abort logic "RTN","DGPFLF3",88,0) . . ; "RTN","DGPFLF3",89,0) . . ;-- prompt for notification days "RTN","DGPFLF3",90,0) . . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X") "RTN","DGPFLF3",91,0) . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",92,0) . . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK "RTN","DGPFLF3",93,0) . . ; "RTN","DGPFLF3",94,0) . . S DGQ=0 "RTN","DGPFLF3",95,0) . . F D Q:(DGQ!DGABORT) "RTN","DGPFLF3",96,0) . . . ;-- prompt for review mail group name, optional entry "RTN","DGPFLF3",97,0) . . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06") "RTN","DGPFLF3",98,0) . . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",99,0) . . . I DGASK'>0 D Q "RTN","DGPFLF3",100,0) . . . . W !," >>> You've entered the Review Frequency and Notification Days," "RTN","DGPFLF3",101,0) . . . . W !," now enter a Review Mail Group or abort this process.",*7 "RTN","DGPFLF3",102,0) . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLF3",103,0) . . . ; "RTN","DGPFLF3",104,0) . . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK) "RTN","DGPFLF3",105,0) . . . S DGQ=1 ;set entry, quit "RTN","DGPFLF3",106,0) . ; "RTN","DGPFLF3",107,0) . ;-- have user enter flag description text (required) "RTN","DGPFLF3",108,0) . S DGCKWP=0 "RTN","DGPFLF3",109,0) . S DGWPROOT=$NA(^TMP($J,"DGPFDESC")) "RTN","DGPFLF3",110,0) . K @DGWPROOT "RTN","DGPFLF3",111,0) . F D Q:(DGCKWP!DGABORT) "RTN","DGPFLF3",112,0) . . W !,"Enter the description for this new record flag:" ;needed for line editor "RTN","DGPFLF3",113,0) . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLF3",114,0) . . S DIWETXT="Patient Record Flag - Flag Description Text" "RTN","DGPFLF3",115,0) . . S DIWESUB="Flag Description Text" "RTN","DGPFLF3",116,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLF3",117,0) . . S DWPK=1 ;if line editor, don't join line "RTN","DGPFLF3",118,0) . . D EN^DIWE "RTN","DGPFLF3",119,0) . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q "RTN","DGPFLF3",120,0) . . W !,"Flag Description Text is required!",!,*7 "RTN","DGPFLF3",121,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLF3",122,0) . ; "RTN","DGPFLF3",123,0) . ;-- quit if required flag description not entered "RTN","DGPFLF3",124,0) . Q:DGABORT "RTN","DGPFLF3",125,0) . ; "RTN","DGPFLF3",126,0) . ;-- place flag description text into assignment array "RTN","DGPFLF3",127,0) . M DGPFLF("DESC")=@DGWPROOT K @DGWPROOT "RTN","DGPFLF3",128,0) . ; "RTN","DGPFLF3",129,0) . ;-- re-display user's answers on full screen "RTN","DGPFLF3",130,0) . S (DGLINE,DGCNT)=0 "RTN","DGPFLF3",131,0) . S DGPFLF("PTR")="26.11" "RTN","DGPFLF3",132,0) . K ^TMP("DGPFDISP",$J) "RTN","DGPFLF3",133,0) . ; "RTN","DGPFLF3",134,0) . D FLAGDET^DGPFLFD1("DGPFDISP",.DGPFLF,.DGLINE,.DGCNT) "RTN","DGPFLF3",135,0) . ; "RTN","DGPFLF3",136,0) . W:$E(IOST,1,2)="C-" @IOF "RTN","DGPFLF3",137,0) . S (DGCNT,DGQ)=0 "RTN","DGPFLF3",138,0) . F S DGCNT=$O(^TMP("DGPFDISP",$J,DGCNT)) Q:DGCNT="" D Q:DGQ "RTN","DGPFLF3",139,0) . . I $Y+3>IOSL W *7,!,"<...There is more Description to display but we need to file this now...>" S DGQ=1 Q "RTN","DGPFLF3",140,0) . . W:^TMP("DGPFDISP",$J,DGCNT,0)]"" !,^TMP("DGPFDISP",$J,DGCNT,0) "RTN","DGPFLF3",141,0) . ; "RTN","DGPFLF3",142,0) . K DGPFLF("PTR") ;clean up "RTN","DGPFLF3",143,0) . K ^TMP("DGPFDISP",$J) ;clean up "RTN","DGPFLF3",144,0) . ; "RTN","DGPFLF3",145,0) . W !,*7 "RTN","DGPFLF3",146,0) . I $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0 S DGABORT=1 Q "RTN","DGPFLF3",147,0) . ; "RTN","DGPFLF3",148,0) . W !,"Filing the new local record flag..." "RTN","DGPFLF3",149,0) . ; "RTN","DGPFLF3",150,0) . ;-- setup remaining flag history array nodes for filing "RTN","DGPFLF3",151,0) . ; note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1 "RTN","DGPFLF3",152,0) . S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLF3",153,0) . S DGPFLH("ENTERBY")=DUZ ;current user "RTN","DGPFLF3",154,0) . S DGPFLH("REASON",1,0)="New Local Patient Record Flag entered." "RTN","DGPFLF3",155,0) . ; "RTN","DGPFLF3",156,0) . ;-- file both the (#26.11) & (#26.12) entries "RTN","DGPFLF3",157,0) . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR) "RTN","DGPFLF3",158,0) . ; "RTN","DGPFLF3",159,0) . W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7 "RTN","DGPFLF3",160,0) . ; "RTN","DGPFLF3",161,0) . D PAUSE^VALM1 "RTN","DGPFLF3",162,0) ; "RTN","DGPFLF3",163,0) I DGABORT D "RTN","DGPFLF3",164,0) . W !," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7 "RTN","DGPFLF3",165,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause "RTN","DGPFLF3",166,0) ; "RTN","DGPFLF3",167,0) ;re-build list of local record flags "RTN","DGPFLF3",168,0) D BLD^DGPFLF "RTN","DGPFLF3",169,0) ; "RTN","DGPFLF3",170,0) ;return to LM (refresh screen) "RTN","DGPFLF3",171,0) S VALMBCK="R" "RTN","DGPFLF3",172,0) Q "RTN","DGPFLF3",173,0) ; "RTN","DGPFLF4") 0^44^B37339881 "RTN","DGPFLF4",1,0) DGPFLF4 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 5/15/03 11:48am "RTN","DGPFLF4",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF4",3,0) ; "RTN","DGPFLF4",4,0) ;no direct entry "RTN","DGPFLF4",5,0) QUIT "RTN","DGPFLF4",6,0) ; "RTN","DGPFLF4",7,0) EF ;Entry point for DGPF EDIT FLAG action protocol. "RTN","DGPFLF4",8,0) ; "RTN","DGPFLF4",9,0) ; Input: DGCAT - flag category (1=National, 2=Local) "RTN","DGPFLF4",10,0) ; "RTN","DGPFLF4",11,0) ; Output: Edit File entry in PRF LOCAL FLAG FILE (#26.11) "RTN","DGPFLF4",12,0) ; New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12) "RTN","DGPFLF4",13,0) ; Set variable VALMBCK to 'R' = refresh screen "RTN","DGPFLF4",14,0) ; "RTN","DGPFLF4",15,0) N X,Y,DIRUT,DTOUT,DUOUT,DIROUT ;input/output vars for ^DIR "RTN","DGPFLF4",16,0) N DGIDXIEN ;ien of flag record from the "IDX" "RTN","DGPFLF4",17,0) N DGPFLF ;array containing flag record field values "RTN","DGPFLF4",18,0) N DGPFLH ;array containing flag history record field values "RTN","DGPFLF4",19,0) N DGPFORIG ;save original array containing flag record field values "RTN","DGPFLF4",20,0) N DGABORT ;abort flag "RTN","DGPFLF4",21,0) N DGRESULT ;result of $$STOALL^DGPFALF1 api call "RTN","DGPFLF4",22,0) N DGERR ;if error returned from $$STOALL^DGPFALF1 api call "RTN","DGPFLF4",23,0) N DGOK ;ok flag to enter record flag entry & flag description "RTN","DGPFLF4",24,0) N DGLOCK ;lock var for flag file edit "RTN","DGPFLF4",25,0) N DGSEL ;user selection (list item) "RTN","DGPFLF4",26,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLF4",27,0) N DGMSG ;user message "RTN","DGPFLF4",28,0) N DGCNT,DGLINE,DGQ,DGSUB ;counters and quit flag "RTN","DGPFLF4",29,0) ; "RTN","DGPFLF4",30,0) S (DGCNT,DGLINE,DGQ,DGSUB)=0 "RTN","DGPFLF4",31,0) ; "RTN","DGPFLF4",32,0) S DGOK=1,(DGSEL,DGIDXIEN)="" "RTN","DGPFLF4",33,0) S (DGABORT,DGLOCK,DGRESULT)=0 "RTN","DGPFLF4",34,0) S DGMSG="W !?2,"">>> '""_$P($G(XQORNOD(0)),U,3)_""' action not allowed for Category II (Local) Flags."",*7" "RTN","DGPFLF4",35,0) ; "RTN","DGPFLF4",36,0) ;- set screen to full scrolling region "RTN","DGPFLF4",37,0) D FULL^VALM1 "RTN","DGPFLF4",38,0) W ! "RTN","DGPFLF4",39,0) ;- check of Category var - Only Local Flags can be created "RTN","DGPFLF4",40,0) I DGCAT=1 D "RTN","DGPFLF4",41,0) . W !?2,">>> '",$P($G(XQORNOD(0)),U,3),"' action not allowed for Category I (National) Flags.",*7 "RTN","DGPFLF4",42,0) . W !?7,"Only Category II (Local) Flags may be edited.",*7 "RTN","DGPFLF4",43,0) . S DGOK=0 "RTN","DGPFLF4",44,0) . D PAUSE^VALM1 "RTN","DGPFLF4",45,0) ; "RTN","DGPFLF4",46,0) ;- check of security key "RTN","DGPFLF4",47,0) I DGOK,'$D(^XUSEC("DGPF LOCAL FLAG EDIT",DUZ)) D "RTN","DGPFLF4",48,0) . X DGMSG "RTN","DGPFLF4",49,0) . W !?7,"You do not have the appropriate Security Key.",*7 "RTN","DGPFLF4",50,0) . S DGOK=0 "RTN","DGPFLF4",51,0) . D PAUSE^VALM1 "RTN","DGPFLF4",52,0) ; "RTN","DGPFLF4",53,0) ;-- init flag record and history arrays "RTN","DGPFLF4",54,0) ; The DGPFLF array will contain 2 "^" pieces (internal^external) "RTN","DGPFLF4",55,0) ; for a final full screen display before filing. "RTN","DGPFLF4",56,0) K DGPFLF,DGPFLH,DGPFORIG "RTN","DGPFLF4",57,0) ; "RTN","DGPFLF4",58,0) ;- allow user to select a single flag for editing "RTN","DGPFLF4",59,0) D:DGOK "RTN","DGPFLF4",60,0) . S DGOK=0,VALMBCK="" "RTN","DGPFLF4",61,0) . D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLF4",62,0) . Q:'$D(VALMY) "RTN","DGPFLF4",63,0) . S DGSEL=$O(VALMY("")) "RTN","DGPFLF4",64,0) . Q:DGSEL']"" "RTN","DGPFLF4",65,0) . Q:'$D(@VALMAR@("IDX",DGSEL)) "RTN","DGPFLF4",66,0) . S DGIDXIEN=$G(@VALMAR@("IDX",DGSEL)) "RTN","DGPFLF4",67,0) . ; lock flag record "RTN","DGPFLF4",68,0) . S DGLOCK=$$LOCKLF^DGPFALF1(DGIDXIEN) "RTN","DGPFLF4",69,0) . I 'DGLOCK D Q "RTN","DGPFLF4",70,0) . . X DGMSG "RTN","DGPFLF4",71,0) . . W !?7,"Unable to Lock Flag, another User is Editing this Flag.",*7 "RTN","DGPFLF4",72,0) . . D PAUSE^VALM1 "RTN","DGPFLF4",73,0) . ; "RTN","DGPFLF4",74,0) . ; call api to get record back in array DGPFLF "RTN","DGPFLF4",75,0) . I '$$GETLF^DGPFALF($P(DGIDXIEN,";"),.DGPFLF) D Q "RTN","DGPFLF4",76,0) . . X DGMSG "RTN","DGPFLF4",77,0) . . W !?7,"No Local Flag record data found. Please check your selection.",*7 "RTN","DGPFLF4",78,0) . . D PAUSE^VALM1 "RTN","DGPFLF4",79,0) . ; "RTN","DGPFLF4",80,0) . M DGPFORIG=DGPFLF ;save original array to compare for edits later "RTN","DGPFLF4",81,0) . S DGOK=1 "RTN","DGPFLF4",82,0) ; "RTN","DGPFLF4",83,0) ;-- Call DGPFLF5 for user prompts to edit fields "RTN","DGPFLF4",84,0) ; - split from this one due to size "RTN","DGPFLF4",85,0) I DGOK D "RTN","DGPFLF4",86,0) . D EFCONT^DGPFLF5(.DGPFLF,.DGPFLH,.DGPFORIG,.DGABORT,DGIDXIEN) "RTN","DGPFLF4",87,0) . Q:DGABORT "RTN","DGPFLF4",88,0) . ; "RTN","DGPFLF4",89,0) . ;-- re-display user's answers on full screen "RTN","DGPFLF4",90,0) . S (DGLINE,DGCNT)=0 "RTN","DGPFLF4",91,0) . S DGPFLF("PTR")="26.11" "RTN","DGPFLF4",92,0) . K ^TMP("DGPFDISP",$J) "RTN","DGPFLF4",93,0) . ; "RTN","DGPFLF4",94,0) . D FLAGDET^DGPFLFD1("DGPFDISP",.DGPFLF,.DGLINE,.DGCNT) "RTN","DGPFLF4",95,0) . ; "RTN","DGPFLF4",96,0) . W:$E(IOST,1,2)="C-" @IOF "RTN","DGPFLF4",97,0) . S (DGCNT,DGQ)=0 "RTN","DGPFLF4",98,0) . F S DGCNT=$O(^TMP("DGPFDISP",$J,DGCNT)) Q:DGCNT="" D Q:DGQ "RTN","DGPFLF4",99,0) . . I $Y+3>IOSL S DIR("A")="Enter RETURN to continue",DIR(0)="E" D ^DIR K DIR W:$E(IOST,1,2)="C-" @IOF "RTN","DGPFLF4",100,0) . . W !,^TMP("DGPFDISP",$J,DGCNT,0) "RTN","DGPFLF4",101,0) . ; "RTN","DGPFLF4",102,0) . K DGPFLF("PTR") ;clean up "RTN","DGPFLF4",103,0) . K ^TMP("DGPFDISP",$J) ;clean up "RTN","DGPFLF4",104,0) . ; "RTN","DGPFLF4",105,0) . W !!,"Enter/Edit Reason:",!,"------------------" "RTN","DGPFLF4",106,0) . S DGSUB=0 "RTN","DGPFLF4",107,0) . F S DGSUB=$O(DGPFLH("REASON",DGSUB)) Q:'DGSUB D "RTN","DGPFLF4",108,0) . . I $Y+3>IOSL S DIR("A")="Enter RETURN to continue",DIR(0)="E" D ^DIR K DIR W:$E(IOST,1,2)="C-" @IOF "RTN","DGPFLF4",109,0) . . W !,$G(DGPFLH("REASON",DGSUB,0)) "RTN","DGPFLF4",110,0) . ; "RTN","DGPFLF4",111,0) . ;-- check to see if user changed anything "RTN","DGPFLF4",112,0) . S DGSUB="",DGQ=0 "RTN","DGPFLF4",113,0) . I $G(DGPFLF("OLDFLAG"))]"" S DGQ=1 ;flag name has changed "RTN","DGPFLF4",114,0) . I 'DGQ D "RTN","DGPFLF4",115,0) . . F DGSUB="STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP" D Q:DGQ "RTN","DGPFLF4",116,0) . . . I DGPFLF(DGSUB)'=DGPFORIG(DGSUB) S DGQ=1 "RTN","DGPFLF4",117,0) . . Q:DGQ "RTN","DGPFLF4",118,0) . . ; "RTN","DGPFLF4",119,0) . . ;was description modified? "RTN","DGPFLF4",120,0) . . I $O(DGPFLF("DESC",""),-1)'=$O(DGPFORIG("DESC",""),-1) S DGQ=1 "RTN","DGPFLF4",121,0) . . Q:DGQ "RTN","DGPFLF4",122,0) . . ; "RTN","DGPFLF4",123,0) . . S DGSUB=0 "RTN","DGPFLF4",124,0) . . F S DGSUB=$O(DGPFLF("DESC",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFLF4",125,0) . . . I DGPFLF("DESC",DGSUB,0)'=$G(DGPFORIG("DESC",DGSUB,0)) S DGQ=1 "RTN","DGPFLF4",126,0) . . Q:DGQ "RTN","DGPFLF4",127,0) . . ; "RTN","DGPFLF4",128,0) . . S DGSUB=0 "RTN","DGPFLF4",129,0) . . F S DGSUB=$O(DGPFLF("PRININV",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFLF4",130,0) . . . I DGPFLF("PRININV",DGSUB,0)'=$G(DGPFORIG("PRININV",DGSUB,0)) S DGQ=1 "RTN","DGPFLF4",131,0) . ; "RTN","DGPFLF4",132,0) . I 'DGQ D Q "RTN","DGPFLF4",133,0) . . W !!," >>> No edits to "_$P(DGPFLF("FLAG"),U,2)_" were found." "RTN","DGPFLF4",134,0) . . S DGABORT=1 "RTN","DGPFLF4",135,0) . ; "RTN","DGPFLF4",136,0) . K DGPFORIG ;kill array - no longer needed "RTN","DGPFLF4",137,0) . ; "RTN","DGPFLF4",138,0) . ; -- file the edits "RTN","DGPFLF4",139,0) . W !,*7 "RTN","DGPFLF4",140,0) . I $$ANSWER^DGPFUT("Would you like to file the local record flag changes","YES","Y")'>0 S DGABORT=1 Q "RTN","DGPFLF4",141,0) . ; "RTN","DGPFLF4",142,0) . W !,"Updating the local record flag..." "RTN","DGPFLF4",143,0) . ; "RTN","DGPFLF4",144,0) . ;-- setup remaining flag history array nodes for filing "RTN","DGPFLF4",145,0) . ; note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1 "RTN","DGPFLF4",146,0) . S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLF4",147,0) . S DGPFLH("ENTERBY")=DUZ ;current user "RTN","DGPFLF4",148,0) . ; "RTN","DGPFLF4",149,0) . ;-- file both the (#26.11) & (#26.12) entries "RTN","DGPFLF4",150,0) . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR) "RTN","DGPFLF4",151,0) . ; "RTN","DGPFLF4",152,0) . W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7 "RTN","DGPFLF4",153,0) . ; "RTN","DGPFLF4",154,0) . D PAUSE^VALM1 "RTN","DGPFLF4",155,0) ; "RTN","DGPFLF4",156,0) I DGLOCK,$$UNLOCK^DGPFALF1(DGIDXIEN) "RTN","DGPFLF4",157,0) ; "RTN","DGPFLF4",158,0) I DGABORT D "RTN","DGPFLF4",159,0) . W !!," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7 "RTN","DGPFLF4",160,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause "RTN","DGPFLF4",161,0) ; "RTN","DGPFLF4",162,0) ;-- re-build list of local record flags "RTN","DGPFLF4",163,0) D BLD^DGPFLF "RTN","DGPFLF4",164,0) ; "RTN","DGPFLF4",165,0) ;- return to LM (refresh screen) "RTN","DGPFLF4",166,0) S VALMBCK="R" "RTN","DGPFLF4",167,0) Q "RTN","DGPFLF4",168,0) ; "RTN","DGPFLF5") 0^45^B50535397 "RTN","DGPFLF5",1,0) DGPFLF5 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 7/31/03 3:07pm "RTN","DGPFLF5",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLF5",3,0) ; "RTN","DGPFLF5",4,0) ;no direct entry "RTN","DGPFLF5",5,0) QUIT "RTN","DGPFLF5",6,0) ; "RTN","DGPFLF5",7,0) EFCONT(DGPFLF,DGPFLH,DGPFORIG,DGABORT,DGIDXIEN) ; EF Edit Flag action "RTN","DGPFLF5",8,0) ;-- Continue entry point for DGPF EDIT FLAG action protocol. "RTN","DGPFLF5",9,0) ; "RTN","DGPFLF5",10,0) ; Input: "RTN","DGPFLF5",11,0) ; DGPFLF - array of flag record fields (passed by reference) "RTN","DGPFLF5",12,0) ; DGPFLH - array for REASON field (passed by reference) "RTN","DGPFLF5",13,0) ; DGPFORIG - DGPFLF copy of original values (passed by reference) "RTN","DGPFLF5",14,0) ; DGABORT - abort flag - value passed in = 0 "RTN","DGPFLF5",15,0) ; DGIDXIEN - ien of flag record from the "IDX" "RTN","DGPFLF5",16,0) ; "RTN","DGPFLF5",17,0) ; Output: "RTN","DGPFLF5",18,0) ; DGPFLF - Edited array of flag record fields "RTN","DGPFLF5",19,0) ; DGABORT - 1 if user wishes to abort, 0 otherwise "RTN","DGPFLF5",20,0) ; "RTN","DGPFLF5",21,0) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call "RTN","DGPFLF5",22,0) N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT ;input/output vars for ^DIR "RTN","DGPFLF5",23,0) N DGDA ;default answer "RTN","DGPFLF5",24,0) N DGCKWP ;check if word-processing is OK "RTN","DGPFLF5",25,0) N DGASK ;return value from $$ANSWER^DGPFUT call "RTN","DGPFLF5",26,0) N DGRDAY ;review frequency "RTN","DGPFLF5",27,0) N DGQ,DGSUB ;counters and quit flag "RTN","DGPFLF5",28,0) ; "RTN","DGPFLF5",29,0) S (DGQ,DGSUB)=0 "RTN","DGPFLF5",30,0) ; "RTN","DGPFLF5",31,0) ;-- user prompts "RTN","DGPFLF5",32,0) D "RTN","DGPFLF5",33,0) . ;-- prompt for flag name, quit if one not entered "RTN","DGPFLF5",34,0) . S DGDA=$P($G(DGPFLF("FLAG")),U,2) "RTN","DGPFLF5",35,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name",DGDA,"26.11,.01^^I X'=DGDA,$D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""") "RTN","DGPFLF5",36,0) . I DGASK=-1!(DGASK=0) S DGABORT=1 Q "RTN","DGPFLF5",37,0) . I DGASK'=DGDA D "RTN","DGPFLF5",38,0) . . N DGACNT ;count of existing assignments "RTN","DGPFLF5",39,0) . . S DGACNT=$$ASGNCNT^DGPFLF6(DGIDXIEN) "RTN","DGPFLF5",40,0) . . I DGACNT D Q "RTN","DGPFLF5",41,0) . . . W !," >>> Name change not allowed ... "_DGACNT_" patients are assigned to this flag." "RTN","DGPFLF5",42,0) . . . S DGABORT=1 "RTN","DGPFLF5",43,0) . . S DGPFLF("OLDFLAG")=DGDA ;save for name change lookup "RTN","DGPFLF5",44,0) . . S DGPFLF("FLAG")=DGASK_U_DGASK "RTN","DGPFLF5",45,0) . Q:DGABORT "RTN","DGPFLF5",46,0) . ; "RTN","DGPFLF5",47,0) . ;-- prompt for status of the flag, quit if one not entered "RTN","DGPFLF5",48,0) . S DGDA=$P($G(DGPFLF("STAT")),U,2) "RTN","DGPFLF5",49,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag",DGDA,"26.11,.02") "RTN","DGPFLF5",50,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF5",51,0) . S:DGASK'=$P($G(DGPFLF("STAT")),U) DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK) "RTN","DGPFLF5",52,0) . ; check for any Active Patient Assignments and give warning "RTN","DGPFLF5",53,0) . ; that all patients will be inactivated when this edit is filed "RTN","DGPFLF5",54,0) . I DGASK=0,$D(^DGPF(26.13,"ASTAT",1,DGIDXIEN)) D "RTN","DGPFLF5",55,0) . . W *7 S DIR("A",1)=" >>> WARNING - All Patient's assigned to this flag will be" "RTN","DGPFLF5",56,0) . . S DIR("A",2)=" Inactivated automatically after filing this edit." "RTN","DGPFLF5",57,0) . . S DIR("A")="Enter RETURN to continue",DIR(0)="E" D ^DIR K DIR "RTN","DGPFLF5",58,0) . ; "RTN","DGPFLF5",59,0) . ;-- prompt for flag type, quit if one not entered "RTN","DGPFLF5",60,0) . S DGDA=$P($G(DGPFLF("TYPE")),U,2) "RTN","DGPFLF5",61,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag",DGDA,"26.11,.03") "RTN","DGPFLF5",62,0) . I DGASK'>0 S DGABORT=1 Q "RTN","DGPFLF5",63,0) . I DGASK'=$P($G(DGPFLF("TYPE")),U) D "RTN","DGPFLF5",64,0) . . N DGACNT ;count of existing assignments "RTN","DGPFLF5",65,0) . . S DGACNT=$$ASGNCNT^DGPFLF6(DGIDXIEN) "RTN","DGPFLF5",66,0) . . I DGACNT D Q "RTN","DGPFLF5",67,0) . . . W !," >>> Flag Type change not allowed ... "_DGACNT_" patients are assigned to this flag." "RTN","DGPFLF5",68,0) . . . S DGABORT=1 "RTN","DGPFLF5",69,0) . . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK) "RTN","DGPFLF5",70,0) . Q:DGABORT "RTN","DGPFLF5",71,0) . ; "RTN","DGPFLF5",72,0) . ;-- delete all principal investigator(s) if flag type not RESEARCH "RTN","DGPFLF5",73,0) . I +DGPFLF("TYPE")'=2,$D(DGPFLF("PRININV")) D "RTN","DGPFLF5",74,0) . . S DGSUB=0 "RTN","DGPFLF5",75,0) . . F S DGSUB=$O(DGPFLF("PRININV",DGSUB)) Q:DGSUB="" D "RTN","DGPFLF5",76,0) . . . S DGPFLF("PRININV",DGSUB,0)="@" "RTN","DGPFLF5",77,0) . ; "RTN","DGPFLF5",78,0) . ;-- prompt for principal investigator(s) name for RESEARCH type flag "RTN","DGPFLF5",79,0) . I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(+DGIDXIEN,.DGPFLF) D Q:DGABORT "RTN","DGPFLF5",80,0) . . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1 S DGABORT=1 "RTN","DGPFLF5",81,0) . ; "RTN","DGPFLF5",82,0) . ;-- prompt for review frequency, quit if one not entered "RTN","DGPFLF5",83,0) . S DGDA=$P($G(DGPFLF("REVFREQ")),U,2) "RTN","DGPFLF5",84,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days",DGDA,"26.11,.04^^K:$L(X)>4!(X[""."") X") "RTN","DGPFLF5",85,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF5",86,0) . S:DGASK'=$P($G(DGPFLF("REVFREQ")),U) DGPFLF("REVFREQ")=DGASK_U_DGASK "RTN","DGPFLF5",87,0) . S DGRDAY=DGASK "RTN","DGPFLF5",88,0) . I DGASK=0 D ;don't ask notification/review group when review freq = 0 "RTN","DGPFLF5",89,0) . . S DGPFLF("NOTIDAYS")=0_U_0 "RTN","DGPFLF5",90,0) . . S DGPFLF("REVGRP")=""_U_"" "RTN","DGPFLF5",91,0) . . ; "RTN","DGPFLF5",92,0) . E D Q:DGABORT "RTN","DGPFLF5",93,0) . . ; "RTN","DGPFLF5",94,0) . . ;-- prompt for notification days "RTN","DGPFLF5",95,0) . . S DGDA=$P($G(DGPFLF("NOTIDAYS")),U,2) "RTN","DGPFLF5",96,0) . . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days",DGDA,"26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X") "RTN","DGPFLF5",97,0) . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF5",98,0) . . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK "RTN","DGPFLF5",99,0) . . ; "RTN","DGPFLF5",100,0) . . S DGQ=0 "RTN","DGPFLF5",101,0) . . F D Q:(DGQ!DGABORT) "RTN","DGPFLF5",102,0) . . . ;-- prompt for review mail group name, optional entry "RTN","DGPFLF5",103,0) . . . S DGDA=$P($G(DGPFLF("REVGRP")),U,2) "RTN","DGPFLF5",104,0) . . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group",DGDA,"26.11,.06r") "RTN","DGPFLF5",105,0) . . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF5",106,0) . . . I DGASK'>0 D Q "RTN","DGPFLF5",107,0) . . . . W !," >>> You've entered the Review Frequency and Notification Days," "RTN","DGPFLF5",108,0) . . . . W !," now enter a Review Mail Group or abort this process.",*7 "RTN","DGPFLF5",109,0) . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLF5",110,0) . . . ; "RTN","DGPFLF5",111,0) . . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK) "RTN","DGPFLF5",112,0) . . . S DGQ=1 ;set entry, quit "RTN","DGPFLF5",113,0) . ; "RTN","DGPFLF5",114,0) . ;-- ask user if they want to edit the flag description text "RTN","DGPFLF5",115,0) . I $$ANSWER^DGPFUT("Would you like to edit the description of this record flag","NO","Y")>0 D Q:DGABORT "RTN","DGPFLF5",116,0) . . S DGCKWP=0 K DGERR "RTN","DGPFLF5",117,0) . . S DGWPROOT=$NA(^TMP($J,"DGPFDESC")) "RTN","DGPFLF5",118,0) . . K @DGWPROOT "RTN","DGPFLF5",119,0) . . S DGDA=$$GET1^DIQ(26.11,$P(DGIDXIEN,";"),"1","Z",DGWPROOT,"DGERR") "RTN","DGPFLF5",120,0) . . I $D(DGERR)!(DGDA="") S DGABORT=1 D Q "RTN","DGPFLF5",121,0) . . . W !,"An error has occurred while trying to retrieve the Flag Description Text.",*7 "RTN","DGPFLF5",122,0) . . F D Q:(DGCKWP!DGABORT) "RTN","DGPFLF5",123,0) . . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLF5",124,0) . . . S DIWETXT="Patient Record Flag - Flag Description Text" "RTN","DGPFLF5",125,0) . . . S DIWESUB="Flag Description Text" "RTN","DGPFLF5",126,0) . . . S DWLW=75 ;max # chars allowed to be stored on WP global node "RTN","DGPFLF5",127,0) . . . S DWPK=1 ;if line editor, don't join line "RTN","DGPFLF5",128,0) . . . D EN^DIWE "RTN","DGPFLF5",129,0) . . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q "RTN","DGPFLF5",130,0) . . . W !,"Flag Description Text is required!",!,*7 "RTN","DGPFLF5",131,0) . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 K @DGWPROOT "RTN","DGPFLF5",132,0) . . ; "RTN","DGPFLF5",133,0) . . ;-- quit if required flag description not entered "RTN","DGPFLF5",134,0) . . Q:DGABORT "RTN","DGPFLF5",135,0) . . ; "RTN","DGPFLF5",136,0) . . ;-- place flag description text into assignment array "RTN","DGPFLF5",137,0) . . I DGCKWP D "RTN","DGPFLF5",138,0) . . . K DGPFLF("DESC") "RTN","DGPFLF5",139,0) . . . M DGPFLF("DESC")=@DGWPROOT "RTN","DGPFLF5",140,0) . . . K @DGWPROOT "RTN","DGPFLF5",141,0) . ; "RTN","DGPFLF5",142,0) . Q:DGABORT "RTN","DGPFLF5",143,0) . ; "RTN","DGPFLF5",144,0) . ;-- have user enter edit reason (required) "RTN","DGPFLF5",145,0) . S DGCKWP=0 "RTN","DGPFLF5",146,0) . S DGWPROOT=$NA(^TMP($J,"DGPFREASON")) "RTN","DGPFLF5",147,0) . K @DGWPROOT "RTN","DGPFLF5",148,0) . F D Q:(DGCKWP!DGABORT) "RTN","DGPFLF5",149,0) . . W !!,"Enter the reason for editing this record flag:" ;needed for line editor "RTN","DGPFLF5",150,0) . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLF5",151,0) . . S DIWETXT="Patient Record Flag - Edit Reason Text" "RTN","DGPFLF5",152,0) . . S DIWESUB="Edit Reason Text" "RTN","DGPFLF5",153,0) . . S DWLW=75 ;max # chars allowed to be stored on WP global node "RTN","DGPFLF5",154,0) . . S DWPK=1 ;if line editor, don't join line "RTN","DGPFLF5",155,0) . . D EN^DIWE "RTN","DGPFLF5",156,0) . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q "RTN","DGPFLF5",157,0) . . W !,"Edit Reason Text is required!",!,*7 "RTN","DGPFLF5",158,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 K @DGWPROOT "RTN","DGPFLF5",159,0) . ; "RTN","DGPFLF5",160,0) . Q:DGABORT "RTN","DGPFLF5",161,0) . I DGCKWP M DGPFLH("REASON")=@DGWPROOT K @DGWPROOT "RTN","DGPFLF5",162,0) . ; "RTN","DGPFLF5",163,0) . S:'DGCKWP DGABORT=1 "RTN","DGPFLF5",164,0) ; "RTN","DGPFLF5",165,0) Q "RTN","DGPFLF6") 0^58^B17883747 "RTN","DGPFLF6",1,0) DGPFLF6 ;ALB/RPM - PRF FLAG MANAGEMENT LM SUB-ROUTINE ; 4/10/03 "RTN","DGPFLF6",2,0) ;;5.3;Registration;**425**;Aug 23, 1993 "RTN","DGPFLF6",3,0) ; "RTN","DGPFLF6",4,0) Q "RTN","DGPFLF6",5,0) ; "RTN","DGPFLF6",6,0) PRININV(DGFIEN,DGPFLF) ;Prompt for principle investigators "RTN","DGPFLF6",7,0) ; "RTN","DGPFLF6",8,0) ; Input: "RTN","DGPFLF6",9,0) ; DGFIEN - (optional) Pointer to PRF LOCAL FLAG (#26.11) file. "RTN","DGPFLF6",10,0) ; [default=0] "RTN","DGPFLF6",11,0) ; DGPFLF - Flag data array "RTN","DGPFLF6",12,0) ; "RTN","DGPFLF6",13,0) ; Output: "RTN","DGPFLF6",14,0) ; Function Value - 1 on success, 0 when user enters "^" "RTN","DGPFLF6",15,0) ; DGPFLF("PRININV") - Array of principal investigators "RTN","DGPFLF6",16,0) ; "RTN","DGPFLF6",17,0) N DGASK ;answer from prompt as a pointer to NEW PERSON (#200) file "RTN","DGPFLF6",18,0) N DGCNT ;place holder for new entries "RTN","DGPFLF6",19,0) N DGDA ;default answer for prompt "RTN","DGPFLF6",20,0) N DGLAST ;last entry in field entry array "RTN","DGPFLF6",21,0) N DGLKUP ;principle investigator dynamic "B" index "RTN","DGPFLF6",22,0) N DGNEWPI ;principal investigator in FM external form "RTN","DGPFLF6",23,0) N DGORIG ;principle investigator unmodified "B" index "RTN","DGPFLF6",24,0) N DGPREV ;next to last entry in field entry array "RTN","DGPFLF6",25,0) N DGQUIT ;loop termination flag "RTN","DGPFLF6",26,0) N DGRSLT ;function value "RTN","DGPFLF6",27,0) ; "RTN","DGPFLF6",28,0) S DGFIEN=+$G(DGFIEN) ;will be zero for 'Add Flag' "RTN","DGPFLF6",29,0) ; "RTN","DGPFLF6",30,0) ;build lookup and "on-file" array "RTN","DGPFLF6",31,0) M DGORIG=^DGPF(26.11,DGFIEN,2,"B") "RTN","DGPFLF6",32,0) M DGLKUP=DGORIG "RTN","DGPFLF6",33,0) ; "RTN","DGPFLF6",34,0) S DGRSLT=1 "RTN","DGPFLF6",35,0) S DGQUIT=0 "RTN","DGPFLF6",36,0) S (DGLAST,DGCNT)=+$O(DGPFLF("PRININV",""),-1) "RTN","DGPFLF6",37,0) ; "RTN","DGPFLF6",38,0) ;set default answer "RTN","DGPFLF6",39,0) S DGDA=$P($G(DGPFLF("PRININV",DGLAST,0)),U,2) "RTN","DGPFLF6",40,0) ; "RTN","DGPFLF6",41,0) F D Q:DGQUIT "RTN","DGPFLF6",42,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Principal Investigator(s)",DGDA,"26.112,.01") "RTN","DGPFLF6",43,0) . ; "RTN","DGPFLF6",44,0) . ;stop prompting if user enters "^" or times out "RTN","DGPFLF6",45,0) . I DGASK=-1 S DGQUIT=1,DGRSLT=0 Q "RTN","DGPFLF6",46,0) . ; "RTN","DGPFLF6",47,0) . ;stop prompting if user accepts default entry "RTN","DGPFLF6",48,0) . I DGASK=$P($G(DGPFLF("PRININV",DGLAST,0)),U,1)!(DGASK="") S DGQUIT=1 Q "RTN","DGPFLF6",49,0) . ; "RTN","DGPFLF6",50,0) . ;perform lookup - re-prompt with new selection when entry exists "RTN","DGPFLF6",51,0) . I $D(DGLKUP(DGASK)) D Q "RTN","DGPFLF6",52,0) . . S DGLAST=+$O(DGLKUP(DGASK,0)) "RTN","DGPFLF6",53,0) . . S DGDA=$P(DGPFLF("PRININV",DGLAST,0),U,2) "RTN","DGPFLF6",54,0) . ; "RTN","DGPFLF6",55,0) . ;process delete - remove entry from lookup array and move last pointer "RTN","DGPFLF6",56,0) . ; to previous entry in list. Set the field entry "RTN","DGPFLF6",57,0) . ; array value to "@" when the entry is "on-file", "RTN","DGPFLF6",58,0) . ; otherwise, remove the field entry array node. "RTN","DGPFLF6",59,0) . I DGASK="@" D Q "RTN","DGPFLF6",60,0) . . Q:'$D(DGPFLF("PRININV",DGLAST,0)) "RTN","DGPFLF6",61,0) . . Q:'$$ANSWER^DGPFUT("Sure you want to delete '"_$P(DGPFLF("PRININV",DGLAST,0),U,2)_"' as a PRINCIPAL INVESTIGATOR","Yes","Y") "RTN","DGPFLF6",62,0) . . K DGLKUP($P(DGPFLF("PRININV",DGLAST,0),U,1)) "RTN","DGPFLF6",63,0) . . S DGPREV=+$O(DGPFLF("PRININV",DGLAST),-1) "RTN","DGPFLF6",64,0) . . I $D(DGORIG($P(DGPFLF("PRININV",DGLAST,0),U,1))) D "RTN","DGPFLF6",65,0) . . . S DGPFLF("PRININV",DGLAST,0)="@" "RTN","DGPFLF6",66,0) . . E D "RTN","DGPFLF6",67,0) . . . K DGPFLF("PRININV",DGLAST,0) "RTN","DGPFLF6",68,0) . . S DGLAST=DGPREV "RTN","DGPFLF6",69,0) . . S DGDA=$P($G(DGPFLF("PRININV",DGLAST,0)),U,2) "RTN","DGPFLF6",70,0) . ; "RTN","DGPFLF6",71,0) . ;process new entry - if we make it here, then the entry is not the "RTN","DGPFLF6",72,0) . ; default, does not already exist in the field "RTN","DGPFLF6",73,0) . ; entry array and is not a delete. Add entry "RTN","DGPFLF6",74,0) . ; to the lookup array and the field entry array. "RTN","DGPFLF6",75,0) . I DGDA=""!(DGASK'=$P($G(DGPFLF("PRININV",DGLAST,0)),U)) D "RTN","DGPFLF6",76,0) . . S DGNEWPI=$$EXTERNAL^DILFD(26.112,.01,"F",DGASK) "RTN","DGPFLF6",77,0) . . Q:'$$ANSWER^DGPFUT("Are you adding '"_DGNEWPI_"' as a new PRINCIPAL INVESTIGATOR","No","Y") "RTN","DGPFLF6",78,0) . . S DGCNT=DGCNT+1 "RTN","DGPFLF6",79,0) . . S DGLKUP(DGASK,DGCNT)="" "RTN","DGPFLF6",80,0) . . S DGPFLF("PRININV",DGCNT,0)=DGASK_U_DGNEWPI "RTN","DGPFLF6",81,0) . . S DGDA="" "RTN","DGPFLF6",82,0) ; "RTN","DGPFLF6",83,0) Q DGRSLT "RTN","DGPFLF6",84,0) ; "RTN","DGPFLF6",85,0) ASGNCNT(DGFIEN,DGDFNLST) ;counts existing assignments for a given flag "RTN","DGPFLF6",86,0) ;This function searches for assignments for a given flag IEN and "RTN","DGPFLF6",87,0) ;returns the count of assignments. An optional array parameter will "RTN","DGPFLF6",88,0) ;be loaded with the DFNs assigned to the flag. "RTN","DGPFLF6",89,0) ; "RTN","DGPFLF6",90,0) ; Input: "RTN","DGPFLF6",91,0) ; DGFIEN - (required) Pointer to PRF LOCAL FLAG (#26.11) file or "RTN","DGPFLF6",92,0) ; PRF NATIONAL FLAG (#26.15) file. "RTN","DGPFLF6",93,0) ; DGDFNLST - (optional) Array name to contain list of DFNs "RTN","DGPFLF6",94,0) ; "RTN","DGPFLF6",95,0) ; Output: "RTN","DGPFLF6",96,0) ; Function Value - count of existing assignments "RTN","DGPFLF6",97,0) ; DGDFNLST - Defined only when existing assignments are found. "RTN","DGPFLF6",98,0) ; Array of DFNs from existing assignments. "RTN","DGPFLF6",99,0) ; Example: DGDFNLST(7172421)=assignment IEN "RTN","DGPFLF6",100,0) ; "RTN","DGPFLF6",101,0) N DGCNT ;function value "RTN","DGPFLF6",102,0) N DGDFN ;pointer to PATIENT (#2) file "RTN","DGPFLF6",103,0) ; "RTN","DGPFLF6",104,0) S DGCNT=0 "RTN","DGPFLF6",105,0) ; "RTN","DGPFLF6",106,0) I $G(DGFIEN)]"",$D(^DGPF(26.13,"AFLAG",DGFIEN)) D "RTN","DGPFLF6",107,0) . ; "RTN","DGPFLF6",108,0) . ;count the assignments "RTN","DGPFLF6",109,0) . S DGDFN=0 "RTN","DGPFLF6",110,0) . F S DGDFN=$O(^DGPF(26.13,"AFLAG",DGFIEN,DGDFN)) Q:'DGDFN D "RTN","DGPFLF6",111,0) . . S DGCNT=DGCNT+1 "RTN","DGPFLF6",112,0) . . S DGDFNLST(DGDFN)=+$O(^DGPF(26.13,"AFLAG",DGFIEN,DGDFN,0)) "RTN","DGPFLF6",113,0) ; "RTN","DGPFLF6",114,0) Q DGCNT "RTN","DGPFLFD") 0^40^B2491174 "RTN","DGPFLFD",1,0) DGPFLFD ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM SCREEN ; 3/13/03 "RTN","DGPFLFD",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLFD",3,0) ; "RTN","DGPFLFD",4,0) ;no direct entry "RTN","DGPFLFD",5,0) QUIT "RTN","DGPFLFD",6,0) ; "RTN","DGPFLFD",7,0) EN ;Main entry point for DGPF FLAG DETAIL list template. "RTN","DGPFLFD",8,0) ; "RTN","DGPFLFD",9,0) ; Input: "RTN","DGPFLFD",10,0) ; DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL "RTN","DGPFLFD",11,0) ; FLAG file [ex: "1;DGPF(26.15,"] "RTN","DGPFLFD",12,0) ; "RTN","DGPFLFD",13,0) ; Output: None "RTN","DGPFLFD",14,0) ; "RTN","DGPFLFD",15,0) ;quit if required input not defined "RTN","DGPFLFD",16,0) Q:$G(DGPFIEN)']"" "RTN","DGPFLFD",17,0) ; "RTN","DGPFLFD",18,0) ;display wait msg to user "RTN","DGPFLFD",19,0) D WAIT^DICD "RTN","DGPFLFD",20,0) ; "RTN","DGPFLFD",21,0) ;invoke DGPF FLAG DETAIL list template "RTN","DGPFLFD",22,0) D EN^VALM("DGPF FLAG DETAIL") "RTN","DGPFLFD",23,0) Q "RTN","DGPFLFD",24,0) ; "RTN","DGPFLFD",25,0) ; "RTN","DGPFLFD",26,0) HDR ;Header Code "RTN","DGPFLFD",27,0) ; "RTN","DGPFLFD",28,0) N DGHDR "RTN","DGPFLFD",29,0) N DGRESULT "RTN","DGPFLFD",30,0) N DGPFLG "RTN","DGPFLFD",31,0) K DGPFLG "RTN","DGPFLFD",32,0) ; "RTN","DGPFLFD",33,0) ;retrieve flag, place into DGHDR array "RTN","DGPFLFD",34,0) S DGRESULT=$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFLG) "RTN","DGPFLFD",35,0) ; "RTN","DGPFLFD",36,0) ;construct header array "RTN","DGPFLFD",37,0) S VALMHDR(1)="Flag Name: "_$S(DGRESULT:$P($G(DGPFLG("FLAG")),U,2),1:"UNKNOWN") "RTN","DGPFLFD",38,0) S DGHDR="Flag Status: "_$S(DGRESULT:$P($G(DGPFLG("STAT")),U,2),1:"UNKNOWN") "RTN","DGPFLFD",39,0) S VALMHDR(1)=$$SETSTR^VALM1(DGHDR,VALMHDR(1),55,$L(DGHDR)) "RTN","DGPFLFD",40,0) ; "RTN","DGPFLFD",41,0) Q "RTN","DGPFLFD",42,0) ; "RTN","DGPFLFD",43,0) ; "RTN","DGPFLFD",44,0) INIT ;Init variables and list array "RTN","DGPFLFD",45,0) ; "RTN","DGPFLFD",46,0) D BLD "RTN","DGPFLFD",47,0) ; "RTN","DGPFLFD",48,0) Q "RTN","DGPFLFD",49,0) ; "RTN","DGPFLFD",50,0) ; "RTN","DGPFLFD",51,0) BLD ;Build flag detail screen (list area) "RTN","DGPFLFD",52,0) ; "RTN","DGPFLFD",53,0) D CLEAN^VALM10 "RTN","DGPFLFD",54,0) K VALMHDR "RTN","DGPFLFD",55,0) K ^TMP("DGPFDET",$J) "RTN","DGPFLFD",56,0) ; "RTN","DGPFLFD",57,0) ;init number of lines in list "RTN","DGPFLFD",58,0) S VALMCNT=0 "RTN","DGPFLFD",59,0) ; "RTN","DGPFLFD",60,0) ;build header "RTN","DGPFLFD",61,0) D HDR "RTN","DGPFLFD",62,0) ; "RTN","DGPFLFD",63,0) ;build list area for flag detail "RTN","DGPFLFD",64,0) D EN^DGPFLFD1("DGPFDET",DGPFIEN,.VALMCNT) "RTN","DGPFLFD",65,0) ; "RTN","DGPFLFD",66,0) Q "RTN","DGPFLFD",67,0) ; "RTN","DGPFLFD",68,0) ; "RTN","DGPFLFD",69,0) HELP ;Help Code "RTN","DGPFLFD",70,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLFD",71,0) Q "RTN","DGPFLFD",72,0) ; "RTN","DGPFLFD",73,0) ; "RTN","DGPFLFD",74,0) EXIT ;Exit Code "RTN","DGPFLFD",75,0) ; "RTN","DGPFLFD",76,0) D CLEAN^VALM10 "RTN","DGPFLFD",77,0) D CLEAR^VALM1 "RTN","DGPFLFD",78,0) K ^TMP("DGPFDET",$J) "RTN","DGPFLFD",79,0) Q "RTN","DGPFLFD",80,0) ; "RTN","DGPFLFD",81,0) ; "RTN","DGPFLFD",82,0) EXPND ;Expand Code "RTN","DGPFLFD",83,0) Q "RTN","DGPFLFD1") 0^41^B39735415 "RTN","DGPFLFD1",1,0) DGPFLFD1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL BUILD LIST AREA ; 7/31/03 3:01pm "RTN","DGPFLFD1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLFD1",3,0) ; "RTN","DGPFLFD1",4,0) ;no direct entry "RTN","DGPFLFD1",5,0) QUIT "RTN","DGPFLFD1",6,0) ; "RTN","DGPFLFD1",7,0) EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build flag detail list area. "RTN","DGPFLFD1",8,0) ; "RTN","DGPFLFD1",9,0) ; Input: "RTN","DGPFLFD1",10,0) ; DGARY - global array subscript "RTN","DGPFLFD1",11,0) ; DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL "RTN","DGPFLFD1",12,0) ; FLAG file [ex: "1;DGPF(26.15,"] "RTN","DGPFLFD1",13,0) ; "RTN","DGPFLFD1",14,0) ; Output: "RTN","DGPFLFD1",15,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLFD1",16,0) ; "RTN","DGPFLFD1",17,0) N DGPFF ;flag array "RTN","DGPFLFD1",18,0) N DGPFFH ;flag history array "RTN","DGPFLFD1",19,0) N DGFHIENS ;contains flag history ien's "RTN","DGPFLFD1",20,0) N DGFHIEN ;flag history ien "RTN","DGPFLFD1",21,0) N DGHISCNT ;history record counter "RTN","DGPFLFD1",22,0) N DGLINE ;line counter "RTN","DGPFLFD1",23,0) N DGSUB ;subscript of flag history ien's "RTN","DGPFLFD1",24,0) ; "RTN","DGPFLFD1",25,0) ;quit if required input paramater not passed "RTN","DGPFLFD1",26,0) Q:'$G(DGPFIEN) "RTN","DGPFLFD1",27,0) ; "RTN","DGPFLFD1",28,0) ;init variables "RTN","DGPFLFD1",29,0) S (DGCNT,DGLINE,DGHISCNT)=0 "RTN","DGPFLFD1",30,0) K DGPFF "RTN","DGPFLFD1",31,0) ; "RTN","DGPFLFD1",32,0) ;get flag into DGPFF array "RTN","DGPFLFD1",33,0) Q:'$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFF) "RTN","DGPFLFD1",34,0) S DGPFF("PTR")=DGPFIEN "RTN","DGPFLFD1",35,0) ; "RTN","DGPFLFD1",36,0) ;build 'Flag Details' list area "RTN","DGPFLFD1",37,0) D FLAGDET(DGARY,.DGPFF,.DGLINE,.DGCNT) "RTN","DGPFLFD1",38,0) ; "RTN","DGPFLFD1",39,0) ;quit if NATIONAL flag, they don't have a history "RTN","DGPFLFD1",40,0) Q:DGPFF("PTR")'["26.11" "RTN","DGPFLFD1",41,0) ; "RTN","DGPFLFD1",42,0) ;set history heading into list area "RTN","DGPFLFD1",43,0) D HISTHDR(DGARY,.DGLINE,.DGCNT) "RTN","DGPFLFD1",44,0) ; "RTN","DGPFLFD1",45,0) ;get all history ien's associated with the flag "RTN","DGPFLFD1",46,0) K DGFHIENS "RTN","DGPFLFD1",47,0) Q:'$$GETALLDT^DGPFALH(+DGPFF("PTR"),.DGFHIENS) "RTN","DGPFLFD1",48,0) ; "RTN","DGPFLFD1",49,0) ;reverse loop through each flag history ien "RTN","DGPFLFD1",50,0) S DGSUB=9999999.999999 "RTN","DGPFLFD1",51,0) F S DGSUB=$O(DGFHIENS(DGSUB),-1) Q:DGSUB="" D "RTN","DGPFLFD1",52,0) . S DGFHIEN=$G(DGFHIENS(DGSUB)) "RTN","DGPFLFD1",53,0) . K DGPFFH "RTN","DGPFLFD1",54,0) . ;- for each ien, get flag history into DGPFFH array "RTN","DGPFLFD1",55,0) . I $$GETHIST^DGPFALH(DGFHIEN,.DGPFFH) D "RTN","DGPFLFD1",56,0) . . ; "RTN","DGPFLFD1",57,0) . . ;-- count of history records "RTN","DGPFLFD1",58,0) . . S DGHISCNT=DGHISCNT+1 "RTN","DGPFLFD1",59,0) . . ; "RTN","DGPFLFD1",60,0) . . ;-- build flag history details list area "RTN","DGPFLFD1",61,0) . . D HISTDET(DGARY,.DGPFFH,.DGLINE,DGHISCNT,.DGCNT) "RTN","DGPFLFD1",62,0) ; "RTN","DGPFLFD1",63,0) Q "RTN","DGPFLFD1",64,0) ; "RTN","DGPFLFD1",65,0) ; "RTN","DGPFLFD1",66,0) FLAGDET(DGARY,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG details in the list area. "RTN","DGPFLFD1",67,0) ; "RTN","DGPFLFD1",68,0) ; Input: "RTN","DGPFLFD1",69,0) ; DGARY - global array subscript "RTN","DGPFLFD1",70,0) ; DGPFF - flag array, pass by reference "RTN","DGPFLFD1",71,0) ; DGLINE - line counter "RTN","DGPFLFD1",72,0) ; "RTN","DGPFLFD1",73,0) ; Output: "RTN","DGPFLFD1",74,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLFD1",75,0) ; "RTN","DGPFLFD1",76,0) ;temp vars used "RTN","DGPFLFD1",77,0) N DGSUB ;array subscript "RTN","DGPFLFD1",78,0) N DGTEMP ;temp text holder "RTN","DGPFLFD1",79,0) N DGCOUNT ;principal investigator count "RTN","DGPFLFD1",80,0) ; "RTN","DGPFLFD1",81,0) ;set flag name "RTN","DGPFLFD1",82,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",83,0) D SET^DGPFLF1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFF("FLAG")),U,2),18,,,,,.DGCNT) "RTN","DGPFLFD1",84,0) ; "RTN","DGPFLFD1",85,0) ;set flag category "RTN","DGPFLFD1",86,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",87,0) S DGTEMP=$S(DGPFF("PTR")["26.11":"II (LOCAL)",DGPFF("PTR")["26.15":"I (NATIONAL)",1:"UNKNOWN") "RTN","DGPFLFD1",88,0) D SET^DGPFLF1(DGARY,DGLINE,"Flag Category: "_DGTEMP,14,,,,,.DGCNT) "RTN","DGPFLFD1",89,0) ; "RTN","DGPFLFD1",90,0) ;set flag type "RTN","DGPFLFD1",91,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",92,0) D SET^DGPFLF1(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),18,,,,,.DGCNT) "RTN","DGPFLFD1",93,0) ; "RTN","DGPFLFD1",94,0) ;set flag status "RTN","DGPFLFD1",95,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",96,0) D SET^DGPFLF1(DGARY,DGLINE,"Flag Status: "_$P($G(DGPFF("STAT")),U,2),16,,,,,.DGCNT) "RTN","DGPFLFD1",97,0) ; "RTN","DGPFLFD1",98,0) ;set flag review frequency "RTN","DGPFLFD1",99,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",100,0) D SET^DGPFLF1(DGARY,DGLINE,"Review Frequency Days: "_$P($G(DGPFF("REVFREQ")),U,2),6,,,,,.DGCNT) "RTN","DGPFLFD1",101,0) ; "RTN","DGPFLFD1",102,0) ;set notification days "RTN","DGPFLFD1",103,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",104,0) D SET^DGPFLF1(DGARY,DGLINE,"Notification Days: "_$P($G(DGPFF("NOTIDAYS")),U,2),10,,,,,.DGCNT) "RTN","DGPFLFD1",105,0) ; "RTN","DGPFLFD1",106,0) ;set flag review mail group "RTN","DGPFLFD1",107,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",108,0) D SET^DGPFLF1(DGARY,DGLINE,"Review Mail Group: "_$P($G(DGPFF("REVGRP")),U,2),10,,,,,.DGCNT) "RTN","DGPFLFD1",109,0) ; "RTN","DGPFLFD1",110,0) ;set if principal investigator(s) "RTN","DGPFLFD1",111,0) I $D(DGPFF("PRININV")) D "RTN","DGPFLFD1",112,0) . S (DGSUB,DGTEMP)="" "RTN","DGPFLFD1",113,0) . S DGCOUNT=1 "RTN","DGPFLFD1",114,0) . F S DGSUB=$O(DGPFF("PRININV",DGSUB)) Q:'DGSUB D "RTN","DGPFLFD1",115,0) . . Q:$G(DGPFF("PRININV",DGSUB,0))="@" "RTN","DGPFLFD1",116,0) . . I DGCOUNT=1 D "RTN","DGPFLFD1",117,0) . . . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",118,0) . . . S DGTEMP="Principal Investigator(s): "_$P($G(DGPFF("PRININV",DGSUB,0)),U,2) "RTN","DGPFLFD1",119,0) . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,2,,,,,.DGCNT) "RTN","DGPFLFD1",120,0) . . I DGCOUNT>1 D "RTN","DGPFLFD1",121,0) . . . S DGTEMP=$P($G(DGPFF("PRININV",DGSUB,0)),U,2) "RTN","DGPFLFD1",122,0) . . . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",123,0) . . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,29,,,,,.DGCNT) "RTN","DGPFLFD1",124,0) . . S DGCOUNT=DGCOUNT+1 "RTN","DGPFLFD1",125,0) ; "RTN","DGPFLFD1",126,0) ;set flag description "RTN","DGPFLFD1",127,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",128,0) D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT) "RTN","DGPFLFD1",129,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",130,0) D SET^DGPFLF1(DGARY,DGLINE,"Flag Description:",1,IORVON,IORVOFF,,,.DGCNT) "RTN","DGPFLFD1",131,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",132,0) D SET^DGPFLF1(DGARY,DGLINE,"-----------------",1,,,,,.DGCNT) "RTN","DGPFLFD1",133,0) I '$D(DGPFF("DESC",1,0)) D Q "RTN","DGPFLFD1",134,0) . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",135,0) . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT) "RTN","DGPFLFD1",136,0) S DGSUB=0,DGTEMP="" "RTN","DGPFLFD1",137,0) F S DGSUB=$O(DGPFF("DESC",DGSUB)) Q:'DGSUB D "RTN","DGPFLFD1",138,0) . S DGTEMP=$G(DGPFF("DESC",DGSUB,0)) "RTN","DGPFLFD1",139,0) . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",140,0) . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT) "RTN","DGPFLFD1",141,0) ; "RTN","DGPFLFD1",142,0) Q "RTN","DGPFLFD1",143,0) ; "RTN","DGPFLFD1",144,0) ; "RTN","DGPFLFD1",145,0) HISTDET(DGARY,DGPFFH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG HISTORY details in the list area. "RTN","DGPFLFD1",146,0) ; "RTN","DGPFLFD1",147,0) ; Input: "RTN","DGPFLFD1",148,0) ; DGARY - global array subscript "RTN","DGPFLFD1",149,0) ; DGPFFH - flag history array, pass by reference "RTN","DGPFLFD1",150,0) ; DGLINE - line counter "RTN","DGPFLFD1",151,0) ; DGHISCNT - history record counter "RTN","DGPFLFD1",152,0) ; "RTN","DGPFLFD1",153,0) ; Output: "RTN","DGPFLFD1",154,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLFD1",155,0) ; "RTN","DGPFLFD1",156,0) ;temporary variables used "RTN","DGPFLFD1",157,0) N DGTEMP "RTN","DGPFLFD1",158,0) N DGSUB "RTN","DGPFLFD1",159,0) S DGTEMP="" "RTN","DGPFLFD1",160,0) ; "RTN","DGPFLFD1",161,0) ;set blank line "RTN","DGPFLFD1",162,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",163,0) D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT) "RTN","DGPFLFD1",164,0) ; "RTN","DGPFLFD1",165,0) ;add an additional blank line except on the first history "RTN","DGPFLFD1",166,0) I DGHISCNT>1 D "RTN","DGPFLFD1",167,0) . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",168,0) . D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT) "RTN","DGPFLFD1",169,0) ; "RTN","DGPFLFD1",170,0) ;set history counter "RTN","DGPFLFD1",171,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",172,0) S DGTEMP=DGHISCNT_"." "RTN","DGPFLFD1",173,0) D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,IORVON,IORVOFF,,,.DGCNT) "RTN","DGPFLFD1",174,0) ; "RTN","DGPFLFD1",175,0) ;set edit date/time "RTN","DGPFLFD1",176,0) D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit On: "_$$FDTTM^VALM1($P($G(DGPFFH("ENTERDT")),U)),14,IORVON,IORVOFF,,,.DGCNT) "RTN","DGPFLFD1",177,0) ; "RTN","DGPFLFD1",178,0) ;set entered by "RTN","DGPFLFD1",179,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",180,0) D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit By: "_$P($G(DGPFFH("ENTERBY")),U,2),14,,,,,.DGCNT) "RTN","DGPFLFD1",181,0) ; "RTN","DGPFLFD1",182,0) ;set blank line "RTN","DGPFLFD1",183,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",184,0) D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT) "RTN","DGPFLFD1",185,0) ; "RTN","DGPFLFD1",186,0) ;set edit reason text "RTN","DGPFLFD1",187,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",188,0) D SET^DGPFLF1(DGARY,DGLINE,"Reason For Flag Enter/Edit:",1,,,,,.DGCNT) "RTN","DGPFLFD1",189,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",190,0) D SET^DGPFLF1(DGARY,DGLINE,"---------------------------",1,,,,,.DGCNT) "RTN","DGPFLFD1",191,0) I $D(DGPFFH("REASON",1,0)) D "RTN","DGPFLFD1",192,0) . S DGSUB=0,DGTEMP="" "RTN","DGPFLFD1",193,0) . F S DGSUB=$O(DGPFFH("REASON",DGSUB)) Q:'DGSUB D "RTN","DGPFLFD1",194,0) .. S DGTEMP=$G(DGPFFH("REASON",DGSUB,0)) "RTN","DGPFLFD1",195,0) .. S DGLINE=DGLINE+1 "RTN","DGPFLFD1",196,0) .. D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT) "RTN","DGPFLFD1",197,0) E D "RTN","DGPFLFD1",198,0) . S DGLINE=DGLINE+1 "RTN","DGPFLFD1",199,0) . D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT) "RTN","DGPFLFD1",200,0) ; "RTN","DGPFLFD1",201,0) Q "RTN","DGPFLFD1",202,0) ; "RTN","DGPFLFD1",203,0) ; "RTN","DGPFLFD1",204,0) HISTHDR(DGARY,DGLINE,DGCNT) ;Set history heading into list area. "RTN","DGPFLFD1",205,0) ; "RTN","DGPFLFD1",206,0) ; Input: "RTN","DGPFLFD1",207,0) ; DGARY - global array subscript "RTN","DGPFLFD1",208,0) ; DGLINE - line counter "RTN","DGPFLFD1",209,0) ; "RTN","DGPFLFD1",210,0) ; Output: "RTN","DGPFLFD1",211,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLFD1",212,0) ; "RTN","DGPFLFD1",213,0) ;set blank line "RTN","DGPFLFD1",214,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",215,0) D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT) "RTN","DGPFLFD1",216,0) ; "RTN","DGPFLFD1",217,0) ;set hist heading "RTN","DGPFLFD1",218,0) S DGLINE=DGLINE+1 "RTN","DGPFLFD1",219,0) D SET^DGPFLF1(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,,,.DGCNT) "RTN","DGPFLFD1",220,0) D SET^DGPFLF1(DGARY,DGLINE,"",28,IORVON,IORVOFF,,,.DGCNT) "RTN","DGPFLFD1",221,0) ; "RTN","DGPFLFD1",222,0) Q "RTN","DGPFLMA") 0^14^B1371064 "RTN","DGPFLMA",1,0) DGPFLMA ;ALB/KCL - PRF ASSIGNMENT LISTMAN SCREEN ; 4/24/03 4:34pm "RTN","DGPFLMA",2,0) ;;5.3;Registration;**425**;Aug 13,1993 "RTN","DGPFLMA",3,0) ; "RTN","DGPFLMA",4,0) ; "RTN","DGPFLMA",5,0) EN ;Main entry point for DGPF RECORD FLAG ASSIGNMENT option. "RTN","DGPFLMA",6,0) ; "RTN","DGPFLMA",7,0) ; Input: None "RTN","DGPFLMA",8,0) ; Output: None "RTN","DGPFLMA",9,0) ; "RTN","DGPFLMA",10,0) ;display wait msg to user "RTN","DGPFLMA",11,0) D WAIT^DICD "RTN","DGPFLMA",12,0) ; "RTN","DGPFLMA",13,0) ;invoke list manager and load list template "RTN","DGPFLMA",14,0) D EN^VALM("DGPF RECORD FLAG ASSIGNMENT") "RTN","DGPFLMA",15,0) Q "RTN","DGPFLMA",16,0) ; "RTN","DGPFLMA",17,0) ; "RTN","DGPFLMA",18,0) HDR ;Header Code "RTN","DGPFLMA",19,0) S VALMHDR(1)="Patient: No Patient Selected" "RTN","DGPFLMA",20,0) S VALMHDR(2)="" "RTN","DGPFLMA",21,0) Q "RTN","DGPFLMA",22,0) ; "RTN","DGPFLMA",23,0) ; "RTN","DGPFLMA",24,0) INIT ;Init variables and list array "RTN","DGPFLMA",25,0) N DGTEXT "RTN","DGPFLMA",26,0) S DGTEXT=" A patient has not been selected. Please select a patient." "RTN","DGPFLMA",27,0) D SET^VALM10(1,"") "RTN","DGPFLMA",28,0) D SET^VALM10(2,DGTEXT) "RTN","DGPFLMA",29,0) D CNTRL^VALM10(2,4,$L(DGTEXT),$G(IOINHI),$G(IOINORM)) "RTN","DGPFLMA",30,0) S VALMCNT=2 "RTN","DGPFLMA",31,0) Q "RTN","DGPFLMA",32,0) ; "RTN","DGPFLMA",33,0) ; "RTN","DGPFLMA",34,0) HELP ;Help Code "RTN","DGPFLMA",35,0) N X "RTN","DGPFLMA",36,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMA",37,0) Q "RTN","DGPFLMA",38,0) ; "RTN","DGPFLMA",39,0) ; "RTN","DGPFLMA",40,0) EXIT ;Exit Code "RTN","DGPFLMA",41,0) K DGDFN "RTN","DGPFLMA",42,0) K DGPFA "RTN","DGPFLMA",43,0) K DGPFAH "RTN","DGPFLMA",44,0) D CLEAN^VALM10 "RTN","DGPFLMA",45,0) D CLEAR^VALM1 "RTN","DGPFLMA",46,0) Q "RTN","DGPFLMA",47,0) ; "RTN","DGPFLMA",48,0) ; "RTN","DGPFLMA",49,0) EXPND ;Expand Code "RTN","DGPFLMA",50,0) Q "RTN","DGPFLMA1") 0^15^B5185010 "RTN","DGPFLMA1",1,0) DGPFLMA1 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS ; 6/10/03 3:57pm "RTN","DGPFLMA1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMA1",3,0) ; "RTN","DGPFLMA1",4,0) ;no direct entry "RTN","DGPFLMA1",5,0) QUIT "RTN","DGPFLMA1",6,0) ; "RTN","DGPFLMA1",7,0) SP ;Entry point for DGPF SELECT PATIENT action protocol. "RTN","DGPFLMA1",8,0) ; "RTN","DGPFLMA1",9,0) ; Input: None "RTN","DGPFLMA1",10,0) ; "RTN","DGPFLMA1",11,0) ; Output: "RTN","DGPFLMA1",12,0) ; DGDFN - pointer to patient in PATIENT #2 file "RTN","DGPFLMA1",13,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMA1",14,0) ; "RTN","DGPFLMA1",15,0) N DGPAT ;patient lookup array "RTN","DGPFLMA1",16,0) ; "RTN","DGPFLMA1",17,0) ;set screen to full scrolling region "RTN","DGPFLMA1",18,0) D FULL^VALM1 "RTN","DGPFLMA1",19,0) ; "RTN","DGPFLMA1",20,0) ;patient selection (lookup) "RTN","DGPFLMA1",21,0) D SELPAT^DGPFUT1(.DGPAT) "RTN","DGPFLMA1",22,0) I (+$G(DGPAT)>0) D "RTN","DGPFLMA1",23,0) . S DGDFN=+DGPAT "RTN","DGPFLMA1",24,0) . ; "RTN","DGPFLMA1",25,0) . Q:'$$CONTINUE^DGPFUT() "RTN","DGPFLMA1",26,0) . ; "RTN","DGPFLMA1",27,0) . ;- build header for selected patient "RTN","DGPFLMA1",28,0) . D BLDHDR^DGPFLMU(DGDFN,.VALMHDR) "RTN","DGPFLMA1",29,0) . ; "RTN","DGPFLMA1",30,0) . ;- build list of flag assignments for selected patient "RTN","DGPFLMA1",31,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA1",32,0) ; "RTN","DGPFLMA1",33,0) ;return to LM (refresh screen) "RTN","DGPFLMA1",34,0) S VALMBCK="R" "RTN","DGPFLMA1",35,0) Q "RTN","DGPFLMA1",36,0) ; "RTN","DGPFLMA1",37,0) ; "RTN","DGPFLMA1",38,0) DF ;Entry point for DGPF DISPLAY ASSIGNMENT DETAIL action protocol. "RTN","DGPFLMA1",39,0) ; "RTN","DGPFLMA1",40,0) ; Input: None "RTN","DGPFLMA1",41,0) ; "RTN","DGPFLMA1",42,0) ; Output: "RTN","DGPFLMA1",43,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMA1",44,0) ; "RTN","DGPFLMA1",45,0) N DGDFN ;patient dfn "RTN","DGPFLMA1",46,0) N DGIEN ;assignment ien "RTN","DGPFLMA1",47,0) N SEL ;user selection "RTN","DGPFLMA1",48,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMA1",49,0) ; "RTN","DGPFLMA1",50,0) ;set screen to full scroll region "RTN","DGPFLMA1",51,0) D FULL^VALM1 "RTN","DGPFLMA1",52,0) ; "RTN","DGPFLMA1",53,0) ;is action selection allowed? "RTN","DGPFLMA1",54,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMA1",55,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA1",56,0) . I '$G(DGDFN) W !?6,"A patient has not been selected." "RTN","DGPFLMA1",57,0) . E W !?6,"There are no record flag assignments for this patient." "RTN","DGPFLMA1",58,0) . D PAUSE^VALM1 "RTN","DGPFLMA1",59,0) . S VALMBCK="R" "RTN","DGPFLMA1",60,0) ; "RTN","DGPFLMA1",61,0) ;ask user to select a single assignment for detail display "RTN","DGPFLMA1",62,0) S (SEL,DGIEN,VALMBCK)="" "RTN","DGPFLMA1",63,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMA1",64,0) ; "RTN","DGPFLMA1",65,0) ;process user selection "RTN","DGPFLMA1",66,0) S SEL=$O(VALMY("")) "RTN","DGPFLMA1",67,0) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D "RTN","DGPFLMA1",68,0) . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U) "RTN","DGPFLMA1",69,0) . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2) "RTN","DGPFLMA1",70,0) . ;-display flag assignment details "RTN","DGPFLMA1",71,0) . N VALMHDR "RTN","DGPFLMA1",72,0) . D EN^DGPFLMAD "RTN","DGPFLMA1",73,0) ; "RTN","DGPFLMA1",74,0) ;return to LM (refresh screen) "RTN","DGPFLMA1",75,0) S VALMBCK="R" "RTN","DGPFLMA1",76,0) Q "RTN","DGPFLMA2") 0^16^B29486174 "RTN","DGPFLMA2",1,0) DGPFLMA2 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 4/24/03 4:35pm "RTN","DGPFLMA2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "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 DGOK ;ok flag for entering assignment narrative "RTN","DGPFLMA2",18,0) N DGPFA ;assignment array "RTN","DGPFLMA2",19,0) N DGPFAH ;assignment history array "RTN","DGPFLMA2",20,0) N DGRDAT ;results of review date calculation "RTN","DGPFLMA2",21,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA2",22,0) N DGREASON ;reason if unable to add new assignment "RTN","DGPFLMA2",23,0) N DGPFERR ;if error returned from STOALL api call "RTN","DGPFLMA2",24,0) ; "RTN","DGPFLMA2",25,0) ;set screen to full scrolling region "RTN","DGPFLMA2",26,0) D FULL^VALM1 "RTN","DGPFLMA2",27,0) ; "RTN","DGPFLMA2",28,0) D ;drop out of do block on failure "RTN","DGPFLMA2",29,0) . ; "RTN","DGPFLMA2",30,0) . ;-security key check "RTN","DGPFLMA2",31,0) . I '$D(^XUSEC("DGPF RECORD FLAG ASSIGNMENT",DUZ)) D Q "RTN","DGPFLMA2",32,0) . . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA2",33,0) . . W !?6,"You do not have the appropriate Security Key." "RTN","DGPFLMA2",34,0) . . D PAUSE^VALM1 "RTN","DGPFLMA2",35,0) . ; "RTN","DGPFLMA2",36,0) . ;-is action selection allowed? "RTN","DGPFLMA2",37,0) . I '$G(DGDFN) D Q "RTN","DGPFLMA2",38,0) . . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA2",39,0) . . W !?6,"A patient has not been selected." "RTN","DGPFLMA2",40,0) . . D PAUSE^VALM1 "RTN","DGPFLMA2",41,0) . ; "RTN","DGPFLMA2",42,0) . ;-init assignment and history arrays "RTN","DGPFLMA2",43,0) . K DGPFA,DGPFAH "RTN","DGPFLMA2",44,0) . ; "RTN","DGPFLMA2",45,0) . ;-get patient DFN into assignment array "RTN","DGPFLMA2",46,0) . S DGPFA("DFN")=$G(DGDFN) "RTN","DGPFLMA2",47,0) . Q:'DGPFA("DFN") "RTN","DGPFLMA2",48,0) . ; "RTN","DGPFLMA2",49,0) . ;-select flag for assignment, quit if not selected "RTN","DGPFLMA2",50,0) . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02") "RTN","DGPFLMA2",51,0) . Q:(DGPFA("FLAG")'>0) "RTN","DGPFLMA2",52,0) . ; "RTN","DGPFLMA2",53,0) . ;-check if ok to add new assignment "RTN","DGPFLMA2",54,0) . K DGREASON "RTN","DGPFLMA2",55,0) . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),.DGREASON) D Q "RTN","DGPFLMA2",56,0) . . W !!,"Unable to add new assignment..."_$$LOW^XLFSTR($G(DGREASON)) "RTN","DGPFLMA2",57,0) . . D PAUSE^VALM1 "RTN","DGPFLMA2",58,0) . ; "RTN","DGPFLMA2",59,0) . ;-if local flag assignment, owner site = current site "RTN","DGPFLMA2",60,0) . ;-else if nat'l flag assignment, prompt for owner site "RTN","DGPFLMA2",61,0) . I DGPFA("FLAG")["26.11" S DGPFA("OWNER")=$P($$SITE^VASITE,U) "RTN","DGPFLMA2",62,0) . E S DGPFA("OWNER")=$$ANSWER^DGPFUT("Enter Owner Site",$P($$SITE^VASITE,U,2),"P^4:EMZ") "RTN","DGPFLMA2",63,0) . Q:(DGPFA("OWNER")'>0) "RTN","DGPFLMA2",64,0) . ; "RTN","DGPFLMA2",65,0) . ;-prompt user for approved by person, quit if not selected "RTN","DGPFLMA2",66,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA2",67,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA2",68,0) . ; "RTN","DGPFLMA2",69,0) . ;-have user enter assignment narrative text (required) "RTN","DGPFLMA2",70,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA2",71,0) . S DGWPROOT=$NA(^TMP($J,"DGPFNARR")) "RTN","DGPFLMA2",72,0) . K @DGWPROOT "RTN","DGPFLMA2",73,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA2",74,0) . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor "RTN","DGPFLMA2",75,0) . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLMA2",76,0) . . S DIWETXT="Patient Record Flag - Assignment Narrative Text" "RTN","DGPFLMA2",77,0) . . S DIWESUB="Assignment Narrative Text" "RTN","DGPFLMA2",78,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA2",79,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA2",80,0) . . D EN^DIWE "RTN","DGPFLMA2",81,0) . . I $$CKWP^DGPFUT(DGWPROOT) S DGOK=1 Q "RTN","DGPFLMA2",82,0) . . W !,"Assignment Narrative Text is required!",*7 "RTN","DGPFLMA2",83,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA2",84,0) . . ; "RTN","DGPFLMA2",85,0) . ;-quit if required assignment narrative not entered "RTN","DGPFLMA2",86,0) . Q:$G(DGABORT) "RTN","DGPFLMA2",87,0) . ; "RTN","DGPFLMA2",88,0) . ;-place assignment narrative text into assignment array "RTN","DGPFLMA2",89,0) . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT "RTN","DGPFLMA2",90,0) . ; "RTN","DGPFLMA2",91,0) . ;-setup remaining assignment and history array nodes for filing "RTN","DGPFLMA2",92,0) . S DGPFA("STATUS")=1 ;active "RTN","DGPFLMA2",93,0) . S DGPFA("ORIGSITE")=$P($$SITE^VASITE(),U) ;current site "RTN","DGPFLMA2",94,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA2",95,0) . S DGPFAH("ACTION")=1 ;new assignment "RTN","DGPFLMA2",96,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA2",97,0) . S DGPFAH("COMMENT",1,0)="New record flag assignment." "RTN","DGPFLMA2",98,0) . ; "RTN","DGPFLMA2",99,0) . ;calculate the Review date, null if no date "RTN","DGPFLMA2",100,0) . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT")) "RTN","DGPFLMA2",101,0) . S DGPFA("REVIEWDT")=$S(DGRDAT>0:DGRDAT,1:"") "RTN","DGPFLMA2",102,0) . ; "RTN","DGPFLMA2",103,0) . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0 "RTN","DGPFLMA2",104,0) . ; "RTN","DGPFLMA2",105,0) . ;-file the assignment and history using STOALL api "RTN","DGPFLMA2",106,0) . W !,"Filing the patient's new record flag assignment..." "RTN","DGPFLMA2",107,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA2",108,0) . W !," >>> Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.") "RTN","DGPFLMA2",109,0) . ; "RTN","DGPFLMA2",110,0) . ;-- send HL7 message if adding an assignment to a NATIONAL flag "RTN","DGPFLMA2",111,0) . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA2",112,0) . . W !," >>> HL7 message sent...updating patient's sites of record." "RTN","DGPFLMA2",113,0) . ; "RTN","DGPFLMA2",114,0) . D PAUSE^VALM1 "RTN","DGPFLMA2",115,0) . ; "RTN","DGPFLMA2",116,0) . ;-re-build list of flag assignments for patient "RTN","DGPFLMA2",117,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA2",118,0) ; "RTN","DGPFLMA2",119,0) ;return to LM (refresh screen) "RTN","DGPFLMA2",120,0) S VALMBCK="R" "RTN","DGPFLMA2",121,0) ; "RTN","DGPFLMA2",122,0) Q "RTN","DGPFLMA3") 0^17^B53692057 "RTN","DGPFLMA3",1,0) DGPFLMA3 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 4/24/03 "RTN","DGPFLMA3",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "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) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call "RTN","DGPFLMA3",15,0) N DGAROOT ;assignment narrative word processing root "RTN","DGPFLMA3",16,0) N DGCROOT ;assignment history comment word processing root "RTN","DGPFLMA3",17,0) N DGABORT ;abort flag for entering assignment narrative "RTN","DGPFLMA3",18,0) N DGOK ;ok flag for entering assignment narrative "RTN","DGPFLMA3",19,0) N DGCODE ;action code "RTN","DGPFLMA3",20,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFLMA3",21,0) N DGIEN ;assignment ien "RTN","DGPFLMA3",22,0) N DGPFA ;assignment array "RTN","DGPFLMA3",23,0) N DGPFAH ;assignment history array "RTN","DGPFLMA3",24,0) N DGRDAT ;review date "RTN","DGPFLMA3",25,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA3",26,0) N DGREASON ;reason if unable to edit assignment "RTN","DGPFLMA3",27,0) N DGPFERR ;if error returned from STOALL api call "RTN","DGPFLMA3",28,0) N SEL ;user selection (list item) "RTN","DGPFLMA3",29,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMA3",30,0) ; "RTN","DGPFLMA3",31,0) ;set screen to full scroll region "RTN","DGPFLMA3",32,0) D FULL^VALM1 "RTN","DGPFLMA3",33,0) ; "RTN","DGPFLMA3",34,0) ;security key check "RTN","DGPFLMA3",35,0) I '$D(^XUSEC("DGPF RECORD FLAG ASSIGNMENT",DUZ)) D Q "RTN","DGPFLMA3",36,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA3",37,0) . W !?6,"You do not have the appropriate Security Key." "RTN","DGPFLMA3",38,0) . D PAUSE^VALM1 "RTN","DGPFLMA3",39,0) . S VALMBCK="R" "RTN","DGPFLMA3",40,0) ; "RTN","DGPFLMA3",41,0) ;is action selection allowed? "RTN","DGPFLMA3",42,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMA3",43,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA3",44,0) . I '$G(DGDFN) W !?6,"A patient has not been selected." "RTN","DGPFLMA3",45,0) . E W !?6,"There are no record flag assignments for this patient." "RTN","DGPFLMA3",46,0) . D PAUSE^VALM1 "RTN","DGPFLMA3",47,0) . S VALMBCK="R" "RTN","DGPFLMA3",48,0) ; "RTN","DGPFLMA3",49,0) ;allow user to select a SINGLE flag assignment for editing "RTN","DGPFLMA3",50,0) S (DGIEN,DGSELECT,VALMBCK)="" "RTN","DGPFLMA3",51,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMA3",52,0) ; "RTN","DGPFLMA3",53,0) ;process user selection "RTN","DGPFLMA3",54,0) S SEL=$O(VALMY("")) "RTN","DGPFLMA3",55,0) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D "RTN","DGPFLMA3",56,0) . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U) "RTN","DGPFLMA3",57,0) . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2) "RTN","DGPFLMA3",58,0) . ; "RTN","DGPFLMA3",59,0) . ;-attempt to obtain lock on assignment record "RTN","DGPFLMA3",60,0) . I '$$LOCK^DGPFAA3(DGIEN) D Q "RTN","DGPFLMA3",61,0) . . W !!,"Record flag assignment currently in use, can not be edited!" "RTN","DGPFLMA3",62,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",63,0) . ; "RTN","DGPFLMA3",64,0) . ;-init word processing arrays "RTN","DGPFLMA3",65,0) . S DGAROOT=$NA(^TMP($J,"DGPFNARR")) "RTN","DGPFLMA3",66,0) . S DGCROOT=$NA(^TMP($J,"DGPFCMNT")) "RTN","DGPFLMA3",67,0) . K @DGAROOT,@DGCROOT "RTN","DGPFLMA3",68,0) . ; "RTN","DGPFLMA3",69,0) . ;-get PRF assignment into DGPFA array "RTN","DGPFLMA3",70,0) . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q "RTN","DGPFLMA3",71,0) . . W !!,"Unable to retrieve the record flag assignment selected." "RTN","DGPFLMA3",72,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",73,0) . ; "RTN","DGPFLMA3",74,0) . ;-is editing of assignment allowed?, quit if not allowed "RTN","DGPFLMA3",75,0) . K DGREASON "RTN","DGPFLMA3",76,0) . I '$$EDTOK^DGPFAA2(.DGPFA,"",.DGREASON) D Q "RTN","DGPFLMA3",77,0) . . W !!,"Assignment can not be edited..."_$$LOW^XLFSTR($G(DGREASON)) "RTN","DGPFLMA3",78,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",79,0) . ; "RTN","DGPFLMA3",80,0) . ;-if assigment is active, set available action codes to 'Continue' "RTN","DGPFLMA3",81,0) . ; and 'Inactivate', else set action code to 'Reactivate' "RTN","DGPFLMA3",82,0) . I +DGPFA("STATUS")=1 S DGCODE="S^C:Continue Assignment;I:Inactivate Assignment" "RTN","DGPFLMA3",83,0) . E S DGCODE="S^R:Reactivate Assignment" "RTN","DGPFLMA3",84,0) . ; "RTN","DGPFLMA3",85,0) . ;-prompt user for assignment action, quit if no action selected "RTN","DGPFLMA3",86,0) . S DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE) "RTN","DGPFLMA3",87,0) . Q:(DGPFAH("ACTION")=-1) "RTN","DGPFLMA3",88,0) . S DGPFAH("ACTION")=$S(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4) "RTN","DGPFLMA3",89,0) . ; "RTN","DGPFLMA3",90,0) . ;-if assignment action is 'Inactivate', set status to 'Inactive' "RTN","DGPFLMA3",91,0) . S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,1:1) "RTN","DGPFLMA3",92,0) . ; "RTN","DGPFLMA3",93,0) . ;-if action is not 'Inactivate', then prompt user to edit the narr "RTN","DGPFLMA3",94,0) . I (DGPFAH("ACTION")'=3),(($$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y")>0)) D "RTN","DGPFLMA3",95,0) . . ;--allow user to edit the assignment narrative (required) "RTN","DGPFLMA3",96,0) . . S (DGABORT,DGOK)=0 "RTN","DGPFLMA3",97,0) . . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA3",98,0) . . . S DGROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT) "RTN","DGPFLMA3",99,0) . . . S DIC=$$OREF^DILF(DGAROOT) "RTN","DGPFLMA3",100,0) . . . S DIWETXT="Patient Record Flag - Assignment Narrative Text" "RTN","DGPFLMA3",101,0) . . . S DIWESUB="Assignment Narrative Text" "RTN","DGPFLMA3",102,0) . . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA3",103,0) . . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA3",104,0) . . . D EN^DIWE "RTN","DGPFLMA3",105,0) . . . I $$CKWP^DGPFUT(DGAROOT) S DGOK=1 Q "RTN","DGPFLMA3",106,0) . . . W !,"Assignment Narrative Text is required!",*7 "RTN","DGPFLMA3",107,0) . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA3",108,0) . . ; "RTN","DGPFLMA3",109,0) . ;-quit if required assignment narrative not entered "RTN","DGPFLMA3",110,0) . Q:$G(DGABORT) "RTN","DGPFLMA3",111,0) . ; "RTN","DGPFLMA3",112,0) . ;-if narrative edited, place new narrative into DGPFA array "RTN","DGPFLMA3",113,0) . I $G(DGOK) D "RTN","DGPFLMA3",114,0) . . K DGPFA("NARR") ;remove old narrative text "RTN","DGPFLMA3",115,0) . . M DGPFA("NARR")=@DGAROOT K @DGAROOT "RTN","DGPFLMA3",116,0) . ; "RTN","DGPFLMA3",117,0) . ;-prompt user for 'Approved By' person, quit if not selected "RTN","DGPFLMA3",118,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA3",119,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA3",120,0) . ; "RTN","DGPFLMA3",121,0) . ;-have user enter the edit reason/history comments (required) "RTN","DGPFLMA3",122,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA3",123,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA3",124,0) . . W !!,"Enter the reason for editing this assignment:" ;needed for line editor "RTN","DGPFLMA3",125,0) . . S DIC=$$OREF^DILF(DGCROOT) "RTN","DGPFLMA3",126,0) . . S DIWETXT="Patient Record Flag - Edit Reason Text" "RTN","DGPFLMA3",127,0) . . S DIWESUB="Edit Reason Text" "RTN","DGPFLMA3",128,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA3",129,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA3",130,0) . . D EN^DIWE "RTN","DGPFLMA3",131,0) . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q "RTN","DGPFLMA3",132,0) . . W !,"Edit Reason is required!",*7 "RTN","DGPFLMA3",133,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA3",134,0) . ; "RTN","DGPFLMA3",135,0) . ;-quit if required edit reason/history comments not entered "RTN","DGPFLMA3",136,0) . Q:$G(DGABORT) "RTN","DGPFLMA3",137,0) . ; "RTN","DGPFLMA3",138,0) . ;-place comments into history array "RTN","DGPFLMA3",139,0) . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT "RTN","DGPFLMA3",140,0) . ; "RTN","DGPFLMA3",141,0) . ;-setup remaining assignment history nodes for filing "RTN","DGPFLMA3",142,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA3",143,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA3",144,0) . ; "RTN","DGPFLMA3",145,0) . ;-calculate the review date when Status is ACTIVE, otherwise null "RTN","DGPFLMA3",146,0) . S DGRDAT=$S(DGPFA("STATUS")=1:$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT")),1:0) "RTN","DGPFLMA3",147,0) . S DGPFA("REVIEWDT")=$S(DGRDAT>0:DGRDAT,1:"") "RTN","DGPFLMA3",148,0) . ; "RTN","DGPFLMA3",149,0) . Q:$$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0 "RTN","DGPFLMA3",150,0) . ; "RTN","DGPFLMA3",151,0) . ;-file the assignment and history using STOALL api "RTN","DGPFLMA3",152,0) . W !,"Updating the patient's record flag assignment..." "RTN","DGPFLMA3",153,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA3",154,0) . W !," >>> Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.") "RTN","DGPFLMA3",155,0) . ; "RTN","DGPFLMA3",156,0) . ;-- send HL7 message if editing assignment to a NATIONAL flag "RTN","DGPFLMA3",157,0) . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA3",158,0) . . W !," >>> HL7 message sent...updating patient's sites of record." "RTN","DGPFLMA3",159,0) . ; "RTN","DGPFLMA3",160,0) . D PAUSE^VALM1 "RTN","DGPFLMA3",161,0) . ; "RTN","DGPFLMA3",162,0) . ;-re-build list of flag assignments for patient "RTN","DGPFLMA3",163,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA3",164,0) . ; "RTN","DGPFLMA3",165,0) . ;-release lock after edit "RTN","DGPFLMA3",166,0) . D UNLOCK^DGPFAA3(DGIEN) "RTN","DGPFLMA3",167,0) ; "RTN","DGPFLMA3",168,0) ;return to LM (refresh screen) "RTN","DGPFLMA3",169,0) S VALMBCK="R" "RTN","DGPFLMA3",170,0) ; "RTN","DGPFLMA3",171,0) Q "RTN","DGPFLMA4") 0^18^B36618689 "RTN","DGPFLMA4",1,0) DGPFLMA4 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 4/24/03 4:43pm "RTN","DGPFLMA4",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMA4",3,0) ; "RTN","DGPFLMA4",4,0) ;no direct entry "RTN","DGPFLMA4",5,0) QUIT "RTN","DGPFLMA4",6,0) ; "RTN","DGPFLMA4",7,0) ; "RTN","DGPFLMA4",8,0) CO ;Entry point for DGPF CHANGE ASSIGNMENT OWNERSHIP action protocol. "RTN","DGPFLMA4",9,0) ; "RTN","DGPFLMA4",10,0) ; Input: None "RTN","DGPFLMA4",11,0) ; "RTN","DGPFLMA4",12,0) ; Output: "RTN","DGPFLMA4",13,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMA4",14,0) ; "RTN","DGPFLMA4",15,0) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DDWC,DWPK ;input vars for EN^DIWE "RTN","DGPFLMA4",16,0) N DGCROOT ;assignment history comment word processing root "RTN","DGPFLMA4",17,0) N DGABORT ;abort flag for entering assignment narrative "RTN","DGPFLMA4",18,0) N DGOK ;ok flag for entering assignment narrative "RTN","DGPFLMA4",19,0) N DGIEN ;assignment ien "RTN","DGPFLMA4",20,0) N DGPFA ;assignment array "RTN","DGPFLMA4",21,0) N DGPFAH ;assignment history array "RTN","DGPFLMA4",22,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA4",23,0) N DGREASON ;reason if unable to edit assignment "RTN","DGPFLMA4",24,0) N DGPFERR ;if error returned from STOALL api call "RTN","DGPFLMA4",25,0) N SEL ;user selection (list item) "RTN","DGPFLMA4",26,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMA4",27,0) ; "RTN","DGPFLMA4",28,0) ;set screen to full scroll region "RTN","DGPFLMA4",29,0) D FULL^VALM1 "RTN","DGPFLMA4",30,0) ; "RTN","DGPFLMA4",31,0) ;security key check "RTN","DGPFLMA4",32,0) I '$D(^XUSEC("DGPF RECORD FLAG ASSIGNMENT",DUZ)) D Q "RTN","DGPFLMA4",33,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA4",34,0) . W !?6,"You do not have the appropriate Security Key." "RTN","DGPFLMA4",35,0) . D PAUSE^VALM1 "RTN","DGPFLMA4",36,0) . S VALMBCK="R" "RTN","DGPFLMA4",37,0) ; "RTN","DGPFLMA4",38,0) ;is action selection allowed? "RTN","DGPFLMA4",39,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMA4",40,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMA4",41,0) . I '$G(DGDFN) W !?6,"A patient has not been selected." "RTN","DGPFLMA4",42,0) . E W !?6,"There are no record flag assignments for this patient." "RTN","DGPFLMA4",43,0) . D PAUSE^VALM1 "RTN","DGPFLMA4",44,0) . S VALMBCK="R" "RTN","DGPFLMA4",45,0) ; "RTN","DGPFLMA4",46,0) ;allow user to select a SINGLE flag assignment for ownership change "RTN","DGPFLMA4",47,0) S (DGIEN,DGSELECT,VALMBCK)="" "RTN","DGPFLMA4",48,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMA4",49,0) ; "RTN","DGPFLMA4",50,0) ;process user selection "RTN","DGPFLMA4",51,0) S SEL=$O(VALMY("")) "RTN","DGPFLMA4",52,0) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D "RTN","DGPFLMA4",53,0) . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U) "RTN","DGPFLMA4",54,0) . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2) "RTN","DGPFLMA4",55,0) . ; "RTN","DGPFLMA4",56,0) . ;-attempt to obtain lock on assignment record "RTN","DGPFLMA4",57,0) . I '$$LOCK^DGPFAA3(DGIEN) D Q "RTN","DGPFLMA4",58,0) . . W !!,"Record flag assignment currently in use, can not be edited!",*7 "RTN","DGPFLMA4",59,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",60,0) . ; "RTN","DGPFLMA4",61,0) . ;-get assignment into DGPFA array "RTN","DGPFLMA4",62,0) . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q "RTN","DGPFLMA4",63,0) . . W !!,"Unable to retrieve the record flag assignment selected.",*7 "RTN","DGPFLMA4",64,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",65,0) . ; "RTN","DGPFLMA4",66,0) . ;-can site change ownership of the assignment? "RTN","DGPFLMA4",67,0) . I '$$CHGOWN^DGPFAA2(.DGPFA,,.DGREASON) D Q "RTN","DGPFLMA4",68,0) . . W !!,"Changing the ownership of this record flag assignment not allowed.",*7 "RTN","DGPFLMA4",69,0) . . W !," >>> "_$G(DGREASON)_"." "RTN","DGPFLMA4",70,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",71,0) . ; "RTN","DGPFLMA4",72,0) . ;-prompt for new OWNER SITE of the assignment "RTN","DGPFLMA4",73,0) . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Select new owner site for this record flag assignment","","P^4:EMZ") "RTN","DGPFLMA4",74,0) . I DGPFA("OWNER")=+$$SITE^VASITE D "RTN","DGPFLMA4",75,0) . . W !!,"Ownership of this record flag assignment has not been changed!",*7 "RTN","DGPFLMA4",76,0) . . S DGPFA("OWNER")=0 "RTN","DGPFLMA4",77,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",78,0) . Q:(DGPFA("OWNER")'>0) "RTN","DGPFLMA4",79,0) . ; "RTN","DGPFLMA4",80,0) . ;-prompt for APPROVED BY person "RTN","DGPFLMA4",81,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA4",82,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA4",83,0) . ; "RTN","DGPFLMA4",84,0) . ;-allow user to enter HISTORY COMMENTS (edit reason) "RTN","DGPFLMA4",85,0) . S DGCROOT=$NA(^TMP($J,"DGPFCMNT")) ;init WP array for hist comments "RTN","DGPFLMA4",86,0) . K @DGCROOT "RTN","DGPFLMA4",87,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA4",88,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA4",89,0) . . W !!,"Enter the reason for editing this assignment:" ;needed for line editor "RTN","DGPFLMA4",90,0) . . S @DGCROOT@(1,0)="Change of flag assignment ownership. " "RTN","DGPFLMA4",91,0) . . S DIC=$$OREF^DILF(DGCROOT) "RTN","DGPFLMA4",92,0) . . S DIWETXT="Enter the reason for record flag assignment ownership change:" "RTN","DGPFLMA4",93,0) . . ;S DIWETXT="Enter Record Flag Assignment - Edit Reason Text" "RTN","DGPFLMA4",94,0) . . S DIWESUB="Change of Ownership Reason" "RTN","DGPFLMA4",95,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA4",96,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA4",97,0) . . S DDWC="E" ;initially place cursor at end of line 1 "RTN","DGPFLMA4",98,0) . . D EN^DIWE "RTN","DGPFLMA4",99,0) . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q "RTN","DGPFLMA4",100,0) . . W !,"The reason for editing this record flag assignment is required!",*7 "RTN","DGPFLMA4",101,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA4",102,0) . ; "RTN","DGPFLMA4",103,0) . ;-quit if required HISTORY COMMENTS not entered "RTN","DGPFLMA4",104,0) . Q:$G(DGABORT) "RTN","DGPFLMA4",105,0) . ; "RTN","DGPFLMA4",106,0) . ;-place HISTORY COMMENTS into history array "RTN","DGPFLMA4",107,0) . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT "RTN","DGPFLMA4",108,0) . ; "RTN","DGPFLMA4",109,0) . ;-setup remaining assignment history array nodes for filing "RTN","DGPFLMA4",110,0) . S DGPFAH("ACTION")=2 ;continue "RTN","DGPFLMA4",111,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA4",112,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA4",113,0) . ; "RTN","DGPFLMA4",114,0) . ;-relinquishing ownership should remove existing review date "RTN","DGPFLMA4",115,0) . S DGPFA("REVIEWDT")="" "RTN","DGPFLMA4",116,0) . ; "RTN","DGPFLMA4",117,0) . ;-ask user if ok to file ownership change "RTN","DGPFLMA4",118,0) . Q:$$ANSWER^DGPFUT("Would you like to file the assignment ownership change","YES","Y")'>0 "RTN","DGPFLMA4",119,0) . ; "RTN","DGPFLMA4",120,0) . ;-file the assignment and history using STOALL api "RTN","DGPFLMA4",121,0) . W !!,"Updating the ownership of this patient's record flag assignment..." "RTN","DGPFLMA4",122,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA4",123,0) . W !," >>> Update was "_$S(+$G(DGRESULT):"successful",1:"not successful")_"." "RTN","DGPFLMA4",124,0) . ; "RTN","DGPFLMA4",125,0) . ;-- send HL7 ORU msg if editing assignment to a Cat I (NATIONAL) flag "RTN","DGPFLMA4",126,0) . I +$G(DGRESULT),$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA4",127,0) . . W !," >>> HL7 message sent...updating patient's sites of record." "RTN","DGPFLMA4",128,0) . ; "RTN","DGPFLMA4",129,0) . D PAUSE^VALM1 "RTN","DGPFLMA4",130,0) . ; "RTN","DGPFLMA4",131,0) . ;-rebuild list of flag assignments for patient "RTN","DGPFLMA4",132,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA4",133,0) . ; "RTN","DGPFLMA4",134,0) . ;-release lock after CO edit "RTN","DGPFLMA4",135,0) . D UNLOCK^DGPFAA3(DGIEN) "RTN","DGPFLMA4",136,0) ; "RTN","DGPFLMA4",137,0) ;return to LM (refresh screen) "RTN","DGPFLMA4",138,0) S VALMBCK="R" "RTN","DGPFLMA4",139,0) ; "RTN","DGPFLMA4",140,0) Q "RTN","DGPFLMAD") 0^24^B1178565 "RTN","DGPFLMAD",1,0) DGPFLMAD ;ALB/KCL - PRF DISPLAY ASSIGNMENT DETAIL LM SCREEN ; 4/25/03 3:22pm "RTN","DGPFLMAD",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMAD",3,0) ; "RTN","DGPFLMAD",4,0) ;no direct entry "RTN","DGPFLMAD",5,0) QUIT "RTN","DGPFLMAD",6,0) ; "RTN","DGPFLMAD",7,0) EN ;Main entry point for DGPF RECORD FLAG DETAIL list template. "RTN","DGPFLMAD",8,0) ; "RTN","DGPFLMAD",9,0) ; Input: "RTN","DGPFLMAD",10,0) ; DGDFN - ien of PATIENT (#2) file "RTN","DGPFLMAD",11,0) ; DGIEN - ien of PRF ASSIGNMENT (#26.13) file "RTN","DGPFLMAD",12,0) ; "RTN","DGPFLMAD",13,0) ; Output: None "RTN","DGPFLMAD",14,0) ; "RTN","DGPFLMAD",15,0) ;quit if required input parameters not defined "RTN","DGPFLMAD",16,0) Q:'$G(DGDFN) "RTN","DGPFLMAD",17,0) Q:'$G(DGIEN) "RTN","DGPFLMAD",18,0) ; "RTN","DGPFLMAD",19,0) ;display wait msg to user "RTN","DGPFLMAD",20,0) D WAIT^DICD "RTN","DGPFLMAD",21,0) ; "RTN","DGPFLMAD",22,0) ;invoke list manager and load list template "RTN","DGPFLMAD",23,0) D EN^VALM("DGPF ASSIGNMENT DETAIL") "RTN","DGPFLMAD",24,0) Q "RTN","DGPFLMAD",25,0) ; "RTN","DGPFLMAD",26,0) ; "RTN","DGPFLMAD",27,0) HDR ;Header Code "RTN","DGPFLMAD",28,0) D BLDHDR^DGPFLMU(DGDFN,.VALMHDR) "RTN","DGPFLMAD",29,0) Q "RTN","DGPFLMAD",30,0) ; "RTN","DGPFLMAD",31,0) ; "RTN","DGPFLMAD",32,0) INIT ;Init variables and list array "RTN","DGPFLMAD",33,0) D BLD "RTN","DGPFLMAD",34,0) Q "RTN","DGPFLMAD",35,0) ; "RTN","DGPFLMAD",36,0) ; "RTN","DGPFLMAD",37,0) BLD ;Build record flag detail LM screen "RTN","DGPFLMAD",38,0) D CLEAN^VALM10 "RTN","DGPFLMAD",39,0) K VALMHDR "RTN","DGPFLMAD",40,0) K ^TMP("DGPFDET",$J) "RTN","DGPFLMAD",41,0) ; "RTN","DGPFLMAD",42,0) ;init number of lines in list "RTN","DGPFLMAD",43,0) S VALMCNT=0 "RTN","DGPFLMAD",44,0) ; "RTN","DGPFLMAD",45,0) ;build header "RTN","DGPFLMAD",46,0) D HDR "RTN","DGPFLMAD",47,0) ; "RTN","DGPFLMAD",48,0) ;build list area for record flag detail "RTN","DGPFLMAD",49,0) D EN^DGPFLMU1("DGPFDET",DGIEN,DGDFN,.VALMCNT) "RTN","DGPFLMAD",50,0) ; "RTN","DGPFLMAD",51,0) Q "RTN","DGPFLMAD",52,0) ; "RTN","DGPFLMAD",53,0) ; "RTN","DGPFLMAD",54,0) HELP ;Help Code "RTN","DGPFLMAD",55,0) N X "RTN","DGPFLMAD",56,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMAD",57,0) Q "RTN","DGPFLMAD",58,0) ; "RTN","DGPFLMAD",59,0) ; "RTN","DGPFLMAD",60,0) EXIT ;Exit Code "RTN","DGPFLMAD",61,0) D CLEAN^VALM10 "RTN","DGPFLMAD",62,0) D CLEAR^VALM1 "RTN","DGPFLMAD",63,0) K ^TMP("DGPFDET",$J) "RTN","DGPFLMAD",64,0) Q "RTN","DGPFLMAD",65,0) ; "RTN","DGPFLMAD",66,0) ; "RTN","DGPFLMAD",67,0) EXPND ;Expand Code "RTN","DGPFLMAD",68,0) Q "RTN","DGPFLMD") 0^63^B1757260 "RTN","DGPFLMD",1,0) DGPFLMD ;ALB/RPM - PRF DISPLAY ACTIVE FLAG ASSIGNMENTS LM ; 5/20/03 2:49pm "RTN","DGPFLMD",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMD",3,0) ; "RTN","DGPFLMD",4,0) ;no direct entry "RTN","DGPFLMD",5,0) QUIT "RTN","DGPFLMD",6,0) ; "RTN","DGPFLMD",7,0) EN(DGDFN,DGPFAPI) ;DGPF ACTIVE ASSIGNMENTS list template main entry point "RTN","DGPFLMD",8,0) ; "RTN","DGPFLMD",9,0) ; Input: "RTN","DGPFLMD",10,0) ; DGDFN - IEN of record in PATIENT (#2) file "RTN","DGPFLMD",11,0) ; DGPFAPI - data array of active patient record flag assignments "RTN","DGPFLMD",12,0) ; "RTN","DGPFLMD",13,0) ; Output: None "RTN","DGPFLMD",14,0) ; "RTN","DGPFLMD",15,0) ; "RTN","DGPFLMD",16,0) ;quit if required input not defined "RTN","DGPFLMD",17,0) Q:+$G(DGDFN)'>0 "RTN","DGPFLMD",18,0) Q:'$D(DGPFAPI) "RTN","DGPFLMD",19,0) ; "RTN","DGPFLMD",20,0) ;display wait msg to user "RTN","DGPFLMD",21,0) D WAIT^DICD "RTN","DGPFLMD",22,0) ; "RTN","DGPFLMD",23,0) ;invoke DISPLAY list template "RTN","DGPFLMD",24,0) D EN^VALM("DGPF ACTIVE ASSIGNMENTS") "RTN","DGPFLMD",25,0) Q "RTN","DGPFLMD",26,0) ; "RTN","DGPFLMD",27,0) ; "RTN","DGPFLMD",28,0) HDR ;Header Code "RTN","DGPFLMD",29,0) ; "RTN","DGPFLMD",30,0) D BLDHDR^DGPFLMU(DGDFN,.VALMHDR) "RTN","DGPFLMD",31,0) S VALMHDR(3)=" " "RTN","DGPFLMD",32,0) S VALMHDR(4)=$$CJ^XLFSTR("<<< Active Patient Record Flag Assignments >>>",80) "RTN","DGPFLMD",33,0) Q "RTN","DGPFLMD",34,0) ; "RTN","DGPFLMD",35,0) ; "RTN","DGPFLMD",36,0) INIT ;Init variables and list array "RTN","DGPFLMD",37,0) ; "RTN","DGPFLMD",38,0) D BLD "RTN","DGPFLMD",39,0) ; "RTN","DGPFLMD",40,0) Q "RTN","DGPFLMD",41,0) ; "RTN","DGPFLMD",42,0) ; "RTN","DGPFLMD",43,0) BLD ;Build flag detail screen (list area) "RTN","DGPFLMD",44,0) ; "RTN","DGPFLMD",45,0) D CLEAN^VALM10 "RTN","DGPFLMD",46,0) K VALMHDR "RTN","DGPFLMD",47,0) K ^TMP("DGPFACT",$J) "RTN","DGPFLMD",48,0) ; "RTN","DGPFLMD",49,0) ;init number of lines in list "RTN","DGPFLMD",50,0) S VALMCNT=0 "RTN","DGPFLMD",51,0) ; "RTN","DGPFLMD",52,0) ;build header "RTN","DGPFLMD",53,0) D HDR "RTN","DGPFLMD",54,0) ; "RTN","DGPFLMD",55,0) ;build list area for flag detail "RTN","DGPFLMD",56,0) D EN^DGPFLMD1("DGPFACT",.DGPFAPI,.VALMCNT) "RTN","DGPFLMD",57,0) ; "RTN","DGPFLMD",58,0) Q "RTN","DGPFLMD",59,0) ; "RTN","DGPFLMD",60,0) ; "RTN","DGPFLMD",61,0) HELP ;Help Code "RTN","DGPFLMD",62,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMD",63,0) Q "RTN","DGPFLMD",64,0) ; "RTN","DGPFLMD",65,0) ; "RTN","DGPFLMD",66,0) EXIT ;Exit Code "RTN","DGPFLMD",67,0) ; "RTN","DGPFLMD",68,0) D CLEAN^VALM10 "RTN","DGPFLMD",69,0) D CLEAR^VALM1 "RTN","DGPFLMD",70,0) K ^TMP("DGPFACT",$J) "RTN","DGPFLMD",71,0) Q "RTN","DGPFLMD",72,0) ; "RTN","DGPFLMD",73,0) ; "RTN","DGPFLMD",74,0) EXPND ;Expand Code "RTN","DGPFLMD",75,0) Q "RTN","DGPFLMD1") 0^64^B11731182 "RTN","DGPFLMD1",1,0) DGPFLMD1 ;ALB/RPM - PRF DISPLAY ACTIVE FLAG ASSIGNMENTS LM ; 5/20/03 2:50pm "RTN","DGPFLMD1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMD1",3,0) ; "RTN","DGPFLMD1",4,0) EN(DGARRY,DGPFAPI,DGCNT) ; "RTN","DGPFLMD1",5,0) ; "RTN","DGPFLMD1",6,0) N DGFLG "RTN","DGPFLMD1",7,0) N DGI "RTN","DGPFLMD1",8,0) N DGLINE "RTN","DGPFLMD1",9,0) N DGNARR "RTN","DGPFLMD1",10,0) N DGNUM "RTN","DGPFLMD1",11,0) N DGTEXT "RTN","DGPFLMD1",12,0) ; "RTN","DGPFLMD1",13,0) S (DGNUM,DGFLG,DGLINE)=0 "RTN","DGPFLMD1",14,0) F S DGFLG=$O(DGPFAPI(DGFLG)) Q:'DGFLG D "RTN","DGPFLMD1",15,0) . S DGNUM=DGNUM+1 "RTN","DGPFLMD1",16,0) . ; "RTN","DGPFLMD1",17,0) . ;blank line(s) "RTN","DGPFLMD1",18,0) . F DGI=1:1:$S(DGNUM>1:2,1:1) D "RTN","DGPFLMD1",19,0) . . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",20,0) . . D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT) "RTN","DGPFLMD1",21,0) . ; "RTN","DGPFLMD1",22,0) . ;Flag Name "RTN","DGPFLMD1",23,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",24,0) . S DGTEXT=DGNUM_"." "RTN","DGPFLMD1",25,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMD1",26,0) . S DGTEXT="Flag Name: " "RTN","DGPFLMD1",27,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT) "RTN","DGPFLMD1",28,0) . S DGTEXT="<"_$P(DGPFAPI(DGFLG,"FLAG"),U,2)_">" "RTN","DGPFLMD1",29,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,16,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMD1",30,0) . ; "RTN","DGPFLMD1",31,0) . ;Category "RTN","DGPFLMD1",32,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",33,0) . S DGTEXT="Category: "_$P(DGPFAPI(DGFLG,"CATEGORY"),U,2) "RTN","DGPFLMD1",34,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,6,,,.DGCNT) "RTN","DGPFLMD1",35,0) . ; "RTN","DGPFLMD1",36,0) . ;Flag Type "RTN","DGPFLMD1",37,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",38,0) . S DGTEXT="Type: "_$P(DGPFAPI(DGFLG,"FLAGTYPE"),U,2) "RTN","DGPFLMD1",39,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT) "RTN","DGPFLMD1",40,0) . ; "RTN","DGPFLMD1",41,0) . ;Assignment Narrative "RTN","DGPFLMD1",42,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",43,0) . D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT) "RTN","DGPFLMD1",44,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",45,0) . S DGTEXT="Assignment Narrative:" "RTN","DGPFLMD1",46,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMD1",47,0) . S DGNARR=0 "RTN","DGPFLMD1",48,0) . F S DGNARR=$O(DGPFAPI(DGFLG,"NARR",DGNARR)) Q:'DGNARR D "RTN","DGPFLMD1",49,0) . . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",50,0) . . S DGTEXT=$G(DGPFAPI(DGFLG,"NARR",DGNARR,0)) "RTN","DGPFLMD1",51,0) . . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,,,.DGCNT) "RTN","DGPFLMD1",52,0) . ; "RTN","DGPFLMD1",53,0) . ;blank line "RTN","DGPFLMD1",54,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",55,0) . D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT) "RTN","DGPFLMD1",56,0) . ; "RTN","DGPFLMD1",57,0) . ;assignment details header "RTN","DGPFLMD1",58,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",59,0) . S DGTEXT="Assignment Details:" "RTN","DGPFLMD1",60,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMD1",61,0) . ; "RTN","DGPFLMD1",62,0) . ;Assignment Date "RTN","DGPFLMD1",63,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",64,0) . S DGTEXT="Initial Assignment: "_$$FMTE^XLFDT($P(DGPFAPI(DGFLG,"ASSIGNDT"),U),"D") "RTN","DGPFLMD1",65,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,3,,,.DGCNT) "RTN","DGPFLMD1",66,0) . ; "RTN","DGPFLMD1",67,0) . ;Approved By "RTN","DGPFLMD1",68,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",69,0) . S DGTEXT="Approved By: "_$P(DGPFAPI(DGFLG,"APPRVBY"),U,2) "RTN","DGPFLMD1",70,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT) "RTN","DGPFLMD1",71,0) . ; "RTN","DGPFLMD1",72,0) . ;Review Date "RTN","DGPFLMD1",73,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",74,0) . S DGTEXT="Next Review Date: "_$S($P(DGPFAPI(DGFLG,"REVIEWDT"),U)>0:$$FMTE^XLFDT($P(DGPFAPI(DGFLG,"REVIEWDT"),U),"D"),1:"N/A") "RTN","DGPFLMD1",75,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT) "RTN","DGPFLMD1",76,0) . ; "RTN","DGPFLMD1",77,0) . ;Owner Site "RTN","DGPFLMD1",78,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",79,0) . S DGTEXT="Owner Site: "_$P(DGPFAPI(DGFLG,"OWNER"),U,2) "RTN","DGPFLMD1",80,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,11,,,.DGCNT) "RTN","DGPFLMD1",81,0) . ; "RTN","DGPFLMD1",82,0) . ;Originating Site "RTN","DGPFLMD1",83,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMD1",84,0) . S DGTEXT="Originating Site: "_$P(DGPFAPI(DGFLG,"ORIGSITE"),U,2) "RTN","DGPFLMD1",85,0) . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT) "RTN","DGPFLMD1",86,0) ; "RTN","DGPFLMD1",87,0) Q "RTN","DGPFLMU") 0^25^B15922307 "RTN","DGPFLMU",1,0) DGPFLMU ;ALB/KCL - PRF ASSIGNMENT LISTMAN UTILITIES ; 4/25/03 3:39pm "RTN","DGPFLMU",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMU",3,0) ; "RTN","DGPFLMU",4,0) ;no direct entry "RTN","DGPFLMU",5,0) QUIT "RTN","DGPFLMU",6,0) ; "RTN","DGPFLMU",7,0) BLDHDR(DGDFN,DGPFHDR) ;This procedure builds the VALMHDR array to display the ListMan header. "RTN","DGPFLMU",8,0) ; "RTN","DGPFLMU",9,0) ; Supported DBIA #2701: The supported DBIA is used to access the "RTN","DGPFLMU",10,0) ; MPI functions to retrieve the ICN and CMOR. "RTN","DGPFLMU",11,0) ; "RTN","DGPFLMU",12,0) ; Input: "RTN","DGPFLMU",13,0) ; DGDFN - internal entry number of PATIENT (#2) file "RTN","DGPFLMU",14,0) ; DGPFHDR - header array passed by reference "RTN","DGPFLMU",15,0) ; "RTN","DGPFLMU",16,0) ; Output: "RTN","DGPFLMU",17,0) ; DGPFHDR - header array "RTN","DGPFLMU",18,0) ; "RTN","DGPFLMU",19,0) N DGCMOR ;CIRN Master of Record "RTN","DGPFLMU",20,0) N DGICN ;Integrated Control Number "RTN","DGPFLMU",21,0) N DGPFPAT ;Patient identifying info "RTN","DGPFLMU",22,0) ; "RTN","DGPFLMU",23,0) ;retrieve patient identifying info "RTN","DGPFLMU",24,0) I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT) "RTN","DGPFLMU",25,0) ; "RTN","DGPFLMU",26,0) ;set 1st line of header "RTN","DGPFLMU",27,0) S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" " "RTN","DGPFLMU",28,0) S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80) "RTN","DGPFLMU",29,0) S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80) "RTN","DGPFLMU",30,0) ; "RTN","DGPFLMU",31,0) ;set 2nd line of header "RTN","DGPFLMU",32,0) S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFLMU",33,0) S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN) "RTN","DGPFLMU",34,0) S DGPFHDR(2)=" ICN: "_DGICN "RTN","DGPFLMU",35,0) S DGCMOR=$$CMOR2^MPIF001(DGDFN) "RTN","DGPFLMU",36,0) S DGCMOR=$S(DGCMOR<0:$P(DGCMOR,U,2),1:DGCMOR) "RTN","DGPFLMU",37,0) S DGCMOR="CMOR: "_DGCMOR "RTN","DGPFLMU",38,0) S DGPFHDR(2)=$$SETSTR^VALM1(DGCMOR,DGPFHDR(2),53,27) "RTN","DGPFLMU",39,0) Q "RTN","DGPFLMU",40,0) ; "RTN","DGPFLMU",41,0) ; "RTN","DGPFLMU",42,0) BLDLIST(DGDFN) ;This procedure will build list of flag assignments for a patient for display in ListMan. "RTN","DGPFLMU",43,0) ; "RTN","DGPFLMU",44,0) ; Input: "RTN","DGPFLMU",45,0) ; DGDFN - internal entry number of PATIENT (#2) file "RTN","DGPFLMU",46,0) ; "RTN","DGPFLMU",47,0) ; Output: None "RTN","DGPFLMU",48,0) ; "RTN","DGPFLMU",49,0) N DGIEN ;ien of assignment "RTN","DGPFLMU",50,0) N DGIENS ;array of assignment ien's "RTN","DGPFLMU",51,0) N DGPTR ;pointer to last assignment history record "RTN","DGPFLMU",52,0) N DGTXT ;msg text if no assignments for patient "RTN","DGPFLMU",53,0) ; "RTN","DGPFLMU",54,0) ;kill data and video cntrl arrays associated with active list "RTN","DGPFLMU",55,0) D CLEAN^VALM10 "RTN","DGPFLMU",56,0) ; "RTN","DGPFLMU",57,0) ;if no assignments, display msg, quit "RTN","DGPFLMU",58,0) K DGIENS "RTN","DGPFLMU",59,0) I '$$GETALL^DGPFAA(DGDFN,.DGIENS) D Q "RTN","DGPFLMU",60,0) . S DGTXT=" Selected patient has no record flag assignments on file." "RTN","DGPFLMU",61,0) . D SET^VALM10(1,"") "RTN","DGPFLMU",62,0) . D SET^VALM10(2,DGTXT) "RTN","DGPFLMU",63,0) . D CNTRL^VALM10(2,4,$L(DGTXT),$G(IOINHI),$G(IOINORM)) "RTN","DGPFLMU",64,0) . S VALMCNT=2 "RTN","DGPFLMU",65,0) ; "RTN","DGPFLMU",66,0) ;if assignments, get data and build list "RTN","DGPFLMU",67,0) S DGIEN=0,VALMCNT=0 "RTN","DGPFLMU",68,0) F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D "RTN","DGPFLMU",69,0) . ;-get assignment "RTN","DGPFLMU",70,0) . K DGPFA "RTN","DGPFLMU",71,0) . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFLMU",72,0) . ;-get initial assignment history "RTN","DGPFLMU",73,0) . K DGPFAH "RTN","DGPFLMU",74,0) . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFLMU",75,0) . ;-get 'initial assignment' date "RTN","DGPFLMU",76,0) . S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFLMU",77,0) . Q:'DGPFAH("INITASSIGN") "RTN","DGPFLMU",78,0) . ;-increment line number count "RTN","DGPFLMU",79,0) . S VALMCNT=VALMCNT+1 "RTN","DGPFLMU",80,0) . ;-build list "RTN","DGPFLMU",81,0) . D BLDLIN(VALMCNT,.DGPFA,.DGPFAH,DGIEN) "RTN","DGPFLMU",82,0) ; "RTN","DGPFLMU",83,0) Q "RTN","DGPFLMU",84,0) ; "RTN","DGPFLMU",85,0) ; "RTN","DGPFLMU",86,0) BLDLIN(DGLNUM,DGPFA,DGPFAH,DGIEN) ;This procedure will build and setup ListMan lines and array. "RTN","DGPFLMU",87,0) ; "RTN","DGPFLMU",88,0) ; Input: "RTN","DGPFLMU",89,0) ; DGLNUM - line number "RTN","DGPFLMU",90,0) ; DGPFA - array containing assignment, passed by reference "RTN","DGPFLMU",91,0) ; DGPFAH - array containing assignment history, passed by reference "RTN","DGPFLMU",92,0) ; DGIEN - internal entry number of assignment "RTN","DGPFLMU",93,0) ; "RTN","DGPFLMU",94,0) ; Output: None "RTN","DGPFLMU",95,0) ; "RTN","DGPFLMU",96,0) N DGTXT ;used as temporary text field "RTN","DGPFLMU",97,0) N DGLINE ;string to insert field data "RTN","DGPFLMU",98,0) S DGLINE="" ;init "RTN","DGPFLMU",99,0) S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3) "RTN","DGPFLMU",100,0) ; "RTN","DGPFLMU",101,0) ;flag name "RTN","DGPFLMU",102,0) S DGTXT=$P($G(DGPFA("FLAG")),U,2) "RTN","DGPFLMU",103,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG") "RTN","DGPFLMU",104,0) ; "RTN","DGPFLMU",105,0) ;initial assignment date "RTN","DGPFLMU",106,0) S DGTXT=$$FDATE^VALM1(+$G(DGPFAH("INITASSIGN"))) "RTN","DGPFLMU",107,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE") "RTN","DGPFLMU",108,0) ; "RTN","DGPFLMU",109,0) ;approved by "RTN","DGPFLMU",110,0) S DGTXT=$P($G(DGPFAH("APPRVBY")),U,2) "RTN","DGPFLMU",111,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"APPROV BY") "RTN","DGPFLMU",112,0) ; "RTN","DGPFLMU",113,0) ;review date "RTN","DGPFLMU",114,0) S DGTXT=+$G(DGPFA("REVIEWDT")) "RTN","DGPFLMU",115,0) S DGTXT=$S(DGTXT:$$FDATE^VALM1(DGTXT),1:"N/A") "RTN","DGPFLMU",116,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"REVIEW DATE") "RTN","DGPFLMU",117,0) ; "RTN","DGPFLMU",118,0) ;status/active (yes/no) "RTN","DGPFLMU",119,0) S DGTXT=$P($G(DGPFA("STATUS")),U) "RTN","DGPFLMU",120,0) S DGTXT=$S(DGTXT=1:"YES",1:"NO") "RTN","DGPFLMU",121,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS") "RTN","DGPFLMU",122,0) ; "RTN","DGPFLMU",123,0) ;local (yes/no) "RTN","DGPFLMU",124,0) S DGTXT="NO" "RTN","DGPFLMU",125,0) I $P($G(DGPFA("FLAG")),U)["26.11" S DGTXT="YES" "RTN","DGPFLMU",126,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"LOCAL") "RTN","DGPFLMU",127,0) ; "RTN","DGPFLMU",128,0) ;construct initial list array "RTN","DGPFLMU",129,0) D SET^VALM10(DGLNUM,DGLINE,DGLNUM) "RTN","DGPFLMU",130,0) ; "RTN","DGPFLMU",131,0) ;set assignment ien and pt DFN into index "RTN","DGPFLMU",132,0) S @VALMAR@("IDX",DGLNUM,DGLNUM)=$G(DGIEN)_U_+$G(DGPFA("DFN")) "RTN","DGPFLMU",133,0) ; "RTN","DGPFLMU",134,0) Q "RTN","DGPFLMU1") 0^26^B40071877 "RTN","DGPFLMU1",1,0) DGPFLMU1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM UTILITIES CONT ; 02/04/03 "RTN","DGPFLMU1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFLMU1",3,0) ; "RTN","DGPFLMU1",4,0) ;no direct entry "RTN","DGPFLMU1",5,0) QUIT "RTN","DGPFLMU1",6,0) ; "RTN","DGPFLMU1",7,0) EN(DGARY,DGIEN,DGDFN,DGCNT) ;Entry point to build flag assignment detail list area. "RTN","DGPFLMU1",8,0) ; "RTN","DGPFLMU1",9,0) ; Input: "RTN","DGPFLMU1",10,0) ; DGARY - global array subscript "RTN","DGPFLMU1",11,0) ; DGIEN - ien of PATIENT ASSIGNMENT (#26.13) file "RTN","DGPFLMU1",12,0) ; DGDFN - ien of PATIENT (#2) file "RTN","DGPFLMU1",13,0) ; "RTN","DGPFLMU1",14,0) ; Output: "RTN","DGPFLMU1",15,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",16,0) ; "RTN","DGPFLMU1",17,0) N DGHIEN ;assignment history ien "RTN","DGPFLMU1",18,0) N DGHIENS ;contains assignment history ien's "RTN","DGPFLMU1",19,0) N DGHISCNT ;count of history records "RTN","DGPFLMU1",20,0) N DGLINE ;line counter "RTN","DGPFLMU1",21,0) N DGPFA ;assignment array "RTN","DGPFLMU1",22,0) N DGPFAH ;assignment history array "RTN","DGPFLMU1",23,0) N DGPFF ;flag array "RTN","DGPFLMU1",24,0) N DGSUB ;subscript of history ien's array "RTN","DGPFLMU1",25,0) ; "RTN","DGPFLMU1",26,0) ;init variables "RTN","DGPFLMU1",27,0) S DGCNT=0 "RTN","DGPFLMU1",28,0) S (DGLINE,VALMBEG)=1 "RTN","DGPFLMU1",29,0) K DGPFA "RTN","DGPFLMU1",30,0) K DGPFAH "RTN","DGPFLMU1",31,0) K DGPFF "RTN","DGPFLMU1",32,0) K DGHIENS "RTN","DGPFLMU1",33,0) ; "RTN","DGPFLMU1",34,0) Q:'$G(DGIEN) "RTN","DGPFLMU1",35,0) ; "RTN","DGPFLMU1",36,0) ;get assignment into DGPFA array "RTN","DGPFLMU1",37,0) Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFLMU1",38,0) S DGPFA("INITASSIGN")=$$GETADT^DGPFAAH(DGIEN) ;initial assign date "RTN","DGPFLMU1",39,0) ; "RTN","DGPFLMU1",40,0) ;get most recent assignment history and place in DGPFAH array "RTN","DGPFLMU1",41,0) Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFLMU1",42,0) ; "RTN","DGPFLMU1",43,0) ;get record flag into DGPFF array "RTN","DGPFLMU1",44,0) Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFF) "RTN","DGPFLMU1",45,0) ; "RTN","DGPFLMU1",46,0) ;build Assignment Details area "RTN","DGPFLMU1",47,0) D ASGN(DGARY,.DGPFA,.DGPFAH,.DGPFF,.DGLINE,.DGCNT) "RTN","DGPFLMU1",48,0) ; "RTN","DGPFLMU1",49,0) ;build Assignment History heading "RTN","DGPFLMU1",50,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",51,0) D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT) "RTN","DGPFLMU1",52,0) D SET(DGARY,DGLINE,"",30,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",53,0) ; "RTN","DGPFLMU1",54,0) ;get all history ien's associated with the assignment "RTN","DGPFLMU1",55,0) Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS) "RTN","DGPFLMU1",56,0) ; "RTN","DGPFLMU1",57,0) ;reverse loop through each assignment history ien "RTN","DGPFLMU1",58,0) ;and get record into DGPFAH array "RTN","DGPFLMU1",59,0) S DGHISCNT=0,DGSUB=9999999.999999 "RTN","DGPFLMU1",60,0) F S DGSUB=$O(DGHIENS(DGSUB),-1) Q:DGSUB="" D "RTN","DGPFLMU1",61,0) . S DGHIEN=+$G(DGHIENS(DGSUB)) "RTN","DGPFLMU1",62,0) . K DGPFAH "RTN","DGPFLMU1",63,0) . I $$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D "RTN","DGPFLMU1",64,0) . . ; "RTN","DGPFLMU1",65,0) . . ;-history record counter "RTN","DGPFLMU1",66,0) . . S DGHISCNT=DGHISCNT+1 "RTN","DGPFLMU1",67,0) . . ; "RTN","DGPFLMU1",68,0) . . ;-build assignment history area "RTN","DGPFLMU1",69,0) . . D HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT) "RTN","DGPFLMU1",70,0) Q "RTN","DGPFLMU1",71,0) ; "RTN","DGPFLMU1",72,0) ; "RTN","DGPFLMU1",73,0) ASGN(DGARY,DGPFA,DGPFAH,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT details. "RTN","DGPFLMU1",74,0) ; "RTN","DGPFLMU1",75,0) ; Input: "RTN","DGPFLMU1",76,0) ; DGARY - global array subscript "RTN","DGPFLMU1",77,0) ; DGPFF - flag array, pass by reference "RTN","DGPFLMU1",78,0) ; DGPFA - assignment array, pass by reference "RTN","DGPFLMU1",79,0) ; DGPFAH - assignment history array, pass by reference "RTN","DGPFLMU1",80,0) ; DGLINE - line counter "RTN","DGPFLMU1",81,0) ; "RTN","DGPFLMU1",82,0) ; Output: "RTN","DGPFLMU1",83,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",84,0) ; "RTN","DGPFLMU1",85,0) ;temporary variables used "RTN","DGPFLMU1",86,0) N DGSUB "RTN","DGPFLMU1",87,0) N DGTMP "RTN","DGPFLMU1",88,0) ; "RTN","DGPFLMU1",89,0) ;set flag name "RTN","DGPFLMU1",90,0) D SET(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),12,,,.DGCNT) "RTN","DGPFLMU1",91,0) ; "RTN","DGPFLMU1",92,0) ;set flag type "RTN","DGPFLMU1",93,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",94,0) D SET(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),12,,,.DGCNT) "RTN","DGPFLMU1",95,0) ; "RTN","DGPFLMU1",96,0) ;set flag category "RTN","DGPFLMU1",97,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",98,0) S DGTMP=$S($P($G(DGPFA("FLAG")),U)["26.11":"II (LOCAL)",1:"I (NATIONAL)") "RTN","DGPFLMU1",99,0) D SET(DGARY,DGLINE,"Flag Category: "_DGTMP,8,,,.DGCNT) "RTN","DGPFLMU1",100,0) ; "RTN","DGPFLMU1",101,0) ;set flag assignment status "RTN","DGPFLMU1",102,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",103,0) D SET(DGARY,DGLINE,"Assignment Status: "_$P($G(DGPFA("STATUS")),U,2),4,,,.DGCNT) "RTN","DGPFLMU1",104,0) ; "RTN","DGPFLMU1",105,0) ;set initial assignment date "RTN","DGPFLMU1",106,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",107,0) D SET(DGARY,DGLINE,"Initial Assignment: "_$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U)),3,,,.DGCNT) "RTN","DGPFLMU1",108,0) ; "RTN","DGPFLMU1",109,0) ;set last review date (do not set if only initial assignment) "RTN","DGPFLMU1",110,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",111,0) I (+$G(DGPFAH("ASSIGNDT")))=(+$G(DGPFA("INITASSIGN"))) D "RTN","DGPFLMU1",112,0) . S DGTMP="N/A" "RTN","DGPFLMU1",113,0) E S DGTMP=$$FDATE^VALM1(+$G(DGPFAH("ASSIGNDT"))) "RTN","DGPFLMU1",114,0) D SET(DGARY,DGLINE,"Last Review Date: "_DGTMP,5,,,.DGCNT) "RTN","DGPFLMU1",115,0) ; "RTN","DGPFLMU1",116,0) ;set next review date "RTN","DGPFLMU1",117,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",118,0) S DGTMP=+$G(DGPFA("REVIEWDT")) "RTN","DGPFLMU1",119,0) S DGTMP=$S(DGTMP:$$FDATE^VALM1(DGTMP),1:"N/A") "RTN","DGPFLMU1",120,0) D SET(DGARY,DGLINE,"Next Review Date: "_DGTMP,5,,,.DGCNT) "RTN","DGPFLMU1",121,0) ; "RTN","DGPFLMU1",122,0) ;set owner site "RTN","DGPFLMU1",123,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",124,0) D SET(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2),11,,,.DGCNT) "RTN","DGPFLMU1",125,0) ; "RTN","DGPFLMU1",126,0) ;set originating site "RTN","DGPFLMU1",127,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",128,0) D SET(DGARY,DGLINE,"Originating Site: "_$P($G(DGPFA("ORIGSITE")),U,2),5,,,.DGCNT) "RTN","DGPFLMU1",129,0) ; "RTN","DGPFLMU1",130,0) ;set assignment narrative "RTN","DGPFLMU1",131,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",132,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",133,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",134,0) D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",135,0) I '$D(DGPFA("NARR",1,0)) D Q "RTN","DGPFLMU1",136,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",137,0) . D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT) "RTN","DGPFLMU1",138,0) S (DGSUB,DGTMP)="" "RTN","DGPFLMU1",139,0) F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB D "RTN","DGPFLMU1",140,0) . S DGTMP=$G(DGPFA("NARR",DGSUB,0)) "RTN","DGPFLMU1",141,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",142,0) . D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT) "RTN","DGPFLMU1",143,0) ; "RTN","DGPFLMU1",144,0) ;set blank lines "RTN","DGPFLMU1",145,0) S DGLINE=DGLINE+2 "RTN","DGPFLMU1",146,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",147,0) ; "RTN","DGPFLMU1",148,0) Q "RTN","DGPFLMU1",149,0) ; "RTN","DGPFLMU1",150,0) ; "RTN","DGPFLMU1",151,0) HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG ASSIGNMENT HISTORY details. "RTN","DGPFLMU1",152,0) ; "RTN","DGPFLMU1",153,0) ; Input: "RTN","DGPFLMU1",154,0) ; DGARY - global array subscript "RTN","DGPFLMU1",155,0) ; DGPFAH - assignment history array, pass by reference "RTN","DGPFLMU1",156,0) ; DGLINE - line counter "RTN","DGPFLMU1",157,0) ; "RTN","DGPFLMU1",158,0) ; Output: "RTN","DGPFLMU1",159,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",160,0) ; "RTN","DGPFLMU1",161,0) ;temporary variables used "RTN","DGPFLMU1",162,0) N DGTMP "RTN","DGPFLMU1",163,0) N DGSUB "RTN","DGPFLMU1",164,0) ; "RTN","DGPFLMU1",165,0) ;set blank line "RTN","DGPFLMU1",166,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",167,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",168,0) ; "RTN","DGPFLMU1",169,0) ;add an additional blank line except on the first history "RTN","DGPFLMU1",170,0) I DGHISCNT>1 D "RTN","DGPFLMU1",171,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",172,0) . D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",173,0) ; "RTN","DGPFLMU1",174,0) ;set action "RTN","DGPFLMU1",175,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",176,0) S DGTMP=DGHISCNT_"." "RTN","DGPFLMU1",177,0) D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",178,0) D SET(DGARY,DGLINE,"Action: "_$P($G(DGPFAH("ACTION")),U,2),10,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",179,0) ; "RTN","DGPFLMU1",180,0) ;set assignment date "RTN","DGPFLMU1",181,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",182,0) D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT) "RTN","DGPFLMU1",183,0) ; "RTN","DGPFLMU1",184,0) ;set entered by "RTN","DGPFLMU1",185,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",186,0) D SET(DGARY,DGLINE,"Entered By: "_$P($G(DGPFAH("ENTERBY")),U,2),6,,,.DGCNT) "RTN","DGPFLMU1",187,0) ; "RTN","DGPFLMU1",188,0) ;set approved by "RTN","DGPFLMU1",189,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",190,0) D SET(DGARY,DGLINE,"Approved By: "_$P($G(DGPFAH("APPRVBY")),U,2),5,,,.DGCNT) "RTN","DGPFLMU1",191,0) ; "RTN","DGPFLMU1",192,0) ;set history comments "RTN","DGPFLMU1",193,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",194,0) D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT) "RTN","DGPFLMU1",195,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",196,0) D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT) "RTN","DGPFLMU1",197,0) I $D(DGPFAH("COMMENT",1,0)) D "RTN","DGPFLMU1",198,0) . S (DGSUB,DGTMP)="" "RTN","DGPFLMU1",199,0) . F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D "RTN","DGPFLMU1",200,0) .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0)) "RTN","DGPFLMU1",201,0) .. S DGLINE=DGLINE+1 "RTN","DGPFLMU1",202,0) .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT) "RTN","DGPFLMU1",203,0) E D "RTN","DGPFLMU1",204,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",205,0) . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT) "RTN","DGPFLMU1",206,0) ; "RTN","DGPFLMU1",207,0) Q "RTN","DGPFLMU1",208,0) ; "RTN","DGPFLMU1",209,0) ; "RTN","DGPFLMU1",210,0) SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;This procedure will set the lines of flag assignment details into the LM display area. "RTN","DGPFLMU1",211,0) ; "RTN","DGPFLMU1",212,0) ; Input: "RTN","DGPFLMU1",213,0) ; DGARY - global array subscript "RTN","DGPFLMU1",214,0) ; DGLINE - line number "RTN","DGPFLMU1",215,0) ; DGTEXT - text "RTN","DGPFLMU1",216,0) ; DGCOL - starting column "RTN","DGPFLMU1",217,0) ; DGON - highlighting on "RTN","DGPFLMU1",218,0) ; DGOFF - highlighting off "RTN","DGPFLMU1",219,0) ; "RTN","DGPFLMU1",220,0) ; Output: "RTN","DGPFLMU1",221,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",222,0) ; "RTN","DGPFLMU1",223,0) N DGX ;temp variable for line of display text "RTN","DGPFLMU1",224,0) ; "RTN","DGPFLMU1",225,0) S DGCNT=DGLINE "RTN","DGPFLMU1",226,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLMU1",227,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLMU1",228,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLMU1",229,0) Q "RTN","DGPFPARM") 0^61^B1696408 "RTN","DGPFPARM",1,0) DGPFPARM ;ALB/RPM - PRF PARAMETER FILE EDIT ; 4/30/03 "RTN","DGPFPARM",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFPARM",3,0) ; "RTN","DGPFPARM",4,0) Q ;no direct entry "RTN","DGPFPARM",5,0) ; "RTN","DGPFPARM",6,0) EN ; "RTN","DGPFPARM",7,0) N DA,DD,DO,DIC,DIE,DINUM,DR,X,Y "RTN","DGPFPARM",8,0) ; "RTN","DGPFPARM",9,0) W !!,"Patient Record Flag Parameter Enter/Edit" "RTN","DGPFPARM",10,0) I '$D(^DGPF(26.18,1,0)) D "RTN","DGPFPARM",11,0) .W !,"You do not have an entry in your parameter file!!" "RTN","DGPFPARM",12,0) .W !,"Creating a new entry in the PRF PARAMETER (#26.18) file... ",! "RTN","DGPFPARM",13,0) .S DIC="^DGPF(26.18,",DIC(0)="",X=1,DINUM=1 "RTN","DGPFPARM",14,0) .K DD,DO D FILE^DICN W " done." "RTN","DGPFPARM",15,0) .K %,DA,DIC,DIE,X,Y "RTN","DGPFPARM",16,0) ; "RTN","DGPFPARM",17,0) S DIE="^DGPF(26.18,",DA=1,DR="2;3" D ^DIE "RTN","DGPFPARM",18,0) K DIE,DR,DA "RTN","DGPFPARM",19,0) Q "RTN","DGPFPARM",20,0) ; "RTN","DGPFPARM",21,0) ON() ;Used to determine if the PRF software is 'active'. "RTN","DGPFPARM",22,0) ; "RTN","DGPFPARM",23,0) ; Input: None "RTN","DGPFPARM",24,0) ; "RTN","DGPFPARM",25,0) ;Output: "RTN","DGPFPARM",26,0) ; Function Value - 1 = 'Active', 0 = 'Not Active' "RTN","DGPFPARM",27,0) ; "RTN","DGPFPARM",28,0) ; - init variables "RTN","DGPFPARM",29,0) N DGACT,RESULT "RTN","DGPFPARM",30,0) S RESULT=0 "RTN","DGPFPARM",31,0) ; "RTN","DGPFPARM",32,0) ;- get software activation date from PRF PARAMETERS (#26.18) file "RTN","DGPFPARM",33,0) S DGACT=+$P($G(^DGPF(26.18,1,0)),U,2) "RTN","DGPFPARM",34,0) ; "RTN","DGPFPARM",35,0) ; - check if activation is past current date "RTN","DGPFPARM",36,0) D "RTN","DGPFPARM",37,0) .Q:('DGACT)!(DT>> No Patient Record Flag Assignments have been found. Select another flag.",*7 "RTN","DGPFRFA",70,0) . . ;a good one to report on "RTN","DGPFRFA",71,0) . . S DGSORT("DGFLAG")=DGFIL_U_$$EXTERNAL^DILFD(26.13,.02,"F",DGFIL) "RTN","DGPFRFA",72,0) . . S DGQ=1 "RTN","DGPFRFA",73,0) ; "RTN","DGPFRFA",74,0) Q:(DGASK=-1) "RTN","DGPFRFA",75,0) ; "RTN","DGPFRFA",76,0) ;-- prompt for beginning date "RTN","DGPFRFA",77,0) S DGFIRST=$P(+$O(^DGPF(26.14,"D","")),".") ;first assignment date "RTN","DGPFRFA",78,0) I 'DGFIRST D Q "RTN","DGPFRFA",79,0) . W !?2,">>> No Patient Record Flag Assignments have been found.",*7 "RTN","DGPFRFA",80,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause "RTN","DGPFRFA",81,0) ; "RTN","DGPFRFA",82,0) S DGDIRA="Select Beginning Date" "RTN","DGPFRFA",83,0) S DGDIRB="" "RTN","DGPFRFA",84,0) S DGDIRH="Enter the earliest Assignment Date to include in the report" "RTN","DGPFRFA",85,0) S DGDIRO="D^::EX" "RTN","DGPFRFA",86,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFA",87,0) Q:(DGASK=-1) "RTN","DGPFRFA",88,0) S (DGSORT("DGBEG"),DGBEG)=DGASK "RTN","DGPFRFA",89,0) ; "RTN","DGPFRFA",90,0) ;-- prompt for ending date "RTN","DGPFRFA",91,0) S DGDIRA="Select Ending Date" "RTN","DGPFRFA",92,0) S DGDIRB="" "RTN","DGPFRFA",93,0) S DGDIRH="Enter the lastest Assignment Date to include in the report" "RTN","DGPFRFA",94,0) S DGDIRO="D^::EX" "RTN","DGPFRFA",95,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFA",96,0) Q:(DGASK=-1) "RTN","DGPFRFA",97,0) S DGSORT("DGEND")=DGASK "RTN","DGPFRFA",98,0) ; "RTN","DGPFRFA",99,0) K DGCAT,DGFIL,DGSEL,DGDIRA,DGDIRB,DGDIRO,DGDIRH "RTN","DGPFRFA",100,0) K DGASK,DGRSLT,DGFIRST,DGBEG "RTN","DGPFRFA",101,0) ; "RTN","DGPFRFA",102,0) ;-- prompt for device "RTN","DGPFRFA",103,0) S ZTSAVE("DGSORT")="" "RTN","DGPFRFA",104,0) D EN^XUTMDEVQ("START^DGPFRFA1","Patient Record Flag Assignment Report",.ZTSAVE) "RTN","DGPFRFA",105,0) D HOME^%ZIS "RTN","DGPFRFA",106,0) Q "RTN","DGPFRFA1") 0^51^B41598008 "RTN","DGPFRFA1",1,0) DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 5/21/03 4:35pm "RTN","DGPFRFA1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFRFA1",3,0) ; "RTN","DGPFRFA1",4,0) ;This routine will compile and produce the FLAG ASSIGNMENT REPORT. "RTN","DGPFRFA1",5,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRFA1",6,0) ; assignments for Category I and Category II Patient Record Flags. "RTN","DGPFRFA1",7,0) ; "RTN","DGPFRFA1",8,0) ;All sort input was created in routine DGPFRFA. "RTN","DGPFRFA1",9,0) ; Input: The following array contains the sort var's: "RTN","DGPFRFA1",10,0) ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth) "RTN","DGPFRFA1",11,0) ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on "RTN","DGPFRFA1",12,0) ; = IEN of a (S)ingle Flag (#26.11)/(#26.15) "RTN","DGPFRFA1",13,0) ; example: "1;DGPF(26.15," "RTN","DGPFRFA1",14,0) ; DGSORT("DGBEG") = Beginning date to report on "RTN","DGPFRFA1",15,0) ; DGSORT("DGEND") = Ending date to report on "RTN","DGPFRFA1",16,0) ; "RTN","DGPFRFA1",17,0) ; Output: A formatted report of Record Flag Assignments to patients. "RTN","DGPFRFA1",18,0) ; "RTN","DGPFRFA1",19,0) ;- no direct entry "RTN","DGPFRFA1",20,0) QUIT "RTN","DGPFRFA1",21,0) ; "RTN","DGPFRFA1",22,0) START ; compile and print report "RTN","DGPFRFA1",23,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGPFRFA1",24,0) N DGLIST "RTN","DGPFRFA1",25,0) S DGLIST=$NA(^TMP("DGPFRFA1",$J)) "RTN","DGPFRFA1",26,0) K @DGLIST "RTN","DGPFRFA1",27,0) D LOOP(.DGSORT) "RTN","DGPFRFA1",28,0) D PRINT(.DGSORT,DGLIST) "RTN","DGPFRFA1",29,0) D EXIT "RTN","DGPFRFA1",30,0) Q "RTN","DGPFRFA1",31,0) ; "RTN","DGPFRFA1",32,0) LOOP(DGSORT) ;use sort var's for record searching to build list "RTN","DGPFRFA1",33,0) ; Input: "RTN","DGPFRFA1",34,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRFA1",35,0) ; "RTN","DGPFRFA1",36,0) ; Output: "RTN","DGPFRFA1",37,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRFA1",38,0) ; "RTN","DGPFRFA1",39,0) N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGDFNLST "RTN","DGPFRFA1",40,0) N DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT "RTN","DGPFRFA1",41,0) S (DGQ,DGFG,DGSUB,DGCNT)=0 "RTN","DGPFRFA1",42,0) S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX) "RTN","DGPFRFA1",43,0) S DGC=$S(+DGCAT=3:0,1:+DGCAT) ;0 = both categories (National & Local) "RTN","DGPFRFA1",44,0) S:DGC DGC=$S(DGC=1:26.15,1:26.11) "RTN","DGPFRFA1",45,0) S DGF=$P(DGFLAG,U) ;"A"=all flags - "5;DGPF(26.11," is selection "RTN","DGPFRFA1",46,0) ; re-seed var to start looping before actual selection "RTN","DGPFRFA1",47,0) D:+DGF "RTN","DGPFRFA1",48,0) . S DGSUB=+DGF-1 "RTN","DGPFRFA1",49,0) . S:DGSUB<0 DGSUB=0 "RTN","DGPFRFA1",50,0) . S DGSUB=DGSUB_";"_$P(DGF,";",2) "RTN","DGPFRFA1",51,0) ;ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien "RTN","DGPFRFA1",52,0) ; "RTN","DGPFRFA1",53,0) S (DGDFN,DGIEN)="" "RTN","DGPFRFA1",54,0) F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRFA1",55,0) . I DGC,DGSUB'[DGC Q ;not correct file based on category "RTN","DGPFRFA1",56,0) . I +DGF,DGSUB>DGF S DGQ=1 Q ;done with loop on user selection "RTN","DGPFRFA1",57,0) . K DGDFNLST "RTN","DGPFRFA1",58,0) . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) ;get list of dfn's "RTN","DGPFRFA1",59,0) . Q:'DGCNT "RTN","DGPFRFA1",60,0) . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D "RTN","DGPFRFA1",61,0) . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN="" "RTN","DGPFRFA1",62,0) . . D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST) "RTN","DGPFRFA1",63,0) K DGDFNLST "RTN","DGPFRFA1",64,0) Q "RTN","DGPFRFA1",65,0) ; "RTN","DGPFRFA1",66,0) BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder "RTN","DGPFRFA1",67,0) ; Input: "RTN","DGPFRFA1",68,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRFA1",69,0) ; DGDFN - ien of patient in PATIENT (#2) file "RTN","DGPFRFA1",70,0) ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record "RTN","DGPFRFA1",71,0) ; DGLIST - temp global name used for report list "RTN","DGPFRFA1",72,0) ; "RTN","DGPFRFA1",73,0) ; Output: "RTN","DGPFRFA1",74,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRFA1",75,0) ; "RTN","DGPFRFA1",76,0) N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG "RTN","DGPFRFA1",77,0) S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)="" "RTN","DGPFRFA1",78,0) K DGPFA,DGPFAH,DGPFPAT "RTN","DGPFRFA1",79,0) ;retrieve a single assign record "RTN","DGPFRFA1",80,0) Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRFA1",81,0) ;retrieve initial history assign record "RTN","DGPFRFA1",82,0) Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFRFA1",83,0) ;-- get 'initial assignment' date "RTN","DGPFRFA1",84,0) S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFRFA1",85,0) Q:'DGPFAH("INITASSIGN") "RTN","DGPFRFA1",86,0) S DGINIT=+DGPFAH("INITASSIGN") "RTN","DGPFRFA1",87,0) I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D "RTN","DGPFRFA1",88,0) . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT) "RTN","DGPFRFA1",89,0) . S DGCATG=$S(DGSUB[26.15:1,1:2) "RTN","DGPFRFA1",90,0) . S DGFG=$P(DGPFA("FLAG"),U,2) "RTN","DGPFRFA1",91,0) . S DGNAME=DGPFPAT("NAME") "RTN","DGPFRFA1",92,0) . S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN")) "RTN","DGPFRFA1",93,0) . I +DGPFA("REVIEWDT") D "RTN","DGPFRFA1",94,0) .. S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT")) "RTN","DGPFRFA1",95,0) . E S DGREV="N/A" "RTN","DGPFRFA1",96,0) . S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$P(DGPFA("STATUS"),U,2) "RTN","DGPFRFA1",97,0) . S DGLINE=DGLINE_U_$P(DGPFA("OWNER"),U,2) "RTN","DGPFRFA1",98,0) . S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE "RTN","DGPFRFA1",99,0) K DGPFA,DGPFAH,DGPFPAT "RTN","DGPFRFA1",100,0) Q "RTN","DGPFRFA1",101,0) ; "RTN","DGPFRFA1",102,0) PRINT(DGSORT,DGLIST) ;output report "RTN","DGPFRFA1",103,0) ; Input: "RTN","DGPFRFA1",104,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRFA1",105,0) ; DGLIST - temp global name used for report list "RTN","DGPFRFA1",106,0) ; "RTN","DGPFRFA1",107,0) ; Output: Formated report to user selected device "RTN","DGPFRFA1",108,0) ; "RTN","DGPFRFA1",109,0) N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE "RTN","DGPFRFA1",110,0) S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)="" "RTN","DGPFRFA1",111,0) S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2) "RTN","DGPFRFA1",112,0) I $O(@DGLIST@(""))="" D Q "RTN","DGPFRFA1",113,0) . S DGCAT=+DGSORT("DGCAT") "RTN","DGPFRFA1",114,0) . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2)) "RTN","DGPFRFA1",115,0) . D HEAD "RTN","DGPFRFA1",116,0) . W !!," >>> No Record Flag Assignments were found using the report criteria." "RTN","DGPFRFA1",117,0) ; loop and print report "RTN","DGPFRFA1",118,0) S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)="" "RTN","DGPFRFA1",119,0) F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ "RTN","DGPFRFA1",120,0) . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ "RTN","DGPFRFA1",121,0) .. I DGFG'=DGOFG D "RTN","DGPFRFA1",122,0) ... D:DGCNT SUB(.DGCNT,1) "RTN","DGPFRFA1",123,0) ... D HEAD "RTN","DGPFRFA1",124,0) ... S DGOFG=DGFG,DGCNT=0 "RTN","DGPFRFA1",125,0) .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ "RTN","DGPFRFA1",126,0) ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGPFRFA1",127,0) .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1 "RTN","DGPFRFA1",128,0) .... D:$Y>(IOSL-4) HEAD "RTN","DGPFRFA1",129,0) .... Q:DGQ "RTN","DGPFRFA1",130,0) .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) "RTN","DGPFRFA1",131,0) .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?53,$P(DGSTR,U,4),?63,$E($P(DGSTR,U,5),1,17) "RTN","DGPFRFA1",132,0) . Q:DGQ "RTN","DGPFRFA1",133,0) . I DGCNT D "RTN","DGPFRFA1",134,0) .. D SUB(.DGCNT,1) "RTN","DGPFRFA1",135,0) .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags "RTN","DGPFRFA1",136,0) .. S DGOFG="",DGCNT=0 "RTN","DGPFRFA1",137,0) ; "RTN","DGPFRFA1",138,0) ;Shutdown if stop task requested "RTN","DGPFRFA1",139,0) I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q "RTN","DGPFRFA1",140,0) ; "RTN","DGPFRFA1",141,0) I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories "RTN","DGPFRFA1",142,0) . S DGCAT=3,DGFG="All Flags",DGGRAND=1 "RTN","DGPFRFA1",143,0) . D HEAD "RTN","DGPFRFA1",144,0) . W !!,"REPORT SUMMARY:",!,"---------------" "RTN","DGPFRFA1",145,0) . F DGCAT=1,2,3 D "RTN","DGPFRFA1",146,0) .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT)) "RTN","DGPFRFA1",147,0) .. W:DGCAT=3 !?39,"-------" "RTN","DGPFRFA1",148,0) .. W !,"Total Assignments for Category " "RTN","DGPFRFA1",149,0) .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":" "RTN","DGPFRFA1",150,0) .. W ?40,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRFA1",151,0) ; "RTN","DGPFRFA1",152,0) W !!,"" "RTN","DGPFRFA1",153,0) Q "RTN","DGPFRFA1",154,0) ; "RTN","DGPFRFA1",155,0) PAUSE(DGQ) ; pause screen display "RTN","DGPFRFA1",156,0) ; Input: "RTN","DGPFRFA1",157,0) ; DGQ - var used to quit report processing to user CRT "RTN","DGPFRFA1",158,0) ; Output: "RTN","DGPFRFA1",159,0) ; DGQ - passed by reference - 0 = Continue, 1 = Quit "RTN","DGPFRFA1",160,0) ; "RTN","DGPFRFA1",161,0) I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1 "RTN","DGPFRFA1",162,0) Q "RTN","DGPFRFA1",163,0) ; "RTN","DGPFRFA1",164,0) SUB(CNT,TYP) ; print sub-totals "RTN","DGPFRFA1",165,0) ; Input: "RTN","DGPFRFA1",166,0) ; CNT - count of records printed "RTN","DGPFRFA1",167,0) ; TYP - indicator of which total count is being printed "RTN","DGPFRFA1",168,0) ; Output: Write lines of Sub-Totals and Totals per Flag and Category "RTN","DGPFRFA1",169,0) ; "RTN","DGPFRFA1",170,0) N DGTYPE,DGCOUNT "RTN","DGPFRFA1",171,0) S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II")) "RTN","DGPFRFA1",172,0) S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT)) "RTN","DGPFRFA1",173,0) W:TYP=1 ! "RTN","DGPFRFA1",174,0) W !,"Total Assignments for "_DGTYPE_": ",DGCOUNT "RTN","DGPFRFA1",175,0) Q "RTN","DGPFRFA1",176,0) ; "RTN","DGPFRFA1",177,0) HEAD ;Print/Display page header "RTN","DGPFRFA1",178,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q "RTN","DGPFRFA1",179,0) D PAUSE(.DGQ) "RTN","DGPFRFA1",180,0) Q:DGQ "RTN","DGPFRFA1",181,0) W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF "RTN","DGPFRFA1",182,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGPFRFA1",183,0) W !?25,"PATIENT RECORD FLAGS" "RTN","DGPFRFA1",184,0) W !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$G(DGPAGE) "RTN","DGPFRFA1",185,0) W !?24,"----------------------",?48,"Printed: ",DGDT "RTN","DGPFRFA1",186,0) W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRFA1",187,0) W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND"))) "RTN","DGPFRFA1",188,0) W !?1,"FLAG NAME: ",$G(DGFG),! "RTN","DGPFRFA1",189,0) I DGGRAND W DGLINE Q "RTN","DGPFRFA1",190,0) W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE" "RTN","DGPFRFA1",191,0) W !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------" "RTN","DGPFRFA1",192,0) Q "RTN","DGPFRFA1",193,0) ; "RTN","DGPFRFA1",194,0) EXIT ; "RTN","DGPFRFA1",195,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRFA1",196,0) K @DGLIST "RTN","DGPFRFA1",197,0) I '$D(ZTQUEUED) D "RTN","DGPFRFA1",198,0) . K %ZIS,POP "RTN","DGPFRFA1",199,0) . D ^%ZISC,HOME^%ZIS "RTN","DGPFRFA1",200,0) Q "RTN","DGPFRFR") 0^59^B16456376 "RTN","DGPFRFR",1,0) DGPFRFR ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT ; 5/20/03 3:04pm "RTN","DGPFRFR",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFRFR",3,0) ; "RTN","DGPFRFR",4,0) ;This routine will be used for selecting sort parameters to produce "RTN","DGPFRFR",5,0) ; the FLAGS DUE FOR REVIEW REPORT for Patient Record Flags. "RTN","DGPFRFR",6,0) ; "RTN","DGPFRFR",7,0) ;Selection options will provide the user with the ability to report "RTN","DGPFRFR",8,0) ; by: "RTN","DGPFRFR",9,0) ; CATEGORY: "RTN","DGPFRFR",10,0) ; 1 Category I (National) "RTN","DGPFRFR",11,0) ; 2 Category II (Local) "RTN","DGPFRFR",12,0) ; 3 BOTH "RTN","DGPFRFR",13,0) ; FLAG: "RTN","DGPFRFR",14,0) ; S Single Flag "RTN","DGPFRFR",15,0) ; A All Flags "RTN","DGPFRFR",16,0) ; BEGINING DATE: FileMan date "RTN","DGPFRFR",17,0) ; ENDING DATE: FileMan date "RTN","DGPFRFR",18,0) ; "RTN","DGPFRFR",19,0) ;-- no direct entry "RTN","DGPFRFR",20,0) QUIT "RTN","DGPFRFR",21,0) ; "RTN","DGPFRFR",22,0) EN ;Entry point "RTN","DGPFRFR",23,0) ;-- user prompts for report selection sorts "RTN","DGPFRFR",24,0) ; Input: none "RTN","DGPFRFR",25,0) ; Output: Report generated using user selected parameters "RTN","DGPFRFR",26,0) ; "RTN","DGPFRFR",27,0) N DGASK,DGRSLT,DGDIRA,DGDIRB,DGDIRO,DGDIRH "RTN","DGPFRFR",28,0) N DGSORT,DGCAT,DGFIL,DGSEL,DGNOW,DGFIRST,DGBEG,DGEND "RTN","DGPFRFR",29,0) N ZTSAVE,DGQ "RTN","DGPFRFR",30,0) ; "RTN","DGPFRFR",31,0) ;-- prompt for selection of a flag category "RTN","DGPFRFR",32,0) S DGDIRA="Select Flag Category",DGDIRB="" "RTN","DGPFRFR",33,0) S DGDIRH="Enter one of the category selections to report on" "RTN","DGPFRFR",34,0) S DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both" "RTN","DGPFRFR",35,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFR",36,0) Q:(DGASK<1) "RTN","DGPFRFR",37,0) S DGCAT=DGASK,DGSORT("DGCAT")=DGASK_U_$S(DGASK=1:"Category I (National)",DGASK=2:"Category II (Local)",DGASK=3:"Both",1:"") "RTN","DGPFRFR",38,0) ; "RTN","DGPFRFR",39,0) ;-- prompt for selection of a single flag or all flags "RTN","DGPFRFR",40,0) S DGSEL="" "RTN","DGPFRFR",41,0) ;default to (A)ll flags if user selects Both Category's "RTN","DGPFRFR",42,0) I DGCAT=3 D "RTN","DGPFRFR",43,0) . S DGSORT("DGFLAG")="A" "RTN","DGPFRFR",44,0) ; "RTN","DGPFRFR",45,0) D:DGCAT'=3 ;only prompt if user selects a Category I or II "RTN","DGPFRFR",46,0) . S DGDIRA="Select to report on a (S)ingle flag or (A)ll flags" "RTN","DGPFRFR",47,0) . S DGDIRB="Single Flag" "RTN","DGPFRFR",48,0) . S DGDIRO="S^S:Single Flag;A:All Flags" "RTN","DGPFRFR",49,0) . S DGDIRH="Enter one of the flag selections to report on" "RTN","DGPFRFR",50,0) . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFR",51,0) . Q:(DGASK=-1) "RTN","DGPFRFR",52,0) . S DGSEL=DGASK "RTN","DGPFRFR",53,0) . S DGSORT("DGFLAG")=DGASK "RTN","DGPFRFR",54,0) Q:(DGASK=-1) "RTN","DGPFRFR",55,0) ; "RTN","DGPFRFR",56,0) ;-- prompt for selection of a record flag name - only if (S)ingle "RTN","DGPFRFR",57,0) D:DGSEL="S" "RTN","DGPFRFR",58,0) . S DGQ=0 "RTN","DGPFRFR",59,0) . S DGDIRA="Select Record Flag Name" "RTN","DGPFRFR",60,0) . S DGDIRB="" "RTN","DGPFRFR",61,0) . S DGDIRO=$S(DGCAT=1:"P^26.15,.01:EMZ",1:"P^26.11,.01:EMZ") "RTN","DGPFRFR",62,0) . F D Q:DGQ "RTN","DGPFRFR",63,0) . . S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO) "RTN","DGPFRFR",64,0) . . I DGASK=-1 S DGQ=1 Q "RTN","DGPFRFR",65,0) . . ;set data string = pointer value (5;DGPF(26.11,) ^ external name "RTN","DGPFRFR",66,0) . . S DGFIL=DGASK_$S(DGCAT=1:";DGPF(26.15,",1:";DGPF(26.11,") "RTN","DGPFRFR",67,0) . . ;if (S)ingle flag selected, check for any flag assignments "RTN","DGPFRFR",68,0) . . I '$$ASGNCNT^DGPFLF6(DGFIL) D Q "RTN","DGPFRFR",69,0) . . . W !?2,">>> No Patient Record Flag Assignments have been found. Select another flag.",*7 "RTN","DGPFRFR",70,0) . . ;a good one to report on "RTN","DGPFRFR",71,0) . . S DGSORT("DGFLAG")=DGFIL_U_$$EXTERNAL^DILFD(26.13,.02,"F",DGFIL) "RTN","DGPFRFR",72,0) . . S DGQ=1 "RTN","DGPFRFR",73,0) ; "RTN","DGPFRFR",74,0) Q:(DGASK=-1) "RTN","DGPFRFR",75,0) ; "RTN","DGPFRFR",76,0) ;-- prompt for beginning date "RTN","DGPFRFR",77,0) S DGNOW=$$DT^XLFDT() "RTN","DGPFRFR",78,0) S DGFIRST=$P(+$O(^DGPF(26.13,"AFREV","")),".") ;first review date "RTN","DGPFRFR",79,0) I 'DGFIRST D Q "RTN","DGPFRFR",80,0) . W !?2,">>> No Patient Record Flag Assignments have been found.",*7 "RTN","DGPFRFR",81,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") "RTN","DGPFRFR",82,0) ; "RTN","DGPFRFR",83,0) S DGDIRA="Select Beginning Date" "RTN","DGPFRFR",84,0) S DGDIRB="" "RTN","DGPFRFR",85,0) S DGDIRH="Enter the earliest Review Date to include in the report" "RTN","DGPFRFR",86,0) S DGDIRO="D^::EX" "RTN","DGPFRFR",87,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFR",88,0) Q:(DGASK=-1) "RTN","DGPFRFR",89,0) S (DGSORT("DGBEG"),DGBEG)=DGASK "RTN","DGPFRFR",90,0) ; "RTN","DGPFRFR",91,0) ;-- prompt for ending date "RTN","DGPFRFR",92,0) S DGDIRA="Select Ending Date" "RTN","DGPFRFR",93,0) S DGDIRB="" "RTN","DGPFRFR",94,0) S DGDIRH="Enter the latest Review Date to include in the report" "RTN","DGPFRFR",95,0) S DGDIRO="D^::EX" "RTN","DGPFRFR",96,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRFR",97,0) Q:(DGASK=-1) "RTN","DGPFRFR",98,0) S DGSORT("DGEND")=DGASK "RTN","DGPFRFR",99,0) S DGSORT("DGNOW")=DGNOW "RTN","DGPFRFR",100,0) ; "RTN","DGPFRFR",101,0) K DGCAT,DGFIL,DGSEL,DGDIRA,DGDIRB,DGDIRO "RTN","DGPFRFR",102,0) K DGASK,DGRSLT,DGNOW,DGFIRST,DGBEG "RTN","DGPFRFR",103,0) ; "RTN","DGPFRFR",104,0) ;-- prompt for device "RTN","DGPFRFR",105,0) S ZTSAVE("DGSORT")="" "RTN","DGPFRFR",106,0) D EN^XUTMDEVQ("START^DGPFRFR1","Flags Due For Review Report",.ZTSAVE) "RTN","DGPFRFR",107,0) D HOME^%ZIS "RTN","DGPFRFR",108,0) Q "RTN","DGPFRFR1") 0^60^B42214767 "RTN","DGPFRFR1",1,0) DGPFRFR1 ;ALB/RBS - PRF ASSIGNMENTS DUE REVIEW REPORT CONT. ; 5/21/03 4:40pm "RTN","DGPFRFR1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFRFR1",3,0) ; "RTN","DGPFRFR1",4,0) ;This routine will create the ASSIGNMENTS DUE FOR REVIEW REPORT. "RTN","DGPFRFR1",5,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRFR1",6,0) ; assignments due for Review for Category I and Category II PRF's. "RTN","DGPFRFR1",7,0) ; "RTN","DGPFRFR1",8,0) ;All sort input was created in routine DGPFRFR. "RTN","DGPFRFR1",9,0) ; Input: The following array contains the sort var's: "RTN","DGPFRFR1",10,0) ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth) "RTN","DGPFRFR1",11,0) ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on "RTN","DGPFRFR1",12,0) ; = IEN of a (S)ingle Flag (#26.11)/(#26.15) "RTN","DGPFRFR1",13,0) ; example: "1;DGPF(26.15," "RTN","DGPFRFR1",14,0) ; DGSORT("DGBEG") = Beginning date to report on "RTN","DGPFRFR1",15,0) ; DGSORT("DGEND") = Ending date to report on "RTN","DGPFRFR1",16,0) ; "RTN","DGPFRFR1",17,0) ; Output: Formatted report of Record Flag Assignments due for review. "RTN","DGPFRFR1",18,0) ; "RTN","DGPFRFR1",19,0) ;- no direct entry "RTN","DGPFRFR1",20,0) QUIT "RTN","DGPFRFR1",21,0) ; "RTN","DGPFRFR1",22,0) START ; compile and print report "RTN","DGPFRFR1",23,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGPFRFR1",24,0) N DGLIST "RTN","DGPFRFR1",25,0) S DGLIST=$NA(^TMP("DGPFRFR1",$J)) "RTN","DGPFRFR1",26,0) K @DGLIST "RTN","DGPFRFR1",27,0) D LOOP(.DGSORT) "RTN","DGPFRFR1",28,0) D PRINT(.DGSORT,DGLIST) "RTN","DGPFRFR1",29,0) D EXIT "RTN","DGPFRFR1",30,0) Q "RTN","DGPFRFR1",31,0) ; "RTN","DGPFRFR1",32,0) LOOP(DGSORT) ;use sort var's for record searching to build list "RTN","DGPFRFR1",33,0) ; Input: "RTN","DGPFRFR1",34,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRFR1",35,0) ; "RTN","DGPFRFR1",36,0) ; Output: "RTN","DGPFRFR1",37,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRFR1",38,0) ; "RTN","DGPFRFR1",39,0) N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGC,DGX,DGQ,DGFG,DGSUB,DGNOW "RTN","DGPFRFR1",40,0) S (DGQ,DGFG)=0 "RTN","DGPFRFR1",41,0) S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX) "RTN","DGPFRFR1",42,0) S DGC=$S(+DGCAT=3:0,1:+DGCAT) ; 0 = both cat. I,II (National,Local) "RTN","DGPFRFR1",43,0) S:DGC DGC=$S(DGC=1:26.15,1:26.11) "RTN","DGPFRFR1",44,0) S DGFG=$P(DGFLAG,U) ;"A"=all flags or "5;DGPF(26.11," is selection "RTN","DGPFRFR1",45,0) S DGSUB=DGBEG-1 ; seed var to start at user selected beginning date "RTN","DGPFRFR1",46,0) F S DGSUB=$O(^DGPF(26.13,"AFREV",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRFR1",47,0) . I DGSUB>DGEND S DGQ=1 Q "RTN","DGPFRFR1",48,0) . S DGDFN="" "RTN","DGPFRFR1",49,0) . F S DGDFN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN)) Q:DGDFN="" D "RTN","DGPFRFR1",50,0) .. S DGIEN="" "RTN","DGPFRFR1",51,0) .. F S DGIEN=$O(^DGPF(26.13,"AFREV",DGSUB,DGDFN,DGIEN)) Q:DGIEN="" D "RTN","DGPFRFR1",52,0) ... Q:'$D(^DGPF(26.13,"D",DGDFN,1,DGIEN)) ;status not active "RTN","DGPFRFR1",53,0) ... I +DGFG,'$D(^DGPF(26.13,"C",DGDFN,DGFG,DGIEN)) Q ;flag not found "RTN","DGPFRFR1",54,0) ... D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST) "RTN","DGPFRFR1",55,0) Q "RTN","DGPFRFR1",56,0) ; "RTN","DGPFRFR1",57,0) BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder "RTN","DGPFRFR1",58,0) ; Input: "RTN","DGPFRFR1",59,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRFR1",60,0) ; DGDFN - ien of patient in PATIENT (#2) file "RTN","DGPFRFR1",61,0) ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record "RTN","DGPFRFR1",62,0) ; "RTN","DGPFRFR1",63,0) ; Output: "RTN","DGPFRFR1",64,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRFR1",65,0) ; "RTN","DGPFRFR1",66,0) N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG "RTN","DGPFRFR1",67,0) N DGLINE,DGNAME,DGREV,DGFG,DGNOT,DGYN "RTN","DGPFRFR1",68,0) S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGNOT,DGYN)="" "RTN","DGPFRFR1",69,0) K DGPFA,DGPFAH,DGPFPAT "RTN","DGPFRFR1",70,0) ;retrieve a single assign record "RTN","DGPFRFR1",71,0) Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRFR1",72,0) I +DGC,$P(DGPFA("FLAG"),U)'[+DGC Q ;not category selected "RTN","DGPFRFR1",73,0) ;retrieve initial history assign record "RTN","DGPFRFR1",74,0) Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFRFR1",75,0) ;-- get 'initial assignment' date "RTN","DGPFRFR1",76,0) S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFRFR1",77,0) Q:'DGPFAH("INITASSIGN") "RTN","DGPFRFR1",78,0) Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT) "RTN","DGPFRFR1",79,0) S DGCATG=$S($P(DGPFA("FLAG"),U)[26.15:1,1:2) "RTN","DGPFRFR1",80,0) S DGFG=$P(DGPFA("FLAG"),U,2) "RTN","DGPFRFR1",81,0) S DGNAME=DGPFPAT("NAME") "RTN","DGPFRFR1",82,0) S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN")) "RTN","DGPFRFR1",83,0) I +DGPFA("REVIEWDT") D "RTN","DGPFRFR1",84,0) . S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT")) "RTN","DGPFRFR1",85,0) . I +DGPFA("REVIEWDT")>> No Record Flag Assignments were found using the report criteria." "RTN","DGPFRFR1",109,0) ; loop and print report "RTN","DGPFRFR1",110,0) S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)="" "RTN","DGPFRFR1",111,0) F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ "RTN","DGPFRFR1",112,0) . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ "RTN","DGPFRFR1",113,0) .. I DGFG'=DGOFG D "RTN","DGPFRFR1",114,0) ... D:DGCNT SUB(.DGCNT,1) "RTN","DGPFRFR1",115,0) ... D HEAD "RTN","DGPFRFR1",116,0) ... S DGOFG=DGFG,DGCNT=0 "RTN","DGPFRFR1",117,0) .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ "RTN","DGPFRFR1",118,0) ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGPFRFR1",119,0) .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1 "RTN","DGPFRFR1",120,0) .... D:$Y>(IOSL-4) HEAD "RTN","DGPFRFR1",121,0) .... Q:DGQ "RTN","DGPFRFR1",122,0) .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) "RTN","DGPFRFR1",123,0) .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?60,$P(DGSTR,U,4) "RTN","DGPFRFR1",124,0) . Q:DGQ "RTN","DGPFRFR1",125,0) . I DGCNT D "RTN","DGPFRFR1",126,0) .. D SUB(.DGCNT,1) "RTN","DGPFRFR1",127,0) .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags "RTN","DGPFRFR1",128,0) .. S DGOFG="",DGCNT=0 "RTN","DGPFRFR1",129,0) ; "RTN","DGPFRFR1",130,0) ;Shutdown if stop task requested "RTN","DGPFRFR1",131,0) I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q "RTN","DGPFRFR1",132,0) ; "RTN","DGPFRFR1",133,0) I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories "RTN","DGPFRFR1",134,0) . S DGCAT=3,DGFG="All Flags",DGGRAND=1 "RTN","DGPFRFR1",135,0) . D HEAD "RTN","DGPFRFR1",136,0) . W !!,"REPORT SUMMARY:",!,"---------------" "RTN","DGPFRFR1",137,0) . F DGCAT=1,2,3 D "RTN","DGPFRFR1",138,0) .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT)) "RTN","DGPFRFR1",139,0) .. W:DGCAT=3 !?46,"-------" "RTN","DGPFRFR1",140,0) .. W !,"Total Review Assignments for Category " "RTN","DGPFRFR1",141,0) .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":" "RTN","DGPFRFR1",142,0) .. W ?47,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRFR1",143,0) ; "RTN","DGPFRFR1",144,0) W !!,"" "RTN","DGPFRFR1",145,0) Q "RTN","DGPFRFR1",146,0) ; "RTN","DGPFRFR1",147,0) PAUSE(DGQ) ; pause screen display "RTN","DGPFRFR1",148,0) ; Input: "RTN","DGPFRFR1",149,0) ; DGQ - var used to quit report processing to user CRT "RTN","DGPFRFR1",150,0) ; Output: "RTN","DGPFRFR1",151,0) ; DGQ - passed by reference - 0 = Continue, 1 = Quit "RTN","DGPFRFR1",152,0) ; "RTN","DGPFRFR1",153,0) I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1 "RTN","DGPFRFR1",154,0) Q "RTN","DGPFRFR1",155,0) ; "RTN","DGPFRFR1",156,0) SUB(CNT,TYP) ; print sub-totals "RTN","DGPFRFR1",157,0) ; Input: "RTN","DGPFRFR1",158,0) ; CNT - count of records printed "RTN","DGPFRFR1",159,0) ; TYP - indicator of which total count is being printed "RTN","DGPFRFR1",160,0) ; Output: Write lines of Sub-Totals and Totals per Flag and Category "RTN","DGPFRFR1",161,0) ; "RTN","DGPFRFR1",162,0) N DGTYPE,DGCOUNT "RTN","DGPFRFR1",163,0) S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II")) "RTN","DGPFRFR1",164,0) S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT)) "RTN","DGPFRFR1",165,0) W:TYP=1 ! "RTN","DGPFRFR1",166,0) W !,"Total Review Assignments for "_DGTYPE_": ",DGCOUNT "RTN","DGPFRFR1",167,0) W:TYP=1 !,"Note: "" * "" indicates that review date is past due",! "RTN","DGPFRFR1",168,0) Q "RTN","DGPFRFR1",169,0) ; "RTN","DGPFRFR1",170,0) HEAD ;Print/Display page header "RTN","DGPFRFR1",171,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q "RTN","DGPFRFR1",172,0) D PAUSE(.DGQ) "RTN","DGPFRFR1",173,0) Q:DGQ "RTN","DGPFRFR1",174,0) W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF "RTN","DGPFRFR1",175,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGPFRFR1",176,0) W !?22,"PATIENT RECORD FLAGS" "RTN","DGPFRFR1",177,0) W !?16,"ASSIGNMENTS DUE FOR REVIEW REPORT",?70,"Page: ",$G(DGPAGE) "RTN","DGPFRFR1",178,0) W !?16,"---------------------------------",?51,"Printed: ",DGDT "RTN","DGPFRFR1",179,0) W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRFR1",180,0) W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND"))) "RTN","DGPFRFR1",181,0) W !?1,"FLAG NAME: ",$G(DGFG),! "RTN","DGPFRFR1",182,0) I DGGRAND W DGLINE Q "RTN","DGPFRFR1",183,0) W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?54,"NOTIFICATION SENT" "RTN","DGPFRFR1",184,0) W !,"--------------------",?22,"---------",?33,"--------",?43,"---------",?54,"-----------------" "RTN","DGPFRFR1",185,0) Q "RTN","DGPFRFR1",186,0) ; "RTN","DGPFRFR1",187,0) EXIT ; "RTN","DGPFRFR1",188,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRFR1",189,0) K @DGLIST "RTN","DGPFRFR1",190,0) I '$D(ZTQUEUED) D "RTN","DGPFRFR1",191,0) . K %ZIS,POP "RTN","DGPFRFR1",192,0) . D ^%ZISC,HOME^%ZIS "RTN","DGPFRFR1",193,0) Q "RTN","DGPFUT") 0^11^B25005178 "RTN","DGPFUT",1,0) DGPFUT ;ALB/RPM - PRF UTILITIES ; 4/24/03 3:34pm "RTN","DGPFUT",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFUT",3,0) ; "RTN","DGPFUT",4,0) Q ;no direct entry "RTN","DGPFUT",5,0) ; "RTN","DGPFUT",6,0) ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;wrap FileMan Classic Reader call "RTN","DGPFUT",7,0) ; "RTN","DGPFUT",8,0) ; Input "RTN","DGPFUT",9,0) ; DGDIR0 - DIR(0) string "RTN","DGPFUT",10,0) ; DGDIRA - DIR("A") string "RTN","DGPFUT",11,0) ; DGDIRB - DIR("B") string "RTN","DGPFUT",12,0) ; DGDIRH - DIR("?") string "RTN","DGPFUT",13,0) ; "RTN","DGPFUT",14,0) ; Output "RTN","DGPFUT",15,0) ; Function Value - Internal value returned from ^DIR or -1 if user "RTN","DGPFUT",16,0) ; up-arrows, double up-arrows or the read times out. "RTN","DGPFUT",17,0) ; "RTN","DGPFUT",18,0) ; DIR(0) type Results "RTN","DGPFUT",19,0) ; ------------ ------------------------------- "RTN","DGPFUT",20,0) ; DD IEN of selected entry "RTN","DGPFUT",21,0) ; Pointer IEN of selected entry "RTN","DGPFUT",22,0) ; Set of Codes Internal value of code "RTN","DGPFUT",23,0) ; Yes/No 0 for No, 1 for Yes "RTN","DGPFUT",24,0) ; "RTN","DGPFUT",25,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables "RTN","DGPFUT",26,0) ; "RTN","DGPFUT",27,0) S DIR(0)=DGDIR0 "RTN","DGPFUT",28,0) S DIR("A")=$G(DGDIRA) "RTN","DGPFUT",29,0) I $G(DGDIRB)]"" S DIR("B")=DGDIRB "RTN","DGPFUT",30,0) I $D(DGDIRH) S DIR("?")=DGDIRH "RTN","DGPFUT",31,0) D ^DIR "RTN","DGPFUT",32,0) Q $S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,X="@":"@",1:$P(Y,U)) "RTN","DGPFUT",33,0) ; "RTN","DGPFUT",34,0) CONTINUE() ;pause display "RTN","DGPFUT",35,0) ; "RTN","DGPFUT",36,0) ; Input: none "RTN","DGPFUT",37,0) ; "RTN","DGPFUT",38,0) ; Output: 1 - continue "RTN","DGPFUT",39,0) ; 0 - quit "RTN","DGPFUT",40,0) ; "RTN","DGPFUT",41,0) N DIR,Y "RTN","DGPFUT",42,0) S DIR(0)="E" D ^DIR "RTN","DGPFUT",43,0) Q $S(Y'=1:0,1:1) "RTN","DGPFUT",44,0) ; "RTN","DGPFUT",45,0) VALID(DGRTN,DGFILE,DGIP,DGERR) ;validate input values before filing "RTN","DGPFUT",46,0) ; "RTN","DGPFUT",47,0) ; Input: "RTN","DGPFUT",48,0) ; DGRTN - (required) Routine name that contains $TEXT table "RTN","DGPFUT",49,0) ; DGFILE - (required) File number for input values "RTN","DGPFUT",50,0) ; DGIP - (required) Input value array "RTN","DGPFUT",51,0) ; DGERR - (optional) Returns error message passed by reference "RTN","DGPFUT",52,0) ; "RTN","DGPFUT",53,0) ; Output: "RTN","DGPFUT",54,0) ; Function Value - Returns 1 on all values valid, 0 on failure "RTN","DGPFUT",55,0) ; "RTN","DGPFUT",56,0) I $G(DGRTN)=""!('$G(DGFILE)) Q 0 "RTN","DGPFUT",57,0) N DGVLD ;function return value "RTN","DGPFUT",58,0) N DGFXR ;node name to field xref array "RTN","DGPFUT",59,0) N DGREQ ;array of required fields "RTN","DGPFUT",60,0) N DGWP ;word processing flag "RTN","DGPFUT",61,0) N DGN ;array node name "RTN","DGPFUT",62,0) ; "RTN","DGPFUT",63,0) S DGVLD=1 "RTN","DGPFUT",64,0) S DGN="" "RTN","DGPFUT",65,0) D BLDXR(DGRTN,.DGFXR) "RTN","DGPFUT",66,0) ; "RTN","DGPFUT",67,0) F S DGN=$O(DGFXR(DGN)) Q:DGN="" D Q:'DGVLD "RTN","DGPFUT",68,0) . S DGREQ=$P(DGFXR(DGN),U,2) "RTN","DGPFUT",69,0) . S DGWP=$P(DGFXR(DGN),U,3) "RTN","DGPFUT",70,0) . I DGREQ D ;required field check "RTN","DGPFUT",71,0) . . I DGWP,'$$CKWP("DGIP(DGN)") S DGVLD=0 Q "RTN","DGPFUT",72,0) . . I 'DGWP,$G(DGIP(DGN))']"" S DGVLD=0 Q "RTN","DGPFUT",73,0) . I 'DGVLD D Q "RTN","DGPFUT",74,0) . . S DGERR=$$GET1^DID(DGFILE,+DGFXR(DGN),,"LABEL")_" REQUIRED" "RTN","DGPFUT",75,0) . Q:DGWP ;don't check word processing fields for invalid values "RTN","DGPFUT",76,0) . ;check for invalid values "RTN","DGPFUT",77,0) . I '$$TESTVAL(DGFILE,+DGFXR(DGN),$P($G(DGIP(DGN)),U)) D Q "RTN","DGPFUT",78,0) . . S DGVLD=0,DGERR=$$GET1^DID(DGFILE,+DGFXR(DGN),,"LABEL")_" NOT VALID" "RTN","DGPFUT",79,0) Q DGVLD "RTN","DGPFUT",80,0) ; "RTN","DGPFUT",81,0) BLDXR(DGRTN,DGFLDA) ;build name/field xref array "RTN","DGPFUT",82,0) ;This procedure reads in the text from the XREF line tag of the DGRTN "RTN","DGPFUT",83,0) ;input parameter and loads name/field xref array with parsed line data. "RTN","DGPFUT",84,0) ; "RTN","DGPFUT",85,0) ; Input: "RTN","DGPFUT",86,0) ; DGRTN - (required) Routine name that contains the XREF line tag "RTN","DGPFUT",87,0) ; DGFLDA - (required) Array name for name/field xref passed by "RTN","DGPFUT",88,0) ; reference "RTN","DGPFUT",89,0) ; "RTN","DGPFUT",90,0) ; Output: "RTN","DGPFUT",91,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFUT",92,0) ; DGFLDA - Name/field xref array "RTN","DGPFUT",93,0) ; format: DGFLDA(subscript)=field#^required?^word proc? "RTN","DGPFUT",94,0) ; "RTN","DGPFUT",95,0) S DGRTN=$G(DGRTN) "RTN","DGPFUT",96,0) Q:DGRTN="" "RTN","DGPFUT",97,0) I $E(DGRTN,1)'="^" S DGRTN="^"_DGRTN "RTN","DGPFUT",98,0) Q:($T(@DGRTN)="") "RTN","DGPFUT",99,0) N DGTAG "RTN","DGPFUT",100,0) N DGOFF "RTN","DGPFUT",101,0) N DGLINE "RTN","DGPFUT",102,0) ; "RTN","DGPFUT",103,0) F DGOFF=1:1 S DGTAG="XREF+"_DGOFF_DGRTN,DGLINE=$T(@DGTAG) Q:DGLINE="" D "RTN","DGPFUT",104,0) . S DGFLDA($P(DGLINE,";",3))=$P(DGLINE,";",4)_U_+$P(DGLINE,";",5)_U_+$P(DGLINE,";",6) "RTN","DGPFUT",105,0) Q "RTN","DGPFUT",106,0) ; "RTN","DGPFUT",107,0) CKWP(DGROOT) ;ck word processing required fields "RTN","DGPFUT",108,0) ;This function verifies that at least one line in the word processing "RTN","DGPFUT",109,0) ;array contains text more than one space long. "RTN","DGPFUT",110,0) ; "RTN","DGPFUT",111,0) ; Input: "RTN","DGPFUT",112,0) ; DGROOT - (required) Word processing root "RTN","DGPFUT",113,0) ; "RTN","DGPFUT",114,0) ; Output: "RTN","DGPFUT",115,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFUT",116,0) ; "RTN","DGPFUT",117,0) N DGLIN "RTN","DGPFUT",118,0) N DGRSLT "RTN","DGPFUT",119,0) S DGRSLT=0 "RTN","DGPFUT",120,0) I $D(@DGROOT) D "RTN","DGPFUT",121,0) . S DGLIN="" "RTN","DGPFUT",122,0) . F S DGLIN=$O(@DGROOT@(DGLIN)) Q:DGLIN="" D Q:DGRSLT "RTN","DGPFUT",123,0) . . I $G(@DGROOT@(DGLIN,0))]"",@DGROOT@(DGLIN,0)'=" " S DGRSLT=1 "RTN","DGPFUT",124,0) Q DGRSLT "RTN","DGPFUT",125,0) ; "RTN","DGPFUT",126,0) TESTVAL(DGFIL,DGFLD,DGVAL) ;validate individual value against field def "RTN","DGPFUT",127,0) ; "RTN","DGPFUT",128,0) ; Input: "RTN","DGPFUT",129,0) ; DGFIL - (required) File number "RTN","DGPFUT",130,0) ; DGFLD - (required) Field number "RTN","DGPFUT",131,0) ; DGVAL - (required) Field value to be validated "RTN","DGPFUT",132,0) ; "RTN","DGPFUT",133,0) ; Output: "RTN","DGPFUT",134,0) ; Function Value - Returns 1 if value is valid, 0 if value is invalid "RTN","DGPFUT",135,0) ; "RTN","DGPFUT",136,0) N DGVALEX ;external value after conversion "RTN","DGPFUT",137,0) N DGTYP ;field type "RTN","DGPFUT",138,0) N DGRSLT ;results of CHK^DIE "RTN","DGPFUT",139,0) N VALID ;function results "RTN","DGPFUT",140,0) ; "RTN","DGPFUT",141,0) S VALID=1 "RTN","DGPFUT",142,0) I $G(DGFIL)>0,($G(DGFLD)>0),($G(DGVAL)'="") D "RTN","DGPFUT",143,0) . S DGVALEX=$$EXTERNAL^DILFD(DGFIL,DGFLD,"F",DGVAL) "RTN","DGPFUT",144,0) . I DGVALEX="" S VALID=0 Q "RTN","DGPFUT",145,0) . I $$GET1^DID(DGFIL,DGFLD,"","TYPE")'["POINTER" D "RTN","DGPFUT",146,0) . . D CHK^DIE(DGFIL,DGFLD,,DGVALEX,.DGRSLT) I DGRSLT="^" S VALID=0 Q "RTN","DGPFUT",147,0) Q VALID "RTN","DGPFUT",148,0) ; "RTN","DGPFUT",149,0) STATUS(DGACT) ;calculate the an assignment STATUS given an ACTION code "RTN","DGPFUT",150,0) ; "RTN","DGPFUT",151,0) ; Input: "RTN","DGPFUT",152,0) ; DGACT - (required) Action (.03) field value for PRF ASSIGNMENT "RTN","DGPFUT",153,0) ; HISTORY (#26.14) file in internal or external format "RTN","DGPFUT",154,0) ; "RTN","DGPFUT",155,0) ; Output: "RTN","DGPFUT",156,0) ; Function Value - Status value on success, -1 on failure "RTN","DGPFUT",157,0) ; "RTN","DGPFUT",158,0) N DGERR ;FM message root "RTN","DGPFUT",159,0) N DGRSLT ;CHK^DIE result array "RTN","DGPFUT",160,0) N DGSTAT ;calculated status value "RTN","DGPFUT",161,0) ; "RTN","DGPFUT",162,0) S DGSTAT=-1 "RTN","DGPFUT",163,0) I $G(DGACT)]"" D "RTN","DGPFUT",164,0) . I DGACT?1.N S DGACT=$$EXTERNAL^DILFD(26.14,.03,"F",DGACT,"DGERR") "RTN","DGPFUT",165,0) . Q:$D(DGERR) "RTN","DGPFUT",166,0) . D CHK^DIE(26.14,.03,"E",DGACT,.DGRSLT,"DGERR") "RTN","DGPFUT",167,0) . Q:$D(DGERR) "RTN","DGPFUT",168,0) . I DGRSLT(0)="INACTIVATE" S DGSTAT=0 "RTN","DGPFUT",169,0) . E S DGSTAT=1 "RTN","DGPFUT",170,0) Q DGSTAT "RTN","DGPFUT",171,0) ; "RTN","DGPFUT",172,0) MPIOK(DGDFN,DGICN,DGCMOR) ;return non-local CMOR and ICN "RTN","DGPFUT",173,0) ;This function retrieves an ICN given a pointer to the PATIENT (#2) file "RTN","DGPFUT",174,0) ;for a patient. When the ICN is not local and the local site is not the "RTN","DGPFUT",175,0) ;Coordinating Master of Record (CMOR), the CMOR is retrieved as a "RTN","DGPFUT",176,0) ;pointer to the INSTITUTION (#4) file. "RTN","DGPFUT",177,0) ; "RTN","DGPFUT",178,0) ; Supported DBIA #2701: The supported DBIA is used to access MPI "RTN","DGPFUT",179,0) ; APIs to retrieve ICN, determine if ICN "RTN","DGPFUT",180,0) ; is local and if site is CMOR. "RTN","DGPFUT",181,0) ; Supported DBIA #2702: The supported DBIA is used to retrieve the "RTN","DGPFUT",182,0) ; MPI node from the PATIENT (#2) file. "RTN","DGPFUT",183,0) ; "RTN","DGPFUT",184,0) ; Input: "RTN","DGPFUT",185,0) ; DGDFN - IEN of patient in PATIENT (#2) file "RTN","DGPFUT",186,0) ; DGICN - passed by reference to contain national ICN "RTN","DGPFUT",187,0) ; DGCMOR - passed by reference to contain CMOR "RTN","DGPFUT",188,0) ; "RTN","DGPFUT",189,0) ; Output: "RTN","DGPFUT",190,0) ; Function Value - 1 on national ICN and non-local CMOR, 0 on failure "RTN","DGPFUT",191,0) ; DGICN - Patient's Integrated Control Number "RTN","DGPFUT",192,0) ; DGCMOR - Pointer to INSTITUTION (#4) file for CMOR if CMOR "RTN","DGPFUT",193,0) ; is not local, undefined otherwise. "RTN","DGPFUT",194,0) ; "RTN","DGPFUT",195,0) N DGRSLT "RTN","DGPFUT",196,0) S DGRSLT=0 "RTN","DGPFUT",197,0) I $G(DGDFN)>0,$D(^DPT(DGDFN,"MPI")) D "RTN","DGPFUT",198,0) . S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFUT",199,0) . ; "RTN","DGPFUT",200,0) . ;ICN must be valid "RTN","DGPFUT",201,0) . Q:(DGICN'>0) "RTN","DGPFUT",202,0) . ; "RTN","DGPFUT",203,0) . ;ICN must not be local "RTN","DGPFUT",204,0) . Q:$$IFLOCAL^MPIF001(DGDFN) "RTN","DGPFUT",205,0) . ; "RTN","DGPFUT",206,0) . ;local site must not be CMOR site "RTN","DGPFUT",207,0) . Q:($$IFVCCI^MPIF001(DGDFN)=1) "RTN","DGPFUT",208,0) . ; "RTN","DGPFUT",209,0) . ;get CMOR institution number "RTN","DGPFUT",210,0) . S DGCMOR=$P($$MPINODE^MPIFAPI(DGDFN),U,3) "RTN","DGPFUT",211,0) . Q:(DGCMOR'>0) "RTN","DGPFUT",212,0) . ; "RTN","DGPFUT",213,0) . S DGRSLT=1 "RTN","DGPFUT",214,0) Q DGRSLT "RTN","DGPFUT1") 0^12^B26680017 "RTN","DGPFUT1",1,0) DGPFUT1 ;ALB/RBS - PRF UTILITIES CONTINUED ; 7/21/03 12:29pm "RTN","DGPFUT1",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFUT1",3,0) ; "RTN","DGPFUT1",4,0) Q ;no direct entry "RTN","DGPFUT1",5,0) ; "RTN","DGPFUT1",6,0) DISPACT(DGPFAPI) ;Display all ACTIVE Patient Record Flag's for a patient "RTN","DGPFUT1",7,0) ; Input: DGPFAPI() = Array of patients active flags "RTN","DGPFUT1",8,0) ; (passed by reference) "RTN","DGPFUT1",9,0) ; See $$GETACT^DGPFAPI for array format. "RTN","DGPFUT1",10,0) ; Output: None "RTN","DGPFUT1",11,0) ; "RTN","DGPFUT1",12,0) I '$G(DGPFAPI) Q ;no flags "RTN","DGPFUT1",13,0) ; "RTN","DGPFUT1",14,0) N DGPF,DGPFIEN,DGPFFLAG,DGPFCAT,IORVON,IORVOFF "RTN","DGPFUT1",15,0) W !!,">>> Active Patient Record Flag(s):" "RTN","DGPFUT1",16,0) ; "RTN","DGPFUT1",17,0) ; setup for reverse video display "RTN","DGPFUT1",18,0) ; "RTN","DGPFUT1",19,0) S (IORVON,IORVOFF)="" "RTN","DGPFUT1",20,0) D:$D(IOST(0)) "RTN","DGPFUT1",21,0) . N X S X="IORVON;IORVOFF" D ENDR^%ZISS "RTN","DGPFUT1",22,0) ; "RTN","DGPFUT1",23,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFUT1",24,0) S DGPFIEN="" F S DGPFIEN=$O(DGPFAPI(DGPFIEN)) Q:DGPFIEN="" D "RTN","DGPFUT1",25,0) . S DGPFFLAG=$P($G(DGPFAPI(DGPFIEN,"FLAG")),U,2) "RTN","DGPFUT1",26,0) . Q:(DGPFFLAG'["") "RTN","DGPFUT1",27,0) . S DGPFCAT=$P($P($G(DGPFAPI(DGPFIEN,"CATEGORY")),U,2)," ") "RTN","DGPFUT1",28,0) . W !?5,IORVON,"<"_DGPFFLAG_">",IORVOFF,?45,"CATEGORY ",DGPFCAT "RTN","DGPFUT1",29,0) W ! "RTN","DGPFUT1",30,0) Q "RTN","DGPFUT1",31,0) ; "RTN","DGPFUT1",32,0) ASKDET(DGPFOUT) ; Prompt to ask User for Displaying Flag Details "RTN","DGPFUT1",33,0) ; Input: None "RTN","DGPFUT1",34,0) ; Output: 1 = Yes, view flag details "RTN","DGPFUT1",35,0) ; 0 = No, quit "RTN","DGPFUT1",36,0) ; DGPFOUT = [Optional] Returns 1 if Timeout or Up-arrow "RTN","DGPFUT1",37,0) ; "RTN","DGPFUT1",38,0) N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT "RTN","DGPFUT1",39,0) S DIR(0)="Y",DIR("B")="YES" "RTN","DGPFUT1",40,0) S DIR("A")="Do you wish to view active patient record flag details" "RTN","DGPFUT1",41,0) D ^DIR "RTN","DGPFUT1",42,0) S DGPFOUT=$S(+$G(DIRUT):1,1:0) ;timeout or up-arrow "RTN","DGPFUT1",43,0) W:(+Y'=1) ! "RTN","DGPFUT1",44,0) Q $S(+Y'=1:0,1:1) "RTN","DGPFUT1",45,0) ; "RTN","DGPFUT1",46,0) DISPDET(DGPFAPI) ; Display the details of patients Active record flags "RTN","DGPFUT1",47,0) ; "RTN","DGPFUT1",48,0) ; Input: DGPFAPI() = Array of patients active flags "RTN","DGPFUT1",49,0) ; (passed by reference) "RTN","DGPFUT1",50,0) ; See $$GETACT^DGPFAPI for array format. "RTN","DGPFUT1",51,0) ; Output: None "RTN","DGPFUT1",52,0) ; "RTN","DGPFUT1",53,0) I '$G(DGPFAPI) Q ;no flags "RTN","DGPFUT1",54,0) ; "RTN","DGPFUT1",55,0) N DGPFI,DGPFQ,DGPFIEN,DGPFFLAG,IORVON,IORVOFF,DIRUT,DUOUT,DTOUT,X "RTN","DGPFUT1",56,0) ; "RTN","DGPFUT1",57,0) S (IORVON,IORVOFF)="" "RTN","DGPFUT1",58,0) D:$D(IOST(0)) "RTN","DGPFUT1",59,0) . N X S X="IORVON;IORVOFF" D ENDR^%ZISS "RTN","DGPFUT1",60,0) ; "RTN","DGPFUT1",61,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFUT1",62,0) S (DGPFIEN,DGPFQ)="" "RTN","DGPFUT1",63,0) F S DGPFIEN=$O(DGPFAPI(DGPFIEN)) Q:DGPFIEN="" D Q:DGPFQ "RTN","DGPFUT1",64,0) . S DGPFFLAG=$P($G(DGPFAPI(DGPFIEN,"FLAG")),U,2) "RTN","DGPFUT1",65,0) . Q:(DGPFFLAG'["") "RTN","DGPFUT1",66,0) . I $G(DGPFQ)=0 W ! S DGPFQ='$$CONTINUE^DGPFUT() Q:DGPFQ "RTN","DGPFUT1",67,0) . S DGPFQ=0 "RTN","DGPFUT1",68,0) . W:$E(IOST,1,2)="C-" @IOF "RTN","DGPFUT1",69,0) . W !?11,"Flag Name: ",IORVON,"<"_DGPFFLAG_">",IORVOFF "RTN","DGPFUT1",70,0) . W !?11,"Flag Type: ",$P($G(DGPFAPI(DGPFIEN,"FLAGTYPE")),U,2) "RTN","DGPFUT1",71,0) . W !?7,"Flag Category: ",$P($G(DGPFAPI(DGPFIEN,"CATEGORY")),U,2) "RTN","DGPFUT1",72,0) . W !?3,"Assignment Status: ACTIVE" "RTN","DGPFUT1",73,0) . W !?2,"Initial Assignment: ",$P($G(DGPFAPI(DGPFIEN,"ASSIGNDT")),U,2) "RTN","DGPFUT1",74,0) . W !?9,"Approved By: ",$P($G(DGPFAPI(DGPFIEN,"APPRVBY")),U,2) "RTN","DGPFUT1",75,0) . W !?4,"Next Review Date: ",$P($G(DGPFAPI(DGPFIEN,"REVIEWDT")),U,2) "RTN","DGPFUT1",76,0) . W !?10,"Owner Site: ",$P($G(DGPFAPI(DGPFIEN,"OWNER")),U,2) "RTN","DGPFUT1",77,0) . W !?4,"Originating Site: ",$P($G(DGPFAPI(DGPFIEN,"ORIGSITE")),U,2) "RTN","DGPFUT1",78,0) . W !,"Assignment Narrative:",!,"---------------------" "RTN","DGPFUT1",79,0) . I $D(DGPFAPI(DGPFIEN,"NARR",1,0)) D "RTN","DGPFUT1",80,0) . . S DGPFI="" "RTN","DGPFUT1",81,0) . . F S DGPFI=$O(DGPFAPI(DGPFIEN,"NARR",DGPFI)) Q:DGPFI="" D Q:DGPFQ "RTN","DGPFUT1",82,0) . . . I $Y>(IOSL-3) S DGPFQ='$$CONTINUE^DGPFUT() Q:DGPFQ S $Y=2 "RTN","DGPFUT1",83,0) . . . W !,$G(DGPFAPI(DGPFIEN,"NARR",DGPFI,0)) "RTN","DGPFUT1",84,0) ; "RTN","DGPFUT1",85,0) W !!,IORVON,"",IORVOFF,! "RTN","DGPFUT1",86,0) N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT "RTN","DGPFUT1",87,0) S DIR("A")="Enter RETURN to continue",DIR(0)="E" "RTN","DGPFUT1",88,0) D ^DIR K DIR "RTN","DGPFUT1",89,0) W ! "RTN","DGPFUT1",90,0) Q "RTN","DGPFUT1",91,0) ; "RTN","DGPFUT1",92,0) DISPPRF(DGDFN) ; Patient Record Flags screen Display "RTN","DGPFUT1",93,0) ; "RTN","DGPFUT1",94,0) ; Input: "RTN","DGPFUT1",95,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFUT1",96,0) ; "RTN","DGPFUT1",97,0) ; Output: "RTN","DGPFUT1",98,0) ; none "RTN","DGPFUT1",99,0) ; "RTN","DGPFUT1",100,0) ; patient ien not setup "RTN","DGPFUT1",101,0) S DGDFN=+$G(DGDFN) "RTN","DGPFUT1",102,0) Q:'DGDFN "RTN","DGPFUT1",103,0) ; "RTN","DGPFUT1",104,0) N DGPFAPI "RTN","DGPFUT1",105,0) ; "RTN","DGPFUT1",106,0) ; call API to get the display array for ALL Active Assignments "RTN","DGPFUT1",107,0) S DGPFAPI=$$GETACT^DGPFAPI(DGDFN,"DGPFAPI") ;DBIA #3860 "RTN","DGPFUT1",108,0) ; "RTN","DGPFUT1",109,0) ; quit if no Active Record Flags to display "RTN","DGPFUT1",110,0) Q:'+DGPFAPI "RTN","DGPFUT1",111,0) ; "RTN","DGPFUT1",112,0) ; call api to display Active Record Flags "RTN","DGPFUT1",113,0) D DISPACT(.DGPFAPI) "RTN","DGPFUT1",114,0) ; "RTN","DGPFUT1",115,0) ; prompt to ask User for Displaying Flag Details "RTN","DGPFUT1",116,0) Q:'$$ASKDET() "RTN","DGPFUT1",117,0) ; "RTN","DGPFUT1",118,0) ; display the details of patients Active record flags "RTN","DGPFUT1",119,0) ;D DISPDET(.DGPFAPI) ;roll-and-scroll "RTN","DGPFUT1",120,0) D EN^DGPFLMD(DGDFN,.DGPFAPI) ;ListMan "RTN","DGPFUT1",121,0) Q "RTN","DGPFUT1",122,0) ; "RTN","DGPFUT1",123,0) SELPAT(DGPAT) ;This procedure is used to perform a patient lookup for an existing patient in the PATIENT (#2) file. "RTN","DGPFUT1",124,0) ; "RTN","DGPFUT1",125,0) ; Input: None "RTN","DGPFUT1",126,0) ; "RTN","DGPFUT1",127,0) ; Output: "RTN","DGPFUT1",128,0) ; DGPAT - result array containing the patient selection on success, "RTN","DGPFUT1",129,0) ; pass by reference. Array will have same structure as the Y "RTN","DGPFUT1",130,0) ; variable returned by the ^DIC call. "RTN","DGPFUT1",131,0) ; Array Format: "RTN","DGPFUT1",132,0) ; ------------- "RTN","DGPFUT1",133,0) ; DGPAT = IEN of patient in PATIENT (#2) file on "RTN","DGPFUT1",134,0) ; success, -1 on failure "RTN","DGPFUT1",135,0) ; DGPAT(0) = zero node of entry selected "RTN","DGPFUT1",136,0) ; DGPAT(0,0) = external form of the .01 field of the entry "RTN","DGPFUT1",137,0) ; "RTN","DGPFUT1",138,0) ;- int input vars for ^DIC call "RTN","DGPFUT1",139,0) N DIC,DTOUT,DUPOT,X,Y "RTN","DGPFUT1",140,0) S DIC="^DPT(",DIC(0)="AEMQZV" "RTN","DGPFUT1",141,0) ; "RTN","DGPFUT1",142,0) ;- lookup patient "RTN","DGPFUT1",143,0) D ^DIC K DIC "RTN","DGPFUT1",144,0) ; "RTN","DGPFUT1",145,0) ;- result of lookup "RTN","DGPFUT1",146,0) S DGPAT=Y "RTN","DGPFUT1",147,0) ; "RTN","DGPFUT1",148,0) ;- if success, setup return array using output vars from ^DIC call "RTN","DGPFUT1",149,0) I (+DGPAT>0) D "RTN","DGPFUT1",150,0) . S DGPAT=+Y ;patient ien "RTN","DGPFUT1",151,0) . S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#2) file "RTN","DGPFUT1",152,0) . S DGPAT(0,0)=$G(Y(0,0)) ;external form of the .01 field "RTN","DGPFUT1",153,0) ; "RTN","DGPFUT1",154,0) Q "RTN","DGPFUT1",155,0) ; "RTN","DGPFUT1",156,0) ; "RTN","DGPFUT1",157,0) GETFLAG(DGPFPTR,DGPFLAG) ;retrieve a single FLAG record "RTN","DGPFUT1",158,0) ; This function acts as a wrapper around the $$GETLF and $$GETNF "RTN","DGPFUT1",159,0) ; API's. Function will be used to obtain a single flag record from "RTN","DGPFUT1",160,0) ; either the PRF LOCAL FLAG (#26.11) file or the PRF NATIONAL FLAG "RTN","DGPFUT1",161,0) ; (#26.15) file depending on the value of the DGPFPTR input parameter. "RTN","DGPFUT1",162,0) ; "RTN","DGPFUT1",163,0) ; Input: "RTN","DGPFUT1",164,0) ; DGPFPTR - (required) IEN of patient record flag in PRF NATIONAL "RTN","DGPFUT1",165,0) ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file. "RTN","DGPFUT1",166,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFUT1",167,0) ; "RTN","DGPFUT1",168,0) ; Output: "RTN","DGPFUT1",169,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFUT1",170,0) ; DGPFLAG - (required) result array passed by reference. See the "RTN","DGPFUT1",171,0) ; $$GETLF and $$GETNF for the result array structure. "RTN","DGPFUT1",172,0) ; "RTN","DGPFUT1",173,0) N RESULT ;returned function value "RTN","DGPFUT1",174,0) N DGPFIEN ;ien of PRF local or national flag file "RTN","DGPFUT1",175,0) N DGPFILE ;file # of PRF local or national flag file "RTN","DGPFUT1",176,0) ; "RTN","DGPFUT1",177,0) S RESULT=0 "RTN","DGPFUT1",178,0) ; "RTN","DGPFUT1",179,0) D "RTN","DGPFUT1",180,0) . ;-- quit if pointer is not valid "RTN","DGPFUT1",181,0) . Q:$G(DGPFPTR)']"" "RTN","DGPFUT1",182,0) . Q:'$$TESTVAL^DGPFUT(26.13,.02,DGPFPTR) "RTN","DGPFUT1",183,0) . ; "RTN","DGPFUT1",184,0) . ;-- get ien and file from pointer value "RTN","DGPFUT1",185,0) . S DGPFIEN=+$G(DGPFPTR) "RTN","DGPFUT1",186,0) . S DGPFILE=$P($G(DGPFPTR),";",2) "RTN","DGPFUT1",187,0) . ; "RTN","DGPFUT1",188,0) . ;-- if local flag file, get local flag into DGPFLAG array "RTN","DGPFUT1",189,0) . I DGPFILE["26.11" D "RTN","DGPFUT1",190,0) . . Q:'$$GETLF^DGPFALF(+DGPFIEN,.DGPFLAG) "RTN","DGPFUT1",191,0) . . S RESULT=1 ;success "RTN","DGPFUT1",192,0) . ; "RTN","DGPFUT1",193,0) . ;-- if national flag file, get national flag into DGPFLAG array "RTN","DGPFUT1",194,0) . I DGPFILE["26.15" D "RTN","DGPFUT1",195,0) . . Q:'$$GETNF^DGPFANF(+DGPFIEN,.DGPFLAG) "RTN","DGPFUT1",196,0) . . S RESULT=1 ;success "RTN","DGPFUT1",197,0) ; "RTN","DGPFUT1",198,0) Q RESULT "RTN","DGPFUT2") 0^13^B32476578 "RTN","DGPFUT2",1,0) DGPFUT2 ;ALB/KCL - PRF UTILITIES CONTINUED ; 8/15/03 1:43pm "RTN","DGPFUT2",2,0) ;;5.3;Registration;**425**;Aug 13, 1993 "RTN","DGPFUT2",3,0) ; "RTN","DGPFUT2",4,0) ; This routine contains generic calls for use throughout DGPF*. "RTN","DGPFUT2",5,0) ; "RTN","DGPFUT2",6,0) ;- no direct entry "RTN","DGPFUT2",7,0) QUIT "RTN","DGPFUT2",8,0) ; "RTN","DGPFUT2",9,0) ; "RTN","DGPFUT2",10,0) GETPAT(DGDFN,DGPAT) ;retrieve patient identifying information "RTN","DGPFUT2",11,0) ; Used to obtain identifying information for a patient "RTN","DGPFUT2",12,0) ; in the PATIENT (#2) file and place it in an array format. "RTN","DGPFUT2",13,0) ; "RTN","DGPFUT2",14,0) ; NOTE: Direct global reference of patient's zero node in the "RTN","DGPFUT2",15,0) ; PATIENT (#2) file is supported by DBIA #10035 "RTN","DGPFUT2",16,0) ; "RTN","DGPFUT2",17,0) ; Input: "RTN","DGPFUT2",18,0) ; DGDFN - (required) ien of patient in PATIENT (#2) file "RTN","DGPFUT2",19,0) ; "RTN","DGPFUT2",20,0) ; Output: "RTN","DGPFUT2",21,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFUT2",22,0) ; DGPAT - output array containing the patient identifying information, "RTN","DGPFUT2",23,0) ; on success, pass by reference. "RTN","DGPFUT2",24,0) ; Array subscripts are: "RTN","DGPFUT2",25,0) ; "DFN" - ien PATIENT (#2) file "RTN","DGPFUT2",26,0) ; "NAME" - patient name "RTN","DGPFUT2",27,0) ; "SSN" - patient Social Security Number "RTN","DGPFUT2",28,0) ; "DOB" - patient date of birth (FM format) "RTN","DGPFUT2",29,0) ; "SEX" - patient sex "RTN","DGPFUT2",30,0) ; "RTN","DGPFUT2",31,0) N DGNODE "RTN","DGPFUT2",32,0) N RESULT "RTN","DGPFUT2",33,0) ; "RTN","DGPFUT2",34,0) S RESULT=0 "RTN","DGPFUT2",35,0) ; "RTN","DGPFUT2",36,0) I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D "RTN","DGPFUT2",37,0) . "RTN","DGPFUT2",38,0) . ;-- obtain zero node of patient record (supported by DBIA #10035) "RTN","DGPFUT2",39,0) . S DGNODE=$G(^DPT(DGDFN,0)) "RTN","DGPFUT2",40,0) . ; "RTN","DGPFUT2",41,0) . S DGPAT("DFN")=DGDFN "RTN","DGPFUT2",42,0) . S DGPAT("NAME")=$P(DGNODE,"^") "RTN","DGPFUT2",43,0) . S DGPAT("SEX")=$P(DGNODE,"^",2) "RTN","DGPFUT2",44,0) . S DGPAT("DOB")=$P(DGNODE,"^",3) "RTN","DGPFUT2",45,0) . S DGPAT("SSN")=$P(DGNODE,"^",9) "RTN","DGPFUT2",46,0) . S RESULT=1 ;success "RTN","DGPFUT2",47,0) ; "RTN","DGPFUT2",48,0) Q RESULT "RTN","DGPFUT2",49,0) ; "RTN","DGPFUT2",50,0) GETDFN(DGICN,DGDOB,DGSSN) ;Convert ICN to DFN after verifying DOB and SSN "RTN","DGPFUT2",51,0) ; "RTN","DGPFUT2",52,0) ; Supported DBIA #2701: The supported DBIA is used to retrieve the "RTN","DGPFUT2",53,0) ; pointer (DFN) to the PATIENT (#2) file for a "RTN","DGPFUT2",54,0) ; given ICN. "RTN","DGPFUT2",55,0) ; "RTN","DGPFUT2",56,0) ; Input: "RTN","DGPFUT2",57,0) ; DGICN - Integrated Control Number with or without checksum "RTN","DGPFUT2",58,0) ; DGDOB - Date of Birth in FileMan format "RTN","DGPFUT2",59,0) ; DGSSN - Social Security Number with no delimiters "RTN","DGPFUT2",60,0) ; "RTN","DGPFUT2",61,0) ; Output: "RTN","DGPFUT2",62,0) ; Function Value - DFN on success, 0 on failure "RTN","DGPFUT2",63,0) ; "RTN","DGPFUT2",64,0) N DGDFN ;pointer to patient "RTN","DGPFUT2",65,0) N DGDPT ;patient data array "RTN","DGPFUT2",66,0) N DGRSLT ;function value "RTN","DGPFUT2",67,0) ; "RTN","DGPFUT2",68,0) S DGRSLT=0 "RTN","DGPFUT2",69,0) S DGICN=+$G(DGICN) "RTN","DGPFUT2",70,0) S DGDOB=+$G(DGDOB) "RTN","DGPFUT2",71,0) S DGSSN=+$G(DGSSN) "RTN","DGPFUT2",72,0) I DGICN,DGDOB,DGSSN D ;drops out of block on first failure "RTN","DGPFUT2",73,0) . S DGDFN=+$$GETDFN^MPIF001(DGICN) "RTN","DGPFUT2",74,0) . Q:(DGDFN'>0) "RTN","DGPFUT2",75,0) . Q:('$$GETPAT^DGPFUT2(DGDFN,.DGDPT)) "RTN","DGPFUT2",76,0) . Q:(DGDOB'=+DGDPT("DOB")) "RTN","DGPFUT2",77,0) . Q:(DGSSN'=+DGDPT("SSN")) "RTN","DGPFUT2",78,0) . S DGRSLT=DGDFN "RTN","DGPFUT2",79,0) Q DGRSLT "RTN","DGPFUT2",80,0) ; "RTN","DGPFUT2",81,0) SORT(DGPFAPI) ;sort active record flags by category then name "RTN","DGPFUT2",82,0) ; This procedure takes the initial active flag assignment list for a "RTN","DGPFUT2",83,0) ; patient and sorts it by category then by name. "RTN","DGPFUT2",84,0) ; "RTN","DGPFUT2",85,0) ; Input: "RTN","DGPFUT2",86,0) ; DGPFAPI - active flag data array list "RTN","DGPFUT2",87,0) ; "RTN","DGPFUT2",88,0) ; Output: "RTN","DGPFUT2",89,0) ; DGPFAPI - sorted active flag data array list "RTN","DGPFUT2",90,0) ; "RTN","DGPFUT2",91,0) N DGCAT ;category "RTN","DGPFUT2",92,0) N DGINDX ;index array "RTN","DGPFUT2",93,0) N DGNAME ;flag name "RTN","DGPFUT2",94,0) N DGSORT ;sorted data array "RTN","DGPFUT2",95,0) N DGX ;generic counter "RTN","DGPFUT2",96,0) ; "RTN","DGPFUT2",97,0) ;build index "RTN","DGPFUT2",98,0) S DGX=0 "RTN","DGPFUT2",99,0) F S DGX=$O(DGPFAPI(DGX)) Q:'DGX D "RTN","DGPFUT2",100,0) . S DGCAT=$S($P(DGPFAPI(DGX,"FLAG"),U)[26.11:2,1:1) "RTN","DGPFUT2",101,0) . S DGINDX(DGCAT,$P(DGPFAPI(DGX,"FLAG"),U,2))=DGX "RTN","DGPFUT2",102,0) ; "RTN","DGPFUT2",103,0) ;build sorted data array "RTN","DGPFUT2",104,0) S DGCAT=0,DGX=0 "RTN","DGPFUT2",105,0) F S DGCAT=$O(DGINDX(DGCAT)) Q:'DGCAT D "RTN","DGPFUT2",106,0) . S DGNAME="" "RTN","DGPFUT2",107,0) . F S DGNAME=$O(DGINDX(DGCAT,DGNAME)) Q:DGNAME="" D "RTN","DGPFUT2",108,0) . . S DGX=DGX+1 "RTN","DGPFUT2",109,0) . . M DGSORT(DGX)=DGPFAPI(DGINDX(DGCAT,DGNAME)) "RTN","DGPFUT2",110,0) ; "RTN","DGPFUT2",111,0) ;remove input array and replace with sorted array "RTN","DGPFUT2",112,0) K DGPFAPI "RTN","DGPFUT2",113,0) M DGPFAPI=DGSORT "RTN","DGPFUT2",114,0) Q "RTN","DGPFUT2",115,0) ; "RTN","DGPFUT2",116,0) ACTDT ; update PRF Software Activation Date field in (#26.18) "RTN","DGPFUT2",117,0) ; This utility should only be run at the Alpha and Beta test sites "RTN","DGPFUT2",118,0) ; of the Patient Record Flags Project, Patch DG*5.3*425. "RTN","DGPFUT2",119,0) ; If necessary, this entry point will change the date that the "RTN","DGPFUT2",120,0) ; Patient Record Flags (PRF) System became active. "RTN","DGPFUT2",121,0) ; The (#1) PRF SOFTWARE ACTIVATION DATE field of the (#26.18) PRF "RTN","DGPFUT2",122,0) ; PARAMETERS file, will be changed to: SEP 25, 2003 "RTN","DGPFUT2",123,0) ; "RTN","DGPFUT2",124,0) ; Input: none "RTN","DGPFUT2",125,0) ; "RTN","DGPFUT2",126,0) ; Output: User message on successful or failure of file update "RTN","DGPFUT2",127,0) ; "RTN","DGPFUT2",128,0) N DGACTDT ; Nationally Released Software Activation Date value "RTN","DGPFUT2",129,0) N DGIENS ; IEN - internal entry # OF (#26.18) FILE "RTN","DGPFUT2",130,0) N DGFLD ; PRF Software Activation Date field # "RTN","DGPFUT2",131,0) N DGFDA ; FDA data array for filer "RTN","DGPFUT2",132,0) N DGERR ; error message array returned from filer "RTN","DGPFUT2",133,0) N DGERRMSG ; error message for display "RTN","DGPFUT2",134,0) N DGPARM ; current internal/external values of field "RTN","DGPFUT2",135,0) ; "RTN","DGPFUT2",136,0) S DGACTDT="SEP 25, 2003" "RTN","DGPFUT2",137,0) S DGIENS="1," "RTN","DGPFUT2",138,0) S DGFLD=1 "RTN","DGPFUT2",139,0) ; "RTN","DGPFUT2",140,0) ; display user message "RTN","DGPFUT2",141,0) W !!,"Updating the PRF SOFTWARE ACTIVATION DATE (#1) field in the PRF PARAMETERS FILE (#26.18) to the value of SEP 25, 2003..." "RTN","DGPFUT2",142,0) ; "RTN","DGPFUT2",143,0) ; checks for necessary programmer variables "RTN","DGPFUT2",144,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D "RTN","DGPFUT2",145,0) . S DGERRMSG="Your programming variables are not set up properly." "RTN","DGPFUT2",146,0) ; "RTN","DGPFUT2",147,0) ; check if activation is not less than the current date "RTN","DGPFUT2",148,0) I '$D(DGERRMSG),DT<3030925 D "RTN","DGPFUT2",149,0) . S DGERRMSG="This file/field update can't be run before the date of SEP 25, 2003 is reached." "RTN","DGPFUT2",150,0) ; "RTN","DGPFUT2",151,0) ; get current activation date from PRF PARAMETERS (#26.18) file "RTN","DGPFUT2",152,0) I '$D(DGERRMSG) D "RTN","DGPFUT2",153,0) . D GETS^DIQ(26.18,"1,",1,"IE","DGPARM","DGERR") "RTN","DGPFUT2",154,0) . ; "RTN","DGPFUT2",155,0) . ; check for errors and inform the user "RTN","DGPFUT2",156,0) . I $D(DGERR) D Q "RTN","DGPFUT2",157,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",158,0) . ; "RTN","DGPFUT2",159,0) . ; check to make sure field is not set already "RTN","DGPFUT2",160,0) . I $G(DGPARM(26.18,"1,",1,"I"))=3030925 D "RTN","DGPFUT2",161,0) . . S DGERRMSG="The date value is already set to SEP 25, 2003." "RTN","DGPFUT2",162,0) ; "RTN","DGPFUT2",163,0) ; now start the (#26.18) filing process "RTN","DGPFUT2",164,0) I '$D(DGERRMSG) D "RTN","DGPFUT2",165,0) . ; "RTN","DGPFUT2",166,0) . ; DELETE activation date before filing since field is uneditable "RTN","DGPFUT2",167,0) . S DGFDA(26.18,DGIENS,1)="@" "RTN","DGPFUT2",168,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFUT2",169,0) . ; "RTN","DGPFUT2",170,0) . ; check for errors and inform the user "RTN","DGPFUT2",171,0) . I $D(DGERR) D Q "RTN","DGPFUT2",172,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",173,0) . ; "RTN","DGPFUT2",174,0) . ; setup and file the new activation date value (external) "RTN","DGPFUT2",175,0) . S DGFDA(26.18,DGIENS,1)=DGACTDT "RTN","DGPFUT2",176,0) . D FILE^DIE("SE","DGFDA","DGERR") "RTN","DGPFUT2",177,0) . ; "RTN","DGPFUT2",178,0) . ; check for success or errors and inform the user of update status "RTN","DGPFUT2",179,0) . I $D(DGERR) D Q "RTN","DGPFUT2",180,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",181,0) ; "RTN","DGPFUT2",182,0) ; display successful/failure file update - updated field and value "RTN","DGPFUT2",183,0) W !!,$C(7) "RTN","DGPFUT2",184,0) I $D(DGERRMSG) D "RTN","DGPFUT2",185,0) . W "Field could not be updated...",DGERRMSG "RTN","DGPFUT2",186,0) E D "RTN","DGPFUT2",187,0) . W "Field was successfully changed from ",$G(DGPARM(26.18,"1,",1,"E"))," to ",$G(DGFDA(26.18,DGIENS,DGFLD)),"." "RTN","DGPFUT2",188,0) ; "RTN","DGPFUT2",189,0) Q "RTN","DGREG") 0^46^B35298833 "RTN","DGREG",1,0) DGREG ;ALB/JDS,MRL-REGISTER PATIENT ; 5/28/03 1:12pm "RTN","DGREG",2,0) ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425**;Aug 13, 1993 "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)) I '$G(DG1010TF) W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S") 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",12,0) ; "RTN","DGREG",13,0) D CIRN "RTN","DGREG",14,0) ; "RTN","DGREG",15,0) I +$G(DGNEW) D "RTN","DGREG",16,0) . ; query CMOR for Patient Record Flag Assignments if NEW patient and "RTN","DGREG",17,0) . ; display results. "RTN","DGREG",18,0) . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) "RTN","DGREG",19,0) ; "RTN","DGREG",20,0) S (DGFC,CURR)=0 "RTN","DGREG",21,0) D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0) "RTN","DGREG",22,0) I '$G(DG1010TF) 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",23,0) I '$G(DG1010TF) D HINQ^DG10 "RTN","DGREG",24,0) I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3 "RTN","DGREG",25,0) D REG^IVMCQ($G(DFN)) ; send financial query "RTN","DGREG",26,0) G A1 "RTN","DGREG",27,0) ; "RTN","DGREG",28,0) RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3 "RTN","DGREG",29,0) Q "RTN","DGREG",30,0) ; "RTN","DGREG",31,0) A1 I '$G(DG1010TF) W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G Q:'$D(DA) "RTN","DGREG",32,0) G CH "RTN","DGREG",33,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",34,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",35,0) S CURR=% G SEEN "RTN","DGREG",36,0) ; "RTN","DGREG",37,0) CK S DGEDCN=1 D ^DGRPC "RTN","DGREG",38,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",39,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",40,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",41,0) ABIL D ^DGREGG "RTN","DGREG",42,0) ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94 "RTN","DGREG",43,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",44,0) REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// " "RTN","DGREG",45,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",46,0) I (RESULT'="^") W " ("_RESULT(0)_")" "RTN","DGREG",47,0) S DINUM=9999999-RESULT "RTN","DGREG",48,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",49,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",50,0) ; "RTN","DGREG",51,0) ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT "RTN","DGREG",52,0) S VAFCDDT=X "RTN","DGREG",53,0) ; "RTN","DGREG",54,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",55,0) I $G(DG1010TF) S DR=DR_";.2///1" "RTN","DGREG",56,0) D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK "RTN","DGREG",57,0) I $D(DTOUT) D G Q "RTN","DGREG",58,0) .K DTOUT "RTN","DGREG",59,0) .N DA,DIK "RTN","DGREG",60,0) .S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS""," "RTN","DGREG",61,0) .D ^DIK "RTN","DGREG",62,0) .W !!?5,"User Time-out. Required registration data could be missing." "RTN","DGREG",63,0) .W !,?5,"This registration has been deleted." "RTN","DGREG",64,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",65,0) S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^") "RTN","DGREG",66,0) I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE "RTN","DGREG",67,0) G ^DGREG0 "RTN","DGREG",68,0) PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG "RTN","DGREG",69,0) PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG "RTN","DGREG",70,0) H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1 "RTN","DGREG",71,0) Q K DG,DQ G Q1^DGREG0 "RTN","DGREG",72,0) Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q "RTN","DGREG",73,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",74,0) S DR=DR_"HUMANITARIAN EMERGENCY" Q "RTN","DGREG",75,0) FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1 "RTN","DGREG",76,0) ; "RTN","DGREG",77,0) EN1010T(DFN,DGNEWPF,DGDIV,DGIO,DGASKDEV,DG1010TF) ;Registration entry point for 10-10T "RTN","DGREG",78,0) S DGNEW=DGNEWPF ;set new patient flag "RTN","DGREG",79,0) I $G(DGASKDF) S DGASKDEV="" ;ask device flag "RTN","DGREG",80,0) D A "RTN","DGREG",81,0) K DFN1,DG1,DGMT,DGMTCOR,DGRGAUTO,DGWRT "RTN","DGREG",82,0) G Q1 "RTN","DGREG",83,0) ; "RTN","DGREG",84,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",85,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",86,0) Q "RTN","DGREG",87,0) MSG W !,"Another user is editing, try later ..." G Q "RTN","DGREG",88,0) ; "RTN","DGREG",89,0) BEGINREG(DFN) ; "RTN","DGREG",90,0) ;Description: This is called at the begining of the registration process. "RTN","DGREG",91,0) ;Concurrent processes can check the lock to determine if the patient is "RTN","DGREG",92,0) ;currently being registered. "RTN","DGREG",93,0) ; "RTN","DGREG",94,0) Q:'$G(DFN) 0 "RTN","DGREG",95,0) I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!! "RTN","DGREG",96,0) L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1 "RTN","DGREG",97,0) I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record "RTN","DGREG",98,0) Q "RTN","DGREG",99,0) ; "RTN","DGREG",100,0) ENDREG(DFN) ; "RTN","DGREG",101,0) ;Description: releases the lock obtained by calling BEGINREG. "RTN","DGREG",102,0) ; "RTN","DGREG",103,0) Q:'$G(DFN) "RTN","DGREG",104,0) L -^TMP(DFN,"REGISTRATION IN PROGRESS") "RTN","DGREG",105,0) D UNLOCK^DGENPTA1(DFN) "RTN","DGREG",106,0) Q "RTN","DGREG",107,0) ; "RTN","DGREG",108,0) IFREG(DFN) ; "RTN","DGREG",109,0) ;Description: tests whether the lock set by BEGINREG is set "RTN","DGREG",110,0) ; "RTN","DGREG",111,0) ;Input: DFN "RTN","DGREG",112,0) ;Output: "RTN","DGREG",113,0) ; Function Value = 1 if lock is set, 0 otherwise "RTN","DGREG",114,0) ; "RTN","DGREG",115,0) N RETURN "RTN","DGREG",116,0) Q:'$G(DFN) 0 "RTN","DGREG",117,0) L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1 "RTN","DGREG",118,0) S RETURN='$T "RTN","DGREG",119,0) L -^TMP(DFN,"REGISTRATION IN PROGRESS") "RTN","DGREG",120,0) Q RETURN "RTN","DGREG",121,0) Q "RTN","DGREG",122,0) CIRN ;MPI QUERY "RTN","DGREG",123,0) ;check to see if CIRN PD/MPI is installed "RTN","DGREG",124,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T "RTN","DGREG",125,0) K MPIFRTN "RTN","DGREG",126,0) D MPIQ^MPIFAPI(DFN) "RTN","DGREG",127,0) K MPIFRTN "RTN","DGREG",128,0) Q "RTN","DGRPT") 0^47^B1410821 "RTN","DGRPT",1,0) DGRPT ;ALB/RMO-10-10T Registration ; 2/20/03 12:05pm "RTN","DGRPT",2,0) ;;5.3;Registration;**108,149,425**;Aug 13, 1993 "RTN","DGRPT",3,0) ; "RTN","DGRPT",4,0) EN ;Entry point for 10-10T registration option "RTN","DGRPT",5,0) ; Input -- None "RTN","DGRPT",6,0) ; Output -- None "RTN","DGRPT",7,0) N DFN,DGNEWPF,DGRPTOUT "RTN","DGRPT",8,0) ; "RTN","DGRPT",9,0) ;Get Patient file (#2) IEN - DFN "RTN","DGRPT",10,0) D GETPAT^DGRPTU(1,1,.DFN,.DGNEWPF) G Q:DFN<0 "RTN","DGRPT",11,0) ; "RTN","DGRPT",12,0) ;MPI Query "RTN","DGRPT",13,0) ;check to see if CIRN PD/MPI is installed "RTN","DGRPT",14,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP "RTN","DGRPT",15,0) K MPIFRTN "RTN","DGRPT",16,0) D MPIQ^MPIFAPI(DFN) "RTN","DGRPT",17,0) K MPIFRTN "RTN","DGRPT",18,0) ; "RTN","DGRPT",19,0) I $G(DGNEWPF) D "RTN","DGRPT",20,0) . ; query CMOR for Patient Record Flag Assignments if NEW patient and "RTN","DGRPT",21,0) . ; display results. "RTN","DGRPT",22,0) . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN) "RTN","DGRPT",23,0) ; "RTN","DGRPT",24,0) SKIP ; "RTN","DGRPT",25,0) ;If new patient invoke 10-10T interview "RTN","DGRPT",26,0) I $G(DGNEWPF) D "RTN","DGRPT",27,0) . D INT^DGRPTI(DFN,DGNEWPF,.DGRPTOUT) "RTN","DGRPT",28,0) ELSE D "RTN","DGRPT",29,0) . ;Load 10-10T registration screen "RTN","DGRPT",30,0) . D EN^DGRPTL(DFN,.DGRPTOUT) "RTN","DGRPT",31,0) ;I VAFCFLDS IS DEFINED IT MEANS USER DIDN'T COMPLETE A 10-10 "RTN","DGRPT",32,0) ;REGISTRATION BUT DID EDIT SOME FIELDS FROM THAT OPTION "RTN","DGRPT",33,0) I $D(VAFCFLDS) D HL7A08^VAFCDD01 "RTN","DGRPT",34,0) Q Q "RTN","DGRPT",35,0) ; "RTN","DGSEC") 0^48^B42562784 "RTN","DGSEC",1,0) DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 2/21/03 10:19am "RTN","DGSEC",2,0) ;;5.3;Registration;**32,46,197,214,249,281,352,391,425**;Aug 13, 1993 "RTN","DGSEC",3,0) ; "RTN","DGSEC",4,0) ;Entry point from DPTLK "RTN","DGSEC",5,0) N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1 "RTN","DGSEC",6,0) ;Y=Patient file DFN "RTN","DGSEC",7,0) S DGY=Y "RTN","DGSEC",8,0) ;OWNREC^DGSEC4 parameters: "RTN","DGSEC",9,0) ; DGREC = output array passed by reference "RTN","DGSEC",10,0) ; DGY = Patient file DFN "RTN","DGSEC",11,0) ; DUZ = New Person file IEN "RTN","DGSEC",12,0) ; 1=generate error msg "RTN","DGSEC",13,0) ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry "RTN","DGSEC",14,0) ; DGPTSSN - set to patient's SSN when adding new Patient file entry "RTN","DGSEC",15,0) ; X=Patient's SSN from DPTLK2 "RTN","DGSEC",16,0) I $G(DGNEWPT)=1 S DGPTSSN=X "RTN","DGSEC",17,0) D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN)) "RTN","DGSEC",18,0) S Y=DGY "RTN","DGSEC",19,0) I DGREC(1)=1!(DGREC(1)=2) D G Q "RTN","DGSEC",20,0) .S Y=-1 "RTN","DGSEC",21,0) .D DISP(.DGREC) "RTN","DGSEC",22,0) .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME "RTN","DGSEC",23,0) ;SENS^DGSEC4 parameters: "RTN","DGSEC",24,0) ; DGSENS = output array passed by reference "RTN","DGSEC",25,0) ; Y = Patient fileDFN "RTN","DGSEC",26,0) ; DUZ = New Person file IEN "RTN","DGSEC",27,0) ; DDS - Screenman variable "RTN","DGSEC",28,0) ; DGSENFLG - If defined, patient record sensitivity not checked "RTN","DGSEC",29,0) D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG) "RTN","DGSEC",30,0) ;DUZ must be defined to access a sensitive record "RTN","DGSEC",31,0) I DGSENS(1)=-1 D G Q "RTN","DGSEC",32,0) .S Y=-1 "RTN","DGSEC",33,0) .D DISP(.DGSENS) "RTN","DGSEC",34,0) I DGSENS(1)=0 G Q "RTN","DGSEC",35,0) ;Get option name for DG Security Log file and bulletin "RTN","DGSEC",36,0) D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",37,0) I DGSENS(1)=1 D "RTN","DGSEC",38,0) .I DIC(0)["E" D "RTN","DGSEC",39,0) ..W $C(7) "RTN","DGSEC",40,0) ..D DISP(.DGSENS) "RTN","DGSEC",41,0) .I Y>0 D "RTN","DGSEC",42,0) ..;Parameters: DFN,DUZ,,Option name^Menu text "RTN","DGSEC",43,0) ..D SETLOG1(+Y,DUZ,,DGOPT) "RTN","DGSEC",44,0) I DGSENS(1)=2 D "RTN","DGSEC",45,0) .I DIC(0)["E" D "RTN","DGSEC",46,0) ..W $C(7) "RTN","DGSEC",47,0) ..D DISP(.DGSENS) "RTN","DGSEC",48,0) ..D NOTCE1 "RTN","DGSEC",49,0) .I Y>0 D "RTN","DGSEC",50,0) ..D SETLOG1(+Y,DUZ,,DGOPT) "RTN","DGSEC",51,0) ..;Parameters: DFN,DUZ,Option name^Menu text,message array "RTN","DGSEC",52,0) ..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG) "RTN","DGSEC",53,0) ..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG) "RTN","DGSEC",54,0) D Q "RTN","DGSEC",55,0) Q "RTN","DGSEC",56,0) ; "RTN","DGSEC",57,0) REC ;DPTLK2 entry point when adding new Patient file record "RTN","DGSEC",58,0) ;Input: X=Patient's SSN "RTN","DGSEC",59,0) ;Output: DGREC=1 (adding own record or SSN not defined) or 0 "RTN","DGSEC",60,0) ; "RTN","DGSEC",61,0) ;Parameters: DGREC=output array "RTN","DGSEC",62,0) ; DUZ "RTN","DGSEC",63,0) ; 1 - generate error msg "RTN","DGSEC",64,0) ; DGNEWPT = 1 (adding new Patient (#2) file record "RTN","DGSEC",65,0) ; DGPTSSN = X (Patient's SSN) "RTN","DGSEC",66,0) N DGPTSSN "RTN","DGSEC",67,0) S DGPTSSN=X "RTN","DGSEC",68,0) D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN)) "RTN","DGSEC",69,0) I DGREC(1)=1!(DGREC(1)=2) D "RTN","DGSEC",70,0) .D DISP(.DGREC) "RTN","DGSEC",71,0) .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME "RTN","DGSEC",72,0) S DGREC=+DGREC(1) "RTN","DGSEC",73,0) I DGREC=2 S DGREC=1 "RTN","DGSEC",74,0) Q "RTN","DGSEC",75,0) SETLOG ;Entry point for DBIA #2242 "RTN","DGSEC",76,0) ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text "RTN","DGSEC",77,0) D SETLOG1(Y,DUZ,DG1,DGOPT) "RTN","DGSEC",78,0) D Q "RTN","DGSEC",79,0) Q "RTN","DGSEC",80,0) BULTIN ;Entry point for DBIA #2242 "RTN","DGSEC",81,0) ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text "RTN","DGSEC",82,0) D BULTIN1(Y,DUZ,DGOPT) "RTN","DGSEC",83,0) Q "RTN","DGSEC",84,0) SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1) "RTN","DGSEC",85,0) ;Input: "RTN","DGSEC",86,0) ; DFN - Patient (#2) file DFN (Required) "RTN","DGSEC",87,0) ; DGDUZ - New Person (#200) file IEN "RTN","DGSEC",88,0) ; DG1 - Inpatient or Outpatient (Optional) "RTN","DGSEC",89,0) ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional) "RTN","DGSEC",90,0) ; "RTN","DGSEC",91,0) N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT "RTN","DGSEC",92,0) ;Lock global "RTN","DGSEC",93,0) LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK "RTN","DGSEC",94,0) ;Add new entry for patient if not found "RTN","DGSEC",95,0) I '$D(^DGSL(38.1,+DFN,0)) D "RTN","DGSEC",96,0) .S ^DGSL(38.1,+DFN,0)=+DFN "RTN","DGSEC",97,0) .S ^DGSL(38.1,"B",+DFN,+DFN)="" "RTN","DGSEC",98,0) .S $P(^DGSL(38.1,0),U,3)=+DFN "RTN","DGSEC",99,0) .S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1 "RTN","DGSEC",100,0) .;Determine if entry is automatically sensitive "RTN","DGSEC",101,0) .N ELIG,FLAG,X "RTN","DGSEC",102,0) .S FLAG=0 "RTN","DGSEC",103,0) .S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"") "RTN","DGSEC",104,0) .I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1 "RTN","DGSEC",105,0) .I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG "RTN","DGSEC",106,0) ..S X=$G(^DIC(8,ELIG,0)) "RTN","DGSEC",107,0) ..I $P(X,"^",12) S FLAG=1 "RTN","DGSEC",108,0) .S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG "RTN","DGSEC",109,0) .;Date/time sensitivity was set "RTN","DGSEC",110,0) .S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT() "RTN","DGSEC",111,0) ;determine if an inpatient "RTN","DGSEC",112,0) D H^DGUTL "RTN","DGSEC",113,0) S DGT=DGTIME "RTN","DGSEC",114,0) I $G(DG1)="" D ^DGPMSTAT "RTN","DGSEC",115,0) ;get option name "RTN","DGSEC",116,0) I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",117,0) SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR "RTN","DGSEC",118,0) S:'$D(^DGSL(38.1,+DFN,"D",0)) ^(0)="^38.11DA^^" S ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$P(DGOPT,U,2)_U_$S(DG1:"y",1:"n"),$P(^(0),U,3,4)=DGDTE_U_($P(^DGSL(38.1,+DFN,"D",0),U,4)+1) "RTN","DGSEC",119,0) S ^DGSL(38.1,"AD",DGDTE,+DFN)="" "RTN","DGSEC",120,0) S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)="" "RTN","DGSEC",121,0) L -^DGSL(38.1,+DFN) "RTN","DGSEC",122,0) Q "RTN","DGSEC",123,0) Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT "RTN","DGSEC",124,0) N DGTEST S DGTEST=^%ZOSF("TEST") "RTN","DGSEC",125,0) I DIC(0)["E",Y>0 D "RTN","DGSEC",126,0) .S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display "RTN","DGSEC",127,0) ..N DGPFSAVY S DGPFSAVY=Y "RTN","DGSEC",128,0) ..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY "RTN","DGSEC",129,0) .S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI "RTN","DGSEC",130,0) .S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD "RTN","DGSEC",131,0) .S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR "RTN","DGSEC",132,0) Q "RTN","DGSEC",133,0) ; "RTN","DGSEC",134,0) BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin "RTN","DGSEC",135,0) ; "RTN","DGSEC",136,0) ;Input: DFN = Patient file IEN "RTN","DGSEC",137,0) ; DGDUZ = New Person (#200) file IEN "RTN","DGSEC",138,0) ; DGOPT = Option (#19) file Name (#.01)^Menu text "RTN","DGSEC",139,0) ; DGMSG = Message array (Optional) "RTN","DGSEC",140,0) ; "RTN","DGSEC",141,0) N DGEMPLEE,XMSUB,XQOPT "RTN","DGSEC",142,0) K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10 "RTN","DGSEC",143,0) Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED" "RTN","DGSEC",144,0) S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB "RTN","DGSEC",145,0) S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB) "RTN","DGSEC",146,0) I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",147,0) N XMB,XMY,XMY0,XMZ "RTN","DGSEC",148,0) S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U) "RTN","DGSEC",149,0) S DGEMPLEE=$$EMPL^DGSEC4(+DFN) "RTN","DGSEC",150,0) I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)" "RTN","DGSEC",151,0) S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)="" "RTN","DGSEC",152,0) N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y "RTN","DGSEC",153,0) D SEND(.XMB,.XMY) "RTN","DGSEC",154,0) S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer." "RTN","DGSEC",155,0) Q "RTN","DGSEC",156,0) ; "RTN","DGSEC",157,0) SEND(XMB,XMY) ;Queue mail bulletin "RTN","DGSEC",158,0) ;Input: XMB,XMY=Mailman bulletin parameters "RTN","DGSEC",159,0) ; "RTN","DGSEC",160,0) N ZTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DGI,X,Y "RTN","DGSEC",161,0) F DGI="XMB","XMB(","XMY(" S ZTSAVE(DGI)="" "RTN","DGSEC",162,0) S ZTRTN="EN^XMB",ZTDESC="DG Security Bulletin",ZTIO="",ZTDTH=$H "RTN","DGSEC",163,0) D ^%ZTLOAD "RTN","DGSEC",164,0) Q "RTN","DGSEC",165,0) ; "RTN","DGSEC",166,0) DISP(ARRAY) ;Display message text to screen "RTN","DGSEC",167,0) ;Input: Array containg message text "RTN","DGSEC",168,0) ; "RTN","DGSEC",169,0) I '$D(ARRAY) Q "RTN","DGSEC",170,0) I DIC(0)'["E" Q "RTN","DGSEC",171,0) I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM") "RTN","DGSEC",172,0) N DGI,DGWHERE "RTN","DGSEC",173,0) I '$D(DDS) W !! "RTN","DGSEC",174,0) F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D "RTN","DGSEC",175,0) .S DGWHERE=(80-$L(ARRAY(DGI)))\2 "RTN","DGSEC",176,0) .W ?DGWHERE,ARRAY(DGI),! "RTN","DGSEC",177,0) Q "RTN","DGSEC",178,0) ; "RTN","DGSEC",179,0) NOTCE1 W:'$D(DDS) !! W "Do you want to continue processing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue processing, or 'NO' to quit processing this record." W:$D(DDS) ! G NOTCE1 "RTN","DGSEC",180,0) .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY "RTN","DGSEC",181,0) Q "RTN","DGSEC",182,0) ; "RTN","DGSEC",183,0) LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array "RTN","DGSEC",184,0) ;PDX plans to use this - remember to NEW DIC before ^XMD call "RTN","DGSEC",185,0) ; Input - None "RTN","DGSEC",186,0) ; Output - XMY("G.mailgroupname")="" if field #509 is defined "RTN","DGSEC",187,0) ; where mailgroupname is text value of mail group "RTN","DGSEC",188,0) ; Returns: 0 - Ok "RTN","DGSEC",189,0) ; -1^errortext - if can't find mail group "RTN","DGSEC",190,0) ; "RTN","DGSEC",191,0) N DGB,DGERR "RTN","DGSEC",192,0) S DGERR=0 "RTN","DGSEC",193,0) S DGB=+$P($G(^DG(43,1,"NOT")),"^",10) "RTN","DGSEC",194,0) I '$D(^XMB(3.8,DGB,0))#2 S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX "RTN","DGSEC",195,0) S XMY("G."_$P($G(^XMB(3.8,DGB,0)),"^",1))="" ; pass mailgroup "RTN","DGSEC",196,0) QTLOADX Q DGERR "SEC","^DIC",26.13,26.13,0,"AUDIT") @ "SEC","^DIC",26.13,26.13,0,"DD") @ "SEC","^DIC",26.13,26.13,0,"DEL") @ "SEC","^DIC",26.13,26.13,0,"LAYGO") @ "SEC","^DIC",26.13,26.13,0,"RD") d "SEC","^DIC",26.13,26.13,0,"WR") @ "VER") 8.0^22.0 "^DD",26.11,26.11,0) FIELD^^.06^8 "^DD",26.11,26.11,0,"DDA") N "^DD",26.11,26.11,0,"DT") 3030425 "^DD",26.11,26.11,0,"ID",.02) W " ",@("$P($P($C(59)_$S($D(^DD(26.11,.02,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,2)_"":"",2),$C(59),1)") "^DD",26.11,26.11,0,"ID",.03) S %I=Y,Y=$S('$D(^(0)):"",$D(^DGPF(26.16,+$P(^(0),U,3),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(26.16,.01,0),U,2) D Y^DIQ:Y]"" W " ",Y,@("$E("_DIC_"%I,0),0)") S Y=%I K %I "^DD",26.11,26.11,0,"IX","B",26.11,.01) "^DD",26.11,26.11,0,"NM","PRF LOCAL FLAG") "^DD",26.11,26.11,0,"PT",26.12,.01) "^DD",26.11,26.11,0,"PT",26.13,.02) "^DD",26.11,26.11,.01,0) NAME^RFXI^^0;1^S X=$$UP^XLFSTR(X) K:$L(X)>30!($L(X)<3)!'($TR(X," ","")?1.U) X "^DD",26.11,26.11,.01,.1) PATIENT RECORD FLAG NAME "^DD",26.11,26.11,.01,1,0) ^.1 "^DD",26.11,26.11,.01,1,1,0) 26.11^B "^DD",26.11,26.11,.01,1,1,1) S ^DGPF(26.11,"B",$E(X,1,30),DA)="" "^DD",26.11,26.11,.01,1,1,2) K ^DGPF(26.11,"B",$E(X,1,30),DA) "^DD",26.11,26.11,.01,3) Answer must be 3-30 characters in length. No punctuation characters except spaces maybe used. "^DD",26.11,26.11,.01,21,0) ^.001^1^1^3030418^^^^ "^DD",26.11,26.11,.01,21,1,0) This field contains the locally assigned name of the Patient Record Flag. "^DD",26.11,26.11,.01,"DT") 3030423 "^DD",26.11,26.11,.02,0) STATUS^RSI^0:INACTIVE;1:ACTIVE;^0;2^Q "^DD",26.11,26.11,.02,3) Enter the status of the patient record flag. "^DD",26.11,26.11,.02,21,0) ^^3^3^3030418^ "^DD",26.11,26.11,.02,21,1,0) This field contains the ACTIVE or INACTIVE status of the Patient Record "^DD",26.11,26.11,.02,21,2,0) Flag. Changing this field from ACTIVE to INACTIVE will inactivate all "^DD",26.11,26.11,.02,21,3,0) patient record flag assignments associated with this flag. "^DD",26.11,26.11,.02,23,0) ^.001^8^8^3030418^^^ "^DD",26.11,26.11,.02,23,1,0) This field contains the Active or Inactive status of the Patient Record "^DD",26.11,26.11,.02,23,2,0) Flag as a set of codes. "^DD",26.11,26.11,.02,23,3,0) This field will be used as a trigger that will be fired when the Status "^DD",26.11,26.11,.02,23,4,0) of either a LOCAL (#26.11) or a NATIONAL (#26.15) Patient Record Flag is "^DD",26.11,26.11,.02,23,5,0) changed from Active to Inactive. "^DD",26.11,26.11,.02,23,6,0) The trigger process will Inactivate ALL active Patient Record Flag "^DD",26.11,26.11,.02,23,7,0) Assignment records in the PRF ASSIGNMENT (#26.13) file associated with "^DD",26.11,26.11,.02,23,8,0) this flag. "^DD",26.11,26.11,.02,"DT") 3030423 "^DD",26.11,26.11,.03,0) TYPE^RP26.16'I^DGPF(26.16,^0;3^Q "^DD",26.11,26.11,.03,3) Enter the Patient Record Flag Type. "^DD",26.11,26.11,.03,21,0) ^.001^1^1^3030424^^^ "^DD",26.11,26.11,.03,21,1,0) This field identifies the usage classification of the Patient Record Flag. "^DD",26.11,26.11,.03,23,0) ^.001^2^2^3030424^^^^ "^DD",26.11,26.11,.03,23,1,0) This field identifies the usage classification of the Patient Record Flag "^DD",26.11,26.11,.03,23,2,0) as a pointer to the PRF TYPE file (#26.16). "^DD",26.11,26.11,.03,"DT") 3030423 "^DD",26.11,26.11,.04,0) REVIEW FREQUENCY DAYS^RNJ4,0I^^0;4^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1N.N) X "^DD",26.11,26.11,.04,3) Enter a number of days from 0 to 9999. (ex: 730 days = 2 years) "^DD",26.11,26.11,.04,21,0) ^.001^3^3^3030418^^ "^DD",26.11,26.11,.04,21,1,0) This field represents the number of days that may elapse between reviews "^DD",26.11,26.11,.04,21,2,0) of a Patient Record Flag Assignment. A value of zero ("0") indicates "^DD",26.11,26.11,.04,21,3,0) that no automatic review will occur. (example: 730 = 2 years) "^DD",26.11,26.11,.04,"DT") 3030731 "^DD",26.11,26.11,.05,0) NOTIFICATION DAYS^RNJ4,0I^^0;5^K:+X'=X!(X>9998)!(X<0)!(X?.E1"."1N.N) X "^DD",26.11,26.11,.05,3) Enter a Number between 0 and 9998, 0 Decimal Digits "^DD",26.11,26.11,.05,21,0) ^^5^5^3030418^ "^DD",26.11,26.11,.05,21,1,0) This field contains the number of days prior to a patient record flag "^DD",26.11,26.11,.05,21,2,0) assignment's Review date that a review notification is sent to "^DD",26.11,26.11,.05,21,3,0) the flag's Review Mail Group. A value of zero ("0") indicates "^DD",26.11,26.11,.05,21,4,0) that NO prior notification is required. This field should always be less "^DD",26.11,26.11,.05,21,5,0) than the Review Frequency field value. "^DD",26.11,26.11,.05,"DT") 3030423 "^DD",26.11,26.11,.06,0) REVIEW MAIL GROUP^*P3.8'I^XMB(3.8,^0;6^S DIC("S")="I $E($P(^(0),""^""),1,4)=""DGPF""" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",26.11,26.11,.06,3) Enter the mail group that will receive review notifications. "^DD",26.11,26.11,.06,12) Allows only mail group names that begin with DGPF. "^DD",26.11,26.11,.06,12.1) S DIC("S")="I $E($P(^(0),""^""),1,4)=""DGPF""" "^DD",26.11,26.11,.06,21,0) ^^7^7^3030425^ "^DD",26.11,26.11,.06,21,1,0) This field contains the name of the mail group whose members will "^DD",26.11,26.11,.06,21,2,0) receive MailMan notification of Patient Record Flag Assignments "^DD",26.11,26.11,.06,21,3,0) that are due for review. "^DD",26.11,26.11,.06,21,4,0) "^DD",26.11,26.11,.06,21,5,0) The mail group name must begin with 'DGPF' and it is further recommended "^DD",26.11,26.11,.06,21,6,0) that locally-defined flag mail group names begin with 'DGPFZ' to prevent "^DD",26.11,26.11,.06,21,7,0) conflicts with nationally-released patient record flags. "^DD",26.11,26.11,.06,"DT") 3030425 "^DD",26.11,26.11,1,0) DESCRIPTION^26.111^^1;0 "^DD",26.11,26.11,1,21,0) ^^2^2^3030423^ "^DD",26.11,26.11,1,21,1,0) This field contains the text that describes the purpose and instructions "^DD",26.11,26.11,1,21,2,0) for application of this local Patient Record Flag to a patient. "^DD",26.11,26.11,1,"DT") 3021226 "^DD",26.11,26.11,2,0) PRINCIPAL INVESTIGATOR(S)^26.112PA^^2;0 "^DD",26.11,26.11,2,21,0) ^^2^2^3030418^ "^DD",26.11,26.11,2,21,1,0) This multiple field contains the principal investigator(s) names when the "^DD",26.11,26.11,2,21,2,0) Flag TYPE is RESEARCH. "^DD",26.11,26.11,2,23,0) ^.001^3^3^3030418^^ "^DD",26.11,26.11,2,23,1,0) This multiple field contains the principal investigator(s) names as a "^DD",26.11,26.11,2,23,2,0) pointer to the NEW PERSON file (#200). This field is only used when the "^DD",26.11,26.11,2,23,3,0) Flag TYPE is RESEARCH. "^DD",26.11,26.111,0) DESCRIPTION SUB-FIELD^^.01^1 "^DD",26.11,26.111,0,"DT") 3021129 "^DD",26.11,26.111,0,"NM","DESCRIPTION") "^DD",26.11,26.111,0,"UP") 26.11 "^DD",26.11,26.111,.01,0) DESCRIPTION^WL^^0;1^Q "^DD",26.11,26.111,.01,3) Enter the purpose and instructions for assigning this flag. "^DD",26.11,26.111,.01,"DT") 3030423 "^DD",26.11,26.112,0) PRINCIPAL INVESTIGATOR(S) SUB-FIELD^^.01^1 "^DD",26.11,26.112,0,"DT") 3030304 "^DD",26.11,26.112,0,"IX","B",26.112,.01) "^DD",26.11,26.112,0,"NM","PRINCIPAL INVESTIGATOR(S)") "^DD",26.11,26.112,0,"UP") 26.11 "^DD",26.11,26.112,.01,0) PRINCIPAL INVESTIGATOR(S)^MP200'I^VA(200,^0;1^Q "^DD",26.11,26.112,.01,1,0) ^.1 "^DD",26.11,26.112,.01,1,1,0) 26.112^B "^DD",26.11,26.112,.01,1,1,1) S ^DGPF(26.11,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",26.11,26.112,.01,1,1,2) K ^DGPF(26.11,DA(1),2,"B",$E(X,1,30),DA) "^DD",26.11,26.112,.01,3) Enter the Principal Investigator name. "^DD",26.11,26.112,.01,4) I $D(DGLKUP) D PIHELP^DGPFDD "^DD",26.11,26.112,.01,21,0) ^^2^2^3030418^ "^DD",26.11,26.112,.01,21,1,0) This field contains the name of the Principal Investigator associated "^DD",26.11,26.112,.01,21,2,0) with the Research Type of this Patient Record Flag. "^DD",26.11,26.112,.01,"DT") 3030423 "^DD",26.12,26.12,0) FIELD^^.04^5 "^DD",26.12,26.12,0,"DDA") N "^DD",26.12,26.12,0,"DT") 3030207 "^DD",26.12,26.12,0,"ID",.02) W " ",$$FMTE^DILIBF($P(^(0),U,2),6) "^DD",26.12,26.12,0,"IX","B",26.12,.01) "^DD",26.12,26.12,0,"NM","PRF LOCAL FLAG HISTORY") "^DD",26.12,26.12,.001,0) NUMBER^NJ15,0I^^ ^K:+X'=X!(X>999999999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",26.12,26.12,.001,3) Type a Number between 1 and 999999999999999, 0 Decimal Digits "^DD",26.12,26.12,.001,21,0) ^^3^3^3030227^ "^DD",26.12,26.12,.001,21,1,0) This is the internal entry number which is assigned to each record of "^DD",26.12,26.12,.001,21,2,0) this file. This field can be used to help in identifying all History "^DD",26.12,26.12,.001,21,3,0) records for each Enter/Edit/Review to the PRF LOCAL FLAG (#26.11) record. "^DD",26.12,26.12,.001,"DT") 3030423 "^DD",26.12,26.12,.01,0) FLAG NAME^RP26.11'I^DGPF(26.11,^0;1^Q "^DD",26.12,26.12,.01,1,0) ^.1 "^DD",26.12,26.12,.01,1,1,0) 26.12^B "^DD",26.12,26.12,.01,1,1,1) S ^DGPF(26.12,"B",$E(X,1,30),DA)="" "^DD",26.12,26.12,.01,1,1,2) K ^DGPF(26.12,"B",$E(X,1,30),DA) "^DD",26.12,26.12,.01,3) "^DD",26.12,26.12,.01,21,0) ^^2^2^3030509^ "^DD",26.12,26.12,.01,21,1,0) This field contains the record flag name that is associated with the "^DD",26.12,26.12,.01,21,2,0) history record. "^DD",26.12,26.12,.01,23,0) ^.001^2^2^3030418^^ "^DD",26.12,26.12,.01,23,1,0) This field contains a pointer to the record flag NAME field (#.01) of the "^DD",26.12,26.12,.01,23,2,0) PRF LOCAL FLAG (#26.11) file. "^DD",26.12,26.12,.01,"DT") 3030509 "^DD",26.12,26.12,.02,0) FLAG EDIT DATE/TIME^RDI^^0;2^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.12,26.12,.02,21,0) ^^2^2^3030418^ "^DD",26.12,26.12,.02,21,1,0) This field contains the date/time that an entry in the PRF LOCAL FLAG "^DD",26.12,26.12,.02,21,2,0) file was Entered, Edited, or Reviewed. "^DD",26.12,26.12,.02,"DT") 3030423 "^DD",26.12,26.12,.03,0) ENTERED/EDITED BY^RP200'I^VA(200,^0;3^Q "^DD",26.12,26.12,.03,21,0) ^^2^2^3030418^ "^DD",26.12,26.12,.03,21,1,0) This field contains the name of the person making the Enter/Edit/Review to "^DD",26.12,26.12,.03,21,2,0) the associated PRF LOCAL FLAG record. "^DD",26.12,26.12,.03,23,0) ^.001^3^3^3030418^^ "^DD",26.12,26.12,.03,23,1,0) This field contains the pointer to the NEW PERSON FILE (#200) of the "^DD",26.12,26.12,.03,23,2,0) person making the Enter/Edit/Review to the associated PRF LOCAL FLAG "^DD",26.12,26.12,.03,23,3,0) (#26.11) record. "^DD",26.12,26.12,.03,"DT") 3030423 "^DD",26.12,26.12,.04,0) EDIT REASON^26.122^^1;0 "^DD",26.12,26.12,.04,21,0) ^.001^2^2^3030418^^ "^DD",26.12,26.12,.04,21,1,0) This field contains the text of the reason for the Enter/Edit/Review to "^DD",26.12,26.12,.04,21,2,0) the associated PRF LOCAL FLAG record. "^DD",26.12,26.122,0) EDIT REASON SUB-FIELD^^.01^1 "^DD",26.12,26.122,0,"DT") 3021129 "^DD",26.12,26.122,0,"NM","EDIT REASON") "^DD",26.12,26.122,0,"UP") 26.12 "^DD",26.12,26.122,.01,0) EDIT REASON^WL^^0;1^Q "^DD",26.12,26.122,.01,21,0) ^^2^2^3030418^ "^DD",26.12,26.122,.01,21,1,0) This field contains the comment text that applies to the reason for the "^DD",26.12,26.122,.01,21,2,0) Enter/Edit/Review to the associated PRF LOCAL FLAG record. "^DD",26.12,26.122,.01,"DT") 3030227 "^DD",26.13,26.13,0) FIELD^^1^8 "^DD",26.13,26.13,0,"DDA") N "^DD",26.13,26.13,0,"DT") 3030423 "^DD",26.13,26.13,0,"ID",.02) S DIY=$S($D(@(DIC_(+Y)_",""0"")")):$P(^("0"),U,2),1:"") D NAME^DICM2 W " ",DINAME,@("$E("_DIC_"Y,0),0)") "^DD",26.13,26.13,0,"IX","B",26.13,.01) "^DD",26.13,26.13,0,"NM","PRF ASSIGNMENT") "^DD",26.13,26.13,0,"PT",26.14,.01) "^DD",26.13,26.13,.001,0) NUMBER^NJ15,0I^^ ^K:+X'=X!(X>999999999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",26.13,26.13,.001,3) Type a Number between 1 and 999999999999999, 0 Decimal Digits "^DD",26.13,26.13,.001,21,0) ^^2^2^3021210^ "^DD",26.13,26.13,.001,21,1,0) This is the internal entry number which is assigned to each record of this "^DD",26.13,26.13,.001,21,2,0) file. "^DD",26.13,26.13,.001,"DT") 3030423 "^DD",26.13,26.13,.01,0) PATIENT NAME^RP2'I^DPT(^0;1^Q "^DD",26.13,26.13,.01,1,0) ^.1 "^DD",26.13,26.13,.01,1,1,0) 26.13^B "^DD",26.13,26.13,.01,1,1,1) S ^DGPF(26.13,"B",$E(X,1,30),DA)="" "^DD",26.13,26.13,.01,1,1,2) K ^DGPF(26.13,"B",$E(X,1,30),DA) "^DD",26.13,26.13,.01,3) Enter the patient for this record flag assignment. "^DD",26.13,26.13,.01,21,0) ^^2^2^3030421^ "^DD",26.13,26.13,.01,21,1,0) This field contains the name of the patient that has been assigned the "^DD",26.13,26.13,.01,21,2,0) PATIENT RECORD FLAG. "^DD",26.13,26.13,.01,23,0) ^.001^2^2^3030421^^ "^DD",26.13,26.13,.01,23,1,0) This field contains a pointer to the PATIENT FILE (#2) of the patient "^DD",26.13,26.13,.01,23,2,0) that has been assigned the PATIENT RECORD FLAG. "^DD",26.13,26.13,.01,"DT") 3030423 "^DD",26.13,26.13,.02,0) FLAG NAME^RVI^^0;2^Q "^DD",26.13,26.13,.02,3) Enter the patient record flag name. "^DD",26.13,26.13,.02,21,0) ^.001^2^2^3030423^^ "^DD",26.13,26.13,.02,21,1,0) This field contains the Patient Record Flag Name that is assigned to a "^DD",26.13,26.13,.02,21,2,0) patient. "^DD",26.13,26.13,.02,23,0) ^.001^3^3^3030423^^^ "^DD",26.13,26.13,.02,23,1,0) This field contains the Patient Record Flag Name that is assigned to a "^DD",26.13,26.13,.02,23,2,0) patient as a variable pointer field that will either reference the PRF "^DD",26.13,26.13,.02,23,3,0) NATIONAL FLAG file (#26.15) or the PRF LOCAL FLAG file (#26.11). "^DD",26.13,26.13,.02,"DT") 3030423 "^DD",26.13,26.13,.02,"V",0) ^.12P^2^2 "^DD",26.13,26.13,.02,"V",1,0) 26.15^National Flag^1^N^n^n "^DD",26.13,26.13,.02,"V",2,0) 26.11^Local Flag^2^L^n^n "^DD",26.13,26.13,.03,0) STATUS^RSI^0:INACTIVE;1:ACTIVE;^0;3^Q "^DD",26.13,26.13,.03,3) Enter the status of the record flag assignment. "^DD",26.13,26.13,.03,21,0) ^^2^2^3030421^ "^DD",26.13,26.13,.03,21,1,0) This field indicates if the patient record flag assignment is Active or "^DD",26.13,26.13,.03,21,2,0) Inactive for this patient. "^DD",26.13,26.13,.03,"DT") 3030423 "^DD",26.13,26.13,.04,0) OWNER SITE^RP4'I^DIC(4,^0;4^Q "^DD",26.13,26.13,.04,3) Enter the site that owns this record flag assignment. "^DD",26.13,26.13,.04,21,0) ^^4^4^3030421^ "^DD",26.13,26.13,.04,21,1,0) This field contains the current site that owns this patient flag "^DD",26.13,26.13,.04,21,2,0) assignment. Patient assignments may only be edited by the owner site. The "^DD",26.13,26.13,.04,21,3,0) owner site normally corresponds to the site providing primary care to the "^DD",26.13,26.13,.04,21,4,0) patient. "^DD",26.13,26.13,.04,23,0) ^.001^4^4^3030421^^ "^DD",26.13,26.13,.04,23,1,0) This field contains a pointer to the INSTITUTION file (#4) of the current "^DD",26.13,26.13,.04,23,2,0) site that owns this patient flag assignment. Patient assignments may only "^DD",26.13,26.13,.04,23,3,0) be edited by the owner site. The owner site normally corresponds to the "^DD",26.13,26.13,.04,23,4,0) site providing primary care to the patient. "^DD",26.13,26.13,.04,"DT") 3030423 "^DD",26.13,26.13,.05,0) ORIGINATING SITE^RP4'I^DIC(4,^0;5^Q "^DD",26.13,26.13,.05,3) Enter the site that initially made the record flag assignment. "^DD",26.13,26.13,.05,21,0) ^^3^3^3030421^ "^DD",26.13,26.13,.05,21,1,0) This field contains the site that initially assigned the patient "^DD",26.13,26.13,.05,21,2,0) record flag to this patient. The site that assigns the flag is not "^DD",26.13,26.13,.05,21,3,0) required to be the owner of the assignment. "^DD",26.13,26.13,.05,23,0) ^.001^2^2^3030421^^^ "^DD",26.13,26.13,.05,23,1,0) This field contains a pointer to the INSTITUTION FILE (#4) of the site "^DD",26.13,26.13,.05,23,2,0) that first entered the flag on this patient. "^DD",26.13,26.13,.05,"DT") 3030423 "^DD",26.13,26.13,.06,0) REVIEW DATE^DI^^0;6^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X "^DD",26.13,26.13,.06,3) Enter the review date for the record flag assignment. "^DD",26.13,26.13,.06,21,0) ^.001^2^2^3030421^^^ "^DD",26.13,26.13,.06,21,1,0) This field will contain the date that the flag assignment is due for "^DD",26.13,26.13,.06,21,2,0) review to determine continuing appropriateness. "^DD",26.13,26.13,.06,"DT") 3030423 "^DD",26.13,26.13,1,0) ASSIGNMENT NARRATIVE^26.132^^1;0 "^DD",26.13,26.13,1,21,0) ^^5^5^3030423^ "^DD",26.13,26.13,1,21,1,0) This word processing field contains the patient record flag assignment "^DD",26.13,26.13,1,21,2,0) narrative text. The assignment narrative text is a description of the "^DD",26.13,26.13,1,21,3,0) incident or reason that generated the need for this patient record flag "^DD",26.13,26.13,1,21,4,0) assignment. The description is followed by recommended actions that "^DD",26.13,26.13,1,21,5,0) should be performed by a person working with this specific patient. "^DD",26.13,26.132,0) ASSIGNMENT NARRATIVE SUB-FIELD^^.01^1 "^DD",26.13,26.132,0,"DT") 3021129 "^DD",26.13,26.132,0,"NM","ASSIGNMENT NARRATIVE") "^DD",26.13,26.132,0,"UP") 26.13 "^DD",26.13,26.132,.01,0) ASSIGNMENT NARRATIVE^WL^^0;1^Q "^DD",26.13,26.132,.01,3) Enter the narrative text for the record flag assignment. "^DD",26.13,26.132,.01,21,0) ^^5^5^3030421^ "^DD",26.13,26.132,.01,21,1,0) This word field contains the patient record flag assignment narrative "^DD",26.13,26.132,.01,21,2,0) text. The assignment narrative text is a description of the incident or "^DD",26.13,26.132,.01,21,3,0) reason that generated the need for this patient record flag assignment. "^DD",26.13,26.132,.01,21,4,0) The description is followed by recommended actions that should be "^DD",26.13,26.132,.01,21,5,0) performed by a person working with this specific patient. "^DD",26.13,26.132,.01,"DT") 3030423 "^DD",26.14,26.14,0) FIELD^^1^7 "^DD",26.14,26.14,0,"DDA") N "^DD",26.14,26.14,0,"DT") 3030428 "^DD",26.14,26.14,0,"ID",.02) W " ",$$FMTE^DILIBF($P(^(0),U,2),6) "^DD",26.14,26.14,0,"ID",.03) W " ",@("$P($P($C(59)_$S($D(^DD(26.14,.03,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,3)_"":"",2),$C(59),1)") "^DD",26.14,26.14,0,"IX","B",26.14,.01) "^DD",26.14,26.14,0,"NM","PRF ASSIGNMENT HISTORY") "^DD",26.14,26.14,0,"PT",26.17,.02) "^DD",26.14,26.14,.001,0) NUMBER^NJ15,0I^^ ^K:+X'=X!(X>999999999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",26.14,26.14,.001,3) Type a Number between 1 and 999999999999999, 0 Decimal Digits "^DD",26.14,26.14,.001,21,0) ^^2^2^3030204^ "^DD",26.14,26.14,.001,21,1,0) This is the internal entry number which is assigned to each record of this "^DD",26.14,26.14,.001,21,2,0) file. "^DD",26.14,26.14,.001,"DT") 3030423 "^DD",26.14,26.14,.01,0) PRF ASSIGNMENT^RP26.13'I^DGPF(26.13,^0;1^Q "^DD",26.14,26.14,.01,1,0) ^.1 "^DD",26.14,26.14,.01,1,1,0) 26.14^B "^DD",26.14,26.14,.01,1,1,1) S ^DGPF(26.14,"B",$E(X,1,30),DA)="" "^DD",26.14,26.14,.01,1,1,2) K ^DGPF(26.14,"B",$E(X,1,30),DA) "^DD",26.14,26.14,.01,3) Enter the record flag assignment associated with this history record. "^DD",26.14,26.14,.01,21,0) ^^2^2^3030421^ "^DD",26.14,26.14,.01,21,1,0) This field contains the history record's parent Patient Record Flag "^DD",26.14,26.14,.01,21,2,0) Assignment in the PRF ASSIGNMENT file. "^DD",26.14,26.14,.01,23,0) ^.001^2^2^3030421^^ "^DD",26.14,26.14,.01,23,1,0) This field is a pointer to the history record's parent Patient Record Flag "^DD",26.14,26.14,.01,23,2,0) Assignment in the PRF ASSIGNMENT file (#26.13). "^DD",26.14,26.14,.01,"DT") 3030423 "^DD",26.14,26.14,.02,0) DATE/TIME^RDI^^0;2^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X "^DD",26.14,26.14,.02,3) Enter the Date/Time of the assignment history. "^DD",26.14,26.14,.02,21,0) ^.001^3^3^3030421^^^^ "^DD",26.14,26.14,.02,21,1,0) This field will contain the Date and [optional] Time of either the initial "^DD",26.14,26.14,.02,21,2,0) ASSIGNMENT of the PATIENT RECORD FLAG or the REVIEW Date/Time of the "^DD",26.14,26.14,.02,21,3,0) PATIENT RECORD FLAG. "^DD",26.14,26.14,.02,"DT") 3030423 "^DD",26.14,26.14,.03,0) ACTION^RSI^1:NEW ASSIGNMENT;2:CONTINUE;3:INACTIVATE;4:REACTIVATE;^0;3^Q "^DD",26.14,26.14,.03,3) Enter the action associated with the assignment history. "^DD",26.14,26.14,.03,21,0) ^^3^3^3030421^ "^DD",26.14,26.14,.03,21,1,0) This field contains the event that occurred to create this PRF ASSIGNMENT "^DD",26.14,26.14,.03,21,2,0) HISTORY record. Sample events are NEW ASSIGNMENT, CONTINUE, INACTIVATE "^DD",26.14,26.14,.03,21,3,0) and REACTIVATE. "^DD",26.14,26.14,.03,"DT") 3030423 "^DD",26.14,26.14,.04,0) ENTERED BY^RP200'I^VA(200,^0;4^Q "^DD",26.14,26.14,.04,3) Enter the user who is entering or editing the record flag assignment. "^DD",26.14,26.14,.04,21,0) ^^2^2^3030421^ "^DD",26.14,26.14,.04,21,1,0) This field contains the name of the person entering, editing or "^DD",26.14,26.14,.04,21,2,0) reviewing the associated patient record flag assignment. "^DD",26.14,26.14,.04,23,0) ^.001^3^3^3030421^^ "^DD",26.14,26.14,.04,23,1,0) This field contains the pointer to the NEW PERSON FILE (#200) of the "^DD",26.14,26.14,.04,23,2,0) person making the Enter/Edit/Review to a PATIENT RECORD FLAG of the "^DD",26.14,26.14,.04,23,3,0) associated PRF ASSIGNMENT FILE (#26.13) record. "^DD",26.14,26.14,.04,"DT") 3030423 "^DD",26.14,26.14,.05,0) APPROVED BY^RP200'IO^VA(200,^0;5^Q "^DD",26.14,26.14,.05,2) S Y(0)=Y S Y=$$COS^DGPFDD(Y) "^DD",26.14,26.14,.05,2.1) S Y=$$COS^DGPFDD(Y) "^DD",26.14,26.14,.05,3) Enter the person approving the record flag assignment. "^DD",26.14,26.14,.05,21,0) ^.001^2^2^3030428^^^ "^DD",26.14,26.14,.05,21,1,0) This field contains the name of the person who approved the assignment of "^DD",26.14,26.14,.05,21,2,0) the patient record flag to the patient. "^DD",26.14,26.14,.05,23,0) ^^6^6^3030428^ "^DD",26.14,26.14,.05,23,1,0) This field contains the pointer to the NEW PERSON FILE (#200) of the "^DD",26.14,26.14,.05,23,2,0) person who approved the assignment of the patient record flag to the "^DD",26.14,26.14,.05,23,3,0) patient. When the assignment originates from a site different from the "^DD",26.14,26.14,.05,23,4,0) local site, the internal value of the field will be .5 (POSTMASTER). An "^DD",26.14,26.14,.05,23,5,0) output transform converts POSTMASTER to the text "CHIEF OF STAFF" for "^DD",26.14,26.14,.05,23,6,0) screen displays and reports. "^DD",26.14,26.14,.05,"DT") 3030509 "^DD",26.14,26.14,1,0) HISTORY COMMENTS^26.141^^1;0 "^DD",26.14,26.14,1,21,0) ^^3^3^3030423^ "^DD",26.14,26.14,1,21,1,0) This word processing field contains the comments associated with the "^DD",26.14,26.14,1,21,2,0) patient record flag assignment history. The history comments should "^DD",26.14,26.14,1,21,3,0) describe the reason that the history record was generated. "^DD",26.14,26.141,0) HISTORY COMMENTS SUB-FIELD^^.01^1 "^DD",26.14,26.141,0,"DT") 3021204 "^DD",26.14,26.141,0,"NM","HISTORY COMMENTS") "^DD",26.14,26.141,0,"UP") 26.14 "^DD",26.14,26.141,.01,0) HISTORY COMMENTS^WL^^0;1^Q "^DD",26.14,26.141,.01,3) Enter the comments associated with this history record. "^DD",26.14,26.141,.01,23,0) ^.001^2^2^3030421^^^ "^DD",26.14,26.141,.01,23,1,0) This field will contain the comments that apply to the Enter/Edit/Review "^DD",26.14,26.141,.01,23,2,0) of the patient's RECORD FLAG of the PRF ASSIGNMENT FILE (#26.13). "^DD",26.14,26.141,.01,"DT") 3030423 "^DD",26.15,26.15,0) FIELD^^.06^8 "^DD",26.15,26.15,0,"DDA") N "^DD",26.15,26.15,0,"DT") 3030303 "^DD",26.15,26.15,0,"ID",.02) W " ",@("$P($P($C(59)_$S($D(^DD(26.15,.02,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,2)_"":"",2),$C(59),1)") "^DD",26.15,26.15,0,"ID",.03) S %I=Y,Y=$S('$D(^(0)):"",$D(^DGPF(26.16,+$P(^(0),U,3),0))#2:$P(^(0),U,1),1:""),C=$P(^DD(26.16,.01,0),U,2) D Y^DIQ:Y]"" W " ",Y,@("$E("_DIC_"%I,0),0)") S Y=%I K %I "^DD",26.15,26.15,0,"IX","B",26.15,.01) "^DD",26.15,26.15,0,"NM","PRF NATIONAL FLAG") "^DD",26.15,26.15,0,"PT",26.13,.02) "^DD",26.15,26.15,.01,0) NAME^RFI^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",26.15,26.15,.01,1,0) ^.1 "^DD",26.15,26.15,.01,1,1,0) 26.15^B "^DD",26.15,26.15,.01,1,1,1) S ^DGPF(26.15,"B",$E(X,1,30),DA)="" "^DD",26.15,26.15,.01,1,1,2) K ^DGPF(26.15,"B",$E(X,1,30),DA) "^DD",26.15,26.15,.01,3) Enter patient record flag name (3-30 characters) "^DD",26.15,26.15,.01,21,0) ^.001^2^2^3030421^^^ "^DD",26.15,26.15,.01,21,1,0) This field contains the nationally assigned name of the Patient Record "^DD",26.15,26.15,.01,21,2,0) Flag. "^DD",26.15,26.15,.01,"DT") 3030423 "^DD",26.15,26.15,.02,0) STATUS^RSI^0:INACTIVE;1:ACTIVE;^0;2^Q "^DD",26.15,26.15,.02,3) Enter the status of the patient record flag. "^DD",26.15,26.15,.02,21,0) ^^3^3^3030421^ "^DD",26.15,26.15,.02,21,1,0) This field contains the Active or Inactive status of the Patient Record "^DD",26.15,26.15,.02,21,2,0) Flag. Modification of this field should only be performed by national "^DD",26.15,26.15,.02,21,3,0) patch installation. "^DD",26.15,26.15,.02,23,0) ^.001^8^8^3030421^^ "^DD",26.15,26.15,.02,23,1,0) This field contains the Active or Inactive status of the Patient Record "^DD",26.15,26.15,.02,23,2,0) Flag as a set of codes. "^DD",26.15,26.15,.02,23,3,0) This field will be used as a trigger that will be fired when the Status "^DD",26.15,26.15,.02,23,4,0) of either a LOCAL (#26.11) or a NATIONAL (#26.15) Patient Record Flag is "^DD",26.15,26.15,.02,23,5,0) changed from Active to Inactive. "^DD",26.15,26.15,.02,23,6,0) The trigger process will Inactivate ALL active Patient Record Flag "^DD",26.15,26.15,.02,23,7,0) Assignment records in the PRF ASSIGNMENT (#26.13) file associated with "^DD",26.15,26.15,.02,23,8,0) this flag. "^DD",26.15,26.15,.02,"DT") 3030423 "^DD",26.15,26.15,.03,0) TYPE^RP26.16'I^DGPF(26.16,^0;3^Q "^DD",26.15,26.15,.03,3) Enter the Patient Record Flag Type. '??' to list available Types. "^DD",26.15,26.15,.03,21,0) ^^1^1^3030421^ "^DD",26.15,26.15,.03,21,1,0) This field contains the usage classification of the Patient Record Flag. "^DD",26.15,26.15,.03,23,0) ^.001^2^2^3030421^^ "^DD",26.15,26.15,.03,23,1,0) This field contains the usage classification of the Patient Record Flag "^DD",26.15,26.15,.03,23,2,0) as a pointer to the PRF TYPE file (#26.16). "^DD",26.15,26.15,.03,"DT") 3030423 "^DD",26.15,26.15,.04,0) REVIEW FREQUENCY DAYS^RNJ3,0I^^0;4^K:+X'=X!(X>730)!(X<0)!(X?.E1"."1N.N) X "^DD",26.15,26.15,.04,3) Enter a Number between 0 and 730, 0 Decimal Digits "^DD",26.15,26.15,.04,21,0) ^.001^3^3^3030731^^^^ "^DD",26.15,26.15,.04,21,1,0) This field represents the number of days that may elapse between reviews "^DD",26.15,26.15,.04,21,2,0) of a Patient Record Flag Assignment. A value of zero ("0") indicates that "^DD",26.15,26.15,.04,21,3,0) no automatic review will occur. "^DD",26.15,26.15,.04,"DT") 3030731 "^DD",26.15,26.15,.05,0) NOTIFICATION DAYS^RNJ3,0I^^0;5^K:+X'=X!(X>729)!(X<0)!(X?.E1"."1N.N) X "^DD",26.15,26.15,.05,3) Enter a Number between 0 and 729, 0 Decimal Digits "^DD",26.15,26.15,.05,21,0) ^^5^5^3030421^ "^DD",26.15,26.15,.05,21,1,0) This field contains the number of days prior to a patient record flag "^DD",26.15,26.15,.05,21,2,0) assignment's review date that a notification is sent to the flag's Review "^DD",26.15,26.15,.05,21,3,0) Mail Group. "^DD",26.15,26.15,.05,21,4,0) Per the VHA Directive for the Nationally mandated Category I Patient "^DD",26.15,26.15,.05,21,5,0) Record Flags project, this field value will be set to 60 days. "^DD",26.15,26.15,.05,"DT") 3030423 "^DD",26.15,26.15,.06,0) REVIEW MAIL GROUP^P3.8'I^XMB(3.8,^0;6^Q "^DD",26.15,26.15,.06,3) Enter the mail group that will receive review notifications.(Note: Must start with DGPF) "^DD",26.15,26.15,.06,21,0) ^^5^5^3030421^ "^DD",26.15,26.15,.06,21,1,0) This field contains the name of the mail group whose members will receive "^DD",26.15,26.15,.06,21,2,0) MailMan notification of Patient Record Flag Assignments that are due for "^DD",26.15,26.15,.06,21,3,0) review. "^DD",26.15,26.15,.06,21,4,0) "^DD",26.15,26.15,.06,21,5,0) The mail group name must begin with 'DGPF'. "^DD",26.15,26.15,.06,"DT") 3030423 "^DD",26.15,26.15,1,0) DESCRIPTION^26.151^^1;0 "^DD",26.15,26.15,1,21,0) ^.001^2^2^3030421^^^ "^DD",26.15,26.15,1,21,1,0) This field contains the text that describes the purpose and instructions "^DD",26.15,26.15,1,21,2,0) for application of this national Patient Record Flag to a patient. "^DD",26.15,26.15,2,0) PRINCIPAL INVESTIGATOR(S)^26.152PA^^2;0 "^DD",26.15,26.15,2,21,0) ^^2^2^3030421^ "^DD",26.15,26.15,2,21,1,0) This multiple field contains the principal investigator(s) names when the "^DD",26.15,26.15,2,21,2,0) Flag TYPE is RESEARCH. "^DD",26.15,26.15,2,23,0) ^.001^3^3^3030421^^ "^DD",26.15,26.15,2,23,1,0) This multiple field contains the principal investigator(s) names as a "^DD",26.15,26.15,2,23,2,0) pointer to the NEW PERSON file (#200). This field is used when the Flag "^DD",26.15,26.15,2,23,3,0) TYPE is RESEARCH. "^DD",26.15,26.151,0) DESCRIPTION SUB-FIELD^^.01^1 "^DD",26.15,26.151,0,"DT") 3021219 "^DD",26.15,26.151,0,"NM","DESCRIPTION") "^DD",26.15,26.151,0,"UP") 26.15 "^DD",26.15,26.151,.01,0) DESCRIPTION^WL^^0;1^Q "^DD",26.15,26.151,.01,3) Enter the purpose and instructions for assigning this flag "^DD",26.15,26.151,.01,21,0) ^.001^2^2^3030421^^^^ "^DD",26.15,26.151,.01,21,1,0) This field contains the text that describes the purpose and application "^DD",26.15,26.151,.01,21,2,0) of this national Patient Record Flag to a patient. "^DD",26.15,26.151,.01,"DT") 3030227 "^DD",26.15,26.152,0) PRINCIPAL INVESTIGATOR(S) SUB-FIELD^^.01^1 "^DD",26.15,26.152,0,"DT") 3021219 "^DD",26.15,26.152,0,"IX","B",26.152,.01) "^DD",26.15,26.152,0,"NM","PRINCIPAL INVESTIGATOR(S)") "^DD",26.15,26.152,0,"UP") 26.15 "^DD",26.15,26.152,.01,0) PRINCIPAL INVESTIGATOR(S)^P200'I^VA(200,^0;1^Q "^DD",26.15,26.152,.01,1,0) ^.1 "^DD",26.15,26.152,.01,1,1,0) 26.152^B "^DD",26.15,26.152,.01,1,1,1) S ^DGPF(26.15,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",26.15,26.152,.01,1,1,2) K ^DGPF(26.15,DA(1),2,"B",$E(X,1,30),DA) "^DD",26.15,26.152,.01,3) Enter the Principal Investigator name "^DD",26.15,26.152,.01,21,0) ^^2^2^3030421^ "^DD",26.15,26.152,.01,21,1,0) This field contains the name of the Principal Investigator associated "^DD",26.15,26.152,.01,21,2,0) with the Research Type of this Patient Record Flag. "^DD",26.15,26.152,.01,"DT") 3030423 "^DD",26.16,26.16,0) FIELD^^.01^1 "^DD",26.16,26.16,0,"DDA") N "^DD",26.16,26.16,0,"DT") 3021226 "^DD",26.16,26.16,0,"IX","B",26.16,.01) "^DD",26.16,26.16,0,"NM","PRF TYPE") "^DD",26.16,26.16,0,"PT",26.11,.03) "^DD",26.16,26.16,0,"PT",26.15,.03) "^DD",26.16,26.16,.01,0) NAME^RFI^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",26.16,26.16,.01,1,0) ^.1 "^DD",26.16,26.16,.01,1,1,0) 26.16^B "^DD",26.16,26.16,.01,1,1,1) S ^DGPF(26.16,"B",$E(X,1,30),DA)="" "^DD",26.16,26.16,.01,1,1,2) K ^DGPF(26.16,"B",$E(X,1,30),DA) "^DD",26.16,26.16,.01,3) Answer must be 3-30 characters in length. "^DD",26.16,26.16,.01,21,0) ^.001^1^1^3030421^^ "^DD",26.16,26.16,.01,21,1,0) This field contains the name of the Patient Record Flag Type. "^DD",26.16,26.16,.01,"DT") 3030423 "^DD",26.17,26.17,0) FIELD^^.06^6 "^DD",26.17,26.17,0,"DDA") N "^DD",26.17,26.17,0,"DT") 3030613 "^DD",26.17,26.17,0,"ID",.03) W " ",$$FMTE^DILIBF($P(^(0),U,3),6) "^DD",26.17,26.17,0,"ID",.04) W " ",@("$P($P($C(59)_$S($D(^DD(26.17,.04,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,4)_"":"",2),$C(59),1)") "^DD",26.17,26.17,0,"IX","B",26.17,.01) "^DD",26.17,26.17,0,"NM","PRF HL7 TRANSMISSION LOG") "^DD",26.17,26.17,.01,0) MESSAGE CONTROL ID^RF^^0;1^K:$L(X)>20!($L(X)<1)!'(X'?1P.E) X "^DD",26.17,26.17,.01,1,0) ^.1 "^DD",26.17,26.17,.01,1,1,0) 26.17^B "^DD",26.17,26.17,.01,1,1,1) S ^DGPF(26.17,"B",$E(X,1,30),DA)="" "^DD",26.17,26.17,.01,1,1,2) K ^DGPF(26.17,"B",$E(X,1,30),DA) "^DD",26.17,26.17,.01,3) Answer must be 1-20 characters in length. "^DD",26.17,26.17,.01,21,0) ^^1^1^3030306^ "^DD",26.17,26.17,.01,21,1,0) Unique ID generated by the VistA HL7 package. "^DD",26.17,26.17,.01,"DT") 3030306 "^DD",26.17,26.17,.02,0) PRF ASSIGNMENT HISTORY^RP26.14'^DGPF(26.14,^0;2^Q "^DD",26.17,26.17,.02,21,0) ^^1^1^3030613^ "^DD",26.17,26.17,.02,21,1,0) This field contains a pointer to the PRF ASSIGNMENT HISTORY (#26.14) file. "^DD",26.17,26.17,.02,"DT") 3030613 "^DD",26.17,26.17,.03,0) TRANSMISSION DATE/TIME^RD^^0;3^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.17,26.17,.03,21,0) ^^2^2^3030306^ "^DD",26.17,26.17,.03,21,1,0) This field contains the date and time that the HL7 message was "^DD",26.17,26.17,.03,21,2,0) transmitted. "^DD",26.17,26.17,.03,"DT") 3030619 "^DD",26.17,26.17,.04,0) STATUS^RS^T:TRANSMITTED;A:ACCEPTED;RJ:REJECTED;M:MARKED FOR RE-TRANSMIT;RT:RE-TRANSMITTED;^0;4^Q "^DD",26.17,26.17,.04,21,0) ^^1^1^3030306^ "^DD",26.17,26.17,.04,21,1,0) This field will contain the transmission status of the HL7 message. "^DD",26.17,26.17,.04,"DT") 3030619 "^DD",26.17,26.17,.05,0) SITE TRANSMITTED TO^RP4'^DIC(4,^0;5^Q "^DD",26.17,26.17,.05,21,0) ^^1^1^3030613^ "^DD",26.17,26.17,.05,21,1,0) This field will contain the site where the HL7 message was transmitted. "^DD",26.17,26.17,.05,"DT") 3030613 "^DD",26.17,26.17,.06,0) ACK RECEIVED DATE/TIME^D^^0;6^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.17,26.17,.06,21,0) ^^2^2^3030613^ "^DD",26.17,26.17,.06,21,1,0) This field contains the date and time an Acknowledgement message was "^DD",26.17,26.17,.06,21,2,0) received. "^DD",26.17,26.17,.06,"DT") 3030613 "^DD",26.18,26.18,0) FIELD^^5^6 "^DD",26.18,26.18,0,"DDA") N "^DD",26.18,26.18,0,"DT") 3030627 "^DD",26.18,26.18,0,"IX","B",26.18,.01) "^DD",26.18,26.18,0,"NM","PRF PARAMETERS") "^DD",26.18,26.18,.01,0) ONE^RNJ1,0I^^0;1^K:+X'=X!(X>1)!(X<0)!(X?.E1"."1N.N) X "^DD",26.18,26.18,.01,1,0) ^.1 "^DD",26.18,26.18,.01,1,1,0) 26.18^B "^DD",26.18,26.18,.01,1,1,1) S ^DGPF(26.18,"B",$E(X,1,30),DA)="" "^DD",26.18,26.18,.01,1,1,2) K ^DGPF(26.18,"B",$E(X,1,30),DA) "^DD",26.18,26.18,.01,3) Type a Number between 0 and 1, 0 Decimal Digits "^DD",26.18,26.18,.01,21,0) ^^2^2^3030430^ "^DD",26.18,26.18,.01,21,1,0) 'One' designates the 'one' PRF Parameter. There can only be one "^DD",26.18,26.18,.01,21,2,0) set of parameters. "^DD",26.18,26.18,.01,"DT") 3030501 "^DD",26.18,26.18,1,0) PRF SOFTWARE ACTIVATION DATE^RDI^^0;2^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",26.18,26.18,1,3) Enter the starting date that you wish the Patient Record Flag module to become active. "^DD",26.18,26.18,1,21,0) ^.001^2^2^3030501^^ "^DD",26.18,26.18,1,21,1,0) This field will contain the date that the Patient Record Flag software "^DD",26.18,26.18,1,21,2,0) (DGPF*) will become active. "^DD",26.18,26.18,1,"DT") 3030501 "^DD",26.18,26.18,2,0) PRF HL7 UPDATE STATUS^RS^0:INACTIVE;1:ACTIVE;^0;3^Q "^DD",26.18,26.18,2,3) Enter '1' to enable or '0' to disable the Unsolicited Update HL7 interface. "^DD",26.18,26.18,2,21,0) ^.001^2^2^3030501^^ "^DD",26.18,26.18,2,21,1,0) This field is used to enable or disable the Unsolicited Observation "^DD",26.18,26.18,2,21,2,0) Update (ORU~R01) HL7 interface for the Patient Record Flag module. "^DD",26.18,26.18,2,"DT") 3030430 "^DD",26.18,26.18,3,0) PRF HL7 QUERY STATUS^RS^0:INACTIVE;1:DIRECT;2:DEFERRED;^0;4^Q "^DD",26.18,26.18,3,3) Enter '0' to disable the PRF HL7 query interface, '1' to enable the PRF HL7 query interface in "direct" connection mode or '2' to enable the PRF HL7 query interface in "deferred" connection mode. "^DD",26.18,26.18,3,21,0) ^.001^4^4^3030501^^ "^DD",26.18,26.18,3,21,1,0) This field controls the PRF HL7 query (QRY~R02) interface. Setting the "^DD",26.18,26.18,3,21,2,0) value to '0' disables the interface. Setting the value to '1' enables "^DD",26.18,26.18,3,21,3,0) the interface using a VistA HL7 'direct' connection. Setting the value to "^DD",26.18,26.18,3,21,4,0) '2' enables the interface using a VistA HL7 'deferred' connection. "^DD",26.18,26.18,3,"DT") 3030430 "^DD",26.18,26.18,4,0) PRF HL7 RETRANSMIT DATE/TIME^D^^0;5^S %DT="ETXR" D ^%DT S X=Y K:X<1 X "^DD",26.18,26.18,4,3) (No range limit on date) "^DD",26.18,26.18,4,21,0) ^^3^3^3030627^ "^DD",26.18,26.18,4,21,1,0) This field will contain the transmission date/time of the last record "^DD",26.18,26.18,4,21,2,0) scanned during the HL7 retransmission processing from the "ASTAT" cross "^DD",26.18,26.18,4,21,3,0) reference of the (#26.17) PRF HL7 TRANSMISSION LOG file. "^DD",26.18,26.18,4,"DT") 3030627 "^DD",26.18,26.18,5,0) PRF HL7 AUTO RETRANSMIT PERIOD^NJ3,0^^0;6^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1.N) X "^DD",26.18,26.18,5,3) Type a number between 1 and 999, 0 Decimal Digits "^DD",26.18,26.18,5,21,0) ^^2^2^3030627^ "^DD",26.18,26.18,5,21,1,0) This field represents the number of days to wait before an auto "^DD",26.18,26.18,5,21,2,0) retransmission of Rejected HL7 messages should occur. "^DD",26.18,26.18,5,"DT") 3030627 "^DIC",26.11,26.11,0) PRF LOCAL FLAG^26.11 "^DIC",26.11,26.11,0,"GL") ^DGPF(26.11, "^DIC",26.11,26.11,"%",0) ^1.005^^ "^DIC",26.11,26.11,"%D",0) ^1.001^8^8^3030709^^ "^DIC",26.11,26.11,"%D",1,0) This file contains Category II (Local) Patient Record Flags that can be "^DIC",26.11,26.11,"%D",2,0) assigned to a patient. Use the Record Flag Management [DGPF RECORD FLAG "^DIC",26.11,26.11,"%D",3,0) MANAGEMENT] option to create/edit entries in this file. "^DIC",26.11,26.11,"%D",4,0) "^DIC",26.11,26.11,"%D",5,0) Records in this file should not be added, edited, or deleted except "^DIC",26.11,26.11,"%D",6,0) through the use of the Patient Record Flag software that is part of "^DIC",26.11,26.11,"%D",7,0) Registration. Doing so would likely cause the Patient Record Flag "^DIC",26.11,26.11,"%D",8,0) database to become corrupted. "^DIC",26.11,"B","PRF LOCAL FLAG",26.11) "^DIC",26.12,26.12,0) PRF LOCAL FLAG HISTORY^26.12 "^DIC",26.12,26.12,0,"GL") ^DGPF(26.12, "^DIC",26.12,26.12,"%",0) ^1.005^^ "^DIC",26.12,26.12,"%D",0) ^^10^10^3030709^ "^DIC",26.12,26.12,"%D",1,0) This file contains the audit information associated with a record in the "^DIC",26.12,26.12,"%D",2,0) PRF LOCAL FLAG (#26.11) file. Entries in this file are created "^DIC",26.12,26.12,"%D",3,0) automatically by the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] "^DIC",26.12,26.12,"%D",4,0) option for each creation/edit of a PRF LOCAL FLAG (#26.11) "^DIC",26.12,26.12,"%D",5,0) file entry. "^DIC",26.12,26.12,"%D",6,0) "^DIC",26.12,26.12,"%D",7,0) Records in this file should not be added, edited, or deleted except "^DIC",26.12,26.12,"%D",8,0) through the use of the Patient Record Flag software that is part of "^DIC",26.12,26.12,"%D",9,0) Registration. Doing so would likely cause the Patient Record Flag "^DIC",26.12,26.12,"%D",10,0) database to become corrupted. "^DIC",26.12,"B","PRF LOCAL FLAG HISTORY",26.12) "^DIC",26.13,26.13,0) PRF ASSIGNMENT^26.13 "^DIC",26.13,26.13,0,"GL") ^DGPF(26.13, "^DIC",26.13,26.13,"%",0) ^1.005^^ "^DIC",26.13,26.13,"%D",0) ^^7^7^3030709^ "^DIC",26.13,26.13,"%D",1,0) This file contains a list of Patient Record Flag assignments. Use the "^DIC",26.13,26.13,"%D",2,0) Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option to "^DIC",26.13,26.13,"%D",3,0) create/edit entries in this file. "^DIC",26.13,26.13,"%D",4,0) "^DIC",26.13,26.13,"%D",5,0) Records in this file should not be added or edited except through the use "^DIC",26.13,26.13,"%D",6,0) of the Patient Record Flag software that is part of Registration. Doing "^DIC",26.13,26.13,"%D",7,0) so would likely cause Patient Record Flag database corruption. "^DIC",26.13,"B","PRF ASSIGNMENT",26.13) "^DIC",26.14,26.14,0) PRF ASSIGNMENT HISTORY^26.14 "^DIC",26.14,26.14,0,"GL") ^DGPF(26.14, "^DIC",26.14,26.14,"%",0) ^1.005^^ "^DIC",26.14,26.14,"%D",0) ^^10^10^3030709^ "^DIC",26.14,26.14,"%D",1,0) This file contains the audit information associated with a record in the "^DIC",26.14,26.14,"%D",2,0) PRF ASSIGNMENT (#26.13) file. Entries in this file are created "^DIC",26.14,26.14,"%D",3,0) automatically by the Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] "^DIC",26.14,26.14,"%D",4,0) option for each creation/edit of a PRF ASSIGNMENT (#26.13) "^DIC",26.14,26.14,"%D",5,0) file entry. "^DIC",26.14,26.14,"%D",6,0) "^DIC",26.14,26.14,"%D",7,0) Records in this file should not be added, edited, or deleted except "^DIC",26.14,26.14,"%D",8,0) through the use of the Patient Record Flag software that is part of "^DIC",26.14,26.14,"%D",9,0) Registration. Doing so would likely cause the Patient Record Flag "^DIC",26.14,26.14,"%D",10,0) database to become corrupted. "^DIC",26.14,"B","PRF ASSIGNMENT HISTORY",26.14) "^DIC",26.15,26.15,0) PRF NATIONAL FLAG^26.15 "^DIC",26.15,26.15,0,"GL") ^DGPF(26.15, "^DIC",26.15,26.15,"%",0) ^1.005^^ "^DIC",26.15,26.15,"%D",0) ^1.001^6^6^3030709^^ "^DIC",26.15,26.15,"%D",1,0) This file contains a list of the Category I (National) Patient Record "^DIC",26.15,26.15,"%D",2,0) Flags that can be assigned to a patient. "^DIC",26.15,26.15,"%D",3,0) "^DIC",26.15,26.15,"%D",4,0) Category I flags are established at a National level and any changes to "^DIC",26.15,26.15,"%D",5,0) this file or it's entries should only be done through a national patch "^DIC",26.15,26.15,"%D",6,0) release. "^DIC",26.15,"B","PRF NATIONAL FLAG",26.15) "^DIC",26.16,26.16,0) PRF TYPE^26.16 "^DIC",26.16,26.16,0,"GL") ^DGPF(26.16, "^DIC",26.16,26.16,"%",0) ^1.005^^ "^DIC",26.16,26.16,"%D",0) ^^7^7^3030509^ "^DIC",26.16,26.16,"%D",1,0) This file contains a list of usage classifications that can be applied to "^DIC",26.16,26.16,"%D",2,0) a Patient Record Flag. "^DIC",26.16,26.16,"%D",3,0) "^DIC",26.16,26.16,"%D",4,0) Additions or modifications to entries in this file should only be done "^DIC",26.16,26.16,"%D",5,0) through a national patch release. Records in this file should not be "^DIC",26.16,26.16,"%D",6,0) added, edited or deleted locally. Doing so would likely cause the Patient "^DIC",26.16,26.16,"%D",7,0) Record Flag database to become corrupted. "^DIC",26.16,"B","PRF TYPE",26.16) "^DIC",26.17,26.17,0) PRF HL7 TRANSMISSION LOG^26.17 "^DIC",26.17,26.17,0,"GL") ^DGPF(26.17, "^DIC",26.17,26.17,"%",0) ^1.005^^ "^DIC",26.17,26.17,"%D",0) ^1.001^8^8^3030701^^ "^DIC",26.17,26.17,"%D",1,0) This file contains a list of all Unsolicited Observation Update (ORU~R01) "^DIC",26.17,26.17,"%D",2,0) HL7 transmissions that have been generated at the site by the Patient "^DIC",26.17,26.17,"%D",3,0) Record Flags software module. Entries in this file are created/edited "^DIC",26.17,26.17,"%D",4,0) automatically by the Patient Record Flags HL7 interface. "^DIC",26.17,26.17,"%D",5,0) "^DIC",26.17,26.17,"%D",6,0) Records in this file should not be added or edited except through the use "^DIC",26.17,26.17,"%D",7,0) of the Patient Record Flag software that is part of Registration. Doing so "^DIC",26.17,26.17,"%D",8,0) would likely cause Patient Record Flag database to become corrupted. "^DIC",26.17,"B","PRF HL7 TRANSMISSION LOG",26.17) "^DIC",26.18,26.18,0) PRF PARAMETERS^26.18 "^DIC",26.18,26.18,0,"GL") ^DGPF(26.18, "^DIC",26.18,26.18,"%",0) ^1.005^^ "^DIC",26.18,26.18,"%D",0) ^^5^5^3030509^ "^DIC",26.18,26.18,"%D",1,0) This file contains the configuration parameters for the Patient Record "^DIC",26.18,26.18,"%D",2,0) Flag module of the Registration package. The file should contain only "^DIC",26.18,26.18,"%D",3,0) one record numbered "1". Modifications to the file should only be done "^DIC",26.18,26.18,"%D",4,0) through the Patient Record Flag Configuration [DGPF RECORD FLAG "^DIC",26.18,26.18,"%D",5,0) CONFIGURATION] option. "^DIC",26.18,"B","PRF PARAMETERS",26.18) **END** **END**