KIDS Distribution saved on Oct 19, 2006@13:24:43 PATIENT RECORD FLAGS PHASE III DG*5.3*650 (10/19/06) **KIDS**:DG*5.3*650^ **INSTALL NAME** DG*5.3*650 "BLD",5711,0) DG*5.3*650^REGISTRATION^0^3061019^y "BLD",5711,1,0) ^^2^2^3050603^^ "BLD",5711,1,1,0) Please refer to patch DG*5.3*650 in the National Patch Module for a "BLD",5711,1,2,0) complete description of this patch. "BLD",5711,4,0) ^9.64PA^26.21^6 "BLD",5711,4,2,0) 2 "BLD",5711,4,2,2,0) ^9.641^2^1 "BLD",5711,4,2,2,2,0) 2447 (File-top level) "BLD",5711,4,2,2,2,1,0) ^9.6411^991.01^1 "BLD",5711,4,2,2,2,1,991.01,0) INTEGRATION CONTROL NUMBER "BLD",5711,4,2,222) y^n^p^^^^n^^n "BLD",5711,4,2,224) "BLD",5711,4,26.13,0) 26.13 "BLD",5711,4,26.13,2,0) ^9.641^26.13^1 "BLD",5711,4,26.13,2,26.13,0) PRF ASSIGNMENT (File-top level) "BLD",5711,4,26.13,2,26.13,1,0) ^9.6411^.03^2 "BLD",5711,4,26.13,2,26.13,1,.03,0) STATUS "BLD",5711,4,26.13,2,26.13,1,.04,0) OWNER SITE "BLD",5711,4,26.13,222) y^n^p^^^^n^^n "BLD",5711,4,26.13,224) "BLD",5711,4,26.17,0) 26.17 "BLD",5711,4,26.17,2,0) ^9.641^26.1707^1 "BLD",5711,4,26.17,2,26.1707,0) ERROR CODES (sub-file) "BLD",5711,4,26.17,2,26.1707,1,0) ^9.6411^^ "BLD",5711,4,26.17,222) y^n^p^^^^n^^n "BLD",5711,4,26.17,224) "BLD",5711,4,26.19,0) 26.19 "BLD",5711,4,26.19,222) y^n^f^^^^n "BLD",5711,4,26.21,0) 26.21 "BLD",5711,4,26.21,222) y^n^f^^^^n "BLD",5711,4,40.8,0) 40.8 "BLD",5711,4,40.8,2,0) ^9.641^40.8^1 "BLD",5711,4,40.8,2,40.8,0) MEDICAL CENTER DIVISION (File-top level) "BLD",5711,4,40.8,2,40.8,1,0) ^9.6411^.07^4 "BLD",5711,4,40.8,2,40.8,1,.07,0) INSTITUTION FILE POINTER "BLD",5711,4,40.8,2,40.8,1,26.01,0) PRF ASSIGNMENT OWNERSHIP "BLD",5711,4,40.8,2,40.8,1,26.02,0) PRF OWNERSHIP EDITED "BLD",5711,4,40.8,2,40.8,1,26.03,0) PRF OWNERSHIP EDITED BY "BLD",5711,4,40.8,222) y^n^p^^^^n^^n "BLD",5711,4,40.8,224) "BLD",5711,4,"APDD",2,2) "BLD",5711,4,"APDD",2,2,991.01) "BLD",5711,4,"APDD",26.13,26.13) "BLD",5711,4,"APDD",26.13,26.13,.03) "BLD",5711,4,"APDD",26.13,26.13,.04) "BLD",5711,4,"APDD",26.17,26.1707) "BLD",5711,4,"APDD",40.8,40.8) "BLD",5711,4,"APDD",40.8,40.8,.07) "BLD",5711,4,"APDD",40.8,40.8,26.01) "BLD",5711,4,"APDD",40.8,40.8,26.02) "BLD",5711,4,"APDD",40.8,40.8,26.03) "BLD",5711,4,"B",2,2) "BLD",5711,4,"B",26.13,26.13) "BLD",5711,4,"B",26.17,26.17) "BLD",5711,4,"B",26.19,26.19) "BLD",5711,4,"B",26.21,26.21) "BLD",5711,4,"B",40.8,40.8) "BLD",5711,6.3) 3 "BLD",5711,"ABPKG") n "BLD",5711,"INI") PRE^DG53P650 "BLD",5711,"INIT") POST^DG53P650 "BLD",5711,"KRN",0) ^9.67PA^8989.52^19 "BLD",5711,"KRN",.4,0) .4 "BLD",5711,"KRN",.401,0) .401 "BLD",5711,"KRN",.402,0) .402 "BLD",5711,"KRN",.403,0) .403 "BLD",5711,"KRN",.5,0) .5 "BLD",5711,"KRN",.84,0) .84 "BLD",5711,"KRN",.84,"NM",0) ^9.68A^1^1 "BLD",5711,"KRN",.84,"NM",1,0) 261116^^0 "BLD",5711,"KRN",.84,"NM","B",261116,1) "BLD",5711,"KRN",3.6,0) 3.6 "BLD",5711,"KRN",3.8,0) 3.8 "BLD",5711,"KRN",9.2,0) 9.2 "BLD",5711,"KRN",9.8,0) 9.8 "BLD",5711,"KRN",9.8,"NM",0) ^9.68A^46^44 "BLD",5711,"KRN",9.8,"NM",1,0) DGPFAA2^^0^B31192734 "BLD",5711,"KRN",9.8,"NM",2,0) DGPFAA3^^0^B33716755 "BLD",5711,"KRN",9.8,"NM",4,0) DGPFHLR^^0^B69390340 "BLD",5711,"KRN",9.8,"NM",5,0) DGPFHLS^^0^B55420041 "BLD",5711,"KRN",9.8,"NM",6,0) DGPFHLU^^0^B34815804 "BLD",5711,"KRN",9.8,"NM",7,0) DGPFLMA2^^0^B50998481 "BLD",5711,"KRN",9.8,"NM",8,0) DGPFLMA3^^0^B70378995 "BLD",5711,"KRN",9.8,"NM",9,0) DGPFLMA4^^0^B39834723 "BLD",5711,"KRN",9.8,"NM",11,0) DGPFHLL^^0^B41058426 "BLD",5711,"KRN",9.8,"NM",12,0) DGPFHLQ^^0^B44511391 "BLD",5711,"KRN",9.8,"NM",13,0) DGPFHLQ3^^0^B3002263 "BLD",5711,"KRN",9.8,"NM",14,0) DGPFHLU3^^0^B31915353 "BLD",5711,"KRN",9.8,"NM",15,0) DGPFHLU5^^0^B49294437 "BLD",5711,"KRN",9.8,"NM",16,0) DGPFHLQ4^^0^B17883143 "BLD",5711,"KRN",9.8,"NM",17,0) DGPFLMT^^0^B2035581 "BLD",5711,"KRN",9.8,"NM",18,0) DGPFLMT1^^0^B55169432 "BLD",5711,"KRN",9.8,"NM",19,0) DGPFLMT2^^0^B24050413 "BLD",5711,"KRN",9.8,"NM",20,0) DGPFLMT3^^0^B6275876 "BLD",5711,"KRN",9.8,"NM",21,0) DGPFLMT4^^0^B29251148 "BLD",5711,"KRN",9.8,"NM",22,0) DGPFLMT5^^0^B10105469 "BLD",5711,"KRN",9.8,"NM",23,0) DGPFAPI^^0^B36238141 "BLD",5711,"KRN",9.8,"NM",24,0) DGPFDD^^0^B29798054 "BLD",5711,"KRN",9.8,"NM",25,0) DGPFLF4^^0^B26165641 "BLD",5711,"KRN",9.8,"NM",26,0) DGPFHLL1^^0^B8068964 "BLD",5711,"KRN",9.8,"NM",27,0) DGPFUT^^0^B38902808 "BLD",5711,"KRN",9.8,"NM",28,0) DGPFUT2^^0^B44485554 "BLD",5711,"KRN",9.8,"NM",29,0) DGPFLF3^^0^B47245932 "BLD",5711,"KRN",9.8,"NM",30,0) DGPFHLRT^^0^B4258248 "BLD",5711,"KRN",9.8,"NM",31,0) DGPFBGR^^0^B43954617 "BLD",5711,"KRN",9.8,"NM",32,0) DGPFUT1^^0^B28564344 "BLD",5711,"KRN",9.8,"NM",33,0) DGPFLMU^^0^B16582926 "BLD",5711,"KRN",9.8,"NM",34,0) DGPFLMU1^^0^B45355090 "BLD",5711,"KRN",9.8,"NM",35,0) DGPFHLUT^^0^B36458354 "BLD",5711,"KRN",9.8,"NM",36,0) DGPFDIV^^0^B38624185 "BLD",5711,"KRN",9.8,"NM",37,0) DGPFDIV1^^0^B18927567 "BLD",5711,"KRN",9.8,"NM",38,0) DG53P650^^0^B18743146 "BLD",5711,"KRN",9.8,"NM",39,0) DGPFAPI1^^0^B24558175 "BLD",5711,"KRN",9.8,"NM",40,0) DGPFAPI2^^0^B18327429 "BLD",5711,"KRN",9.8,"NM",41,0) DGPFRAL1^^0^B71862269 "BLD",5711,"KRN",9.8,"NM",42,0) DGPFLMQ^^0^B591948 "BLD",5711,"KRN",9.8,"NM",43,0) DGPFLMQD^^0^B1208744 "BLD",5711,"KRN",9.8,"NM",44,0) DGPFLMQ1^^0^B22327142 "BLD",5711,"KRN",9.8,"NM",45,0) DGPFLMQ2^^0^B39288801 "BLD",5711,"KRN",9.8,"NM",46,0) DGPFHLUQ^^0^B40674346 "BLD",5711,"KRN",9.8,"NM","B","DG53P650",38) "BLD",5711,"KRN",9.8,"NM","B","DGPFAA2",1) "BLD",5711,"KRN",9.8,"NM","B","DGPFAA3",2) "BLD",5711,"KRN",9.8,"NM","B","DGPFAPI",23) "BLD",5711,"KRN",9.8,"NM","B","DGPFAPI1",39) "BLD",5711,"KRN",9.8,"NM","B","DGPFAPI2",40) "BLD",5711,"KRN",9.8,"NM","B","DGPFBGR",31) "BLD",5711,"KRN",9.8,"NM","B","DGPFDD",24) "BLD",5711,"KRN",9.8,"NM","B","DGPFDIV",36) "BLD",5711,"KRN",9.8,"NM","B","DGPFDIV1",37) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLL",11) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLL1",26) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLQ",12) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLQ3",13) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLQ4",16) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLR",4) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLRT",30) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLS",5) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLU",6) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLU3",14) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLU5",15) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLUQ",46) "BLD",5711,"KRN",9.8,"NM","B","DGPFHLUT",35) "BLD",5711,"KRN",9.8,"NM","B","DGPFLF3",29) "BLD",5711,"KRN",9.8,"NM","B","DGPFLF4",25) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMA2",7) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMA3",8) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMA4",9) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMQ",42) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMQ1",44) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMQ2",45) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMQD",43) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT",17) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT1",18) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT2",19) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT3",20) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT4",21) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMT5",22) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMU",33) "BLD",5711,"KRN",9.8,"NM","B","DGPFLMU1",34) "BLD",5711,"KRN",9.8,"NM","B","DGPFRAL1",41) "BLD",5711,"KRN",9.8,"NM","B","DGPFUT",27) "BLD",5711,"KRN",9.8,"NM","B","DGPFUT1",32) "BLD",5711,"KRN",9.8,"NM","B","DGPFUT2",28) "BLD",5711,"KRN",19,0) 19 "BLD",5711,"KRN",19,"NM",0) ^9.68A^8^8 "BLD",5711,"KRN",19,"NM",1,0) DGPF TRANSMISSION ERRORS^^0 "BLD",5711,"KRN",19,"NM",2,0) DGPF RECORD FLAGS MAIN MENU^^2 "BLD",5711,"KRN",19,"NM",3,0) DGPF RECORD FLAG ASSIGNMENT^^0 "BLD",5711,"KRN",19,"NM",4,0) DGPF RECORD FLAG MANAGEMENT^^0 "BLD",5711,"KRN",19,"NM",5,0) DGPF ENABLE DIVISIONS^^0 "BLD",5711,"KRN",19,"NM",6,0) DGPF PRF SYSTEM CONFIGURATION^^1^ "BLD",5711,"KRN",19,"NM",7,0) DGPF TRANSMISSION MGMT^^0 "BLD",5711,"KRN",19,"NM",8,0) DGPF MANUAL QUERY^^0 "BLD",5711,"KRN",19,"NM","B","DGPF ENABLE DIVISIONS",5) "BLD",5711,"KRN",19,"NM","B","DGPF MANUAL QUERY",8) "BLD",5711,"KRN",19,"NM","B","DGPF PRF SYSTEM CONFIGURATION",6) "BLD",5711,"KRN",19,"NM","B","DGPF RECORD FLAG ASSIGNMENT",3) "BLD",5711,"KRN",19,"NM","B","DGPF RECORD FLAG MANAGEMENT",4) "BLD",5711,"KRN",19,"NM","B","DGPF RECORD FLAGS MAIN MENU",2) "BLD",5711,"KRN",19,"NM","B","DGPF TRANSMISSION ERRORS",1) "BLD",5711,"KRN",19,"NM","B","DGPF TRANSMISSION MGMT",7) "BLD",5711,"KRN",19.1,0) 19.1 "BLD",5711,"KRN",19.1,"NM",0) ^9.68A^3^2 "BLD",5711,"KRN",19.1,"NM",2,0) DGPF TRANSMISSIONS^^0 "BLD",5711,"KRN",19.1,"NM",3,0) DGPF MANAGER^^0 "BLD",5711,"KRN",19.1,"NM","B","DGPF MANAGER",3) "BLD",5711,"KRN",19.1,"NM","B","DGPF TRANSMISSIONS",2) "BLD",5711,"KRN",101,0) 101 "BLD",5711,"KRN",101,"NM",0) ^9.68A^19^19 "BLD",5711,"KRN",101,"NM",1,0) DGPF TRANSMISSION ERRORS MENU^^0 "BLD",5711,"KRN",101,"NM",2,0) DGPF TRANSMIT REJECT MESSAGE^^0 "BLD",5711,"KRN",101,"NM",3,0) DGPF TRANSMIT SORT LIST^^0 "BLD",5711,"KRN",101,"NM",4,0) DGPF TRANSMIT VIEW MESSAGE^^0 "BLD",5711,"KRN",101,"NM",5,0) DGPF TRANSMIT VIEW MSG MENU^^0 "BLD",5711,"KRN",101,"NM",6,0) DGPF RECORD FLAG MANAGEMENT MENU^^0 "BLD",5711,"KRN",101,"NM",7,0) DGPF DISPLAY FLAG DETAIL^^0 "BLD",5711,"KRN",101,"NM",8,0) DGPF ADD FLAG^^0 "BLD",5711,"KRN",101,"NM",9,0) DGPF EDIT FLAG^^0 "BLD",5711,"KRN",101,"NM",10,0) DGPF RECORD FLAG ASSIGNMENT MENU^^0 "BLD",5711,"KRN",101,"NM",11,0) DGPF EDIT ASSIGNMENT^^0 "BLD",5711,"KRN",101,"NM",12,0) DGPF ASSIGN FLAG^^0 "BLD",5711,"KRN",101,"NM",13,0) DGPF DISPLAY ASSIGNMENT DETAIL^^0 "BLD",5711,"KRN",101,"NM",14,0) DGPF CHANGE ASSIGNMENT OWNERSHIP^^0 "BLD",5711,"KRN",101,"NM",15,0) DGPF SELECT PATIENT^^0 "BLD",5711,"KRN",101,"NM",16,0) DGPF SORT FLAG LIST^^0 "BLD",5711,"KRN",101,"NM",17,0) DGPF CHANGE CATEGORY^^0 "BLD",5711,"KRN",101,"NM",18,0) DGPF RECORD FLAG QUERY MENU^^0 "BLD",5711,"KRN",101,"NM",19,0) DGPF DISPLAY QUERY RESULTS^^0 "BLD",5711,"KRN",101,"NM","B","DGPF ADD FLAG",8) "BLD",5711,"KRN",101,"NM","B","DGPF ASSIGN FLAG",12) "BLD",5711,"KRN",101,"NM","B","DGPF CHANGE ASSIGNMENT OWNERSHIP",14) "BLD",5711,"KRN",101,"NM","B","DGPF CHANGE CATEGORY",17) "BLD",5711,"KRN",101,"NM","B","DGPF DISPLAY ASSIGNMENT DETAIL",13) "BLD",5711,"KRN",101,"NM","B","DGPF DISPLAY FLAG DETAIL",7) "BLD",5711,"KRN",101,"NM","B","DGPF DISPLAY QUERY RESULTS",19) "BLD",5711,"KRN",101,"NM","B","DGPF EDIT ASSIGNMENT",11) "BLD",5711,"KRN",101,"NM","B","DGPF EDIT FLAG",9) "BLD",5711,"KRN",101,"NM","B","DGPF RECORD FLAG ASSIGNMENT MENU",10) "BLD",5711,"KRN",101,"NM","B","DGPF RECORD FLAG MANAGEMENT MENU",6) "BLD",5711,"KRN",101,"NM","B","DGPF RECORD FLAG QUERY MENU",18) "BLD",5711,"KRN",101,"NM","B","DGPF SELECT PATIENT",15) "BLD",5711,"KRN",101,"NM","B","DGPF SORT FLAG LIST",16) "BLD",5711,"KRN",101,"NM","B","DGPF TRANSMISSION ERRORS MENU",1) "BLD",5711,"KRN",101,"NM","B","DGPF TRANSMIT REJECT MESSAGE",2) "BLD",5711,"KRN",101,"NM","B","DGPF TRANSMIT SORT LIST",3) "BLD",5711,"KRN",101,"NM","B","DGPF TRANSMIT VIEW MESSAGE",4) "BLD",5711,"KRN",101,"NM","B","DGPF TRANSMIT VIEW MSG MENU",5) "BLD",5711,"KRN",409.61,0) 409.61 "BLD",5711,"KRN",409.61,"NM",0) ^9.68A^5^5 "BLD",5711,"KRN",409.61,"NM",1,0) DGPF TRANSMISSION ERRORS^^0 "BLD",5711,"KRN",409.61,"NM",2,0) DGPF TRANSMIT VIEW MESSAGE^^0 "BLD",5711,"KRN",409.61,"NM",3,0) DGPF RECORD FLAG ASSIGNMENT^^0 "BLD",5711,"KRN",409.61,"NM",4,0) DGPF RECORD FLAG QUERY^^0 "BLD",5711,"KRN",409.61,"NM",5,0) DGPF QUERY DETAIL^^0 "BLD",5711,"KRN",409.61,"NM","B","DGPF QUERY DETAIL",5) "BLD",5711,"KRN",409.61,"NM","B","DGPF RECORD FLAG ASSIGNMENT",3) "BLD",5711,"KRN",409.61,"NM","B","DGPF RECORD FLAG QUERY",4) "BLD",5711,"KRN",409.61,"NM","B","DGPF TRANSMISSION ERRORS",1) "BLD",5711,"KRN",409.61,"NM","B","DGPF TRANSMIT VIEW MESSAGE",2) "BLD",5711,"KRN",771,0) 771 "BLD",5711,"KRN",870,0) 870 "BLD",5711,"KRN",8989.51,0) 8989.51 "BLD",5711,"KRN",8989.51,"NM",0) ^9.68A^1^1 "BLD",5711,"KRN",8989.51,"NM",1,0) DGPF QUERY TRY LIMIT^^0 "BLD",5711,"KRN",8989.51,"NM","B","DGPF QUERY TRY LIMIT",1) "BLD",5711,"KRN",8989.52,0) 8989.52 "BLD",5711,"KRN",8994,0) 8994 "BLD",5711,"KRN","B",.4,.4) "BLD",5711,"KRN","B",.401,.401) "BLD",5711,"KRN","B",.402,.402) "BLD",5711,"KRN","B",.403,.403) "BLD",5711,"KRN","B",.5,.5) "BLD",5711,"KRN","B",.84,.84) "BLD",5711,"KRN","B",3.6,3.6) "BLD",5711,"KRN","B",3.8,3.8) "BLD",5711,"KRN","B",9.2,9.2) "BLD",5711,"KRN","B",9.8,9.8) "BLD",5711,"KRN","B",19,19) "BLD",5711,"KRN","B",19.1,19.1) "BLD",5711,"KRN","B",101,101) "BLD",5711,"KRN","B",409.61,409.61) "BLD",5711,"KRN","B",771,771) "BLD",5711,"KRN","B",870,870) "BLD",5711,"KRN","B",8989.51,8989.51) "BLD",5711,"KRN","B",8989.52,8989.52) "BLD",5711,"KRN","B",8994,8994) "BLD",5711,"PRE") DG53P650 "BLD",5711,"QUES",0) ^9.62^^ "BLD",5711,"REQB",0) ^9.611^5^5 "BLD",5711,"REQB",1,0) DG*5.3*554^2 "BLD",5711,"REQB",2,0) DG*5.3*607^2 "BLD",5711,"REQB",3,0) DG*5.3*425^2 "BLD",5711,"REQB",4,0) DG*5.3*718^2 "BLD",5711,"REQB",5,0) DG*5.3*699^2 "BLD",5711,"REQB","B","DG*5.3*425",3) "BLD",5711,"REQB","B","DG*5.3*554",1) "BLD",5711,"REQB","B","DG*5.3*607",2) "BLD",5711,"REQB","B","DG*5.3*699",5) "BLD",5711,"REQB","B","DG*5.3*718",4) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,991.01) "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^n^p^^^^n^^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) 1 "FIA",26.13,26.13,.03) "FIA",26.13,26.13,.04) "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^p^^^^n^^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) 1 "FIA",26.17,26.17,.07) "FIA",26.17,26.1707) 0 "FIA",26.19) PRF HL7 QUERY LOG "FIA",26.19,0) ^DGPF(26.19, "FIA",26.19,0,0) 26.19 "FIA",26.19,0,1) y^n^f^^^^n "FIA",26.19,0,10) "FIA",26.19,0,11) "FIA",26.19,0,"RLRO") "FIA",26.19,0,"VR") 5.3^DG "FIA",26.19,26.19) 0 "FIA",26.19,26.1907) 0 "FIA",26.21) PRF HL7 EVENT "FIA",26.21,0) ^DGPF(26.21, "FIA",26.21,0,0) 26.21P "FIA",26.21,0,1) y^n^f^^^^n "FIA",26.21,0,10) "FIA",26.21,0,11) "FIA",26.21,0,"RLRO") "FIA",26.21,0,"VR") 5.3^DG "FIA",26.21,26.21) 0 "FIA",40.8) MEDICAL CENTER DIVISION "FIA",40.8,0) ^DG(40.8, "FIA",40.8,0,0) 40.8I "FIA",40.8,0,1) y^n^p^^^^n^^n "FIA",40.8,0,10) "FIA",40.8,0,11) "FIA",40.8,0,"RLRO") "FIA",40.8,0,"VR") 5.3^DG "FIA",40.8,40.8) 1 "FIA",40.8,40.8,.07) "FIA",40.8,40.8,26.01) "FIA",40.8,40.8,26.02) "FIA",40.8,40.8,26.03) "INI") PRE^DG53P650 "INIT") POST^DG53P650 "IX",2,2,"APRFEVT",0) 2^APRFEVT^Record PRF HL7 event for new patients^MU^^F^^I^2^^^^^A "IX",2,2,"APRFEVT",.1,0) ^^2^2^3050426^ "IX",2,2,"APRFEVT",.1,1,0) This trigger creates an entry in the PRF HL7 EVENT (#26.21) file when no "IX",2,2,"APRFEVT",.1,2,0) entry exists and a national ICN is filed. "IX",2,2,"APRFEVT",1) D EVENT^DGPFDD(DA) "IX",2,2,"APRFEVT",2) Q "IX",2,2,"APRFEVT",11.1,0) ^.114IA^1^1 "IX",2,2,"APRFEVT",11.1,1,0) 1^F^2^991.01^^^F "IX",26.13,26.13,"AOWN",0) 26.13^AOWN^Index the OWNER SITE and STATUS fields^R^^R^IR^I^26.13^^^^^S "IX",26.13,26.13,"AOWN",1) S ^DGPF(26.13,"AOWN",X(1),X(2),DA)="" "IX",26.13,26.13,"AOWN",2) K ^DGPF(26.13,"AOWN",X(1),X(2),DA) "IX",26.13,26.13,"AOWN",2.5) K ^DGPF(26.13,"AOWN") "IX",26.13,26.13,"AOWN",11.1,0) ^.114IA^2^2 "IX",26.13,26.13,"AOWN",11.1,1,0) 1^F^26.13^.04^^1^F "IX",26.13,26.13,"AOWN",11.1,2,0) 2^F^26.13^.03^^2^F "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,"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.19,26.19,"C",0) 26.19^C^Event index^R^^F^IR^I^26.19^^^^^LS "IX",26.19,26.19,"C",1) S ^DGPF(26.19,"C",X,DA)="" "IX",26.19,26.19,"C",2) K ^DGPF(26.19,"C",X,DA) "IX",26.19,26.19,"C",2.5) K ^DGPF(26.19,"C") "IX",26.19,26.19,"C",11.1,0) ^.114IA^1^1 "IX",26.19,26.19,"C",11.1,1,0) 1^F^26.19^.02^^1^F "IX",26.19,26.19,"C",11.1,1,3) "IX",26.21,26.21,"ASTAT",0) 26.21^ASTAT^Index records with INCOMPLETE and ERROR status^R^^F^IR^I^26.21^^^^^S "IX",26.21,26.21,"ASTAT",1) S ^DGPF(26.21,"ASTAT",X,DA)="" "IX",26.21,26.21,"ASTAT",1.4) S X=X2(1)="I"!(X2(1)="E") "IX",26.21,26.21,"ASTAT",2) K ^DGPF(26.21,"ASTAT",X,DA) "IX",26.21,26.21,"ASTAT",2.5) K ^DGPF(26.21,"ASTAT") "IX",26.21,26.21,"ASTAT",11.1,0) ^.114IA^1^1 "IX",26.21,26.21,"ASTAT",11.1,1,0) 1^F^26.21^.03^^1^F "IX",40.8,40.8,"APRF",0) 40.8^APRF^Index the INSTITUTION and PRF ASSIGNMENT OWNERSHIP fields.^R^^R^IR^I^40.8^^^^^S "IX",40.8,40.8,"APRF",1) S ^DG(40.8,"APRF",X(1),X(2),DA)="" "IX",40.8,40.8,"APRF",1.4) S X=X2(2)=1 "IX",40.8,40.8,"APRF",2) K ^DG(40.8,"APRF",X(1),X(2),DA) "IX",40.8,40.8,"APRF",2.4) S X=X2(2)=0 "IX",40.8,40.8,"APRF",2.5) K ^DG(40.8,"APRF") "IX",40.8,40.8,"APRF",11.1,0) ^.114IA^2^2 "IX",40.8,40.8,"APRF",11.1,1,0) 1^F^40.8^.07^^1^F "IX",40.8,40.8,"APRF",11.1,2,0) 2^F^40.8^26.01^^2^F "KRN",.84,261116,-1) 0^1 "KRN",.84,261116,0) 261116^1^^REGISTRATION^Sending Facility Not Owner "KRN",.84,261116,1,0) ^.842^3^3^3050318^^^ "KRN",.84,261116,1,1,0) This error is reported when a facility attempts to share an assignment "KRN",.84,261116,1,2,0) through the HL7 interface and it is not the parent of the assignment "KRN",.84,261116,1,3,0) owner. "KRN",.84,261116,2,0) ^^2^2^3061019^ "KRN",.84,261116,2,1,0) Sending facility is not listed as the owner of the assignment at the "KRN",.84,261116,2,2,0) rejecting facility "KRN",19,11832,-1) 0^3 "KRN",19,11832,0) DGPF RECORD FLAG ASSIGNMENT^Record Flag Assignment^^R^^DGPF ASSIGNMENT^^^^^^REGISTRATION^^ "KRN",19,11832,1,0) ^19.06^10^10^3050616^^ "KRN",19,11832,1,1,0) This option provides a List Manager user interface for assigning Patient "KRN",19,11832,1,2,0) Record Flags to patients. Additionally, this option provides the "KRN",19,11832,1,3,0) ability to review and manage Patient Record Flag assignments. The "KRN",19,11832,1,4,0) following actions are provided within the patient Record Flag Assignment "KRN",19,11832,1,5,0) option. "KRN",19,11832,1,6,0) - Assign a Patient Record Flag to a patient. "KRN",19,11832,1,7,0) - Display the details of a patient's record flag assignments including "KRN",19,11832,1,8,0) the history of the assignment. "KRN",19,11832,1,9,0) - Review/Edit a patient's record flag assignment. "KRN",19,11832,1,10,0) - Change the site ownership of a patient's record flag assignment. "KRN",19,11832,20) "KRN",19,11832,25) EN^DGPFLMA "KRN",19,11832,"U") RECORD FLAG ASSIGNMENT "KRN",19,11837,-1) 2^2 "KRN",19,11837,0) DGPF RECORD FLAGS MAIN MENU^Patient Record Flags Main Menu^^M^66481^^^^^^^5 "KRN",19,11837,10,0) ^19.01IP^6^5 "KRN",19,11837,10,1,0) 11832^FA^20 "KRN",19,11837,10,1,"^") DGPF RECORD FLAG ASSIGNMENT "KRN",19,11837,10,3,0) 11838^FM^30 "KRN",19,11837,10,3,"^") DGPF RECORD FLAG MANAGEMENT "KRN",19,11837,10,5,0) 12157^ED^50 "KRN",19,11837,10,5,"^") DGPF ENABLE DIVISIONS "KRN",19,11837,10,6,0) 12161^TM^40 "KRN",19,11837,10,6,"^") DGPF TRANSMISSION MGMT "KRN",19,11837,"U") PATIENT RECORD FLAGS MAIN MENU "KRN",19,11838,-1) 0^4 "KRN",19,11838,0) DGPF RECORD FLAG MANAGEMENT^Record Flag Management^^R^^DGPF MANAGER^^^^^^ "KRN",19,11838,1,0) ^^5^5^3030522^ "KRN",19,11838,1,1,0) This option will provide users with the ability to: "KRN",19,11838,1,2,0) - Create Category II (Local) Patient Record Flags "KRN",19,11838,1,3,0) - Edit Category II (Local) Patient Record Flags "KRN",19,11838,1,4,0) - List Category I (National) and Category II (Local) Patient Record Flags "KRN",19,11838,1,5,0) - Display details of Category I and Category II Patient Record Flags "KRN",19,11838,25) EN^DGPFLF "KRN",19,11838,"U") RECORD FLAG MANAGEMENT "KRN",19,12145,-1) 0^1 "KRN",19,12145,0) DGPF TRANSMISSION ERRORS^Record Flag Transmission Errors^^R^^DGPF TRANSMISSIONS^^^^^^REGISTRATION^^1^1 "KRN",19,12145,1,0) ^19.06^9^9^3060814^^^^ "KRN",19,12145,1,1,0) This option provides a List Manager user interface that can be used to "KRN",19,12145,1,2,0) review and manage Rejected Status ("RJ") HL7 transmission messages that "KRN",19,12145,1,3,0) are received from Treating Facilities of the patient when trying to share "KRN",19,12145,1,4,0) Category I PRF Assignment information. "KRN",19,12145,1,5,0) The following actions are provided within this option. "KRN",19,12145,1,6,0) - Sort List display by patient name alphabetically or date/time received "KRN",19,12145,1,7,0) - View Message details of the patient's rejected HL7 message record "KRN",19,12145,1,8,0) - Retransmit all of the patient's PRF Assignment and History records to "KRN",19,12145,1,9,0) the site that the rejection message occurred at. "KRN",19,12145,15) L -^TMP("DGPFLMT") "KRN",19,12145,20) L +^TMP("DGPFLMT"):2 E W !!,">>> Sorry, it appears that someone is already using this option.",! S XQUIT=1 "KRN",19,12145,22) S DIR(0)="EA",DIR("A")="Hit the 'Enter' or 'Return' Key to Continue" D ^DIR K DIR "KRN",19,12145,25) EN^DGPFLMT "KRN",19,12145,"U") RECORD FLAG TRANSMISSION ERROR "KRN",19,12157,-1) 0^5 "KRN",19,12157,0) DGPF ENABLE DIVISIONS^Record Flag Enable Divisions^^R^^DGPF MANAGER^^^^^^REGISTRATION^^1 "KRN",19,12157,1,0) ^^7^7^3050919^ "KRN",19,12157,1,1,0) This option allows multi-divisional facilities to enable individual "KRN",19,12157,1,2,0) medical center divisions stored in the MEDICAL CENTER DIVISION (#40.8) "KRN",19,12157,1,3,0) file as patient record flag assignment owners. Once a medical center "KRN",19,12157,1,4,0) division has been enabled as a patient record flag assignment owner, it "KRN",19,12157,1,5,0) may also be disabled through this option. Disabling a medical center "KRN",19,12157,1,6,0) division will only be allowed if there are no active patient record flag "KRN",19,12157,1,7,0) assignments associated with the division. "KRN",19,12157,20) I '$P($G(^DG(43,1,"GL")),U,2) W !,"Your facility is not multi-divisional.",*7 S XQUIT=1 "KRN",19,12157,25) EN^DGPFDIV "KRN",19,12157,"U") RECORD FLAG ENABLE DIVISIONS "KRN",19,12160,-1) 0^8 "KRN",19,12160,0) DGPF MANUAL QUERY^Record Flag Manual Query^^R^^DGPF TRANSMISSIONS^^^^^^REGISTRATION^^ "KRN",19,12160,1,0) ^^8^8^3060824^ "KRN",19,12160,1,1,0) This option allows a user to query a selected treating facility for "KRN",19,12160,1,2,0) existing Category I Patient Record Flag (PRF) assignments for a selected "KRN",19,12160,1,3,0) patient. Any Category I PRF assignment returned by the query that does "KRN",19,12160,1,4,0) not exist at the local facility will automatically be added at the local "KRN",19,12160,1,5,0) facility. A List Manager user interface will display a list of all "KRN",19,12160,1,6,0) Category I PRF assignments found at the queried treating facility. The "KRN",19,12160,1,7,0) following action is provided within the List Manager interface: "KRN",19,12160,1,8,0) - Display the query details for a selected assignment. "KRN",19,12160,20) "KRN",19,12160,25) EN^DGPFHLUQ "KRN",19,12160,99.1) 60275,49582 "KRN",19,12160,"U") RECORD FLAG MANUAL QUERY "KRN",19,12161,-1) 0^7 "KRN",19,12161,0) DGPF TRANSMISSION MGMT^Record Flag Transmission Mgmt^^M^^DGPF TRANSMISSIONS^^^^^^REGISTRATION "KRN",19,12161,1,0) ^^2^2^3060124^ "KRN",19,12161,1,1,0) This option acts as a submenu containing options available to manage "KRN",19,12161,1,2,0) patient record flags transmissions. "KRN",19,12161,10,0) ^19.01IP^2^2 "KRN",19,12161,10,1,0) 12145^TE^1 "KRN",19,12161,10,1,"^") DGPF TRANSMISSION ERRORS "KRN",19,12161,10,2,0) 12160^MQ^2 "KRN",19,12161,10,2,"^") DGPF MANUAL QUERY "KRN",19,12161,99) 60491,37243 "KRN",19,12161,"U") RECORD FLAG TRANSMISSION MGMT "KRN",19,12374,-1) 1^6 "KRN",19,12374,0) DGPF PRF SYSTEM CONFIGURATION "KRN",19.1,478,-1) 0^3 "KRN",19.1,478,0) DGPF MANAGER^Patient Record Flag Manager "KRN",19.1,478,1,0) ^19.11^6^6^3050714^^^^ "KRN",19.1,478,1,1,0) This key should only be given to those individuals who may perform "KRN",19.1,478,1,2,0) certain supervisory patient record flag functions. These functions "KRN",19.1,478,1,3,0) include the following: "KRN",19.1,478,1,4,0) "KRN",19.1,478,1,5,0) - Adding/Editing Category II patient record flags. "KRN",19.1,478,1,6,0) - Enabling/Disabling patient record flag divisions. "KRN",19.1,480,-1) 0^2 "KRN",19.1,480,0) DGPF TRANSMISSIONS^Patient Record Flag Trans "KRN",19.1,480,1,0) ^^8^8^3060125^ "KRN",19.1,480,1,1,0) This key should only be given to those individuals who may perform "KRN",19.1,480,1,2,0) patient record flag functions related to the sharing/transmission of "KRN",19.1,480,1,3,0) Category I PRF assignments with other treating facilities. These "KRN",19.1,480,1,4,0) functions include the following: "KRN",19.1,480,1,5,0) "KRN",19.1,480,1,6,0) - Transmission error processing. "KRN",19.1,480,1,7,0) - Retransmission of patient assignments. "KRN",19.1,480,1,8,0) - Transmission of a query to a selected treating facility. "KRN",101,3539,-1) 0^10 "KRN",101,3539,0) DGPF RECORD FLAG ASSIGNMENT MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3539,1,0) ^101.06^2^2^3030321^^^^ "KRN",101,3539,1,1,0) This protocol menu contains all the activities for creating, editing, and "KRN",101,3539,1,2,0) displaying patient record flag assignments. "KRN",101,3539,4) 40^4 "KRN",101,3539,10,0) ^101.01PA^7^7 "KRN",101,3539,10,3,0) 3541^EF^40^ "KRN",101,3539,10,3,"^") DGPF EDIT ASSIGNMENT "KRN",101,3539,10,4,0) 3542^AF^30^ "KRN",101,3539,10,4,"^") DGPF ASSIGN FLAG "KRN",101,3539,10,5,0) 3540^DA^20^ "KRN",101,3539,10,5,"^") DGPF DISPLAY ASSIGNMENT DETAIL "KRN",101,3539,10,6,0) 3543^SP^10^ "KRN",101,3539,10,6,"^") DGPF SELECT PATIENT "KRN",101,3539,10,7,0) 3548^CO^50^ "KRN",101,3539,10,7,"^") DGPF CHANGE ASSIGNMENT OWNERSHIP "KRN",101,3539,15) "KRN",101,3539,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^",1),24)) ^(24) "KRN",101,3539,26) D SHOW^VALM "KRN",101,3539,28) Select Action: "KRN",101,3539,99) 59427,33656 "KRN",101,3540,-1) 0^13 "KRN",101,3540,0) DGPF DISPLAY ASSIGNMENT DETAIL^Display Assignment Details^^A^^^^^^^^REGISTRATION "KRN",101,3540,1,0) ^^3^3^3030708^ "KRN",101,3540,1,1,0) This action protocol permits the user to view the details of a patient's "KRN",101,3540,1,2,0) flag assignment within the Record Flag Assignment [DGPF RECORD FLAG "KRN",101,3540,1,3,0) ASSIGNMENT] option. "KRN",101,3540,15) "KRN",101,3540,20) D DF^DGPFLMA1 "KRN",101,3540,24) I $G(DGDFN),$D(@VALMAR@("IDX")) "KRN",101,3540,99) 59427,33656 "KRN",101,3541,-1) 0^11 "KRN",101,3541,0) DGPF EDIT ASSIGNMENT^Edit Flag Assignment^^A^^^^^^^^REGISTRATION "KRN",101,3541,1,0) ^^2^2^3030708^ "KRN",101,3541,1,1,0) This action protocol permits the user to edit a patient's flag assignment "KRN",101,3541,1,2,0) within the Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3541,20) D EF^DGPFLMA3 "KRN",101,3541,24) I $G(DGDFN),$D(@VALMAR@("IDX")) "KRN",101,3541,99) 59427,33656 "KRN",101,3542,-1) 0^12 "KRN",101,3542,0) DGPF ASSIGN FLAG^Assign Flag^^A^^^^^^^^REGISTRATION "KRN",101,3542,1,0) ^^2^2^3030708^ "KRN",101,3542,1,1,0) This action protocol permits the user to assign a flag to a patient "KRN",101,3542,1,2,0) within the Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3542,20) D AF^DGPFLMA2 "KRN",101,3542,24) I $G(DGDFN) "KRN",101,3542,99) 59427,33656 "KRN",101,3543,-1) 0^15 "KRN",101,3543,0) DGPF SELECT PATIENT^Select Patient^^A^^^^^^^^REGISTRATION "KRN",101,3543,1,0) ^^2^2^3030708^ "KRN",101,3543,1,1,0) This action protocol permits the user to select a patient within the "KRN",101,3543,1,2,0) Record Flag Assignment [DGPF RECORD FLAG ASSIGNMENT] option. "KRN",101,3543,20) D SP^DGPFLMA1 S VALMBCK="R" "KRN",101,3543,24) "KRN",101,3543,99) 59427,33656 "KRN",101,3548,-1) 0^14 "KRN",101,3548,0) DGPF CHANGE ASSIGNMENT OWNERSHIP^Change Assignment Ownership^^A^^^^^^^^REGISTRATION "KRN",101,3548,1,0) ^^3^3^3030708^ "KRN",101,3548,1,1,0) This action protocol permits the user to change the site ownership of a "KRN",101,3548,1,2,0) patient's flag assignment within the Record Flag Assignment [DGPF RECORD "KRN",101,3548,1,3,0) FLAG ASSIGNMENT] option. "KRN",101,3548,2,0) ^101.02A^^0 "KRN",101,3548,20) D CO^DGPFLMA4 "KRN",101,3548,24) I $G(DGDFN),$D(@VALMAR@("IDX")) "KRN",101,3548,99) 59427,33656 "KRN",101,3549,-1) 0^6 "KRN",101,3549,0) DGPF RECORD FLAG MANAGEMENT MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3549,1,0) ^101.06^2^2^3030715^^ "KRN",101,3549,1,1,0) This protocol menu contains all the activities for creating, editing, and "KRN",101,3549,1,2,0) displaying patient record flags. "KRN",101,3549,4) 26^4 "KRN",101,3549,10,0) ^101.01PA^6^6 "KRN",101,3549,10,1,0) 3550^DF^30^ "KRN",101,3549,10,1,"^") DGPF DISPLAY FLAG DETAIL "KRN",101,3549,10,2,0) 3551^CS^20^ "KRN",101,3549,10,2,"^") DGPF SORT FLAG LIST "KRN",101,3549,10,4,0) 3552^AF^40^ "KRN",101,3549,10,4,"^") DGPF ADD FLAG "KRN",101,3549,10,5,0) 3553^EF^50^ "KRN",101,3549,10,5,"^") DGPF EDIT FLAG "KRN",101,3549,10,6,0) 3554^CC^10^ "KRN",101,3549,10,6,"^") DGPF CHANGE CATEGORY "KRN",101,3549,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^",1),24)) ^(24) "KRN",101,3549,26) D SHOW^VALM "KRN",101,3549,28) Select Action: "KRN",101,3549,99) 59427,33656 "KRN",101,3550,-1) 0^7 "KRN",101,3550,0) DGPF DISPLAY FLAG DETAIL^Display Flag Detail^^A^^^^^^^^REGISTRATION "KRN",101,3550,1,0) ^^3^3^3030708^ "KRN",101,3550,1,1,0) This action protocol permits the user to view the details of a patient "KRN",101,3550,1,2,0) record flag within the Record Flag Management [DGPF RECORD FLAG "KRN",101,3550,1,3,0) MANAGEMENT] option. "KRN",101,3550,20) D DF^DGPFLF2 "KRN",101,3550,24) I $D(@VALMAR@("IDX")) "KRN",101,3550,99) 59427,33656 "KRN",101,3551,-1) 0^16 "KRN",101,3551,0) DGPF SORT FLAG LIST^Change Sort^^A^^^^^^^^REGISTRATION "KRN",101,3551,1,0) ^101.06^3^3^3030715^^ "KRN",101,3551,1,1,0) This action protocol allows the user to select a sort criteria for the "KRN",101,3551,1,2,0) flag list within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] "KRN",101,3551,1,3,0) option. The list may be sorted by flag name or flag type. "KRN",101,3551,20) D SL^DGPFLF2 S VALMBCK="R" "KRN",101,3551,99) 59427,33656 "KRN",101,3552,-1) 0^8 "KRN",101,3552,0) DGPF ADD FLAG^Add New Record Flag^^A^^^^^^^^REGISTRATION "KRN",101,3552,1,0) ^101.06^2^2^3030710^^ "KRN",101,3552,1,1,0) This action protocol allows a user to add a new Category II (Local) flag "KRN",101,3552,1,2,0) within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] option. "KRN",101,3552,20) D AF^DGPFLF3 "KRN",101,3552,24) I $G(DGCAT)>1 "KRN",101,3552,99) 59427,33656 "KRN",101,3553,-1) 0^9 "KRN",101,3553,0) DGPF EDIT FLAG^Edit Record Flag^^A^^^^^^^^REGISTRATION "KRN",101,3553,1,0) ^^2^2^3030708^ "KRN",101,3553,1,1,0) This action protocol allows a user to edit a Category II (Local) flag "KRN",101,3553,1,2,0) within the Record Flag Management [DGPF RECORD FLAG MANAGEMENT] option. "KRN",101,3553,20) D EF^DGPFLF4 "KRN",101,3553,24) I ($G(DGCAT)>1),$D(@VALMAR@("IDX")) "KRN",101,3553,99) 59427,33656 "KRN",101,3554,-1) 0^17 "KRN",101,3554,0) DGPF CHANGE CATEGORY^Change Category^^A^^^^^^^^REGISTRATION "KRN",101,3554,1,0) ^^4^4^3030715^ "KRN",101,3554,1,1,0) This action protocol allows the user to change the category of the flag "KRN",101,3554,1,2,0) list being viewed within the Record Flag Management [DGPF RECORD FLAG "KRN",101,3554,1,3,0) MANAGEMENT] option. The user may view either Category I (National) flags "KRN",101,3554,1,4,0) or Category II (Local) flags. "KRN",101,3554,20) D CC^DGPFLF2 S VALMBCK="R" "KRN",101,3554,99) 59427,33656 "KRN",101,3667,-1) 0^1 "KRN",101,3667,0) DGPF TRANSMISSION ERRORS MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3667,1,0) ^101.06^2^2^3050512^^^^ "KRN",101,3667,1,1,0) This protocol menu contains all the activities for viewing and "KRN",101,3667,1,2,0) retransmitting PRF Rejected Status ("RJ") HL7 error messages. "KRN",101,3667,4) 40^4 "KRN",101,3667,10,0) ^101.01PA^3^3 "KRN",101,3667,10,1,0) 3669^CS^10^ "KRN",101,3667,10,1,"^") DGPF TRANSMIT SORT LIST "KRN",101,3667,10,2,0) 3670^VM^20^ "KRN",101,3667,10,2,"^") DGPF TRANSMIT VIEW MESSAGE "KRN",101,3667,10,3,0) 3668^RM^30^ "KRN",101,3667,10,3,"^") DGPF TRANSMIT REJECT MESSAGE "KRN",101,3667,20) "KRN",101,3667,24) I $D(@VALMAR@("IDX")) "KRN",101,3667,26) D SHOW^VALM "KRN",101,3667,28) Select Action: "KRN",101,3667,99) 60032,58723 "KRN",101,3668,-1) 0^2 "KRN",101,3668,0) DGPF TRANSMIT REJECT MESSAGE^Retransmit Message^^A^^^^^^^^REGISTRATION "KRN",101,3668,1,0) ^101.06^4^4^3050428^^^^ "KRN",101,3668,1,1,0) This protocol provides the action for selecting one or more of the "KRN",101,3668,1,2,0) PRF Rejected Status ("RJ") HL7 error messages from the displayed list. The "KRN",101,3668,1,3,0) selection will trigger the retransmission of the patient's PRF Assignment "KRN",101,3668,1,4,0) and History information to the site that the rejection occurred at. "KRN",101,3668,20) D RM^DGPFLMT2 S VALMBCK="R" "KRN",101,3668,24) I $D(@VALMAR@("IDX")) "KRN",101,3668,99) 59989,40498 "KRN",101,3669,-1) 0^3 "KRN",101,3669,0) DGPF TRANSMIT SORT LIST^Change Sort^^A^^^^^^^^REGISTRATION "KRN",101,3669,1,0) ^101.06^3^3^3050512^^^^ "KRN",101,3669,1,1,0) This action protocol provides for switching the display list of "KRN",101,3669,1,2,0) PRF Rejected Status ("RJ") HL7 error messages from the default sort "KRN",101,3669,1,3,0) by patient name to the date/time error message received. "KRN",101,3669,20) D SL^DGPFLMT2 S VALMBCK="R" "KRN",101,3669,24) I $D(@VALMAR@("IDX")) "KRN",101,3669,99) 60032,58650 "KRN",101,3670,-1) 0^4 "KRN",101,3670,0) DGPF TRANSMIT VIEW MESSAGE^View Message^^A^^^^^^^^REGISTRATION "KRN",101,3670,1,0) ^101.06^2^2^3050428^^^^ "KRN",101,3670,1,1,0) This action protocol allows the user to select a single PRF Rejected Status "KRN",101,3670,1,2,0) ("RJ") HL7 error message from the displayed list and view the details. "KRN",101,3670,10,0) ^101.01PA^^0 "KRN",101,3670,20) D VM^DGPFLMT2 S VALMBCK="R" "KRN",101,3670,24) I $D(@VALMAR@("IDX")) "KRN",101,3670,26) "KRN",101,3670,99) 60005,38787 "KRN",101,3675,-1) 0^5 "KRN",101,3675,0) DGPF TRANSMIT VIEW MSG MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3675,1,0) ^101.06^3^3^3050428^^^^ "KRN",101,3675,1,1,0) This protocol menu provides for the selection of the action protocol "KRN",101,3675,1,2,0) to retransmit a single PRF Rejected Status ("RJ") HL7 error message while "KRN",101,3675,1,3,0) viewing the details of the error message. "KRN",101,3675,10,0) ^101.01PA^1^1 "KRN",101,3675,10,1,0) 3668^RM^10^ "KRN",101,3675,10,1,1) Select Action: "KRN",101,3675,10,1,"^") DGPF TRANSMIT REJECT MESSAGE "KRN",101,3675,24) I $O(^TMP("DGPFSORT",$J,"SELECTION","")) "KRN",101,3675,26) D SHOW^VALM "KRN",101,3675,99) 60005,39484 "KRN",101,3676,-1) 0^18 "KRN",101,3676,0) DGPF RECORD FLAG QUERY MENU^^^M^^^^^^^^REGISTRATION "KRN",101,3676,1,0) ^101.06^2^2^3060126^^ "KRN",101,3676,1,1,0) This menu protocol is used to associate the action protocols used in the "KRN",101,3676,1,2,0) Record Flag Manual Query [DGPF MANUAL QUERY] option. "KRN",101,3676,4) 40 "KRN",101,3676,10,0) ^101.01PA^1^1 "KRN",101,3676,10,1,0) 3677^DR^^ "KRN",101,3676,10,1,"^") DGPF DISPLAY QUERY RESULTS "KRN",101,3676,26) D SHOW^VALM "KRN",101,3676,28) Select Action: "KRN",101,3676,99) 60435,54080 "KRN",101,3677,-1) 0^19 "KRN",101,3677,0) DGPF DISPLAY QUERY RESULTS^Display Query Result Details^^A^^^^^^^^REGISTRATION "KRN",101,3677,1,0) ^101.06^3^3^3060126^^ "KRN",101,3677,1,1,0) This action protocol permits the user to view the details of a "KRN",101,3677,1,2,0) selected patient record flag assignment from query results within the "KRN",101,3677,1,3,0) Record Flag Manual Query [DGPF MANUAL QUERY] option. "KRN",101,3677,20) D DR^DGPFLMQ1 S VALMBCK="R" "KRN",101,3677,99) 60435,54057 "KRN",409.61,741,-1) 0^3 "KRN",409.61,741,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,741,1) ^VALM HIDDEN ACTIONS "KRN",409.61,741,"ARRAY") "KRN",409.61,741,"COL",0) ^409.621^7^6 "KRN",409.61,741,"COL",1,0) FLAG^4^20^Flag "KRN",409.61,741,"COL",2,0) ASSIGN DATE^26^8^Assigned "KRN",409.61,741,"COL",4,0) REVIEW DATE^36^11^Review Date "KRN",409.61,741,"COL",5,0) STATUS^49^6^Active "KRN",409.61,741,"COL",6,0) LOCAL^57^5^Local "KRN",409.61,741,"COL",7,0) OWNER SITE^64^16^Owner Site "KRN",409.61,741,"COL","B","ASSIGN DATE",2) "KRN",409.61,741,"COL","B","FLAG",1) "KRN",409.61,741,"COL","B","LOCAL",6) "KRN",409.61,741,"COL","B","OWNER SITE",7) "KRN",409.61,741,"COL","B","REVIEW DATE",4) "KRN",409.61,741,"COL","B","STATUS",5) "KRN",409.61,741,"EXP") "KRN",409.61,741,"FNL") D EXIT^DGPFLMA "KRN",409.61,741,"HDR") D HDR^DGPFLMA "KRN",409.61,741,"HLP") D HELP^DGPFLMA "KRN",409.61,741,"INIT") D INIT^DGPFLMA "KRN",409.61,764,-1) 0^1 "KRN",409.61,764,0) DGPF TRANSMISSION ERRORS^1^^80^5^17^1^1^Transmission Error^DGPF TRANSMISSION ERRORS MENU^TRANSMISSION ERRORS^1^999^1 "KRN",409.61,764,1) ^VALM HIDDEN ACTIONS "KRN",409.61,764,"ARRAY") ^TMP("DGPFLMT",$J) "KRN",409.61,764,"COL",0) ^409.621^6^5 "KRN",409.61,764,"COL",2,0) PATIENT NAME^6^27^Patient Name^^0 "KRN",409.61,764,"COL",3,0) SSN^35^4^SSN^^0 "KRN",409.61,764,"COL",4,0) ERROR RECEIVED D/T^41^8^Received^^0 "KRN",409.61,764,"COL",5,0) SITE TRANSMITTED TO^51^14^Transmitted To "KRN",409.61,764,"COL",6,0) OWNER SITE^67^14^Owner Site "KRN",409.61,764,"COL","AIDENT",0,2) "KRN",409.61,764,"COL","AIDENT",0,3) "KRN",409.61,764,"COL","AIDENT",0,4) "KRN",409.61,764,"COL","B","ERROR RECEIVED D/T",4) "KRN",409.61,764,"COL","B","OWNER SITE",6) "KRN",409.61,764,"COL","B","PATIENT NAME",2) "KRN",409.61,764,"COL","B","SITE TRANSMITTED TO",5) "KRN",409.61,764,"COL","B","SSN",3) "KRN",409.61,764,"FNL") D EXIT^DGPFLMT "KRN",409.61,764,"HDR") D HDR^DGPFLMT "KRN",409.61,764,"HLP") D HELP^DGPFLMT "KRN",409.61,764,"INIT") D INIT^DGPFLMT "KRN",409.61,765,-1) 0^2 "KRN",409.61,765,0) DGPF TRANSMIT VIEW MESSAGE^1^^80^5^17^1^1^^DGPF TRANSMIT VIEW MSG MENU^TRANSMISSION ERROR DETAILS^1^^1 "KRN",409.61,765,1) ^VALM HIDDEN ACTIONS "KRN",409.61,765,"ARRAY") ^TMP("DGPFVDET",$J) "KRN",409.61,765,"FNL") D EXIT^DGPFLMT3 "KRN",409.61,765,"HDR") D HDR^DGPFLMT3 "KRN",409.61,765,"HLP") D HELP^DGPFLMT3 "KRN",409.61,765,"INIT") D INIT^DGPFLMT3 "KRN",409.61,766,-1) 0^4 "KRN",409.61,766,0) DGPF RECORD FLAG QUERY^1^^80^6^15^1^1^Record Flag Query^DGPF RECORD FLAG QUERY MENU^RECORD FLAG QUERY RESULTS^1^999^1 "KRN",409.61,766,1) ^VALM HIDDEN ACTIONS "KRN",409.61,766,"COL",0) ^409.621^5^5 "KRN",409.61,766,"COL",1,0) FLAG^4^20^Flag^^0 "KRN",409.61,766,"COL",2,0) ASSIGN DATE^26^8^Assigned^^0 "KRN",409.61,766,"COL",3,0) STATUS^36^6^Active^^0 "KRN",409.61,766,"COL",4,0) ACTION CNT^44^8^#Actions^^0 "KRN",409.61,766,"COL",5,0) OWNER SITE^54^16^Owner Site^^0 "KRN",409.61,766,"COL","AIDENT",0,1) "KRN",409.61,766,"COL","AIDENT",0,2) "KRN",409.61,766,"COL","AIDENT",0,3) "KRN",409.61,766,"COL","AIDENT",0,4) "KRN",409.61,766,"COL","AIDENT",0,5) "KRN",409.61,766,"COL","B","ACTION CNT",4) "KRN",409.61,766,"COL","B","ASSIGN DATE",2) "KRN",409.61,766,"COL","B","FLAG",1) "KRN",409.61,766,"COL","B","OWNER SITE",5) "KRN",409.61,766,"COL","B","STATUS",3) "KRN",409.61,766,"FNL") D EXIT^DGPFLMQ "KRN",409.61,766,"HDR") D HDR^DGPFLMQ "KRN",409.61,766,"HLP") D HELP^DGPFLMQ "KRN",409.61,766,"INIT") D INIT^DGPFLMQ "KRN",409.61,767,-1) 0^5 "KRN",409.61,767,0) DGPF QUERY DETAIL^2^^80^5^20^1^1^Query Detail^^QUERY DETAILS^1^^1 "KRN",409.61,767,1) ^VALM HIDDEN ACTIONS "KRN",409.61,767,"ARRAY") ^TMP("DGPFQDET",$J) "KRN",409.61,767,"FNL") D EXIT^DGPFLMQD "KRN",409.61,767,"HDR") D HDR^DGPFLMQD "KRN",409.61,767,"HLP") D HELP^DGPFLMQD "KRN",409.61,767,"INIT") D INIT^DGPFLMQD "KRN",8989.5,1057,0) 5;DIC(9.4,^DGPF QUERY TRY LIMIT^1 "KRN",8989.5,1057,1) 5 "KRN",8989.51,381,-1) 0^1 "KRN",8989.51,381,0) DGPF QUERY TRY LIMIT^Patient Record Flags Query Try Limit^0^^^0 "KRN",8989.51,381,1) N^1:30^Enter the maximum number of PRF query attempts to allow. "KRN",8989.51,381,20,0) ^8989.512^2^2^3050608^^^ "KRN",8989.51,381,20,1,0) This value is used by the Patient Record Flags module to control the "KRN",8989.51,381,20,2,0) maximum number of query attempts that are allowed. "KRN",8989.51,381,30,0) ^8989.513I^1^1 "KRN",8989.51,381,30,1,0) 1^9.4 "MBREQ") 0 "ORD",3,19.1) 19.1;3;1;;KEY^XPDTA1;;;KEYF2^XPDIA1;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "ORD",9,.84) .84;9;;;EDEOUT^DIFROMSO(.84,DA,"",XPDA);FPRE^DIFROMSI(.84,"",XPDA);EPRE^DIFROMSI(.84,DA,"",XPDA,"",OLDA);;EPOST^DIFROMSI(.84,DA,"",XPDA);DEL^DIFROMSK(.84,"",%) "ORD",9,.84,0) DIALOG "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 "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PKG",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^2930813 "PKG",5,22,1,"PAH",1,0) 650^3061019^123457046 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3061019 "PKG",5,22,1,"PAH",1,1,1,0) Please refer to patch DG*5.3*650 in the National Patch Module for a "PKG",5,22,1,"PAH",1,1,2,0) complete description of this patch. "PRE") DG53P650 "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") 44 "RTN","DG53P650") 0^38^B18743146 "RTN","DG53P650",1,0) DG53P650 ;ALB/KCL - PATCH DG*5.3*650 INSTALL UTILITIES ; 7/12/06 09:12am "RTN","DG53P650",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DG53P650",3,0) ; "RTN","DG53P650",4,0) QUIT "RTN","DG53P650",5,0) ; "RTN","DG53P650",6,0) ;-------------------------------------------------------------- "RTN","DG53P650",7,0) ;Patch DG*5.3*650: Environment, Pre-Install, and Post-Install "RTN","DG53P650",8,0) ;entry points. "RTN","DG53P650",9,0) ;-------------------------------------------------------------- "RTN","DG53P650",10,0) ; "RTN","DG53P650",11,0) ENV ;Main entry point for Environment check point "RTN","DG53P650",12,0) ; "RTN","DG53P650",13,0) S XPDABORT="" "RTN","DG53P650",14,0) D PROGCHK(.XPDABORT) ;checks programmer variables "RTN","DG53P650",15,0) I XPDABORT="" K XPDABORT "RTN","DG53P650",16,0) Q "RTN","DG53P650",17,0) ; "RTN","DG53P650",18,0) PRE ;Main entry point for Pre-Install items "RTN","DG53P650",19,0) ; "RTN","DG53P650",20,0) D PRE1 ;rename security key "RTN","DG53P650",21,0) D PRE2 ;delete obsolete security keys "RTN","DG53P650",22,0) Q "RTN","DG53P650",23,0) ; "RTN","DG53P650",24,0) POST ;Main entry point for Post-Install items "RTN","DG53P650",25,0) ; "RTN","DG53P650",26,0) ; "RTN","DG53P650",27,0) D POST1 ;set query try limit parameter "RTN","DG53P650",28,0) D POST2 ;enable primary site for PRF Assignment ownership "RTN","DG53P650",29,0) D POST3 ;build "AOWN" index on file #26.13 "RTN","DG53P650",30,0) Q "RTN","DG53P650",31,0) ; "RTN","DG53P650",32,0) ; "RTN","DG53P650",33,0) PROGCHK(XPDABORT) ;Checks for necessary programmer variables "RTN","DG53P650",34,0) ; "RTN","DG53P650",35,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO "RTN","DG53P650",36,0) .D BMES^XPDUTL("*****") "RTN","DG53P650",37,0) .D MES^XPDUTL("Your programming variables are not set up properly.") "RTN","DG53P650",38,0) .D MES^XPDUTL("Installation aborted.") "RTN","DG53P650",39,0) .D MES^XPDUTL("*****") "RTN","DG53P650",40,0) .S XPDABORT=2 "RTN","DG53P650",41,0) Q "RTN","DG53P650",42,0) ; "RTN","DG53P650",43,0) PRE1 ;Rename security keys "RTN","DG53P650",44,0) ; "RTN","DG53P650",45,0) N DGI,DGOLD,DGNEW "RTN","DG53P650",46,0) ; "RTN","DG53P650",47,0) S DGOLD(1)="DGPF RECORD FLAG ASSIGNMENT" ;old name "RTN","DG53P650",48,0) S DGNEW(1)="DGPF ASSIGNMENT" ;new name "RTN","DG53P650",49,0) ; "RTN","DG53P650",50,0) S DGOLD(2)="DGPF LOCAL FLAG EDIT" ;old name "RTN","DG53P650",51,0) S DGNEW(2)="DGPF MANAGER" ;new name "RTN","DG53P650",52,0) ; "RTN","DG53P650",53,0) D BMES^XPDUTL("*****") "RTN","DG53P650",54,0) D MES^XPDUTL("Attempting to rename security keys...") "RTN","DG53P650",55,0) ; "RTN","DG53P650",56,0) ;loop through keys "RTN","DG53P650",57,0) S DGI=0 "RTN","DG53P650",58,0) F S DGI=$O(DGOLD(DGI)) Q:'DGI D ;drops out of DO block on failure "RTN","DG53P650",59,0) . ; "RTN","DG53P650",60,0) . ;quit if key already renamed "RTN","DG53P650",61,0) . I +$$LKUP^XPDKEY(DGNEW(DGI)) D Q "RTN","DG53P650",62,0) . . D MES^XPDUTL("Security key "_DGOLD(DGI)_" already renamed to "_DGNEW(DGI)_".") "RTN","DG53P650",63,0) . ; "RTN","DG53P650",64,0) . ;attempt to rename key "RTN","DG53P650",65,0) . I '$$RENAME^XPDKEY(DGOLD(DGI),DGNEW(DGI)) D Q "RTN","DG53P650",66,0) . . D MES^XPDUTL("Could not rename "_DGOLD(DGI)_" security key.") "RTN","DG53P650",67,0) . ; "RTN","DG53P650",68,0) . D MES^XPDUTL("Security key "_DGOLD(DGI)_" renamed to "_DGNEW(DGI)_".") "RTN","DG53P650",69,0) ; "RTN","DG53P650",70,0) D MES^XPDUTL("*****") "RTN","DG53P650",71,0) Q "RTN","DG53P650",72,0) ; "RTN","DG53P650",73,0) PRE2 ;Delete obsolete security keys "RTN","DG53P650",74,0) ; "RTN","DG53P650",75,0) N DGIEN,DGNAME "RTN","DG53P650",76,0) ; "RTN","DG53P650",77,0) D BMES^XPDUTL("*****") "RTN","DG53P650",78,0) D MES^XPDUTL("Attempting to delete obsolete security keys...") "RTN","DG53P650",79,0) ; "RTN","DG53P650",80,0) ;loop thru obsolete keys "RTN","DG53P650",81,0) F DGNAME="DGPF PRF ACCESS","DGPF PRF CONFIG" D "RTN","DG53P650",82,0) . ; "RTN","DG53P650",83,0) . ;lookup key "RTN","DG53P650",84,0) . S DGIEN=$$LKUP^XPDKEY(DGNAME) "RTN","DG53P650",85,0) . ; "RTN","DG53P650",86,0) . ;quit with msg if key lookup fails "RTN","DG53P650",87,0) . I '+$G(DGIEN) D Q "RTN","DG53P650",88,0) . . D MES^XPDUTL("Security key "_DGNAME_" already deleted.") "RTN","DG53P650",89,0) . ; "RTN","DG53P650",90,0) . ;delete key "RTN","DG53P650",91,0) . D DEL^XPDKEY(+$G(DGIEN)) "RTN","DG53P650",92,0) . D MES^XPDUTL("Security key "_DGNAME_" deleted. IEN="_DGIEN_".") "RTN","DG53P650",93,0) ; "RTN","DG53P650",94,0) D MES^XPDUTL("*****") "RTN","DG53P650",95,0) Q "RTN","DG53P650",96,0) ; "RTN","DG53P650",97,0) POST1 ;set query try limit parameter "RTN","DG53P650",98,0) ; "RTN","DG53P650",99,0) N DGERR ;XPAR error result "RTN","DG53P650",100,0) N DGPARM ;parameter name "RTN","DG53P650",101,0) N DGRETRY ;# of retries "RTN","DG53P650",102,0) ; "RTN","DG53P650",103,0) S DGPARM="DGPF QUERY TRY LIMIT" "RTN","DG53P650",104,0) S DGRETRY=5 "RTN","DG53P650",105,0) D EN^XPAR("PKG",DGPARM,1,DGRETRY,.DGERR) "RTN","DG53P650",106,0) D BMES^XPDUTL("*****") "RTN","DG53P650",107,0) I '$G(DGERR) D "RTN","DG53P650",108,0) . D MES^XPDUTL(DGPARM_" parameter set to "_DGRETRY_" SUCCESSFULLY") "RTN","DG53P650",109,0) E D "RTN","DG53P650",110,0) . D MES^XPDUTL(DGPARM_" parameter set FAILED") "RTN","DG53P650",111,0) D MES^XPDUTL("*****") "RTN","DG53P650",112,0) ; "RTN","DG53P650",113,0) Q "RTN","DG53P650",114,0) ; "RTN","DG53P650",115,0) POST2 ;enable primary site for PRF Assignment ownership "RTN","DG53P650",116,0) ; "RTN","DG53P650",117,0) N DGDIV ;pointer to MEDICAL CENTER DIVISION (#40.8) file "RTN","DG53P650",118,0) N DGSITE ;$$SITE results "RTN","DG53P650",119,0) ; "RTN","DG53P650",120,0) S DGSITE=$$SITE^VASITE() "RTN","DG53P650",121,0) S DGDIV=+$O(^DG(40.8,"AD",+DGSITE,0)) "RTN","DG53P650",122,0) D BMES^XPDUTL("*****") "RTN","DG53P650",123,0) I DGDIV,$$STODIV^DGPFDIV1(DGDIV,1) D "RTN","DG53P650",124,0) . D MES^XPDUTL($P(DGSITE,U,2)_" enabled for PRF Assignment ownership SUCCESSFULLY") "RTN","DG53P650",125,0) E D "RTN","DG53P650",126,0) . D MES^XPDUTL("Attempt to enable primary site for PRF Assignment ownership FAILED") "RTN","DG53P650",127,0) D MES^XPDUTL("*****") "RTN","DG53P650",128,0) ; "RTN","DG53P650",129,0) Q "RTN","DG53P650",130,0) ; "RTN","DG53P650",131,0) POST3 ;populate "AOWN" index of PRF ASSIGNMENT (#26.13) file "RTN","DG53P650",132,0) ; "RTN","DG53P650",133,0) N DIK "RTN","DG53P650",134,0) ; "RTN","DG53P650",135,0) S DIK="^DGPF(26.13," "RTN","DG53P650",136,0) S DIK(1)=".04^AOWN" "RTN","DG53P650",137,0) D ENALL^DIK "RTN","DG53P650",138,0) ; "RTN","DG53P650",139,0) Q "RTN","DGPFAA2") 0^1^B31192734 "RTN","DGPFAA2",1,0) DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 3/22/05 "RTN","DGPFAA2",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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,DGEROOT) ;This function will be used to determine if a flag may be 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) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for error "RTN","DGPFAA2",15,0) ; dialog returned from BLD^DIALOG. If not passed, error "RTN","DGPFAA2",16,0) ; dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA2",17,0) ; "RTN","DGPFAA2",18,0) ; Output: "RTN","DGPFAA2",19,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFAA2",20,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA2",21,0) ; "RTN","DGPFAA2",22,0) N DGRSLT ;function result "RTN","DGPFAA2",23,0) N DGFARRY ;contains flag array "RTN","DGPFAA2",24,0) K DGFARRY "RTN","DGPFAA2",25,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA2",26,0) ; "RTN","DGPFAA2",27,0) ;init error output array if passed "RTN","DGPFAA2",28,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFAA2",29,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFAA2",30,0) ; "RTN","DGPFAA2",31,0) S DGRSLT=0 "RTN","DGPFAA2",32,0) ; "RTN","DGPFAA2",33,0) D ;drops out of block on failure "RTN","DGPFAA2",34,0) . ; "RTN","DGPFAA2",35,0) . ;quit if DFN invalid "RTN","DGPFAA2",36,0) . I '$G(DGDFN)!'$D(^DPT(+$G(DGDFN),0)) D Q "RTN","DGPFAA2",37,0) . . D BLD^DIALOG(261110,,,DGEROOT,"F") "RTN","DGPFAA2",38,0) . ; "RTN","DGPFAA2",39,0) . ;quit if flag ien invalid "RTN","DGPFAA2",40,0) . I '$$TESTVAL^DGPFUT(26.13,.02,DGFLG) D Q "RTN","DGPFAA2",41,0) . . D BLD^DIALOG(261111,,,DGEROOT,"F") "RTN","DGPFAA2",42,0) . ; "RTN","DGPFAA2",43,0) . ;quit if flag already assigned to patient "RTN","DGPFAA2",44,0) . I $$FNDASGN^DGPFAA(DGDFN,DGFLG) D Q "RTN","DGPFAA2",45,0) . . D BLD^DIALOG(261112,,,DGEROOT,"F") "RTN","DGPFAA2",46,0) . ; "RTN","DGPFAA2",47,0) . ;quit if flag STATUS is INACTIVE "RTN","DGPFAA2",48,0) . I $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY),('+$G(DGFARRY("STAT"))) D Q "RTN","DGPFAA2",49,0) . . D BLD^DIALOG(261113,,,DGEROOT,"F") "RTN","DGPFAA2",50,0) . ; "RTN","DGPFAA2",51,0) . ;quit if no TIU PN TITLE IEN is found for the record flag "RTN","DGPFAA2",52,0) . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q "RTN","DGPFAA2",53,0) . . D BLD^DIALOG(261114,,,DGEROOT,"F") "RTN","DGPFAA2",54,0) . ; "RTN","DGPFAA2",55,0) . ;success "RTN","DGPFAA2",56,0) . S DGRSLT=1 "RTN","DGPFAA2",57,0) ; "RTN","DGPFAA2",58,0) Q DGRSLT "RTN","DGPFAA2",59,0) ; "RTN","DGPFAA2",60,0) EDTOK(DGPFA,DGORIG,DGEROOT) ;This function will be used to determine if a flag assignment may be edited. "RTN","DGPFAA2",61,0) ; "RTN","DGPFAA2",62,0) ; Input: "RTN","DGPFAA2",63,0) ; DGPFA - (required) array containing the flag assignment values "RTN","DGPFAA2",64,0) ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()] "RTN","DGPFAA2",65,0) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFAA2",66,0) ; error dialog returned from BLD^DIALOG. If not passed, "RTN","DGPFAA2",67,0) ; error dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA2",68,0) ; "RTN","DGPFAA2",69,0) ; Output: "RTN","DGPFAA2",70,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFAA2",71,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA2",72,0) ; "RTN","DGPFAA2",73,0) N DGRSLT ;function result "RTN","DGPFAA2",74,0) N DGFARRY ;contains flag array "RTN","DGPFAA2",75,0) K DGFARRY "RTN","DGPFAA2",76,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA2",77,0) ; "RTN","DGPFAA2",78,0) ;init error output array if passed "RTN","DGPFAA2",79,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFAA2",80,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFAA2",81,0) ; "RTN","DGPFAA2",82,0) S DGRSLT=0 "RTN","DGPFAA2",83,0) ; "RTN","DGPFAA2",84,0) D ;drops out of block on failure "RTN","DGPFAA2",85,0) . ; "RTN","DGPFAA2",86,0) . ;quit if current site is not the owner site "RTN","DGPFAA2",87,0) . I +$G(DGORIG)'>0 S DGORIG=+$$SITE^VASITE() "RTN","DGPFAA2",88,0) . I +$G(DGPFA("OWNER"))'=DGORIG D Q "RTN","DGPFAA2",89,0) . . D BLD^DIALOG(261115,,,DGEROOT,"F") "RTN","DGPFAA2",90,0) . ; "RTN","DGPFAA2",91,0) . ;quit if flag STATUS is INACTIVE "RTN","DGPFAA2",92,0) . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY) "RTN","DGPFAA2",93,0) . I '+$G(DGFARRY("STAT")) D Q "RTN","DGPFAA2",94,0) . . D BLD^DIALOG(261113,,,DGEROOT,"F") "RTN","DGPFAA2",95,0) . ; "RTN","DGPFAA2",96,0) . ;quit if no TIU PN TITLE is found for the record flag "RTN","DGPFAA2",97,0) . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q "RTN","DGPFAA2",98,0) . . D BLD^DIALOG(261114,,,DGEROOT,"F") "RTN","DGPFAA2",99,0) . ; "RTN","DGPFAA2",100,0) . ;success "RTN","DGPFAA2",101,0) . S DGRSLT=1 "RTN","DGPFAA2",102,0) ; "RTN","DGPFAA2",103,0) Q DGRSLT "RTN","DGPFAA2",104,0) ; "RTN","DGPFAA2",105,0) ACTIONOK(DGPFA,DGACT,DGEROOT) ;This function will be used to verify that an assignment edit ACTION is appropriate for the current assignment STATUS. "RTN","DGPFAA2",106,0) ; "RTN","DGPFAA2",107,0) ; Input: "RTN","DGPFAA2",108,0) ; DGPFA - (required) assignment array data from current record "RTN","DGPFAA2",109,0) ; DGACT - Assignment edit action in internal format "RTN","DGPFAA2",110,0) ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR] "RTN","DGPFAA2",111,0) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFAA2",112,0) ; error dialog returned from BLD^DIALOG. If not passed, error "RTN","DGPFAA2",113,0) ; dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA2",114,0) ; "RTN","DGPFAA2",115,0) ; Output: "RTN","DGPFAA2",116,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFAA2",117,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA2",118,0) ; "RTN","DGPFAA2",119,0) N DGRSLT ;function result "RTN","DGPFAA2",120,0) N DGSTAT ;current assignment status "RTN","DGPFAA2",121,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA2",122,0) ; "RTN","DGPFAA2",123,0) ;init error output array if passed "RTN","DGPFAA2",124,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFAA2",125,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFAA2",126,0) ; "RTN","DGPFAA2",127,0) S DGACT=+$G(DGACT) "RTN","DGPFAA2",128,0) S DGSTAT=$P($G(DGPFA("STATUS")),U,1) "RTN","DGPFAA2",129,0) S DGRSLT=0 "RTN","DGPFAA2",130,0) ; "RTN","DGPFAA2",131,0) D ;drops out of block on failure "RTN","DGPFAA2",132,0) . ; "RTN","DGPFAA2",133,0) . ;is ACTION valid? "RTN","DGPFAA2",134,0) . I '$$TESTVAL^DGPFUT(26.14,.03,DGACT),'DGSTAT?1N D Q "RTN","DGPFAA2",135,0) . . D BLD^DIALOG(261118,,,DGEROOT,"F") "RTN","DGPFAA2",136,0) . ; "RTN","DGPFAA2",137,0) . ;must not CONTINUE inactive assignments "RTN","DGPFAA2",138,0) . I DGACT=2,DGSTAT=0 D Q "RTN","DGPFAA2",139,0) . . D BLD^DIALOG(261121,,,DGEROOT,"F") "RTN","DGPFAA2",140,0) . ; "RTN","DGPFAA2",141,0) . ;must not INACTIVATE inactive assignments "RTN","DGPFAA2",142,0) . I DGACT=3,DGSTAT=0 D Q "RTN","DGPFAA2",143,0) . . D BLD^DIALOG(261122,,,DGEROOT,"F") "RTN","DGPFAA2",144,0) . ; "RTN","DGPFAA2",145,0) . ;must not ENTERED IN ERROR inactive assignments "RTN","DGPFAA2",146,0) . I DGACT=5,DGSTAT=0 D Q "RTN","DGPFAA2",147,0) . . D BLD^DIALOG(261123,,,DGEROOT,"F") "RTN","DGPFAA2",148,0) . ; "RTN","DGPFAA2",149,0) . ;must not REACTIVATE active assignments "RTN","DGPFAA2",150,0) . I DGACT=4,DGSTAT=1 D Q "RTN","DGPFAA2",151,0) . . D BLD^DIALOG(261124,,,DGEROOT,"F") "RTN","DGPFAA2",152,0) . ; "RTN","DGPFAA2",153,0) . ;success "RTN","DGPFAA2",154,0) . S DGRSLT=1 "RTN","DGPFAA2",155,0) ; "RTN","DGPFAA2",156,0) Q DGRSLT "RTN","DGPFAA2",157,0) ; "RTN","DGPFAA2",158,0) CHGOWN(DGPFA,DGORIG,DGEROOT) ;This function is used to determine if a site is allowed to change ownership of a record flag assignment? "RTN","DGPFAA2",159,0) ; "RTN","DGPFAA2",160,0) ; Input: "RTN","DGPFAA2",161,0) ; DGPFA - (required) array containing the flag assignment values "RTN","DGPFAA2",162,0) ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()] "RTN","DGPFAA2",163,0) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFAA2",164,0) ; error dialog returned from BLD^DIALOG. If not passed, "RTN","DGPFAA2",165,0) ; error dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA2",166,0) ; "RTN","DGPFAA2",167,0) ; Output: "RTN","DGPFAA2",168,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFAA2",169,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA2",170,0) ; "RTN","DGPFAA2",171,0) N DGRSLT ;function result "RTN","DGPFAA2",172,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA2",173,0) ; "RTN","DGPFAA2",174,0) ;init error output array if passed "RTN","DGPFAA2",175,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFAA2",176,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFAA2",177,0) ; "RTN","DGPFAA2",178,0) S:(+$G(DGORIG)'>0) DGORIG=(+$$SITE^VASITE()) "RTN","DGPFAA2",179,0) S DGRSLT=0 "RTN","DGPFAA2",180,0) ; "RTN","DGPFAA2",181,0) D ;drops out of block on failure "RTN","DGPFAA2",182,0) . ; "RTN","DGPFAA2",183,0) . ;ORIGINATING SITE must be OWNER and flag must be ACTIVE "RTN","DGPFAA2",184,0) . Q:('$$EDTOK(.DGPFA,DGORIG,.DGEROOT)) "RTN","DGPFAA2",185,0) . ; "RTN","DGPFAA2",186,0) . ;can't CHANGE OWNERSHIP for an INACTIVE assignment "RTN","DGPFAA2",187,0) . I '+$G(DGPFA("STATUS")) D Q "RTN","DGPFAA2",188,0) . . D BLD^DIALOG(261117,,,DGEROOT,"F") "RTN","DGPFAA2",189,0) . ; "RTN","DGPFAA2",190,0) . ;success "RTN","DGPFAA2",191,0) . S DGRSLT=1 "RTN","DGPFAA2",192,0) ; "RTN","DGPFAA2",193,0) Q DGRSLT "RTN","DGPFAA2",194,0) ; "RTN","DGPFAA2",195,0) ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record "RTN","DGPFAA2",196,0) ; "RTN","DGPFAA2",197,0) ; Input: "RTN","DGPFAA2",198,0) ; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT "RTN","DGPFAA2",199,0) ; (#26.13) file "RTN","DGPFAA2",200,0) ; DGPFOA - Assignment data array prior to record modification "RTN","DGPFAA2",201,0) ; "RTN","DGPFAA2",202,0) ; Output: "RTN","DGPFAA2",203,0) ; Function value - 1 on successful rollback, 0 on failure "RTN","DGPFAA2",204,0) ; "RTN","DGPFAA2",205,0) N DGIENS "RTN","DGPFAA2",206,0) N DGFDA "RTN","DGPFAA2",207,0) N DGEROOT "RTN","DGPFAA2",208,0) N DGRSLT ;function result "RTN","DGPFAA2",209,0) ; "RTN","DGPFAA2",210,0) S DGRSLT=0 "RTN","DGPFAA2",211,0) I +$G(DGAIEN),$D(^DGPF(26.13,DGAIEN)),$D(DGPFOA) D "RTN","DGPFAA2",212,0) . S DGIENS=DGAIEN_"," "RTN","DGPFAA2",213,0) . I $G(DGPFOA("DFN"))="@" D "RTN","DGPFAA2",214,0) . . S DGFDA(26.13,DGIENS,.01)=DGPFOA("DFN") "RTN","DGPFAA2",215,0) . . D FILE^DIE("","DGFDA","DGEROOT") "RTN","DGPFAA2",216,0) . . I '$D(DGEROOT) S DGRSLT=1 "RTN","DGPFAA2",217,0) . E D "RTN","DGPFAA2",218,0) . . I $$STOASGN^DGPFAA(.DGPFOA,.DGEROOT),'$D(DGEROOT) S DGRSLT=1 "RTN","DGPFAA2",219,0) Q DGRSLT "RTN","DGPFAA3") 0^2^B33716755 "RTN","DGPFAA3",1,0) DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03 "RTN","DGPFAA3",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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","DGPFAA3",91,0) ; "RTN","DGPFAA3",92,0) STOHL7(DGPFA,DGPFAH,DGEROOT) ;store a valid assignment from HL7 message "RTN","DGPFAA3",93,0) ; This function files an assignment if the originating site is "RTN","DGPFAA3",94,0) ; authorized to update an existing record and if the action is valid for "RTN","DGPFAA3",95,0) ; the status of an existing record. "RTN","DGPFAA3",96,0) ; "RTN","DGPFAA3",97,0) ; Input: "RTN","DGPFAA3",98,0) ; DGPFA - (required) array of assignment values to be filed (see "RTN","DGPFAA3",99,0) ; $$GETASGN^DGPFAA for valid array structure) "RTN","DGPFAA3",100,0) ; DGPFAH - (required) array of assignment history values to be filed "RTN","DGPFAA3",101,0) ; (see $$STOHIST^DGPFAAH for valid array structure) "RTN","DGPFAA3",102,0) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFAA3",103,0) ; error dialog returned from BLD^DIALOG. If not passed, error "RTN","DGPFAA3",104,0) ; dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA3",105,0) ; "RTN","DGPFAA3",106,0) ; Output: "RTN","DGPFAA3",107,0) ; Function Value - Returns 1 on sucess, 0 on failure "RTN","DGPFAA3",108,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA3",109,0) ; "RTN","DGPFAA3",110,0) N DGDFN "RTN","DGPFAA3",111,0) N DGFLG "RTN","DGPFAA3",112,0) N DGORIG "RTN","DGPFAA3",113,0) N DGACT "RTN","DGPFAA3",114,0) N DGMSG "RTN","DGPFAA3",115,0) N DGRSLT "RTN","DGPFAA3",116,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA3",117,0) ; "RTN","DGPFAA3",118,0) S DGDFN=+$G(DGPFA("DFN")) "RTN","DGPFAA3",119,0) S DGFLG=$G(DGPFA("FLAG")) "RTN","DGPFAA3",120,0) S DGORIG=+$G(DGPFA("SNDFAC")) "RTN","DGPFAA3",121,0) S DGACT=+$G(DGPFAH("ACTION")) "RTN","DGPFAA3",122,0) ; "RTN","DGPFAA3",123,0) S DGRSLT=0 "RTN","DGPFAA3",124,0) ; "RTN","DGPFAA3",125,0) D ;drops out of block on failure "RTN","DGPFAA3",126,0) . ; "RTN","DGPFAA3",127,0) . ;check input params "RTN","DGPFAA3",128,0) . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q "RTN","DGPFAA3",129,0) . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q "RTN","DGPFAA3",130,0) . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q "RTN","DGPFAA3",131,0) . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q "RTN","DGPFAA3",132,0) . ; "RTN","DGPFAA3",133,0) . ;new assignment action "RTN","DGPFAA3",134,0) . I DGACT=1,'$$ADDOK^DGPFAA2(DGDFN,DGFLG,DGEROOT) Q "RTN","DGPFAA3",135,0) . ; "RTN","DGPFAA3",136,0) . ;all other actions "RTN","DGPFAA3",137,0) . I DGACT'=1,'$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) Q "RTN","DGPFAA3",138,0) . ; "RTN","DGPFAA3",139,0) . ;file the assignment and history "RTN","DGPFAA3",140,0) . I '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGMSG)!($D(DGMSG)) D Q "RTN","DGPFAA3",141,0) . . D BLD^DIALOG(261120,,,DGEROOT,"F") "RTN","DGPFAA3",142,0) . ; "RTN","DGPFAA3",143,0) . ;success "RTN","DGPFAA3",144,0) . S DGRSLT=1 "RTN","DGPFAA3",145,0) ; "RTN","DGPFAA3",146,0) Q DGRSLT "RTN","DGPFAA3",147,0) ; "RTN","DGPFAA3",148,0) HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) ;Is site allowed to edit assignment? "RTN","DGPFAA3",149,0) ; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits "RTN","DGPFAA3",150,0) ; that originate from PRF HL7 message processing. "RTN","DGPFAA3",151,0) ; "RTN","DGPFAA3",152,0) ; Supported DBIA #2171: This DBIA is used to access the KERNEL "RTN","DGPFAA3",153,0) ; INSTITUTION (#4) file API PARENT^XUAF4. "RTN","DGPFAA3",154,0) ; "RTN","DGPFAA3",155,0) ; Input: "RTN","DGPFAA3",156,0) ; DGDFN - IEN of patient in PATIENT (#2) file "RTN","DGPFAA3",157,0) ; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15) "RTN","DGPFAA3",158,0) ; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"] "RTN","DGPFAA3",159,0) ; DGORIG - IEN of originating site in INSTITUTION (#4) file "RTN","DGPFAA3",160,0) ; DGACT - Assignment edit action in internal format "RTN","DGPFAA3",161,0) ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR] "RTN","DGPFAA3",162,0) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFAA3",163,0) ; error dialog returned from BLD^DIALOG. If not passed, error "RTN","DGPFAA3",164,0) ; dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFAA3",165,0) ; "RTN","DGPFAA3",166,0) ; Output: "RTN","DGPFAA3",167,0) ; Function value - 1 if authorized, 0 if not authorized "RTN","DGPFAA3",168,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFAA3",169,0) ; "RTN","DGPFAA3",170,0) N DGIEN ;pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAA3",171,0) N DGPFA ;assignment data array "RTN","DGPFAA3",172,0) N DGFARRY ;flag data array "RTN","DGPFAA3",173,0) N DGOWNER ;IEN of owner site in INSTITUTION (#4) file "RTN","DGPFAA3",174,0) N DGRSLT ;function value "RTN","DGPFAA3",175,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFAA3",176,0) ; "RTN","DGPFAA3",177,0) ;init error output array if passed "RTN","DGPFAA3",178,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFAA3",179,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFAA3",180,0) ; "RTN","DGPFAA3",181,0) S DGACT=+$G(DGACT) "RTN","DGPFAA3",182,0) S DGDFN=+$G(DGDFN) "RTN","DGPFAA3",183,0) S DGFLG=$G(DGFLG) "RTN","DGPFAA3",184,0) S DGORIG=+$G(DGORIG) "RTN","DGPFAA3",185,0) S DGRSLT=0 "RTN","DGPFAA3",186,0) ; "RTN","DGPFAA3",187,0) D ;drops out of block on failure "RTN","DGPFAA3",188,0) . ; "RTN","DGPFAA3",189,0) . ;check input params "RTN","DGPFAA3",190,0) . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q "RTN","DGPFAA3",191,0) . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q "RTN","DGPFAA3",192,0) . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q "RTN","DGPFAA3",193,0) . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q "RTN","DGPFAA3",194,0) . ; "RTN","DGPFAA3",195,0) . ;retrieve existing assignment data "RTN","DGPFAA3",196,0) . S DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG) "RTN","DGPFAA3",197,0) . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q "RTN","DGPFAA3",198,0) . . D BLD^DIALOG(261102,,,DGEROOT,"F") "RTN","DGPFAA3",199,0) . ; "RTN","DGPFAA3",200,0) . ;SENDING FACILITY be the OWNER or parent of the OWNER "RTN","DGPFAA3",201,0) . S DGOWNER=+$G(DGPFA("OWNER")) "RTN","DGPFAA3",202,0) . I DGORIG'=DGOWNER,DGORIG'=+$$PARENT^DGPFUT1(DGOWNER) D Q "RTN","DGPFAA3",203,0) . . D BLD^DIALOG(261116,,,DGEROOT,"F") "RTN","DGPFAA3",204,0) . ; "RTN","DGPFAA3",205,0) . ;quit if flag STATUS is INACTIVE "RTN","DGPFAA3",206,0) . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY) "RTN","DGPFAA3",207,0) . I '+$G(DGFARRY("STAT")) D Q "RTN","DGPFAA3",208,0) . . D BLD^DIALOG(261113,,,DGEROOT,"F") "RTN","DGPFAA3",209,0) . ; "RTN","DGPFAA3",210,0) . ;quit if no TIU PN TITLE IEN is found for the record flag "RTN","DGPFAA3",211,0) . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q "RTN","DGPFAA3",212,0) . . D BLD^DIALOG(261114,,,DGEROOT,"F") "RTN","DGPFAA3",213,0) . ; "RTN","DGPFAA3",214,0) . ;ACTION must be valid for current assignment STATUS "RTN","DGPFAA3",215,0) . Q:('$$ACTIONOK^DGPFAA2(.DGPFA,DGACT,DGEROOT)) "RTN","DGPFAA3",216,0) . ; "RTN","DGPFAA3",217,0) . ;success "RTN","DGPFAA3",218,0) . S DGRSLT=1 "RTN","DGPFAA3",219,0) ; "RTN","DGPFAA3",220,0) Q DGRSLT "RTN","DGPFAPI") 0^23^B36238141 "RTN","DGPFAPI",1,0) DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am "RTN","DGPFAPI",2,0) ;;5.3;Registration;**425,554,699,650**;Aug 13, 1993;Build 3 "RTN","DGPFAPI",3,0) ; "RTN","DGPFAPI",4,0) Q ;no direct entry "RTN","DGPFAPI",5,0) ; "RTN","DGPFAPI",6,0) GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments "RTN","DGPFAPI",7,0) ;The purpose of this API is to facilitate the retrieval of specific "RTN","DGPFAPI",8,0) ;data that can be used for the displaying of or the reporting of "RTN","DGPFAPI",9,0) ;only ACTIVE Patient Record Flag (PRF) Assignment information for "RTN","DGPFAPI",10,0) ;a patient. "RTN","DGPFAPI",11,0) ; "RTN","DGPFAPI",12,0) ; Associated DBIA: #3860 - DGPF PATIENT RECORD FLAG "RTN","DGPFAPI",13,0) ; "RTN","DGPFAPI",14,0) ; Input: "RTN","DGPFAPI",15,0) ; DGDFN - IEN of patient in the PATIENT (#2) file "RTN","DGPFAPI",16,0) ; DGPRF - Closed Root array of return values "RTN","DGPFAPI",17,0) ; [Optional-default DGPFAPI] "RTN","DGPFAPI",18,0) ; "RTN","DGPFAPI",19,0) ; Output: "RTN","DGPFAPI",20,0) ; Function result - "0" = No Active record flags for the patient "RTN","DGPFAPI",21,0) ; - "nn" = Total number of flags returned in array "RTN","DGPFAPI",22,0) ; DGPRF() - Array, passed by closed root reference "RTN","DGPFAPI",23,0) ; - Multiple subscripted array of Active flag information "RTN","DGPFAPI",24,0) ; If the function call is successful, this array will "RTN","DGPFAPI",25,0) ; contain each of the Active flag records. "RTN","DGPFAPI",26,0) ; - Subscript field value = internal value^external value "RTN","DGPFAPI",27,0) ; 2 piece string caret(^) delimited "RTN","DGPFAPI",28,0) ; DGPFAPI() - Default array name if no name passed "RTN","DGPFAPI",29,0) ; "RTN","DGPFAPI",30,0) ; Subscript Field Name Field #/File # "RTN","DGPFAPI",31,0) ; --------- ---------- -------------- "RTN","DGPFAPI",32,0) ; "APPRVBY" APPROVED BY (.05)/(#26.14) "RTN","DGPFAPI",33,0) ; (Note: The .5 (POSTMASTER) internal field value "RTN","DGPFAPI",34,0) ; triggers an output transform that converts the "RTN","DGPFAPI",35,0) ; external value of "POSTMASTER" to "CHIEF OF STAFF". "RTN","DGPFAPI",36,0) ; "ASSIGNDT" DATE/TIME (.02)/(#26.14) "RTN","DGPFAPI",37,0) ; "REVIEWDT" REVIEW DATE (.06)/(#26.13) "RTN","DGPFAPI",38,0) ; "FLAG" FLAG NAME (.02)/(#26.13) "RTN","DGPFAPI",39,0) ; "FLAGTYPE" TYPE (.03)/(#26.11 or #26.15) "RTN","DGPFAPI",40,0) ; "CATEGORY" National or Local Flag (#26.15) or (#26.11) "RTN","DGPFAPI",41,0) ; "OWNER" OWNER SITE (.04)/(#26.13) "RTN","DGPFAPI",42,0) ; "ORIGSITE" ORIGINATING SITE (.05)/(#26.13) "RTN","DGPFAPI",43,0) ; "TIUTITLE" TIU PN TITLE (.07)/(#26.11) or (#26.15) "RTN","DGPFAPI",44,0) ; "TIULINK" TIU PN LINK (.06)/(#26.14) "RTN","DGPFAPI",45,0) ; "NARR" ASSIGNMENT NARRATIVE (1)/(#26.13) "RTN","DGPFAPI",46,0) ; (word-processing, multiple nodes) "RTN","DGPFAPI",47,0) ; The format is in a word-processing value that may "RTN","DGPFAPI",48,0) ; contain multiple nodes of text. Each node of text "RTN","DGPFAPI",49,0) ; will be less than 80 characters in length. "RTN","DGPFAPI",50,0) ; The format is as follows: "RTN","DGPFAPI",51,0) ; TARGET_ROOT(nn,"NARR",line#,0)=text "RTN","DGPFAPI",52,0) ; where: "RTN","DGPFAPI",53,0) ; nn = a unique number for each Flag "RTN","DGPFAPI",54,0) ; line# = a unique number starting at 1 for each wp line "RTN","DGPFAPI",55,0) ; of narrative text "RTN","DGPFAPI",56,0) ; 0 = standard subscript format for the nodes of a "RTN","DGPFAPI",57,0) ; FileMan Word Processing field "RTN","DGPFAPI",58,0) ; "RTN","DGPFAPI",59,0) N DGPFTCNT ;return results, "0"=no flags, "nn"=number of flags "RTN","DGPFAPI",60,0) N DGPFIENS ;array of all active flag assignment IEN's "RTN","DGPFAPI",61,0) N DGPFIEN ;ien of record flag assignment in (#26.13) file "RTN","DGPFAPI",62,0) N DGPFA ;flag assignment array "RTN","DGPFAPI",63,0) N DGPFAH ;flag assignment history array "RTN","DGPFAPI",64,0) N DGPFLAG ;flag record array "RTN","DGPFAPI",65,0) N DGPFLAH ;last flag assignment history array "RTN","DGPFAPI",66,0) N DGCAT ;flag category "RTN","DGPFAPI",67,0) ; "RTN","DGPFAPI",68,0) Q:'$G(DGDFN) 0 ;Quit, null parameter "RTN","DGPFAPI",69,0) Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0 ;Quit, no Active assign's "RTN","DGPFAPI",70,0) ; "RTN","DGPFAPI",71,0) S DGPRF=$G(DGPRF) "RTN","DGPFAPI",72,0) I DGPRF']"" S DGPRF="DGPFAPI" ;setup default array name "RTN","DGPFAPI",73,0) ; "RTN","DGPFAPI",74,0) K @DGPRF ;Kill/initialize work array "RTN","DGPFAPI",75,0) ; "RTN","DGPFAPI",76,0) S (DGPFIEN,DGCAT)="",DGPFTCNT=0 "RTN","DGPFAPI",77,0) ; "RTN","DGPFAPI",78,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFAPI",79,0) F S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN="" D "RTN","DGPFAPI",80,0) . K DGPFA,DGPFAH,DGPFLAG,DGPFLAH "RTN","DGPFAPI",81,0) . ; "RTN","DGPFAPI",82,0) . ; retrieve single assignment record fields "RTN","DGPFAPI",83,0) . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA) "RTN","DGPFAPI",84,0) . ; "RTN","DGPFAPI",85,0) . ; no patient DFN match "RTN","DGPFAPI",86,0) . I DGDFN'=$P(DGPFA("DFN"),U) Q "RTN","DGPFAPI",87,0) . ; "RTN","DGPFAPI",88,0) . ; get initial assignment history "RTN","DGPFAPI",89,0) . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH) "RTN","DGPFAPI",90,0) . ; "RTN","DGPFAPI",91,0) . ; get last assignment history "RTN","DGPFAPI",92,0) . Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH) "RTN","DGPFAPI",93,0) . ; "RTN","DGPFAPI",94,0) . ; get record flag record "RTN","DGPFAPI",95,0) . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG) "RTN","DGPFAPI",96,0) . ; "RTN","DGPFAPI",97,0) . S DGPFTCNT=DGPFTCNT+1 "RTN","DGPFAPI",98,0) . ; "RTN","DGPFAPI",99,0) . ; approved by user "RTN","DGPFAPI",100,0) . S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFLAH("APPRVBY")) "RTN","DGPFAPI",101,0) . ; "RTN","DGPFAPI",102,0) . ; initial assignment date/time "RTN","DGPFAPI",103,0) . S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFAPI",104,0) . ; "RTN","DGPFAPI",105,0) . ; next review due date "RTN","DGPFAPI",106,0) . S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT")) "RTN","DGPFAPI",107,0) . ; "RTN","DGPFAPI",108,0) . ; record flag name "RTN","DGPFAPI",109,0) . S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG")) "RTN","DGPFAPI",110,0) . ; "RTN","DGPFAPI",111,0) . ; record flag type "RTN","DGPFAPI",112,0) . S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE")) "RTN","DGPFAPI",113,0) . ; "RTN","DGPFAPI",114,0) . ; category of flag - I (NATIONAL) or II (LOCAL) "RTN","DGPFAPI",115,0) . S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)") "RTN","DGPFAPI",116,0) . S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT "RTN","DGPFAPI",117,0) . ; "RTN","DGPFAPI",118,0) . ; owner site "RTN","DGPFAPI",119,0) . S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)) "RTN","DGPFAPI",120,0) . ; "RTN","DGPFAPI",121,0) . ; originating site "RTN","DGPFAPI",122,0) . S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)) "RTN","DGPFAPI",123,0) . ; "RTN","DGPFAPI",124,0) . ; add TIU info when Owner Site is a local division "RTN","DGPFAPI",125,0) . I $$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) D "RTN","DGPFAPI",126,0) . . ; "RTN","DGPFAPI",127,0) . . ; flag associated TIU PN Title "RTN","DGPFAPI",128,0) . . S @DGPRF@(DGPFTCNT,"TIUTITLE")=$G(DGPFLAG("TIUTITLE")) "RTN","DGPFAPI",129,0) . . ; "RTN","DGPFAPI",130,0) . . ; assignment history TIU PN Link "RTN","DGPFAPI",131,0) . . S @DGPRF@(DGPFTCNT,"TIULINK")=$G(DGPFLAH("TIULINK")) "RTN","DGPFAPI",132,0) . ; "RTN","DGPFAPI",133,0) . ; narrative "RTN","DGPFAPI",134,0) . I '$D(DGPFA("NARR",1,0)) D Q ;should never happen - but - "RTN","DGPFAPI",135,0) . . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text" "RTN","DGPFAPI",136,0) . ; "RTN","DGPFAPI",137,0) . M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR") "RTN","DGPFAPI",138,0) ; "RTN","DGPFAPI",139,0) ; Re-Sort Active flags by category & alpha flag name "RTN","DGPFAPI",140,0) I +$G(DGPFTCNT)>1 D "RTN","DGPFAPI",141,0) . I $$SORT^DGPFUT2(DGPRF) ;naked IF to just do resort "RTN","DGPFAPI",142,0) ; "RTN","DGPFAPI",143,0) Q DGPFTCNT "RTN","DGPFAPI",144,0) ; "RTN","DGPFAPI",145,0) PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments "RTN","DGPFAPI",146,0) ;This function queries a given patient's treating facility to retrieve "RTN","DGPFAPI",147,0) ;all patient record flag assignments for the patient. "RTN","DGPFAPI",148,0) ; "RTN","DGPFAPI",149,0) ; Input: "RTN","DGPFAPI",150,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",151,0) ; "RTN","DGPFAPI",152,0) ; Output: "RTN","DGPFAPI",153,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFAPI",154,0) ; "RTN","DGPFAPI",155,0) N DGEVNT "RTN","DGPFAPI",156,0) N DGRSLT "RTN","DGPFAPI",157,0) ; "RTN","DGPFAPI",158,0) S DGRSLT=0 "RTN","DGPFAPI",159,0) S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN) "RTN","DGPFAPI",160,0) I DGEVNT D "RTN","DGPFAPI",161,0) . ; "RTN","DGPFAPI",162,0) . ;must have INCOMPLETE status "RTN","DGPFAPI",163,0) . Q:'$$ISINCOMP^DGPFHLL1(DGEVNT) "RTN","DGPFAPI",164,0) . ; "RTN","DGPFAPI",165,0) . ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of "RTN","DGPFAPI",166,0) . ;PRF PARAMETERS (#26.18) file. "RTN","DGPFAPI",167,0) . S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM()) "RTN","DGPFAPI",168,0) ; "RTN","DGPFAPI",169,0) Q DGRSLT "RTN","DGPFAPI",170,0) ; "RTN","DGPFAPI",171,0) DISPPRF(DGDFN) ;display active patient record flag assignments "RTN","DGPFAPI",172,0) ;This procedure performs a lookup for active patient record flag "RTN","DGPFAPI",173,0) ;assignments for a given patient and formats the assignment data for "RTN","DGPFAPI",174,0) ;roll-and-scroll display. "RTN","DGPFAPI",175,0) ; "RTN","DGPFAPI",176,0) ; Input: "RTN","DGPFAPI",177,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",178,0) ; "RTN","DGPFAPI",179,0) ; Output: "RTN","DGPFAPI",180,0) ; none "RTN","DGPFAPI",181,0) ; "RTN","DGPFAPI",182,0) Q:'$D(XQY0) "RTN","DGPFAPI",183,0) Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT" "RTN","DGPFAPI",184,0) ; "RTN","DGPFAPI",185,0) ;protect Kernel IO variables "RTN","DGPFAPI",186,0) N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL "RTN","DGPFAPI",187,0) N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON "RTN","DGPFAPI",188,0) ; "RTN","DGPFAPI",189,0) ;protect ListMan variables "RTN","DGPFAPI",190,0) N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON "RTN","DGPFAPI",191,0) N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST "RTN","DGPFAPI",192,0) N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD "RTN","DGPFAPI",193,0) ; "RTN","DGPFAPI",194,0) ;protect Unwinder variables "RTN","DGPFAPI",195,0) N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX "RTN","DGPFAPI",196,0) N XQORM,DQ "RTN","DGPFAPI",197,0) ; "RTN","DGPFAPI",198,0) ; protect original Listman VALM DATA global "RTN","DGPFAPI",199,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",200,0) M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J) "RTN","DGPFAPI",201,0) ; "RTN","DGPFAPI",202,0) D DISPPRF^DGPFUT1(DGDFN) "RTN","DGPFAPI",203,0) ; "RTN","DGPFAPI",204,0) ; restore original Listman VALM DATA global "RTN","DGPFAPI",205,0) M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",206,0) ; "RTN","DGPFAPI",207,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",208,0) Q "RTN","DGPFAPI1") 0^39^B24558175 "RTN","DGPFAPI1",1,0) DGPFAPI1 ;ALB/RBS - PRF EXTERNAL API'S ; 9/27/06 3:00pm "RTN","DGPFAPI1",2,0) ;;5.3;Registration;**554,650**;Aug 13, 1993;Build 3 "RTN","DGPFAPI1",3,0) ; "RTN","DGPFAPI1",4,0) Q ;no direct entry "RTN","DGPFAPI1",5,0) ; "RTN","DGPFAPI1",6,0) GETHTIU(DGDFN,DGTITLE,DGHTIU) ;retrieve PRF/TIU PN link Assignment data "RTN","DGPFAPI1",7,0) ;This function is used to return a patient's ASSIGNMENT (active or "RTN","DGPFAPI1",8,0) ;inactive) based on the TIU PN title. If an ASSIGNMENT is found "RTN","DGPFAPI1",9,0) ;then all ASSIGNMENT HISTORY records will be returned. "RTN","DGPFAPI1",10,0) ;If the request is not from the Owner Site of the PRF Assignment, "RTN","DGPFAPI1",11,0) ;no data is returned. "RTN","DGPFAPI1",12,0) ;The TIU Progress Note Title IEN will be used to search for the "RTN","DGPFAPI1",13,0) ;patient assignment that is linked to the associated record flag. "RTN","DGPFAPI1",14,0) ; "RTN","DGPFAPI1",15,0) ; Associated DBIA: #4383 - DGPF ASSIGNMENT LINK TIU PN "RTN","DGPFAPI1",16,0) ; "RTN","DGPFAPI1",17,0) ; Input: "RTN","DGPFAPI1",18,0) ; DGDFN - [Required] IEN of PATIENT (#2) file "RTN","DGPFAPI1",19,0) ; DGTITLE - [Required] IEN of TIU DOCUMENT DEFINITION (#8925.1) file "RTN","DGPFAPI1",20,0) ; DGHTIU - [Optional] - default name is "DGPFHTIU" "RTN","DGPFAPI1",21,0) ; (Closed Root (local or global) array of return values) "RTN","DGPFAPI1",22,0) ; "RTN","DGPFAPI1",23,0) ; Output: "RTN","DGPFAPI1",24,0) ; Function result - returns 1 on success "RTN","DGPFAPI1",25,0) ; - returns two piece string on failure "RTN","DGPFAPI1",26,0) ; Format: 0^error text generated from EZBLD^DIALOG "RTN","DGPFAPI1",27,0) ; "RTN","DGPFAPI1",28,0) ; DGHTIU() - Array, passed by closed root reference. "RTN","DGPFAPI1",29,0) ; If this function is successful, this array will "RTN","DGPFAPI1",30,0) ; contain the PRF/TIU PN link Assignment data where "RTN","DGPFAPI1",31,0) ; the Subscript field value equals: "RTN","DGPFAPI1",32,0) ; Internal Value^External Value "RTN","DGPFAPI1",33,0) ; Note: The "HISTORY" subscript level will contain a "RTN","DGPFAPI1",34,0) ; unique node for each PRF Assignment History record "RTN","DGPFAPI1",35,0) ; associated with the Assignment where nn = a unique "RTN","DGPFAPI1",36,0) ; number for each History record. "RTN","DGPFAPI1",37,0) ; "RTN","DGPFAPI1",38,0) ; Subscript Field Name Field #/File # "RTN","DGPFAPI1",39,0) ; ----------------------- ----------- ------------ "RTN","DGPFAPI1",40,0) ; "ASSIGNIEN" NUMBER (.001)/(#26.13) "RTN","DGPFAPI1",41,0) ; "FLAG" FLAG NAME (.02)/(#26.13) "RTN","DGPFAPI1",42,0) ; "HISTORY" # OF HISTORY RECORDS N/A "RTN","DGPFAPI1",43,0) ; "HISTORY",nn,"ACTION" ACTION (.03)/(#26.14) "RTN","DGPFAPI1",44,0) ; "HISTORY",nn,"DATETIME") DATE/TIME (.02)/(#26.14) "RTN","DGPFAPI1",45,0) ; "HISTORY",nn,"HISTIEN") NUMBER (.001)/(#26.14) "RTN","DGPFAPI1",46,0) ; "HISTORY",nn,"TIUIEN") TIU PN LINK (.06)/(#26.14) "RTN","DGPFAPI1",47,0) ; "RTN","DGPFAPI1",48,0) N DGAIEN ;ien of record flag assignment in (#26.13) file "RTN","DGPFAPI1",49,0) N DGDIALOG ;failure reason generated from EZBLD^DIALOG "RTN","DGPFAPI1",50,0) N DGFIEN ;variable pointer to #26.11 or #26.15 ie. "1;DGPF(26.15," "RTN","DGPFAPI1",51,0) N DGFLAG ;flag name "RTN","DGPFAPI1",52,0) N DGHIEN ;ien of history record in (#26.14) file "RTN","DGPFAPI1",53,0) N DGHIENS ;array of all assignment history IEN's "RTN","DGPFAPI1",54,0) N DGPFA ;flag assignment array "RTN","DGPFAPI1",55,0) N DGPFAH ;flag assignment history array "RTN","DGPFAPI1",56,0) N DGRSLT ;function result "RTN","DGPFAPI1",57,0) N DGTHCNT ;"nn"=number of history records returned "RTN","DGPFAPI1",58,0) ; "RTN","DGPFAPI1",59,0) S DGDFN=+$G(DGDFN) "RTN","DGPFAPI1",60,0) S DGTITLE=+$G(DGTITLE) "RTN","DGPFAPI1",61,0) ; "RTN","DGPFAPI1",62,0) ;setup return array "RTN","DGPFAPI1",63,0) S DGHTIU=$G(DGHTIU) "RTN","DGPFAPI1",64,0) I DGHTIU']"" S DGHTIU="DGPFHTIU" ;setup default array name "RTN","DGPFAPI1",65,0) K @DGHTIU ;Kill/initialize work array "RTN","DGPFAPI1",66,0) ; "RTN","DGPFAPI1",67,0) S DGRSLT=0 "RTN","DGPFAPI1",68,0) ; "RTN","DGPFAPI1",69,0) ;get IEN variable pointer of National or Local flag "RTN","DGPFAPI1",70,0) S DGFIEN=$P($$FNDTITLE(DGTITLE),U,1) ;strip off flag name "RTN","DGPFAPI1",71,0) ; "RTN","DGPFAPI1",72,0) I '$G(DGFIEN) S DGDIALOG=$$EZBLD^DIALOG(261107) ;no flag link "RTN","DGPFAPI1",73,0) ; "RTN","DGPFAPI1",74,0) ;if flag is assoc with TIU Progres Note Title (quit on failure) "RTN","DGPFAPI1",75,0) I $G(DGFIEN) D "RTN","DGPFAPI1",76,0) . ; "RTN","DGPFAPI1",77,0) . ;get IEN of assignment linked to flag linked to TIU PN Title "RTN","DGPFAPI1",78,0) . S DGAIEN=$$FNDASGN^DGPFAA(DGDFN,DGFIEN) "RTN","DGPFAPI1",79,0) . I '$G(DGAIEN) S DGDIALOG=$$EZBLD^DIALOG(261108) Q "RTN","DGPFAPI1",80,0) . ; "RTN","DGPFAPI1",81,0) . ;get all assignment data for patient "RTN","DGPFAPI1",82,0) . I '$$GETASGN^DGPFAA(DGAIEN,.DGPFA) S DGDIALOG=$$EZBLD^DIALOG(261102) Q "RTN","DGPFAPI1",83,0) . ; "RTN","DGPFAPI1",84,0) . ;check for owner site of assignment "RTN","DGPFAPI1",85,0) . I '$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) S DGDIALOG=$$EZBLD^DIALOG(261103) Q "RTN","DGPFAPI1",86,0) . ; "RTN","DGPFAPI1",87,0) . ;get all history ien's "RTN","DGPFAPI1",88,0) . I '$$GETALL^DGPFAAH(DGAIEN,.DGHIENS) S DGDIALOG=$$EZBLD^DIALOG(261101) Q "RTN","DGPFAPI1",89,0) . ; "RTN","DGPFAPI1",90,0) . S DGHIEN="",DGTHCNT=0 "RTN","DGPFAPI1",91,0) . ; "RTN","DGPFAPI1",92,0) . ;loop all assignment history ien's "RTN","DGPFAPI1",93,0) . F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D Q:$D(DGDIALOG) "RTN","DGPFAPI1",94,0) . . K DGPFAH "RTN","DGPFAPI1",95,0) . . ;get assignment history record "RTN","DGPFAPI1",96,0) . . I '$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) S DGDIALOG=$$EZBLD^DIALOG(261101),DGTHCNT=0 Q "RTN","DGPFAPI1",97,0) . . ; "RTN","DGPFAPI1",98,0) . . S DGTHCNT=DGTHCNT+1 "RTN","DGPFAPI1",99,0) . . S @DGHTIU@("HISTORY",DGTHCNT,"ACTION")=$G(DGPFAH("ACTION")) "RTN","DGPFAPI1",100,0) . . S @DGHTIU@("HISTORY",DGTHCNT,"DATETIME")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFAPI1",101,0) . . S @DGHTIU@("HISTORY",DGTHCNT,"HISTIEN")=DGHIEN_U_DGHIEN "RTN","DGPFAPI1",102,0) . . S @DGHTIU@("HISTORY",DGTHCNT,"TIUIEN")=$G(DGPFAH("TIULINK")) "RTN","DGPFAPI1",103,0) . ; "RTN","DGPFAPI1",104,0) . Q:$D(DGDIALOG) ;stop on error "RTN","DGPFAPI1",105,0) . ; "RTN","DGPFAPI1",106,0) . I DGTHCNT D "RTN","DGPFAPI1",107,0) . . S @DGHTIU@("ASSIGNIEN")=DGAIEN_U_$P($G(DGPFA("DFN")),U,2) "RTN","DGPFAPI1",108,0) . . S @DGHTIU@("FLAG")=$G(DGPFA("FLAG")) "RTN","DGPFAPI1",109,0) . . S @DGHTIU@("HISTORY")=DGTHCNT "RTN","DGPFAPI1",110,0) . ; "RTN","DGPFAPI1",111,0) . S DGRSLT=1 ;success "RTN","DGPFAPI1",112,0) ; "RTN","DGPFAPI1",113,0) ;if failure delete return array "RTN","DGPFAPI1",114,0) I $D(DGDIALOG) K @DGHTIU "RTN","DGPFAPI1",115,0) ; "RTN","DGPFAPI1",116,0) Q $S(DGRSLT:1,1:DGRSLT_"^"_$G(DGDIALOG)) "RTN","DGPFAPI1",117,0) ; "RTN","DGPFAPI1",118,0) FNDTITLE(DGTITLE) ;retrieve IEN of associated PRF (National or Local) Flag "RTN","DGPFAPI1",119,0) ;This function returns the IEN and Name of the National or Local flag "RTN","DGPFAPI1",120,0) ;that is associated with the TIU Progress Note Title. "RTN","DGPFAPI1",121,0) ; "RTN","DGPFAPI1",122,0) ; Input: "RTN","DGPFAPI1",123,0) ; DGTITLE - [Required] IEN of TIU DOCUMENT DEFINITION (#8925.1) file "RTN","DGPFAPI1",124,0) ; "RTN","DGPFAPI1",125,0) ; Output: "RTN","DGPFAPI1",126,0) ; Function Value - returns two piece ^ string on failure or success "RTN","DGPFAPI1",127,0) ; On Failure - 0^error text generated from EZBLD^DIALOG "RTN","DGPFAPI1",128,0) ; On Success - IEN^External Flag Name "RTN","DGPFAPI1",129,0) ; [example: 1;DGPF(26.15,^BEHAVIORAL] "RTN","DGPFAPI1",130,0) ; [Note: "1;DGPF(26.15," is a variable pointer] "RTN","DGPFAPI1",131,0) ; "RTN","DGPFAPI1",132,0) S DGTITLE=+$G(DGTITLE) "RTN","DGPFAPI1",133,0) ; "RTN","DGPFAPI1",134,0) N DGDIALOG ;failure reason "RTN","DGPFAPI1",135,0) N DGFLAG ;flag name "RTN","DGPFAPI1",136,0) N DGIEN ;ien of flag "RTN","DGPFAPI1",137,0) ; "RTN","DGPFAPI1",138,0) ; search for Local Flag "RTN","DGPFAPI1",139,0) I $D(^DGPF(26.11,"ATIU",DGTITLE)) D "RTN","DGPFAPI1",140,0) . S DGFLAG=$O(^DGPF(26.11,"ATIU",DGTITLE,"")) "RTN","DGPFAPI1",141,0) . I DGFLAG]"" D "RTN","DGPFAPI1",142,0) . . S DGIEN=$O(^DGPF(26.11,"ATIU",DGTITLE,DGFLAG,0)) "RTN","DGPFAPI1",143,0) . . I '$D(^DGPF(26.11,DGIEN,0)) K DGIEN Q "RTN","DGPFAPI1",144,0) . . S:$G(DGIEN) DGIEN=DGIEN_";DGPF(26.11,^"_DGFLAG ;add flag name "RTN","DGPFAPI1",145,0) ; "RTN","DGPFAPI1",146,0) ; search for National Flag - (if Title not found in Local Flag file) "RTN","DGPFAPI1",147,0) I '$G(DGIEN),$D(^DGPF(26.15,"ATIU",DGTITLE)) D "RTN","DGPFAPI1",148,0) . S DGFLAG=$O(^DGPF(26.15,"ATIU",DGTITLE,"")) "RTN","DGPFAPI1",149,0) . I DGFLAG]"" D "RTN","DGPFAPI1",150,0) . . S DGIEN=$O(^DGPF(26.15,"ATIU",DGTITLE,DGFLAG,0)) "RTN","DGPFAPI1",151,0) . . I '$D(^DGPF(26.15,DGIEN,0)) K DGIEN Q "RTN","DGPFAPI1",152,0) . . S:$G(DGIEN) DGIEN=DGIEN_";DGPF(26.15,^"_DGFLAG ;add flag name "RTN","DGPFAPI1",153,0) ; "RTN","DGPFAPI1",154,0) I '$G(DGIEN) S DGDIALOG=$$EZBLD^DIALOG(261107) "RTN","DGPFAPI1",155,0) ; "RTN","DGPFAPI1",156,0) Q $S($G(DGIEN)>0:DGIEN,1:"0^"_$G(DGDIALOG)) "RTN","DGPFAPI1",157,0) ; "RTN","DGPFAPI1",158,0) GETLINK(DGTIUIEN) ;get linked assignment history ien "RTN","DGPFAPI1",159,0) ;This function returns the IEN of a patient's record flag assignment "RTN","DGPFAPI1",160,0) ;history record that is linked to a specific TIU Progress Note. "RTN","DGPFAPI1",161,0) ; "RTN","DGPFAPI1",162,0) ; Associated DBIA: #4383 - DGPF ASSIGNMENT LINK TIU PN "RTN","DGPFAPI1",163,0) ; "RTN","DGPFAPI1",164,0) ; Input: "RTN","DGPFAPI1",165,0) ; DGTIUIEN - [Required] IEN of TIU DOCUMENT (#8925) file "RTN","DGPFAPI1",166,0) ; "RTN","DGPFAPI1",167,0) ; Output: "RTN","DGPFAPI1",168,0) ; Function result - returns IEN of linked history record on success "RTN","DGPFAPI1",169,0) ; - "0" if no link found "RTN","DGPFAPI1",170,0) ; "RTN","DGPFAPI1",171,0) Q +$O(^DGPF(26.14,"ATIUPN",+$G(DGTIUIEN),0)) "RTN","DGPFAPI2") 0^40^B18327429 "RTN","DGPFAPI2",1,0) DGPFAPI2 ;ALB/RBS - PRF EXTERNAL API'S ; 6/7/05 4:44pm "RTN","DGPFAPI2",2,0) ;;5.3;Registration;**554,650**;Aug 13, 1993;Build 3 "RTN","DGPFAPI2",3,0) ; "RTN","DGPFAPI2",4,0) Q ;no direct entry "RTN","DGPFAPI2",5,0) ; "RTN","DGPFAPI2",6,0) STOTIU(DGDFN,DGAIEN,DGHIEN,DGTIUIEN) ;store TIU Progress Note link "RTN","DGPFAPI2",7,0) ;This function is used to update the TIU PN LINK (#.06) field of "RTN","DGPFAPI2",8,0) ;the PRF ASSIGNMENT HISTORY (#26.14) file with the IEN of the "RTN","DGPFAPI2",9,0) ;TIU Progress Note in the TIU DOCUMENT (#8925) file. "RTN","DGPFAPI2",10,0) ; "RTN","DGPFAPI2",11,0) ; Associated DBIA: #4384 - DGPF FILE/DELETE TIU PN LINK "RTN","DGPFAPI2",12,0) ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF "RTN","DGPFAPI2",13,0) ; "RTN","DGPFAPI2",14,0) ; Input: "RTN","DGPFAPI2",15,0) ; DGDFN - [Required] IEN of PATIENT (#2) file "RTN","DGPFAPI2",16,0) ; DGAIEN - [Required] IEN of PRF ASSIGNMENT (#26.13) file "RTN","DGPFAPI2",17,0) ; DGHIEN - [Required] IEN of PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFAPI2",18,0) ; DGTIUIEN - [Required] IEN of TIU DOCUMENT (#8925) file "RTN","DGPFAPI2",19,0) ; "RTN","DGPFAPI2",20,0) ; Output: "RTN","DGPFAPI2",21,0) ; Function result - returns 1 on success "RTN","DGPFAPI2",22,0) ; - returns two piece string on failure "RTN","DGPFAPI2",23,0) ; Format: 0^error text generated from EZBLD^DIALOG "RTN","DGPFAPI2",24,0) ; "RTN","DGPFAPI2",25,0) N DGDIALOG ;failure reason generated from EZBLD^DIALOG "RTN","DGPFAPI2",26,0) N DGPFA ;flag assignment array "RTN","DGPFAPI2",27,0) N DGPFAH ;flag assignment history array "RTN","DGPFAPI2",28,0) N DGRSLT ;function result "RTN","DGPFAPI2",29,0) ; "RTN","DGPFAPI2",30,0) S DGDFN=+$G(DGDFN) "RTN","DGPFAPI2",31,0) S DGAIEN=+$G(DGAIEN) "RTN","DGPFAPI2",32,0) S DGHIEN=+$G(DGHIEN) "RTN","DGPFAPI2",33,0) S DGTIUIEN=+$G(DGTIUIEN) "RTN","DGPFAPI2",34,0) ; "RTN","DGPFAPI2",35,0) S DGRSLT=0 "RTN","DGPFAPI2",36,0) ; "RTN","DGPFAPI2",37,0) D ;drops out on error condition "RTN","DGPFAPI2",38,0) . ; "RTN","DGPFAPI2",39,0) . I '$$CHKDOC^TIUPRF(DGTIUIEN) S DGDIALOG=$$EZBLD^DIALOG(261104) Q "RTN","DGPFAPI2",40,0) . ; "RTN","DGPFAPI2",41,0) . ;check if progress note already setup (x-ref "ATIUPN") "RTN","DGPFAPI2",42,0) . I $D(^DGPF(26.14,"ATIUPN",DGTIUIEN)) S DGDIALOG=$$EZBLD^DIALOG(261109) Q "RTN","DGPFAPI2",43,0) . ; "RTN","DGPFAPI2",44,0) . ;get history record that is being updated "RTN","DGPFAPI2",45,0) . I '$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) S DGDIALOG=$$EZBLD^DIALOG(261101) Q "RTN","DGPFAPI2",46,0) . ; "RTN","DGPFAPI2",47,0) . ;check if correct history record of the patient assignment "RTN","DGPFAPI2",48,0) . I $P($G(DGPFAH("ASSIGN")),U)'=DGAIEN S DGDIALOG=$$EZBLD^DIALOG(261101) Q "RTN","DGPFAPI2",49,0) . ; "RTN","DGPFAPI2",50,0) . ;check for existing entry "RTN","DGPFAPI2",51,0) . I +$P($G(DGPFAH("TIULINK")),U) S DGDIALOG=$$EZBLD^DIALOG(261109) Q "RTN","DGPFAPI2",52,0) . ; "RTN","DGPFAPI2",53,0) . ;get assignment record "RTN","DGPFAPI2",54,0) . I '$$GETASGN^DGPFAA(DGAIEN,.DGPFA) S DGDIALOG=$$EZBLD^DIALOG(261102) Q "RTN","DGPFAPI2",55,0) . ; "RTN","DGPFAPI2",56,0) . ;check if current site is Owner Site "RTN","DGPFAPI2",57,0) . I '$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) S DGDIALOG=$$EZBLD^DIALOG(261103) Q "RTN","DGPFAPI2",58,0) . ; "RTN","DGPFAPI2",59,0) . ;file the TIU PN LINK "RTN","DGPFAPI2",60,0) . S DGRSLT=$$STOHIST(DGHIEN,DGTIUIEN) "RTN","DGPFAPI2",61,0) . I 'DGRSLT S DGDIALOG=$P($G(DGRSLT),"^",2) Q "RTN","DGPFAPI2",62,0) . ; "RTN","DGPFAPI2",63,0) . S DGRSLT=1 "RTN","DGPFAPI2",64,0) ; "RTN","DGPFAPI2",65,0) Q $S(DGRSLT:1,1:DGRSLT_"^"_$G(DGDIALOG)) "RTN","DGPFAPI2",66,0) ; "RTN","DGPFAPI2",67,0) STOHIST(DGHIEN,DGTIUIEN) ;update TIU Progress Note link "RTN","DGPFAPI2",68,0) ;This function is used to update the TIU PN LINK (#.06) field of "RTN","DGPFAPI2",69,0) ;the PRF ASSIGNMENT HISTORY (#26.14) file. "RTN","DGPFAPI2",70,0) ; "RTN","DGPFAPI2",71,0) ; Input: "RTN","DGPFAPI2",72,0) ; DGHIEN - [Required] IEN of PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFAPI2",73,0) ; DGTIUIEN - [Required] IEN of TIU DOCUMENT (#8925) file "RTN","DGPFAPI2",74,0) ; "RTN","DGPFAPI2",75,0) ; Output: "RTN","DGPFAPI2",76,0) ; Function result - returns 1 on success "RTN","DGPFAPI2",77,0) ; - returns two piece string on failure "RTN","DGPFAPI2",78,0) ; Format: 0^error text generated from EZBLD^DIALOG "RTN","DGPFAPI2",79,0) ; "RTN","DGPFAPI2",80,0) N DGDIALOG ;failure reason generated from EZBLD^DIALOG "RTN","DGPFAPI2",81,0) N DGERR ;FILE^DIE error array (undefined on filing success) "RTN","DGPFAPI2",82,0) N DGFDA ;FILE^DIE formatted array containing field ien and data "RTN","DGPFAPI2",83,0) N DGFIL ;file number to file data "RTN","DGPFAPI2",84,0) N DGRSLT ;function result "RTN","DGPFAPI2",85,0) ; "RTN","DGPFAPI2",86,0) S DGHIEN=+$G(DGHIEN) "RTN","DGPFAPI2",87,0) S DGTIUIEN=+$G(DGTIUIEN) "RTN","DGPFAPI2",88,0) ; "RTN","DGPFAPI2",89,0) S DGRSLT=0 "RTN","DGPFAPI2",90,0) S DGFIL=26.14 "RTN","DGPFAPI2",91,0) ; "RTN","DGPFAPI2",92,0) D ;drops out on error condition "RTN","DGPFAPI2",93,0) . S DGFDA(DGFIL,DGHIEN_",",.06)=DGTIUIEN "RTN","DGPFAPI2",94,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFAPI2",95,0) . I $D(DGERR) S DGDIALOG=$$EZBLD^DIALOG(261105) Q "RTN","DGPFAPI2",96,0) . ; "RTN","DGPFAPI2",97,0) . S DGRSLT=1 "RTN","DGPFAPI2",98,0) ; "RTN","DGPFAPI2",99,0) Q $S(DGRSLT:1,1:DGRSLT_"^"_$G(DGDIALOG)) "RTN","DGPFAPI2",100,0) ; "RTN","DGPFAPI2",101,0) DELTIU(DGTIUIEN) ;delete TIU Progress Note link "RTN","DGPFAPI2",102,0) ;This function is used to delete the TIU PN LINK (#.06) field of "RTN","DGPFAPI2",103,0) ;the PRF ASSIGNMENT HISTORY (#26.14) file. "RTN","DGPFAPI2",104,0) ; "RTN","DGPFAPI2",105,0) ; Associated DBIA: #4384 - DGPF FILE/DELETE TIU PN LINK "RTN","DGPFAPI2",106,0) ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF "RTN","DGPFAPI2",107,0) ; "RTN","DGPFAPI2",108,0) ; Input: "RTN","DGPFAPI2",109,0) ; DGTIUIEN - [Required] IEN of record in TIU DOCUMENT (#8925) file "RTN","DGPFAPI2",110,0) ; "RTN","DGPFAPI2",111,0) ; Output: "RTN","DGPFAPI2",112,0) ; Function result - returns 1 on success "RTN","DGPFAPI2",113,0) ; - returns two piece string on failure "RTN","DGPFAPI2",114,0) ; Format: 0^error text generated from EZBLD^DIALOG "RTN","DGPFAPI2",115,0) ; "RTN","DGPFAPI2",116,0) N DGDIALOG ;failure reason generated from EZBLD^DIALOG "RTN","DGPFAPI2",117,0) N DGERR ;FILE^DIE error array (undefined on filing success) "RTN","DGPFAPI2",118,0) N DGFDA ;FILE^DIE formatted array containing field ien and data "RTN","DGPFAPI2",119,0) N DGFIL ;file number to file data "RTN","DGPFAPI2",120,0) N DGHIEN ;IEN of history record "RTN","DGPFAPI2",121,0) N DGRSLT ;function result "RTN","DGPFAPI2",122,0) ; "RTN","DGPFAPI2",123,0) S DGTIUIEN=+$G(DGTIUIEN) "RTN","DGPFAPI2",124,0) S (DGRSLT,DGHIEN)=0 "RTN","DGPFAPI2",125,0) S DGFIL=26.14 "RTN","DGPFAPI2",126,0) ; "RTN","DGPFAPI2",127,0) D ;drops out on error condition "RTN","DGPFAPI2",128,0) . ; "RTN","DGPFAPI2",129,0) . S DGHIEN=+$O(^DGPF(DGFIL,"ATIUPN",DGTIUIEN,DGHIEN)) "RTN","DGPFAPI2",130,0) . I '$D(^DGPF(DGFIL,DGHIEN,0)) S DGDIALOG=$$EZBLD^DIALOG(261101) Q "RTN","DGPFAPI2",131,0) . S DGFDA(DGFIL,DGHIEN_",",.06)="@" "RTN","DGPFAPI2",132,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFAPI2",133,0) . I $D(DGERR) S DGDIALOG=$$EZBLD^DIALOG(261106) Q "RTN","DGPFAPI2",134,0) . ; "RTN","DGPFAPI2",135,0) . S DGRSLT=1 "RTN","DGPFAPI2",136,0) ; "RTN","DGPFAPI2",137,0) Q $S(DGRSLT:1,1:DGRSLT_"^"_$G(DGDIALOG)) "RTN","DGPFBGR") 0^31^B43954617 "RTN","DGPFBGR",1,0) DGPFBGR ;ALB/RPM - PRF BACKGROUND PROCESSING DRIVER ; 6/3/05 12:25pm "RTN","DGPFBGR",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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) D NOTIFY($$NOW^XLFDT()) ;send review notification "RTN","DGPFBGR",9,0) D RUNQRY^DGPFHLRT ;run query for incomplete HL7 event status "RTN","DGPFBGR",10,0) Q "RTN","DGPFBGR",11,0) ; "RTN","DGPFBGR",12,0) NOTIFY(DGDATE) ;Send notification message for pending Patient Record Flag "RTN","DGPFBGR",13,0) ;Assignment reviews. "RTN","DGPFBGR",14,0) ; "RTN","DGPFBGR",15,0) ; Input: "RTN","DGPFBGR",16,0) ; DGDATE - (optional) notification date requested in FM format, "RTN","DGPFBGR",17,0) ; defaults to now ($$NOW^XLFDT()) "RTN","DGPFBGR",18,0) ; "RTN","DGPFBGR",19,0) ; Output: "RTN","DGPFBGR",20,0) ; none "RTN","DGPFBGR",21,0) ; "RTN","DGPFBGR",22,0) N DGAIEN ;pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFBGR",23,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFBGR",24,0) N DGDEM ;patient demographics array "RTN","DGPFBGR",25,0) N DGDOB ;patient date of birth "RTN","DGPFBGR",26,0) N DGFLG ;flag data array "RTN","DGPFBGR",27,0) N DGLIST ;closed root array list of patient IENs in a mail group "RTN","DGPFBGR",28,0) N DGMSGTXT ;closed root of mail message text "RTN","DGPFBGR",29,0) N DGNAME ;patient name "RTN","DGPFBGR",30,0) N DGNDT ;notification date "RTN","DGPFBGR",31,0) N DGPFA ;assignment data array "RTN","DGPFBGR",32,0) N DGMGROUP ;review mail group "RTN","DGPFBGR",33,0) N DGSSN ;patient social security number "RTN","DGPFBGR",34,0) ; "RTN","DGPFBGR",35,0) S DGLIST=$NA(^TMP("DGPFREV",$J)) "RTN","DGPFBGR",36,0) K @DGLIST "RTN","DGPFBGR",37,0) ; "RTN","DGPFBGR",38,0) S DGMSGTXT=$NA(^TMP("DGPFMSG",$J)) "RTN","DGPFBGR",39,0) K @DGMSGTXT "RTN","DGPFBGR",40,0) ; "RTN","DGPFBGR",41,0) I '+$G(DGDATE) S DGDATE=$$NOW^XLFDT() "RTN","DGPFBGR",42,0) ; "RTN","DGPFBGR",43,0) S DGNDT=0 "RTN","DGPFBGR",44,0) F S DGNDT=$O(^DGPF(26.13,"ANDAT",DGNDT)) Q:('DGNDT!(DGNDT>DGDATE)) D "RTN","DGPFBGR",45,0) . S DGAIEN=0 "RTN","DGPFBGR",46,0) . F S DGAIEN=$O(^DGPF(26.13,"ANDAT",DGNDT,DGAIEN)) Q:'DGAIEN D "RTN","DGPFBGR",47,0) . . N DGPFA,DGDEM,DGFLG "RTN","DGPFBGR",48,0) . . ; "RTN","DGPFBGR",49,0) . . ;get assignment record "RTN","DGPFBGR",50,0) . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFBGR",51,0) . . ; "RTN","DGPFBGR",52,0) . . ;retrieve pointer to patient record in PATIENT (#2) file "RTN","DGPFBGR",53,0) . . S DGDFN=$P($G(DGPFA("DFN")),U,1) "RTN","DGPFBGR",54,0) . . Q:'DGDFN "RTN","DGPFBGR",55,0) . . ; "RTN","DGPFBGR",56,0) . . ;retrieve patient demographics "RTN","DGPFBGR",57,0) . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM) "RTN","DGPFBGR",58,0) . . S DGNAME=$G(DGDEM("NAME")) "RTN","DGPFBGR",59,0) . . S DGSSN=$G(DGDEM("SSN")) "RTN","DGPFBGR",60,0) . . S DGDOB=$G(DGDEM("DOB")) "RTN","DGPFBGR",61,0) . . ; "RTN","DGPFBGR",62,0) . . ;retrieve review date "RTN","DGPFBGR",63,0) . . S DGREVDT=$P($G(DGPFA("REVIEWDT")),U,1) "RTN","DGPFBGR",64,0) . . Q:'DGREVDT "RTN","DGPFBGR",65,0) . . ; "RTN","DGPFBGR",66,0) . . ;get flag review criteria, notice days and review mail group "RTN","DGPFBGR",67,0) . . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U,1),.DGFLG) "RTN","DGPFBGR",68,0) . . ; "RTN","DGPFBGR",69,0) . . ;retrieve review mail group "RTN","DGPFBGR",70,0) . . S DGMGROUP=$P($G(DGFLG("REVGRP")),U,2) "RTN","DGPFBGR",71,0) . . Q:(DGMGROUP']"") "RTN","DGPFBGR",72,0) . . ; "RTN","DGPFBGR",73,0) . . ;build list "RTN","DGPFBGR",74,0) . . S @DGLIST@(DGMGROUP,DGAIEN)=DGNAME_U_DGSSN_U_DGDOB_U_$P(DGPFA("FLAG"),U,2)_U_DGREVDT "RTN","DGPFBGR",75,0) . . ; "RTN","DGPFBGR",76,0) . . ;remove notification index entry "RTN","DGPFBGR",77,0) . . K ^DGPF(26.13,"ANDAT",DGNDT,DGAIEN) "RTN","DGPFBGR",78,0) ; "RTN","DGPFBGR",79,0) ;build and send the message for each mail group "RTN","DGPFBGR",80,0) S DGMGROUP="" "RTN","DGPFBGR",81,0) F S DGMGROUP=$O(@DGLIST@(DGMGROUP)) Q:(DGMGROUP="") D "RTN","DGPFBGR",82,0) . I $$BLDMSG(DGMGROUP,DGLIST,DGMSGTXT) D SEND(DGMGROUP,DGMSGTXT) "RTN","DGPFBGR",83,0) . K @DGMSGTXT "RTN","DGPFBGR",84,0) ; "RTN","DGPFBGR",85,0) ;cleanup "RTN","DGPFBGR",86,0) K @DGLIST "RTN","DGPFBGR",87,0) ; "RTN","DGPFBGR",88,0) Q "RTN","DGPFBGR",89,0) ; "RTN","DGPFBGR",90,0) BLDMSG(DGMGROUP,DGLIST,DGXMTXT) ;build MailMan message array "RTN","DGPFBGR",91,0) ; "RTN","DGPFBGR",92,0) ; Input: "RTN","DGPFBGR",93,0) ; DGMGROUP - mail group name "RTN","DGPFBGR",94,0) ; DGLIST - closed root array of assignment IENs by mail group "RTN","DGPFBGR",95,0) ; "RTN","DGPFBGR",96,0) ; Output: "RTN","DGPFBGR",97,0) ; DGXMTXT - array of MailMan text lines "RTN","DGPFBGR",98,0) ; "RTN","DGPFBGR",99,0) N DGDOB ;formatted date of birth "RTN","DGPFBGR",100,0) N DGFLAG ;formatted flag name "RTN","DGPFBGR",101,0) N DGLIN ;line counter "RTN","DGPFBGR",102,0) N DGNAME ;formatted patient name "RTN","DGPFBGR",103,0) N DGMAX ;maximum line length "RTN","DGPFBGR",104,0) N DGREC ;contents of a single node of the DGLIST array "RTN","DGPFBGR",105,0) N DGREVDT ;review date "RTN","DGPFBGR",106,0) N DGSITE ;results of VASITE call "RTN","DGPFBGR",107,0) N DGSSN ;formatted social security number "RTN","DGPFBGR",108,0) ; "RTN","DGPFBGR",109,0) S DGLIN=0 "RTN","DGPFBGR",110,0) S DGMAX=78 "RTN","DGPFBGR",111,0) S DGSITE=$$SITE^VASITE() "RTN","DGPFBGR",112,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",113,0) D ADDLINE($$CJ^XLFSTR("* * * * PRF ASSIGNMENT REVIEW NOTIFICATION * * * *",78," "),0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",114,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",115,0) D ADDLINE("The following Patient Record Flag Assignments are due for review for continuing appropriateness:",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",116,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",117,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",118,0) D ADDLINE($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",119,0) ; "RTN","DGPFBGR",120,0) S DGAIEN=0,DGCNT=0 "RTN","DGPFBGR",121,0) F S DGAIEN=$O(@DGLIST@(DGMGROUP,DGAIEN)) Q:'DGAIEN D "RTN","DGPFBGR",122,0) . ;record description: patient_name^SSN^DOB^flag_name^review_date "RTN","DGPFBGR",123,0) . S DGREC=@DGLIST@(DGMGROUP,DGAIEN) "RTN","DGPFBGR",124,0) . ; "RTN","DGPFBGR",125,0) . ;format the fields "RTN","DGPFBGR",126,0) . S DGNAME=$$LJ^XLFSTR($E($P(DGREC,U,1),1,20),22," ") "RTN","DGPFBGR",127,0) . S DGSSN=$$LJ^XLFSTR($P(DGREC,U,2),11," ") "RTN","DGPFBGR",128,0) . S DGDOB=$$LJ^XLFSTR($$FMTE^XLFDT($P(DGREC,U,3),"5D"),10," ") "RTN","DGPFBGR",129,0) . S DGFLAG=$$LJ^XLFSTR($E($P(DGREC,U,4),1,20),22," ") "RTN","DGPFBGR",130,0) . S DGREVDT=$$FMTE^XLFDT($P(DGREC,U,5),"5D") "RTN","DGPFBGR",131,0) . ; "RTN","DGPFBGR",132,0) . ;add the line "RTN","DGPFBGR",133,0) . D ADDLINE(DGNAME_DGSSN_DGDOB_DGFLAG_DGREVDT,0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",134,0) . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFBGR",135,0) . ; "RTN","DGPFBGR",136,0) . ;success "RTN","DGPFBGR",137,0) . S DGCNT=DGCNT+1 "RTN","DGPFBGR",138,0) ; "RTN","DGPFBGR",139,0) Q DGCNT "RTN","DGPFBGR",140,0) ; "RTN","DGPFBGR",141,0) ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array "RTN","DGPFBGR",142,0) ; "RTN","DGPFBGR",143,0) ; Input: "RTN","DGPFBGR",144,0) ; DGTEXT - text string "RTN","DGPFBGR",145,0) ; DGINDENT - number of spaces to insert at start of line "RTN","DGPFBGR",146,0) ; DGMAXLEN - maximum desired line length (default: 60) "RTN","DGPFBGR",147,0) ; DGCNT - line number passed by reference "RTN","DGPFBGR",148,0) ; "RTN","DGPFBGR",149,0) ; Output: "RTN","DGPFBGR",150,0) ; DGXMTXT - array of text strings "RTN","DGPFBGR",151,0) ; "RTN","DGPFBGR",152,0) N DGAVAIL ;available space for text "RTN","DGPFBGR",153,0) N DGLINE ;truncated text "RTN","DGPFBGR",154,0) N DGLOC ;location of space character "RTN","DGPFBGR",155,0) N DGPAD ;space indent "RTN","DGPFBGR",156,0) ; "RTN","DGPFBGR",157,0) S DGTEXT=$G(DGTEXT) "RTN","DGPFBGR",158,0) S DGINDENT=+$G(DGINDENT) "RTN","DGPFBGR",159,0) S DGMAXLEN=+$G(DGMAXLEN) "RTN","DGPFBGR",160,0) S:'DGMAXLEN DGMAXLEN=60 "RTN","DGPFBGR",161,0) I DGINDENT>(DGMAXLEN-1) S DGINDENT=0 "RTN","DGPFBGR",162,0) S DGCNT=$G(DGCNT,0) ;default to 0 "RTN","DGPFBGR",163,0) ; "RTN","DGPFBGR",164,0) S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT) "RTN","DGPFBGR",165,0) ; "RTN","DGPFBGR",166,0) ;determine availaible space for text "RTN","DGPFBGR",167,0) S DGAVAIL=(DGMAXLEN-DGINDENT) "RTN","DGPFBGR",168,0) F D Q:('$L(DGTEXT)) "RTN","DGPFBGR",169,0) . ; "RTN","DGPFBGR",170,0) . ;find potential line break "RTN","DGPFBGR",171,0) . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ") "RTN","DGPFBGR",172,0) . ; "RTN","DGPFBGR",173,0) . ;break a line that is too long when it has potential line breaks "RTN","DGPFBGR",174,0) . I $L(DGTEXT)>DGAVAIL,DGLOC D "RTN","DGPFBGR",175,0) . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1)) "RTN","DGPFBGR",176,0) . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," ")) "RTN","DGPFBGR",177,0) . E D "RTN","DGPFBGR",178,0) . . S DGLINE=DGTEXT,DGTEXT="" "RTN","DGPFBGR",179,0) . ; "RTN","DGPFBGR",180,0) . S DGCNT=DGCNT+1 "RTN","DGPFBGR",181,0) . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE "RTN","DGPFBGR",182,0) Q "RTN","DGPFBGR",183,0) ; "RTN","DGPFBGR",184,0) SEND(DGGROUP,DGXMTXT) ;send the MailMan message "RTN","DGPFBGR",185,0) ; "RTN","DGPFBGR",186,0) ; Input: "RTN","DGPFBGR",187,0) ; DGGROUP - mail group name "RTN","DGPFBGR",188,0) ; DGXMTXT - name of message text array in closed format "RTN","DGPFBGR",189,0) ; "RTN","DGPFBGR",190,0) ; Output: "RTN","DGPFBGR",191,0) ; none "RTN","DGPFBGR",192,0) ; "RTN","DGPFBGR",193,0) N DIFROM ;protect FM package "RTN","DGPFBGR",194,0) N XMDUZ ;sender "RTN","DGPFBGR",195,0) N XMSUB ;message subject "RTN","DGPFBGR",196,0) N XMTEXT ;name of message text array in open format "RTN","DGPFBGR",197,0) N XMY ;recipient array "RTN","DGPFBGR",198,0) N XMZ ;returned message number "RTN","DGPFBGR",199,0) ; "RTN","DGPFBGR",200,0) S XMDUZ="Patient Record Flag Module" "RTN","DGPFBGR",201,0) S XMSUB="PRF ASSIGNMENT REVIEW NOTIFICATION" "RTN","DGPFBGR",202,0) S XMTEXT=$$OREF^DILF(DGXMTXT) "RTN","DGPFBGR",203,0) S XMY("G."_DGGROUP)="" "RTN","DGPFBGR",204,0) D ^XMD "RTN","DGPFBGR",205,0) Q "RTN","DGPFDD") 0^24^B29798054 "RTN","DGPFDD",1,0) DGPFDD ;ALB/RPM - PRF DATA DICTIONARY UTILITIES ; 9/06/06 1:14pm "RTN","DGPFDD",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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","DGPFDD",100,0) ; "RTN","DGPFDD",101,0) TIULIST(DGTIUIEN) ;DD lookup screen for (#26.11) file (#.07) field "RTN","DGPFDD",102,0) ;Get list of TIU Progress Note Titles for Category II (Local) Flags. "RTN","DGPFDD",103,0) ;This function will assist the DIC("S") lookup screen of allowable "RTN","DGPFDD",104,0) ;TIU Progress Note Titles the user can see and select from. "RTN","DGPFDD",105,0) ; "RTN","DGPFDD",106,0) ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF "RTN","DGPFDD",107,0) ; #4383 - $$FNDTITLE^DGPFAPI1 "RTN","DGPFDD",108,0) ; "RTN","DGPFDD",109,0) ; Input: "RTN","DGPFDD",110,0) ; DGTIUIEN - [Required] IEN of (#8925.1) entry being screened "RTN","DGPFDD",111,0) ; "RTN","DGPFDD",112,0) ; Output: "RTN","DGPFDD",113,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFDD",114,0) ; "RTN","DGPFDD",115,0) N DGPNLIST ;temporary file name to hold list of titles "RTN","DGPFDD",116,0) N DGRSLT ;function return value "RTN","DGPFDD",117,0) N DGX ;loop var "RTN","DGPFDD",118,0) N DGY ;loop var "RTN","DGPFDD",119,0) ; "RTN","DGPFDD",120,0) Q:DGTIUIEN']"" 0 "RTN","DGPFDD",121,0) ; "RTN","DGPFDD",122,0) S DGRSLT=0 "RTN","DGPFDD",123,0) ; "RTN","DGPFDD",124,0) ; get list from TIU Progress Note Title API call IA #4380 "RTN","DGPFDD",125,0) S DGPNLIST=$NA(^TMP("DGPNLIST",$J)) "RTN","DGPFDD",126,0) K @DGPNLIST "RTN","DGPFDD",127,0) ; "RTN","DGPFDD",128,0) ; only get Category II (Local) TIU PN Titles (pass a 2) "RTN","DGPFDD",129,0) I $$GETLIST(2,DGPNLIST) D "RTN","DGPFDD",130,0) . S (DGX,DGY)="" F S DGX=$O(@DGPNLIST@("CAT II",DGX)) Q:DGX="" D "RTN","DGPFDD",131,0) . . S DGY=$G(@DGPNLIST@("CAT II",DGX)) "RTN","DGPFDD",132,0) . . ; Need to setup the current assigned progress note title as a "RTN","DGPFDD",133,0) . . ; selectable entry or the ^DIR call won't accept the default "RTN","DGPFDD",134,0) . . ; entry when the user hits the retrun key to go to next prompt. "RTN","DGPFDD",135,0) . . ; Only setup if called by PRF action protocol DGPF EDIT FLAG "RTN","DGPFDD",136,0) . . I $P($G(XQORNOD(0)),U,3)="Edit Record Flag",+DGY=$P($G(DGPFORIG("TIUTITLE")),U) D Q "RTN","DGPFDD",137,0) . . . S @DGPNLIST@(+DGY)="" "RTN","DGPFDD",138,0) . . Q:'DGY "RTN","DGPFDD",139,0) . . I '$$FNDTITLE^DGPFAPI1($P(DGY,U,1)) S @DGPNLIST@(+DGY)="" "RTN","DGPFDD",140,0) ; "RTN","DGPFDD",141,0) I $D(@DGPNLIST@(DGTIUIEN)) S DGRSLT=1 "RTN","DGPFDD",142,0) K @DGPNLIST "RTN","DGPFDD",143,0) ; "RTN","DGPFDD",144,0) Q DGRSLT "RTN","DGPFDD",145,0) ; "RTN","DGPFDD",146,0) GETLIST(DGCAT,DGLIST) ;Get list of TIU Progress Note Titles "RTN","DGPFDD",147,0) ; This function is used to retrieve a list of active TIU Progress "RTN","DGPFDD",148,0) ; Note Titles that can be associated with Category I or Category II "RTN","DGPFDD",149,0) ; Record Flags. "RTN","DGPFDD",150,0) ; "RTN","DGPFDD",151,0) ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF "RTN","DGPFDD",152,0) ; "RTN","DGPFDD",153,0) ; Input: [Required] "RTN","DGPFDD",154,0) ; DGCAT - Category of TIU Progress Note Titles to look for "RTN","DGPFDD",155,0) ; 1:Category I "RTN","DGPFDD",156,0) ; 2:Category II "RTN","DGPFDD",157,0) ; 3:Both Category I and II "RTN","DGPFDD",158,0) ; DGLIST - Closed root reference array name to return values "RTN","DGPFDD",159,0) ; "RTN","DGPFDD",160,0) ; Output: "RTN","DGPFDD",161,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFDD",162,0) ; DGLIST() - Closed Root reference name of returned data "RTN","DGPFDD",163,0) ; "RTN","DGPFDD",164,0) N DGRSLT ;function value "RTN","DGPFDD",165,0) S DGRSLT=0 "RTN","DGPFDD",166,0) ; "RTN","DGPFDD",167,0) I $G(DGCAT)>0,DGLIST]"",$$GETLIST^TIUPRF(DGCAT,DGLIST) S DGRSLT=1 "RTN","DGPFDD",168,0) ; "RTN","DGPFDD",169,0) Q DGRSLT "RTN","DGPFDD",170,0) ; "RTN","DGPFDD",171,0) EVENT(DGDFN) ;PRF HL7 EVENT trigger "RTN","DGPFDD",172,0) ;This trigger creates an entry in the PRF HL7 EVENT (#26.21) file "RTN","DGPFDD",173,0) ;with an INCOMPLETE status. "RTN","DGPFDD",174,0) ; "RTN","DGPFDD",175,0) ; Input: "RTN","DGPFDD",176,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFDD",177,0) ; "RTN","DGPFDD",178,0) ; Output: none "RTN","DGPFDD",179,0) ; "RTN","DGPFDD",180,0) N DGASGN "RTN","DGPFDD",181,0) ; "RTN","DGPFDD",182,0) ;validate input parameter "RTN","DGPFDD",183,0) Q:'$G(DGDFN)!('$D(^DPT(+$G(DGDFN),0))) "RTN","DGPFDD",184,0) ; "RTN","DGPFDD",185,0) ;don't record event when file re-indexing "RTN","DGPFDD",186,0) I $D(DIU(0))!($D(DIK)&$D(DIKJ)&$D(DIKLK)&$D(DIKS)&$D(DIN)) Q "RTN","DGPFDD",187,0) ; "RTN","DGPFDD",188,0) ;ICN must be national value "RTN","DGPFDD",189,0) Q:'$$MPIOK^DGPFUT(DGDFN) "RTN","DGPFDD",190,0) ; "RTN","DGPFDD",191,0) ;limit to one event per patient "RTN","DGPFDD",192,0) Q:$$FNDEVNT^DGPFHLL1(DGDFN) "RTN","DGPFDD",193,0) ; "RTN","DGPFDD",194,0) ;don't trigger when Category I PRF assignments exist "RTN","DGPFDD",195,0) Q:$$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) "RTN","DGPFDD",196,0) ; "RTN","DGPFDD",197,0) ;record event "RTN","DGPFDD",198,0) D STOEVNT^DGPFHLL1(DGDFN) "RTN","DGPFDD",199,0) ; "RTN","DGPFDD",200,0) Q "RTN","DGPFDD",201,0) ; "RTN","DGPFDD",202,0) SCRNSEL(DGIEN,DGSEL) ;screen user selection "RTN","DGPFDD",203,0) ;This function checks that the selected action does not equal the "RTN","DGPFDD",204,0) ;current field value. "RTN","DGPFDD",205,0) ; "RTN","DGPFDD",206,0) ; Input: "RTN","DGPFDD",207,0) ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file (IEN) "RTN","DGPFDD",208,0) ; "RTN","DGPFDD",209,0) ; DGSEL - (required) user selected action [1=enable, 0=disable] "RTN","DGPFDD",210,0) ; "RTN","DGPFDD",211,0) ; Output: "RTN","DGPFDD",212,0) ; Function value - returns 1 on success, 0 on failure "RTN","DGPFDD",213,0) ; "RTN","DGPFDD",214,0) N DGERR ;error root "RTN","DGPFDD",215,0) N DGFLD ;field value "RTN","DGPFDD",216,0) N DGRSLT ;function result "RTN","DGPFDD",217,0) ; "RTN","DGPFDD",218,0) S DGRSLT=0 "RTN","DGPFDD",219,0) ; "RTN","DGPFDD",220,0) I +$G(DGIEN)>0,($G(DGSEL)]"") D "RTN","DGPFDD",221,0) . ; "RTN","DGPFDD",222,0) . S DGFLD=+$$GET1^DIQ(40.8,DGIEN_",",26.01,"I","","DGERR") "RTN","DGPFDD",223,0) . Q:$D(DGERR) "RTN","DGPFDD",224,0) . Q:(DGFLD=DGSEL) "RTN","DGPFDD",225,0) . ; "RTN","DGPFDD",226,0) . S DGRSLT=1 "RTN","DGPFDD",227,0) ; "RTN","DGPFDD",228,0) Q DGRSLT "RTN","DGPFDD",229,0) ; "RTN","DGPFDD",230,0) SCRNDIV(DGIEN,DGSEL) ;division screen "RTN","DGPFDD",231,0) ;This function contains the screen logic for enabling/disabling a "RTN","DGPFDD",232,0) ;medical center division. "RTN","DGPFDD",233,0) ; "RTN","DGPFDD",234,0) ;The function (screen) is called from the following locations: "RTN","DGPFDD",235,0) ; Function: $$ASKDIV^DGPFDIV "RTN","DGPFDD",236,0) ; DD: Screen code for PRF ASSIGNMENT OWNERSHIP (#26.01) field "RTN","DGPFDD",237,0) ; of the MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDD",238,0) ; "RTN","DGPFDD",239,0) ;Entries will be screened if: "RTN","DGPFDD",240,0) ; - division is enabled and active assignments are associated with "RTN","DGPFDD",241,0) ; the division "RTN","DGPFDD",242,0) ; - division is not associated with an active institution "RTN","DGPFDD",243,0) ; - division does not have a PARENT association in the "RTN","DGPFDD",244,0) ; INSTITUTION (#4) file "RTN","DGPFDD",245,0) ; "RTN","DGPFDD",246,0) ; Input: "RTN","DGPFDD",247,0) ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file entry (IEN) "RTN","DGPFDD",248,0) ; being screened "RTN","DGPFDD",249,0) ; DGSEL - (required) user selected action [1=enable, 0=disable] "RTN","DGPFDD",250,0) ; "RTN","DGPFDD",251,0) ; Output: "RTN","DGPFDD",252,0) ; Function value - returns 1 on success, 0 on failure "RTN","DGPFDD",253,0) ; "RTN","DGPFDD",254,0) N DGINST ;ptr to INSTITUTION file "RTN","DGPFDD",255,0) N DGRSLT ;function result "RTN","DGPFDD",256,0) ; "RTN","DGPFDD",257,0) S DGRSLT=0 "RTN","DGPFDD",258,0) ; "RTN","DGPFDD",259,0) I +$G(DGIEN)>0,($G(DGSEL)]"") D "RTN","DGPFDD",260,0) . ; "RTN","DGPFDD",261,0) . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7) "RTN","DGPFDD",262,0) . I DGSEL=0,($D(^DGPF(26.13,"AOWN",DGINST,1))) Q "RTN","DGPFDD",263,0) . I DGSEL=1,'$$ACTIVE^XUAF4(DGINST) Q "RTN","DGPFDD",264,0) . I DGSEL=1,'$$PARENT^DGPFUT1(DGINST) Q "RTN","DGPFDD",265,0) . ; "RTN","DGPFDD",266,0) . S DGRSLT=1 "RTN","DGPFDD",267,0) ; "RTN","DGPFDD",268,0) Q DGRSLT "RTN","DGPFDIV") 0^36^B38624185 "RTN","DGPFDIV",1,0) DGPFDIV ;ALB/KCL - PRF ENABLE MEDICAL CENTER DIVISIONS ; 9/19/05 4:03pm "RTN","DGPFDIV",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFDIV",3,0) ; "RTN","DGPFDIV",4,0) ;No direct entry "RTN","DGPFDIV",5,0) QUIT "RTN","DGPFDIV",6,0) ; "RTN","DGPFDIV",7,0) ; "RTN","DGPFDIV",8,0) EN ;Main entry point for DGPF ENABLE DIVISIONS option. "RTN","DGPFDIV",9,0) ; "RTN","DGPFDIV",10,0) ; Input: none "RTN","DGPFDIV",11,0) ; Output: none "RTN","DGPFDIV",12,0) ; "RTN","DGPFDIV",13,0) ;The following User actions are available: "RTN","DGPFDIV",14,0) ; Action = 0 = Disable Medical Center Divisions "RTN","DGPFDIV",15,0) ; Action = 1 = Enable Medical Center Divisions "RTN","DGPFDIV",16,0) ; Action = 2 = View Medical Center Divisions "RTN","DGPFDIV",17,0) ; "RTN","DGPFDIV",18,0) N DGDIV ;selected divisions array "RTN","DGPFDIV",19,0) N DGQUIT ;user selected action "RTN","DGPFDIV",20,0) N DGSEL ;user selected action array "RTN","DGPFDIV",21,0) ; "RTN","DGPFDIV",22,0) W ! "RTN","DGPFDIV",23,0) W !,"This option allows multi-divisional facilities to enable, disable, and view" "RTN","DGPFDIV",24,0) W !,"individual medical center divisions as patient record flag assignment owners." "RTN","DGPFDIV",25,0) ; "RTN","DGPFDIV",26,0) ;loop actions - quit if none selected "RTN","DGPFDIV",27,0) S DGQUIT=0 "RTN","DGPFDIV",28,0) F D Q:DGQUIT<1 "RTN","DGPFDIV",29,0) . ; "RTN","DGPFDIV",30,0) . ;prompt user for action "RTN","DGPFDIV",31,0) . K DGSEL,DGDIV "RTN","DGPFDIV",32,0) . S DGQUIT=$$ASKACT(.DGSEL) "RTN","DGPFDIV",33,0) . Q:DGQUIT<1 "RTN","DGPFDIV",34,0) . ; "RTN","DGPFDIV",35,0) . ;if view action "RTN","DGPFDIV",36,0) . I +$G(DGSEL("ACTION"))=2 D VIEW^DGPFDIV1 Q "RTN","DGPFDIV",37,0) . ; "RTN","DGPFDIV",38,0) . ;prompt user for divisions "RTN","DGPFDIV",39,0) . S DGQUIT=$$ASKDIV(.DGSEL,.DGDIV) "RTN","DGPFDIV",40,0) . ; "RTN","DGPFDIV",41,0) . ;check to keep looping or Exit the For loop if result less than 0 "RTN","DGPFDIV",42,0) . I DGQUIT<1 S DGQUIT=$S(DGQUIT<0:DGQUIT,1:1) Q "RTN","DGPFDIV",43,0) . ; "RTN","DGPFDIV",44,0) . ;if enable/disable action "RTN","DGPFDIV",45,0) . I +$G(DGSEL("ACTION"))<2 D SET(.DGSEL,.DGDIV) "RTN","DGPFDIV",46,0) . ; "RTN","DGPFDIV",47,0) ; "RTN","DGPFDIV",48,0) Q "RTN","DGPFDIV",49,0) ; "RTN","DGPFDIV",50,0) SET(DGSEL,DGDIV) ;enable/disable medical center divisions "RTN","DGPFDIV",51,0) ;This procedure is used to enable or disable user selected medical "RTN","DGPFDIV",52,0) ;center divisions. "RTN","DGPFDIV",53,0) ; "RTN","DGPFDIV",54,0) ; Input: "RTN","DGPFDIV",55,0) ; DGSEL - (required) array containing the user selected action "RTN","DGPFDIV",56,0) ; (pass by reference) "RTN","DGPFDIV",57,0) ; Ex: DGSEL("ACTION")=0^disable "RTN","DGPFDIV",58,0) ; DGSEL("ACTION")=1^enable "RTN","DGPFDIV",59,0) ; DGDIV - (required) array of selected MEDICAL CENTER DIVISIONs "RTN","DGPFDIV",60,0) ; (passed by reference) subscripted by ien. "RTN","DGPFDIV",61,0) ; Example: DGDIV(500)="" "RTN","DGPFDIV",62,0) ; "RTN","DGPFDIV",63,0) ; Output: none "RTN","DGPFDIV",64,0) ; "RTN","DGPFDIV",65,0) N DGACT ;user selected action "RTN","DGPFDIV",66,0) N DGANS ;$$ANSWER^DGPFUT result "RTN","DGPFDIV",67,0) N DGEXIT ;for loop exit flag "RTN","DGPFDIV",68,0) N DGIEN ;medical center division ien "RTN","DGPFDIV",69,0) N DGIENS ;FM iens "RTN","DGPFDIV",70,0) N DGTXT ;user prompt "RTN","DGPFDIV",71,0) ; "RTN","DGPFDIV",72,0) ;quit if not a valid action and division array not setup "RTN","DGPFDIV",73,0) S DGACT=$G(DGSEL("ACTION")) "RTN","DGPFDIV",74,0) I +DGACT'=0,(+DGACT'=1),($O(DGDIV(0))="") Q "RTN","DGPFDIV",75,0) ; "RTN","DGPFDIV",76,0) W !!,"Preparing to '"_$P(DGACT,U,2)_"' the selected medical center divisions as" "RTN","DGPFDIV",77,0) W !,"patient record flag assignment owners...",! "RTN","DGPFDIV",78,0) ; "RTN","DGPFDIV",79,0) ;loop thru selected divisions and prompt user "RTN","DGPFDIV",80,0) S DGIEN=0 "RTN","DGPFDIV",81,0) F S DGIEN=$O(DGDIV(DGIEN)) Q:'$G(DGIEN)!$G(DGEXIT) D "RTN","DGPFDIV",82,0) . S DGIENS=DGIEN_"," "RTN","DGPFDIV",83,0) . S DGTXT="Ok to "_$P(DGACT,U,2)_" division: " "RTN","DGPFDIV",84,0) . S DGANS=$$ANSWER^DGPFUT(DGTXT_$$GET1^DIQ(40.8,DGIENS,.01),"YES","Y") "RTN","DGPFDIV",85,0) . I DGANS=0 W !?2,">>> "_$$EZBLD^DIALOG(261131)_".",! Q "RTN","DGPFDIV",86,0) . I DGANS<0 S DGEXIT=1 Q "RTN","DGPFDIV",87,0) . ; "RTN","DGPFDIV",88,0) . ;attempt to lock record before update "RTN","DGPFDIV",89,0) . I '$$LOCK^DGPFDIV1(DGIEN) D Q "RTN","DGPFDIV",90,0) . . W !?2,">>> "_$$EZBLD^DIALOG(261131)_": Record is currently locked.",! "RTN","DGPFDIV",91,0) . ; "RTN","DGPFDIV",92,0) . ;update record "RTN","DGPFDIV",93,0) . I $$STODIV^DGPFDIV1(DGIEN,+DGACT) W !?2,">>> Medical center division has been "_$$EXTERNAL^DILFD(40.8,26.01,"",+DGACT),! "RTN","DGPFDIV",94,0) . E W !?2,">>> "_$$EZBLD^DIALOG(261131)_"Unable to file changes.",! "RTN","DGPFDIV",95,0) . ; "RTN","DGPFDIV",96,0) . ;unlock record after update "RTN","DGPFDIV",97,0) . D UNLOCK^DGPFDIV1(DGIEN) "RTN","DGPFDIV",98,0) ; "RTN","DGPFDIV",99,0) Q "RTN","DGPFDIV",100,0) ; "RTN","DGPFDIV",101,0) ASKACT(DGSEL) ;select division action "RTN","DGPFDIV",102,0) ;This function is used to ask a user to select an action. "RTN","DGPFDIV",103,0) ; "RTN","DGPFDIV",104,0) ; Input: none "RTN","DGPFDIV",105,0) ; "RTN","DGPFDIV",106,0) ; Output: "RTN","DGPFDIV",107,0) ; Function value - returns 1 on success (action selected), or "RTN","DGPFDIV",108,0) ; 0 if no action selected, or "RTN","DGPFDIV",109,0) ; -1 if user up-arrows, double up-arrows or "RTN","DGPFDIV",110,0) ; the ^DIR read times out. "RTN","DGPFDIV",111,0) ; DGSEL - on success, local array containing selected action "RTN","DGPFDIV",112,0) ; (passed by reference) Ex: DGSEL("ACTION")=0^disable "RTN","DGPFDIV",113,0) ; DGSEL("ACTION")=1^enable "RTN","DGPFDIV",114,0) ; DGSEL("ACTION")=2^view "RTN","DGPFDIV",115,0) ; "RTN","DGPFDIV",116,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y ;^DIR reader vars "RTN","DGPFDIV",117,0) N DGRSLT ;function result "RTN","DGPFDIV",118,0) ; "RTN","DGPFDIV",119,0) S DGRSLT=0 "RTN","DGPFDIV",120,0) ; "RTN","DGPFDIV",121,0) S DIR(0)="SO^E:Enable Medical Center Divisions;D:Disable Medical Center Divisions;V:View Medical Center Divisions" "RTN","DGPFDIV",122,0) S DIR("A")="Select action" "RTN","DGPFDIV",123,0) S DIR("?",1)="Enter 'Enable' if you would like to select medical center divisions as" "RTN","DGPFDIV",124,0) S DIR("?",2)="being eligible for patient record flag assignment ownership." "RTN","DGPFDIV",125,0) S DIR("?",3)="" "RTN","DGPFDIV",126,0) S DIR("?",4)="Enter 'Disable' if you would like to change a division that is already" "RTN","DGPFDIV",127,0) S DIR("?",5)="eligible for patient record flag assignment ownership to ineligible." "RTN","DGPFDIV",128,0) S DIR("?",6)="Disabling a division will only be allowed if there are no active" "RTN","DGPFDIV",129,0) S DIR("?",7)="assignments associated with the division." "RTN","DGPFDIV",130,0) S DIR("?",8)="" "RTN","DGPFDIV",131,0) S DIR("?")="Enter 'View' if you would like to view all medical center divisions." "RTN","DGPFDIV",132,0) ; "RTN","DGPFDIV",133,0) D ^DIR K DIR "RTN","DGPFDIV",134,0) ; "RTN","DGPFDIV",135,0) D:'$D(DIRUT) ;setup user selected action "RTN","DGPFDIV",136,0) . S DGSEL("ACTION")=$S($G(Y)="E":"1^enable",$G(Y)="D":"0^disable",1:"2^view") "RTN","DGPFDIV",137,0) . S DGRSLT=1 "RTN","DGPFDIV",138,0) ; "RTN","DGPFDIV",139,0) Q $S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,1:DGRSLT) "RTN","DGPFDIV",140,0) ; "RTN","DGPFDIV",141,0) ASKDIV(DGSEL,DGDIV) ;select medical center divisions "RTN","DGPFDIV",142,0) ;This function is used to ask a user to select the Medical Center "RTN","DGPFDIV",143,0) ;Divisions that should be enabled or disabled as a PRF assignment owner. "RTN","DGPFDIV",144,0) ; "RTN","DGPFDIV",145,0) ; Input: "RTN","DGPFDIV",146,0) ; DGSEL - (required) array containing the user selected action "RTN","DGPFDIV",147,0) ; (pass by reference) "RTN","DGPFDIV",148,0) ; "RTN","DGPFDIV",149,0) ; Output: "RTN","DGPFDIV",150,0) ; Function value - returns 1 on success (divisions selected), or "RTN","DGPFDIV",151,0) ; returns 0 on failure (divisions not selected) "RTN","DGPFDIV",152,0) ; DGDIV - on success, the local array of selected MEDICAL CENTER "RTN","DGPFDIV",153,0) ; DIVISIONs (passed by reference) subscripted by ien. "RTN","DGPFDIV",154,0) ; Example: DGDIV(500)="" "RTN","DGPFDIV",155,0) ; "RTN","DGPFDIV",156,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y ;reader vars "RTN","DGPFDIV",157,0) N DGACT ;user selected action "RTN","DGPFDIV",158,0) N DGEXIT ;for loop exit flag "RTN","DGPFDIV",159,0) N DGRSLT ;function result "RTN","DGPFDIV",160,0) ; "RTN","DGPFDIV",161,0) S (DGRSLT,DGEXIT)=0 "RTN","DGPFDIV",162,0) ; "RTN","DGPFDIV",163,0) ;quit if not a valid action "RTN","DGPFDIV",164,0) S DGACT=$G(DGSEL("ACTION")) "RTN","DGPFDIV",165,0) I +DGACT'=0,(+DGACT'=1) Q 0 "RTN","DGPFDIV",166,0) ; "RTN","DGPFDIV",167,0) W !!,"Enter each medical center division that you would like to "_$P(DGACT,U,2)_".",! "RTN","DGPFDIV",168,0) ; "RTN","DGPFDIV",169,0) ;select medical center divisions "RTN","DGPFDIV",170,0) S DIR(0)="PO^40.8:AEM" "RTN","DGPFDIV",171,0) S DIR("A")="Select medical center division" "RTN","DGPFDIV",172,0) S DIR("S")="I $$SCRNSEL^DGPFDD(+Y,+DGACT),$$SCRNDIV^DGPFDD(+Y,+DGACT)" "RTN","DGPFDIV",173,0) S DIR("?",1)="Enter the medical center division that you would like to "_$S(+DGACT:"enable",1:"disable") "RTN","DGPFDIV",174,0) S DIR("?")="as a patient record flag assignment owner." "RTN","DGPFDIV",175,0) ; "RTN","DGPFDIV",176,0) K DGDIV "RTN","DGPFDIV",177,0) ;select divisions loop "RTN","DGPFDIV",178,0) F D Q:$D(DIRUT) "RTN","DGPFDIV",179,0) . ; "RTN","DGPFDIV",180,0) . D ^DIR "RTN","DGPFDIV",181,0) . ; "RTN","DGPFDIV",182,0) . ;exit loop on timeout, up-arrow, or null "RTN","DGPFDIV",183,0) . Q:$D(DIRUT) "RTN","DGPFDIV",184,0) . ; "RTN","DGPFDIV",185,0) . ;place selected division ien in array "RTN","DGPFDIV",186,0) . S DGDIV(+Y)="" "RTN","DGPFDIV",187,0) ; "RTN","DGPFDIV",188,0) K DIR "RTN","DGPFDIV",189,0) I +$O(DGDIV(0)) S DGRSLT=1 "RTN","DGPFDIV",190,0) E S DGRSLT=$S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,1:DGRSLT) "RTN","DGPFDIV",191,0) ; "RTN","DGPFDIV",192,0) Q DGRSLT "RTN","DGPFDIV1") 0^37^B18927567 "RTN","DGPFDIV1",1,0) DGPFDIV1 ;ALB/KCL - PRF ENABLE MEDICAL CENTER DIVISIONS CONT.; 5/07/05 ; 8/25/05 4:12pm "RTN","DGPFDIV1",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFDIV1",3,0) ; "RTN","DGPFDIV1",4,0) ;No direct entry "RTN","DGPFDIV1",5,0) QUIT "RTN","DGPFDIV1",6,0) ; "RTN","DGPFDIV1",7,0) LOCK(DGIEN) ;lock MEDICAL CENTER DIVISION record "RTN","DGPFDIV1",8,0) ;This lock function is used to prevent another process from editing "RTN","DGPFDIV1",9,0) ;a record in the MEDICAL CENTER DIVISION (#40.8) file. "RTN","DGPFDIV1",10,0) ; "RTN","DGPFDIV1",11,0) ; Input: "RTN","DGPFDIV1",12,0) ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDIV1",13,0) ; "RTN","DGPFDIV1",14,0) ; Output: "RTN","DGPFDIV1",15,0) ; Function value - returns 1 on success, 0 on failure "RTN","DGPFDIV1",16,0) ; "RTN","DGPFDIV1",17,0) I $G(DGIEN) L +^DG(40.8,DGIEN):10 "RTN","DGPFDIV1",18,0) ; "RTN","DGPFDIV1",19,0) Q $T "RTN","DGPFDIV1",20,0) ; "RTN","DGPFDIV1",21,0) UNLOCK(DGIEN) ;unlock MEDICAL CENTER DIVISION record "RTN","DGPFDIV1",22,0) ;This procedure is used to release a lock created by $$LOCK. "RTN","DGPFDIV1",23,0) ; "RTN","DGPFDIV1",24,0) ; Input: "RTN","DGPFDIV1",25,0) ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDIV1",26,0) ; "RTN","DGPFDIV1",27,0) ; Output: none "RTN","DGPFDIV1",28,0) ; "RTN","DGPFDIV1",29,0) I $G(DGIEN) L -^DG(40.8,DGIEN) "RTN","DGPFDIV1",30,0) ; "RTN","DGPFDIV1",31,0) Q "RTN","DGPFDIV1",32,0) ; "RTN","DGPFDIV1",33,0) GETDIV(DGIEN,DGDIV) ;retrieve PRF MEDICAL CENTER DIVISION object "RTN","DGPFDIV1",34,0) ;This function is used to retrieve the data fields related to the "RTN","DGPFDIV1",35,0) ;PRF Ownership Indicator from the MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDIV1",36,0) ;and place them in a local array. "RTN","DGPFDIV1",37,0) ; "RTN","DGPFDIV1",38,0) ; Input: "RTN","DGPFDIV1",39,0) ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDIV1",40,0) ; "RTN","DGPFDIV1",41,0) ; Output: "RTN","DGPFDIV1",42,0) ; Function value - returns 1 on success, 0 on failure "RTN","DGPFDIV1",43,0) ; DGDIV - local array of MEDICAL CENTER DIVISION data fields (passed "RTN","DGPFDIV1",44,0) ; by reference) "RTN","DGPFDIV1",45,0) ; Subscript Field# "RTN","DGPFDIV1",46,0) ; ---------- ------ "RTN","DGPFDIV1",47,0) ; "NAME" .01 "RTN","DGPFDIV1",48,0) ; "INST" .07 "RTN","DGPFDIV1",49,0) ; "IND" 26.01 "RTN","DGPFDIV1",50,0) ; "EDITDT" 26.02 "RTN","DGPFDIV1",51,0) ; "EDITBY" 26.03 "RTN","DGPFDIV1",52,0) ; "RTN","DGPFDIV1",53,0) N DGIENS ;ien string "RTN","DGPFDIV1",54,0) N DGFLDS ;target root "RTN","DGPFDIV1",55,0) N DGERR ;error root "RTN","DGPFDIV1",56,0) N DGRSLT ;function result "RTN","DGPFDIV1",57,0) ; "RTN","DGPFDIV1",58,0) K DGDIV S DGDIV="" "RTN","DGPFDIV1",59,0) S DGRSLT=0 "RTN","DGPFDIV1",60,0) ; "RTN","DGPFDIV1",61,0) I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D "RTN","DGPFDIV1",62,0) . S DGIENS=DGIEN_"," "RTN","DGPFDIV1",63,0) . D GETS^DIQ(40.8,DGIENS,".01;.07;26.01;26.02;26.03","IE","DGFLDS","DGERR") "RTN","DGPFDIV1",64,0) . Q:$D(DGERR) "RTN","DGPFDIV1",65,0) . ; "RTN","DGPFDIV1",66,0) . S DGDIV("NAME")=$G(DGFLDS(40.8,DGIENS,.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,.01,"E")) "RTN","DGPFDIV1",67,0) . S DGDIV("INST")=$G(DGFLDS(40.8,DGIENS,.07,"I"))_U_$G(DGFLDS(40.8,DGIENS,.07,"E")) "RTN","DGPFDIV1",68,0) . S DGDIV("IND")=$G(DGFLDS(40.8,DGIENS,26.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.01,"E")) "RTN","DGPFDIV1",69,0) . S DGDIV("EDITDT")=$G(DGFLDS(40.8,DGIENS,26.02,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.02,"E")) "RTN","DGPFDIV1",70,0) . S DGDIV("EDITBY")=$G(DGFLDS(40.8,DGIENS,26.03,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.03,"E")) "RTN","DGPFDIV1",71,0) . ; "RTN","DGPFDIV1",72,0) . ;success "RTN","DGPFDIV1",73,0) . S DGRSLT=1 "RTN","DGPFDIV1",74,0) ; "RTN","DGPFDIV1",75,0) Q DGRSLT "RTN","DGPFDIV1",76,0) ; "RTN","DGPFDIV1",77,0) STODIV(DGIEN,DGIND) ;store PRF MEDICAL CENTER DIVISION object "RTN","DGPFDIV1",78,0) ;This function is used to store the data fields related to the "RTN","DGPFDIV1",79,0) ;PRF Ownership Indicator into the MEDICAL CENTER DIVISION (#40.8) file. "RTN","DGPFDIV1",80,0) ; "RTN","DGPFDIV1",81,0) ; Input: "RTN","DGPFDIV1",82,0) ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file "RTN","DGPFDIV1",83,0) ; DGIND - (required) PRF Ownership Indicator [1=enable, 0=disable] "RTN","DGPFDIV1",84,0) ; "RTN","DGPFDIV1",85,0) ; Output: "RTN","DGPFDIV1",86,0) ; Function value - returns 1 on success, 0 on failure "RTN","DGPFDIV1",87,0) ; "RTN","DGPFDIV1",88,0) ; "RTN","DGPFDIV1",89,0) N DGERR ;error root "RTN","DGPFDIV1",90,0) N DGFDA ;fda array "RTN","DGPFDIV1",91,0) N DGRSLT ;function result "RTN","DGPFDIV1",92,0) ; "RTN","DGPFDIV1",93,0) S DGRSLT=0 "RTN","DGPFDIV1",94,0) ; "RTN","DGPFDIV1",95,0) I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D "RTN","DGPFDIV1",96,0) . ; "RTN","DGPFDIV1",97,0) . ;quit if can't convert internal value to external "RTN","DGPFDIV1",98,0) . Q:$$EXTERNAL^DILFD(40.8,26.01,"",DGIND)']"" "RTN","DGPFDIV1",99,0) . ; "RTN","DGPFDIV1",100,0) . ;file data "RTN","DGPFDIV1",101,0) . S DGFDA(40.8,DGIEN_",",26.01)=DGIND ;indicator "RTN","DGPFDIV1",102,0) . S DGFDA(40.8,DGIEN_",",26.02)=$$NOW^XLFDT() ;current date/time "RTN","DGPFDIV1",103,0) . S DGFDA(40.8,DGIEN_",",26.03)=DUZ ;user "RTN","DGPFDIV1",104,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFDIV1",105,0) . Q:$D(DGERR) "RTN","DGPFDIV1",106,0) . ; "RTN","DGPFDIV1",107,0) . ;success "RTN","DGPFDIV1",108,0) . S DGRSLT=1 "RTN","DGPFDIV1",109,0) ; "RTN","DGPFDIV1",110,0) Q DGRSLT "RTN","DGPFDIV1",111,0) ; "RTN","DGPFDIV1",112,0) VIEW ;view medical center divisions "RTN","DGPFDIV1",113,0) ;This procedure is used to view all medical center divisions within the "RTN","DGPFDIV1",114,0) ;Medical Center Division (#40.8) file and whether or not they have been "RTN","DGPFDIV1",115,0) ;enabled for PRF assignment ownership. "RTN","DGPFDIV1",116,0) ; "RTN","DGPFDIV1",117,0) ; Input: none "RTN","DGPFDIV1",118,0) ; Output: none "RTN","DGPFDIV1",119,0) ; "RTN","DGPFDIV1",120,0) N DGEXIT ;exit var "RTN","DGPFDIV1",121,0) N DGIEN ;file (#40.8) ien "RTN","DGPFDIV1",122,0) N DGINST ;ptr to INSTITUTION file "RTN","DGPFDIV1",123,0) N DGLINE ;display line "RTN","DGPFDIV1",124,0) N DGOBJ ;med center division object array "RTN","DGPFDIV1",125,0) N DGSUB ;loop subscript "RTN","DGPFDIV1",126,0) ; "RTN","DGPFDIV1",127,0) S $P(DGLINE,"_",66)="" "RTN","DGPFDIV1",128,0) W @IOF "RTN","DGPFDIV1",129,0) ; "RTN","DGPFDIV1",130,0) F DGIEN=0:0 S DGIEN=$O(^DG(40.8,DGIEN)) D Q:'DGIEN!($G(DGEXIT)) "RTN","DGPFDIV1",131,0) . K DGOBJ "RTN","DGPFDIV1",132,0) . I $$GETDIV(DGIEN,.DGOBJ) D "RTN","DGPFDIV1",133,0) . . F DGSUB="NAME","IND","EDITBY","EDITDT" D "RTN","DGPFDIV1",134,0) . . . I $P(DGOBJ(DGSUB),U,2)']"" S $P(DGOBJ(DGSUB),U,2)="n/a" "RTN","DGPFDIV1",135,0) . . ; "RTN","DGPFDIV1",136,0) . . S:$P(DGOBJ("IND"),U,2)="n/a" $P(DGOBJ("IND"),U,2)="DISABLED (default)" "RTN","DGPFDIV1",137,0) . . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7) "RTN","DGPFDIV1",138,0) . . S DGOBJ("ACTIVE")=$S($D(^DGPF(26.13,"AOWN",DGINST,1)):"YES",1:"NO") "RTN","DGPFDIV1",139,0) . . ; "RTN","DGPFDIV1",140,0) . . W !," Medical Center Division: ",$P(DGOBJ("NAME"),U,2) "RTN","DGPFDIV1",141,0) . . W !," PRF Assignment Ownership: ",$P(DGOBJ("IND"),U,2) "RTN","DGPFDIV1",142,0) . . W !," Edited By: ",$P(DGOBJ("EDITBY"),U,2) "RTN","DGPFDIV1",143,0) . . W !," Edit Date/Time: ",$P(DGOBJ("EDITDT"),U,2) "RTN","DGPFDIV1",144,0) . . W !," Active PRF Assignments: ",DGOBJ("ACTIVE") "RTN","DGPFDIV1",145,0) . . W !,DGLINE,! "RTN","DGPFDIV1",146,0) . . I $Y>(IOSL-5) S DGEXIT='$$CONTINUE^DGPFUT() W @IOF "RTN","DGPFDIV1",147,0) ; "RTN","DGPFDIV1",148,0) Q "RTN","DGPFHLL") 0^11^B41058426 "RTN","DGPFHLL",1,0) DGPFHLL ;ALB/RPM - PRF HL7 TRANSMISSION LOG API'S ; 3/6/03 "RTN","DGPFHLL",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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) ; "ERROR",n .07 "RTN","DGPFHLL",23,0) ; "RTN","DGPFHLL",24,0) N DGIENS ;IEN string "RTN","DGPFHLL",25,0) N DGFLDS ;results array "RTN","DGPFHLL",26,0) N DGECNT ;error counter "RTN","DGPFHLL",27,0) N DGERR ;error arrary "RTN","DGPFHLL",28,0) N DGRSLT ;function value "RTN","DGPFHLL",29,0) ; "RTN","DGPFHLL",30,0) S DGRSLT=0 "RTN","DGPFHLL",31,0) I $G(DGLIEN)>0,$D(^DGPF(26.17,DGLIEN)) D "RTN","DGPFHLL",32,0) . S DGIENS=DGLIEN_"," "RTN","DGPFHLL",33,0) . D GETS^DIQ(26.17,DGIENS,"**","IEZ","DGFLDS","DGERR") "RTN","DGPFHLL",34,0) . Q:$D(DGERR) "RTN","DGPFHLL",35,0) . S DGRSLT=1 "RTN","DGPFHLL",36,0) . S DGPFL("MSGID")=$G(DGFLDS(26.17,DGIENS,.01,"I"))_U_$G(DGFLDS(26.17,DGIENS,.01,"E")) "RTN","DGPFHLL",37,0) . S DGPFL("ASGNHIST")=$G(DGFLDS(26.17,DGIENS,.02,"I"))_U_$G(DGFLDS(26.17,DGIENS,.02,"E")) "RTN","DGPFHLL",38,0) . S DGPFL("TRANSDT")=$G(DGFLDS(26.17,DGIENS,.03,"I"))_U_$G(DGFLDS(26.17,DGIENS,.03,"E")) "RTN","DGPFHLL",39,0) . S DGPFL("MSGSTAT")=$G(DGFLDS(26.17,DGIENS,.04,"I"))_U_$G(DGFLDS(26.17,DGIENS,.04,"E")) "RTN","DGPFHLL",40,0) . S DGPFL("SITE")=$G(DGFLDS(26.17,DGIENS,.05,"I"))_U_$G(DGFLDS(26.17,DGIENS,.05,"E")) "RTN","DGPFHLL",41,0) . S DGPFL("ACKDT")=$G(DGFLDS(26.17,DGIENS,.06,"I"))_U_$G(DGFLDS(26.17,DGIENS,.06,"E")) "RTN","DGPFHLL",42,0) . ; "RTN","DGPFHLL",43,0) . ;build error code array "RTN","DGPFHLL",44,0) . S DGIENS="",DGECNT=0 "RTN","DGPFHLL",45,0) . F S DGIENS=$O(DGFLDS(26.1707,DGIENS)) Q:DGIENS="" D:$G(DGFLDS(26.1707,DGIENS,.01,"E"))]"" "RTN","DGPFHLL",46,0) . . S DGECNT=DGECNT+1 "RTN","DGPFHLL",47,0) . . S DGPFL("ERROR",DGECNT)=DGFLDS(26.1707,DGIENS,.01,"E") "RTN","DGPFHLL",48,0) ; "RTN","DGPFHLL",49,0) Q DGRSLT "RTN","DGPFHLL",50,0) ; "RTN","DGPFHLL",51,0) GETQLOG(DGLIEN,DGPFL) ;retrieve a query log record "RTN","DGPFHLL",52,0) ; "RTN","DGPFHLL",53,0) ; Input: "RTN","DGPFHLL",54,0) ; DGLIEN - IEN for PRF HL7 QUERY LOG (#26.19) file "RTN","DGPFHLL",55,0) ; "RTN","DGPFHLL",56,0) ; Output: "RTN","DGPFHLL",57,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLL",58,0) ; DGPFL - array of transmission data fields "RTN","DGPFHLL",59,0) ; Subscript Field# "RTN","DGPFHLL",60,0) ; --------- ------ "RTN","DGPFHLL",61,0) ; "MSGID" .01 "RTN","DGPFHLL",62,0) ; "EVNT" .02 "RTN","DGPFHLL",63,0) ; "TRANSDT" .03 "RTN","DGPFHLL",64,0) ; "MSGSTAT" .04 "RTN","DGPFHLL",65,0) ; "SITE" .05 "RTN","DGPFHLL",66,0) ; "ACKDT" .06 "RTN","DGPFHLL",67,0) ; "ERROR",n .07 "RTN","DGPFHLL",68,0) ; "RTN","DGPFHLL",69,0) N DGIENS ;IEN string "RTN","DGPFHLL",70,0) N DGFLDS ;results array "RTN","DGPFHLL",71,0) N DGECNT ;error counter "RTN","DGPFHLL",72,0) N DGERR ;error arrary "RTN","DGPFHLL",73,0) N DGRSLT ;function value "RTN","DGPFHLL",74,0) ; "RTN","DGPFHLL",75,0) S DGRSLT=0 "RTN","DGPFHLL",76,0) I $G(DGLIEN)>0,$D(^DGPF(26.19,DGLIEN)) D "RTN","DGPFHLL",77,0) . S DGIENS=DGLIEN_"," "RTN","DGPFHLL",78,0) . D GETS^DIQ(26.19,DGIENS,"**","IEZ","DGFLDS","DGERR") "RTN","DGPFHLL",79,0) . Q:$D(DGERR) "RTN","DGPFHLL",80,0) . S DGRSLT=1 "RTN","DGPFHLL",81,0) . S DGPFL("MSGID")=$G(DGFLDS(26.19,DGIENS,.01,"I"))_U_$G(DGFLDS(26.19,DGIENS,.01,"E")) "RTN","DGPFHLL",82,0) . S DGPFL("EVNT")=$G(DGFLDS(26.19,DGIENS,.02,"I"))_U_$G(DGFLDS(26.19,DGIENS,.02,"E")) "RTN","DGPFHLL",83,0) . S DGPFL("TRANSDT")=$G(DGFLDS(26.19,DGIENS,.03,"I"))_U_$G(DGFLDS(26.19,DGIENS,.03,"E")) "RTN","DGPFHLL",84,0) . S DGPFL("MSGSTAT")=$G(DGFLDS(26.19,DGIENS,.04,"I"))_U_$G(DGFLDS(26.19,DGIENS,.04,"E")) "RTN","DGPFHLL",85,0) . S DGPFL("SITE")=$G(DGFLDS(26.19,DGIENS,.05,"I"))_U_$G(DGFLDS(26.19,DGIENS,.05,"E")) "RTN","DGPFHLL",86,0) . S DGPFL("ACKDT")=$G(DGFLDS(26.19,DGIENS,.06,"I"))_U_$G(DGFLDS(26.19,DGIENS,.06,"E")) "RTN","DGPFHLL",87,0) . ; "RTN","DGPFHLL",88,0) . ;build error code array "RTN","DGPFHLL",89,0) . S DGIENS="",DGECNT=0 "RTN","DGPFHLL",90,0) . F S DGIENS=$O(DGFLDS(26.1907,DGIENS)) Q:DGIENS="" D:$G(DGFLDS(26.1907,DGIENS,.01,"E"))]"" "RTN","DGPFHLL",91,0) . . S DGECNT=DGECNT+1 "RTN","DGPFHLL",92,0) . . S DGPFL("ERROR",DGECNT)=DGFLDS(26.1907,DGIENS,.01,"E") "RTN","DGPFHLL",93,0) ; "RTN","DGPFHLL",94,0) Q DGRSLT "RTN","DGPFHLL",95,0) ; "RTN","DGPFHLL",96,0) FNDLOG(DGFILE,DGMSGID) ;find and return the record number from a given HL7 "RTN","DGPFHLL",97,0) ; LOG file for a given HL7 Message ID "RTN","DGPFHLL",98,0) ; "RTN","DGPFHLL",99,0) ; Input: "RTN","DGPFHLL",100,0) ; DGFILE - file number of HL7 log file "RTN","DGPFHLL",101,0) ; DGMSGID - HL7 Message ID "RTN","DGPFHLL",102,0) ; "RTN","DGPFHLL",103,0) ; Output: "RTN","DGPFHLL",104,0) ; Function value - IEN of HL7 LOG file on success, 0 on failure "RTN","DGPFHLL",105,0) ; "RTN","DGPFHLL",106,0) N DGIEN ;function value "RTN","DGPFHLL",107,0) ; "RTN","DGPFHLL",108,0) I +$G(DGFILE),+$G(DGMSGID) D "RTN","DGPFHLL",109,0) . S DGIEN=$O(^DGPF(DGFILE,"B",DGMSGID,0)) "RTN","DGPFHLL",110,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFHLL",111,0) ; "RTN","DGPFHLL",112,0) STOXMIT(DGHIEN,DGMSGID,DGINST,DGERR) ;store the transmission log data "RTN","DGPFHLL",113,0) ; "RTN","DGPFHLL",114,0) ; Input: "RTN","DGPFHLL",115,0) ; DGHIEN - pointer to PRF ASSIGNMENT HISTORY (#26.14) file "RTN","DGPFHLL",116,0) ; DGMSGID - message ID from VistA HL7 "RTN","DGPFHLL",117,0) ; DGINST - pointer to the INSTITUTION (#4) file "RTN","DGPFHLL",118,0) ; "RTN","DGPFHLL",119,0) ; Output: "RTN","DGPFHLL",120,0) ; DGERR - undefined on success, error message on failure "RTN","DGPFHLL",121,0) ; "RTN","DGPFHLL",122,0) N DGFDA ;fda array "RTN","DGPFHLL",123,0) N DGFDAIEN ;UPDATE^DIE ien result "RTN","DGPFHLL",124,0) ; "RTN","DGPFHLL",125,0) I +$G(DGHIEN),$D(^DGPF(26.14,DGHIEN)),$D(DGMSGID),+$G(DGINST),$D(^DIC(4,DGINST)) D "RTN","DGPFHLL",126,0) . Q:$$FNDLOG^DGPFHLL(26.17,DGMSGID) "RTN","DGPFHLL",127,0) . S DGFDA(26.17,"+1,",.01)=DGMSGID "RTN","DGPFHLL",128,0) . S DGFDA(26.17,"+1,",.02)=DGHIEN "RTN","DGPFHLL",129,0) . S DGFDA(26.17,"+1,",.03)=$$NOW^XLFDT() "RTN","DGPFHLL",130,0) . S DGFDA(26.17,"+1,",.04)="T" "RTN","DGPFHLL",131,0) . S DGFDA(26.17,"+1,",.05)=DGINST "RTN","DGPFHLL",132,0) . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFHLL",133,0) Q "RTN","DGPFHLL",134,0) ; "RTN","DGPFHLL",135,0) STOQXMIT(DGEVNT,DGMSGID,DGINST,DGERR) ;store the query log data "RTN","DGPFHLL",136,0) ; "RTN","DGPFHLL",137,0) ; Input: "RTN","DGPFHLL",138,0) ; DGEVNT - pointer to PRF event in PRF HL7 EVENT (#26.21) file "RTN","DGPFHLL",139,0) ; DGMSGID - message ID from VistA HL7 "RTN","DGPFHLL",140,0) ; DGINST - pointer to the INSTITUTION (#4) file "RTN","DGPFHLL",141,0) ; "RTN","DGPFHLL",142,0) ; Output: "RTN","DGPFHLL",143,0) ; DGERR - undefined on success, error message on failure "RTN","DGPFHLL",144,0) ; "RTN","DGPFHLL",145,0) N DGFDA ;fda array "RTN","DGPFHLL",146,0) N DGFDAIEN ;UPDATE^DIE ien result "RTN","DGPFHLL",147,0) ; "RTN","DGPFHLL",148,0) I +$G(DGEVNT),$D(DGMSGID),+$G(DGINST),$D(^DIC(4,DGINST)) D "RTN","DGPFHLL",149,0) . Q:$$FNDLOG^DGPFHLL(26.19,DGMSGID) "RTN","DGPFHLL",150,0) . S DGFDA(26.19,"+1,",.01)=DGMSGID "RTN","DGPFHLL",151,0) . S DGFDA(26.19,"+1,",.02)=DGEVNT "RTN","DGPFHLL",152,0) . S DGFDA(26.19,"+1,",.03)=$$NOW^XLFDT() "RTN","DGPFHLL",153,0) . S DGFDA(26.19,"+1,",.04)="T" "RTN","DGPFHLL",154,0) . S DGFDA(26.19,"+1,",.05)=DGINST "RTN","DGPFHLL",155,0) . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFHLL",156,0) Q "RTN","DGPFHLL",157,0) ; "RTN","DGPFHLL",158,0) STOSTAT(DGFILE,DGLIEN,DGSTAT,DGEARR) ;update the HL7 transmission status "RTN","DGPFHLL",159,0) ; "RTN","DGPFHLL",160,0) ; Input: "RTN","DGPFHLL",161,0) ; DGFILE - file number of HL7 LOG file "RTN","DGPFHLL",162,0) ; DGLIEN - IEN of selected HL7 LOG file "RTN","DGPFHLL",163,0) ; DGSTAT - internal Status value "RTN","DGPFHLL",164,0) ; DGEARR - (optional) array of error message codes "RTN","DGPFHLL",165,0) ; format: DGEARR(n)=error code "RTN","DGPFHLL",166,0) ; "RTN","DGPFHLL",167,0) ; Output: "RTN","DGPFHLL",168,0) ; none "RTN","DGPFHLL",169,0) ; "RTN","DGPFHLL",170,0) N DGERR ;filer errors "RTN","DGPFHLL",171,0) N DGFDA ;fda array "RTN","DGPFHLL",172,0) N DGI ;generic index "RTN","DGPFHLL",173,0) N DGLIENS ;iens string "RTN","DGPFHLL",174,0) ; "RTN","DGPFHLL",175,0) I $G(DGFILE)]"",+$G(DGLIEN),$D(^DGPF(DGFILE,DGLIEN)),$G(DGSTAT)]"" D "RTN","DGPFHLL",176,0) . Q:'$$TESTVAL^DGPFUT(DGFILE,.04,DGSTAT) "RTN","DGPFHLL",177,0) . S DGLIENS=DGLIEN_"," "RTN","DGPFHLL",178,0) . S DGFDA(DGFILE,DGLIENS,.04)=DGSTAT "RTN","DGPFHLL",179,0) . S DGFDA(DGFILE,DGLIENS,.06)=$$NOW^XLFDT() "RTN","DGPFHLL",180,0) . S DGI=0 "RTN","DGPFHLL",181,0) . F S DGI=$O(DGEARR(DGI)) Q:'DGI I DGEARR(DGI)]"" D "RTN","DGPFHLL",182,0) . . S DGFDA(DGFILE_"07","+"_DGI_","_DGLIEN_",",.01)=DGEARR(DGI) "RTN","DGPFHLL",183,0) . D UPDATE^DIE("","DGFDA","","DGERR") "RTN","DGPFHLL",184,0) Q "RTN","DGPFHLL",185,0) ; "RTN","DGPFHLL",186,0) GETLSQ(DGEVNT) ;get last site queried "RTN","DGPFHLL",187,0) ; "RTN","DGPFHLL",188,0) ; Input: "RTN","DGPFHLL",189,0) ; DGEVNT - pointer to PRF HL7 EVENT (#26.21) file "RTN","DGPFHLL",190,0) ; "RTN","DGPFHLL",191,0) ; Output: "RTN","DGPFHLL",192,0) ; Function value - last site queried as pointer to INSTITUTION (#4) "RTN","DGPFHLL",193,0) ; file on success; 0 on failure "RTN","DGPFHLL",194,0) ; "RTN","DGPFHLL",195,0) N DGARR ;array of query sites sorted by date "RTN","DGPFHLL",196,0) N DGLIEN ;pointer to PRF HL7 QUERY LOG (#26.19) "RTN","DGPFHLL",197,0) N DGLOG ;query log data array "RTN","DGPFHLL",198,0) ; "RTN","DGPFHLL",199,0) S DGLIEN=0 "RTN","DGPFHLL",200,0) S DGEVNT=+$G(DGEVNT) "RTN","DGPFHLL",201,0) F S DGLIEN=$O(^DGPF(26.19,"C",DGEVNT,DGLIEN)) Q:'DGLIEN D "RTN","DGPFHLL",202,0) . K DGLOG "RTN","DGPFHLL",203,0) . Q:'$$GETQLOG(DGLIEN,.DGLOG) "RTN","DGPFHLL",204,0) . I +$G(DGLOG("TRANSDT"))>0,+$G(DGLOG("SITE"))>0 S DGARR(+$G(DGLOG("TRANSDT")))=+$G(DGLOG("SITE")) "RTN","DGPFHLL",205,0) Q +$G(DGARR(+$O(DGARR(""),-1))) "RTN","DGPFHLL",206,0) ; "RTN","DGPFHLL",207,0) PRGQLOG(DGEVNT) ;purge PRF Query Log entries "RTN","DGPFHLL",208,0) ;This procedure purges non-Accepted entries in the PRF HL7 QUERY LOG "RTN","DGPFHLL",209,0) ;(#26.19) file for a given PRF HL7 EVENT. "RTN","DGPFHLL",210,0) ; "RTN","DGPFHLL",211,0) ; Input: "RTN","DGPFHLL",212,0) ; DGEVNT - pointer to PRF HL7 EVENT (#26.21) file "RTN","DGPFHLL",213,0) ; "RTN","DGPFHLL",214,0) ; Output: none "RTN","DGPFHLL",215,0) ; "RTN","DGPFHLL",216,0) N DGERR ;FM error array "RTN","DGPFHLL",217,0) N DGFDA ;FM FDA array "RTN","DGPFHLL",218,0) N DGLIEN ;PRF HL7 QUERY LOG (#26.19) file IEN "RTN","DGPFHLL",219,0) N DGSTAT ;transmission status "RTN","DGPFHLL",220,0) ; "RTN","DGPFHLL",221,0) S DGEVNT=+$G(DGEVNT) "RTN","DGPFHLL",222,0) S DGLIEN=0 "RTN","DGPFHLL",223,0) ; "RTN","DGPFHLL",224,0) F S DGLIEN=$O(^DGPF(26.19,"C",DGEVNT,DGLIEN)) Q:'DGLIEN D "RTN","DGPFHLL",225,0) . K DGFDA,DGERR "RTN","DGPFHLL",226,0) . S DGSTAT=$$GET1^DIQ(26.19,DGLIEN_",",.04,"I","","DGERR") "RTN","DGPFHLL",227,0) . ; "RTN","DGPFHLL",228,0) . Q:$E(DGSTAT)="A" ;don't purge "A" or "AN" status entries "RTN","DGPFHLL",229,0) . ; "RTN","DGPFHLL",230,0) . S DGFDA(26.19,DGLIEN_",",.01)="@" "RTN","DGPFHLL",231,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFHLL",232,0) ; "RTN","DGPFHLL",233,0) Q "RTN","DGPFHLL1") 0^26^B8068964 "RTN","DGPFHLL1",1,0) DGPFHLL1 ;ALB/RPM - PRF HL7 EVENT LOG API'S ; 2/23/06 "RTN","DGPFHLL1",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFHLL1",3,0) ; "RTN","DGPFHLL1",4,0) Q "RTN","DGPFHLL1",5,0) ; "RTN","DGPFHLL1",6,0) GETEVNT(DGLIEN,DGPFL) ;retrieve a given record from PRF HL7 EVENT LOG (#26.21) "RTN","DGPFHLL1",7,0) ; "RTN","DGPFHLL1",8,0) ; Input: "RTN","DGPFHLL1",9,0) ; DGLIEN - IEN of PRF HL7 EVENT (#26.21) "RTN","DGPFHLL1",10,0) ; "RTN","DGPFHLL1",11,0) ; Output: "RTN","DGPFHLL1",12,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFHLL1",13,0) ; DGPFL - array of event data fields "RTN","DGPFHLL1",14,0) ; Subscript Field# "RTN","DGPFHLL1",15,0) ; --------- ------ "RTN","DGPFHLL1",16,0) ; "DFN" .01 "RTN","DGPFHLL1",17,0) ; "EDT" .02 "RTN","DGPFHLL1",18,0) ; "STAT" .03 "RTN","DGPFHLL1",19,0) ; "RTN","DGPFHLL1",20,0) N DGERR ;error array "RTN","DGPFHLL1",21,0) N DGFLDS ;field result array "RTN","DGPFHLL1",22,0) N DGIENS ;FM IENS string "RTN","DGPFHLL1",23,0) N DGRSLT ;function value "RTN","DGPFHLL1",24,0) ; "RTN","DGPFHLL1",25,0) S DGRSLT=0 "RTN","DGPFHLL1",26,0) I $G(DGLIEN),$D(^DGPF(26.21,DGLIEN)) D "RTN","DGPFHLL1",27,0) . S DGIENS=DGLIEN_"," "RTN","DGPFHLL1",28,0) . D GETS^DIQ(26.21,DGIENS,"**","IEZ","DGFLDS","DGERR") "RTN","DGPFHLL1",29,0) . Q:$D(DGERR) "RTN","DGPFHLL1",30,0) . S DGRSLT=1 "RTN","DGPFHLL1",31,0) . S DGPFL("DFN")=$G(DGFLDS(26.21,DGIENS,.01,"I"))_U_$G(DGFLDS(26.21,DGIENS,.01,"E")) "RTN","DGPFHLL1",32,0) . S DGPFL("EDT")=$G(DGFLDS(26.21,DGIENS,.02,"I"))_U_$G(DGFLDS(26.21,DGIENS,.02,"E")) "RTN","DGPFHLL1",33,0) . S DGPFL("STAT")=$G(DGFLDS(26.21,DGIENS,.03,"I"))_U_$G(DGFLDS(26.21,DGIENS,.03,"E")) "RTN","DGPFHLL1",34,0) ; "RTN","DGPFHLL1",35,0) Q DGRSLT "RTN","DGPFHLL1",36,0) ; "RTN","DGPFHLL1",37,0) GETSTAT(DGDFN) ;retrieve event status for a given patient "RTN","DGPFHLL1",38,0) ;This function retrieves the internal value of the CURRENT STATUS "RTN","DGPFHLL1",39,0) ;(#.03) field in the PRF HL7 EVENT (#26.21) file and returns it as the "RTN","DGPFHLL1",40,0) ;function value. "RTN","DGPFHLL1",41,0) ; "RTN","DGPFHLL1",42,0) ; Input: "RTN","DGPFHLL1",43,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFHLL1",44,0) ; "RTN","DGPFHLL1",45,0) ; Output: "RTN","DGPFHLL1",46,0) ; Function value - returns CURRENT STATUS field value in Internal "RTN","DGPFHLL1",47,0) ; format on success; otherwise returns "" "RTN","DGPFHLL1",48,0) ; "RTN","DGPFHLL1",49,0) N DGERR ;DIQ error array "RTN","DGPFHLL1",50,0) ; "RTN","DGPFHLL1",51,0) Q:'+$G(DGDFN) "" "RTN","DGPFHLL1",52,0) Q $$GET1^DIQ(26.21,$$FNDEVNT(DGDFN)_",",.03,"I","","DGERR") "RTN","DGPFHLL1",53,0) ; "RTN","DGPFHLL1",54,0) FNDEVNT(DGDFN) ;find PRF HL7 EVENT (#26.21) file record number "RTN","DGPFHLL1",55,0) ;This function finds and returns the PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",56,0) ;number for a given patient. "RTN","DGPFHLL1",57,0) ; "RTN","DGPFHLL1",58,0) ; Input: "RTN","DGPFHLL1",59,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFHLL1",60,0) ; "RTN","DGPFHLL1",61,0) ; Output: "RTN","DGPFHLL1",62,0) ; Function value - IEN of PRF HL7 EVENT (#26.21) file on success; "RTN","DGPFHLL1",63,0) ; 0 on failure "RTN","DGPFHLL1",64,0) ; "RTN","DGPFHLL1",65,0) N DGIEN ;function value "RTN","DGPFHLL1",66,0) ; "RTN","DGPFHLL1",67,0) I +$G(DGDFN) D "RTN","DGPFHLL1",68,0) . S DGIEN=$O(^DGPF(26.21,"B",DGDFN,0)) "RTN","DGPFHLL1",69,0) Q $S($G(DGIEN)>0:DGIEN,1:0) "RTN","DGPFHLL1",70,0) ; "RTN","DGPFHLL1",71,0) STOEVNT(DGDFN,DGSTAT,DGERR) ;store event in PRF HL7 EVENT (#26.21) file "RTN","DGPFHLL1",72,0) ; "RTN","DGPFHLL1",73,0) ; Input: "RTN","DGPFHLL1",74,0) ; DGDFN - (required) pointer to patient in PATIENT (#2) file "RTN","DGPFHLL1",75,0) ; DGSTAT - (optional) event status [default = INCOMPLETE] "RTN","DGPFHLL1",76,0) ; DGERR - (optional) passed by reference to hold any FM errors "RTN","DGPFHLL1",77,0) ; "RTN","DGPFHLL1",78,0) ; Output: "RTN","DGPFHLL1",79,0) ; DGERR - only defined when FM call fails "RTN","DGPFHLL1",80,0) ; "RTN","DGPFHLL1",81,0) N DGFDA ;FM FDA array "RTN","DGPFHLL1",82,0) N DGFDAIEN ;UPDATE^DIE result "RTN","DGPFHLL1",83,0) N DGLIEN ;PRF HL7 EVENT (#26.21) file IEN "RTN","DGPFHLL1",84,0) N DGRSLT ;CHK^DIE result "RTN","DGPFHLL1",85,0) ; "RTN","DGPFHLL1",86,0) S DGSTAT=$S($G(DGSTAT)]"":DGSTAT,1:"I") "RTN","DGPFHLL1",87,0) I $G(DGDFN),$D(^DPT(DGDFN,0)) D "RTN","DGPFHLL1",88,0) . S DGLIEN=$$FNDEVNT(DGDFN) "RTN","DGPFHLL1",89,0) . D CHK^DIE(26.21,.03,,DGSTAT,.DGRSLT,"DGERR") "RTN","DGPFHLL1",90,0) . Q:$D(DGERR) "RTN","DGPFHLL1",91,0) . I DGLIEN D "RTN","DGPFHLL1",92,0) . . S DGFDA(26.21,DGLIEN_",",.03)=DGSTAT "RTN","DGPFHLL1",93,0) . . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFHLL1",94,0) . E D "RTN","DGPFHLL1",95,0) . . S DGFDA(26.21,"+1,",.01)=DGDFN "RTN","DGPFHLL1",96,0) . . S DGFDA(26.21,"+1,",.02)=$$NOW^XLFDT() "RTN","DGPFHLL1",97,0) . . S DGFDA(26.21,"+1,",.03)=DGSTAT "RTN","DGPFHLL1",98,0) . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR") "RTN","DGPFHLL1",99,0) ; "RTN","DGPFHLL1",100,0) Q "RTN","DGPFHLL1",101,0) ; "RTN","DGPFHLL1",102,0) LOCK(DGIEN) ;lock HL7 event record "RTN","DGPFHLL1",103,0) ;This function locks a single PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",104,0) ;to prevent more than one PRF query being run at a time. "RTN","DGPFHLL1",105,0) ; "RTN","DGPFHLL1",106,0) ; Input: "RTN","DGPFHLL1",107,0) ; DGIEN - IEN of PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",108,0) ; "RTN","DGPFHLL1",109,0) ; Output: "RTN","DGPFHLL1",110,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFHLL1",111,0) ; "RTN","DGPFHLL1",112,0) I $G(DGIEN) L +^DGPF(26.21,DGIEN):2 "RTN","DGPFHLL1",113,0) ; "RTN","DGPFHLL1",114,0) Q $T "RTN","DGPFHLL1",115,0) ; "RTN","DGPFHLL1",116,0) UNLOCK(DGIEN) ;unlock HL7 event record "RTN","DGPFHLL1",117,0) ;This procedure releases a lock on a PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",118,0) ;created by $$LOCK. "RTN","DGPFHLL1",119,0) ; "RTN","DGPFHLL1",120,0) ; Input: "RTN","DGPFHLL1",121,0) ; DGIEN - IEN of PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",122,0) ; "RTN","DGPFHLL1",123,0) ; Output: "RTN","DGPFHLL1",124,0) ; "RTN","DGPFHLL1",125,0) I $G(DGIEN) L -^DGPF(26.21,DGIEN) "RTN","DGPFHLL1",126,0) Q "RTN","DGPFHLL1",127,0) ; "RTN","DGPFHLL1",128,0) ISINCOMP(DGIEN) ;is the HL7 event status INCOMPLETE? "RTN","DGPFHLL1",129,0) ; "RTN","DGPFHLL1",130,0) ; Input: "RTN","DGPFHLL1",131,0) ; DGIEN - IEN of PRF HL7 EVENT (#26.21) file record "RTN","DGPFHLL1",132,0) ; "RTN","DGPFHLL1",133,0) ; Output: "RTN","DGPFHLL1",134,0) ; Function value - return "1" when status is INCOMPLETE; "RTN","DGPFHLL1",135,0) ; otherwise return "0". "RTN","DGPFHLL1",136,0) ; "RTN","DGPFHLL1",137,0) Q $D(^DGPF(26.21,"ASTAT","I",+$G(DGIEN))) "RTN","DGPFHLQ") 0^12^B44511391 "RTN","DGPFHLQ",1,0) DGPFHLQ ;ALB/RPM - PRF HL7 QRY/ORF PROCESSING ; 1/23/03 "RTN","DGPFHLQ",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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)]"",$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($G(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=261130 ;unable to retrieve existing assignments "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","DGPFHLQ3") 0^13^B3002263 "RTN","DGPFHLQ3",1,0) DGPFHLQ3 ;ALB/RPM - PRF HL7 QRY PROCESSING ; 12/13/04 "RTN","DGPFHLQ3",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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) MSH(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ3",39,0) ; "RTN","DGPFHLQ3",40,0) ; Input: "RTN","DGPFHLQ3",41,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",42,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",43,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",44,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",45,0) ; "RTN","DGPFHLQ3",46,0) ; Output: "RTN","DGPFHLQ3",47,0) ; DGQRY - array of ORF results "RTN","DGPFHLQ3",48,0) ; "SNDFAC" - sending facility "RTN","DGPFHLQ3",49,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLQ3",50,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLQ3",51,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",52,0) ; "RTN","DGPFHLQ3",53,0) D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGQRY,.DGERR) "RTN","DGPFHLQ3",54,0) Q "RTN","DGPFHLQ3",55,0) ; "RTN","DGPFHLQ3",56,0) QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ3",57,0) ; "RTN","DGPFHLQ3",58,0) ; Input: "RTN","DGPFHLQ3",59,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ3",60,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",61,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",62,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",63,0) ; "RTN","DGPFHLQ3",64,0) ; Output: "RTN","DGPFHLQ3",65,0) ; DGQRY("ICN") - Patient's Integrated Control Number "RTN","DGPFHLQ3",66,0) ; DGQRY("QID") - Query ID "RTN","DGPFHLQ3",67,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",68,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",69,0) ; "RTN","DGPFHLQ3",70,0) S DGQRY("QID")=$G(DGSEG(4)) "RTN","DGPFHLQ3",71,0) S DGQRY("ICN")=+$P($G(DGSEG(8)),DGCS,1) "RTN","DGPFHLQ3",72,0) Q "RTN","DGPFHLQ3",73,0) ; "RTN","DGPFHLQ3",74,0) QRF(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ3",75,0) ; This procedure is a placeholder to allow parsing loop to continue. "RTN","DGPFHLQ3",76,0) ; "RTN","DGPFHLQ3",77,0) ; Input: "RTN","DGPFHLQ3",78,0) ; DGSEG - PID segment field array "RTN","DGPFHLQ3",79,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ3",80,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ3",81,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ3",82,0) ; "RTN","DGPFHLQ3",83,0) ; Output: "RTN","DGPFHLQ3",84,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ3",85,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ3",86,0) ; "RTN","DGPFHLQ3",87,0) Q "RTN","DGPFHLQ4") 0^16^B17883143 "RTN","DGPFHLQ4",1,0) DGPFHLQ4 ;ALB/RPM - PRF HL7 ORF PROCESSING ; 12/13/04 "RTN","DGPFHLQ4",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "RTN","DGPFHLQ4",3,0) ; "RTN","DGPFHLQ4",4,0) PARSORF(DGWRK,DGHL,DGROOT,DGMSG) ;Parse ORF~R04 Message/Segments "RTN","DGPFHLQ4",5,0) ; "RTN","DGPFHLQ4",6,0) ; Input: "RTN","DGPFHLQ4",7,0) ; DGWRK - Closed root work global reference "RTN","DGPFHLQ4",8,0) ; DGHL - HL7 environment array "RTN","DGPFHLQ4",9,0) ; DGROOT - Closed root ORF results array "RTN","DGPFHLQ4",10,0) ; "RTN","DGPFHLQ4",11,0) ; Output: "RTN","DGPFHLQ4",12,0) ; DGROOT - array of ORF results "RTN","DGPFHLQ4",13,0) ; OBRsetID,assigndt,"ACTION" "RTN","DGPFHLQ4",14,0) ; OBRsetID,assigndt,"COMMENT",line# "RTN","DGPFHLQ4",15,0) ; OBRsetID,"FLAG" "RTN","DGPFHLQ4",16,0) ; OBRsetID,"NARR",line# "RTN","DGPFHLQ4",17,0) ; OBRsetID,"OWNER" "RTN","DGPFHLQ4",18,0) ; "ACKCODE" - acknowledgment code ("AA","AE","AR") "RTN","DGPFHLQ4",19,0) ; "ICN" - patient's Integrated Control Number "RTN","DGPFHLQ4",20,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLQ4",21,0) ; "MSGID" - "RTN","DGPFHLQ4",22,0) ; "QID" - query ID (DFN) "RTN","DGPFHLQ4",23,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLQ4",24,0) ; "SNDFAC" - sending facility "RTN","DGPFHLQ4",25,0) ; "RTN","DGPFHLQ4",26,0) ; DGMSG - undefined on success, array of MailMan text on failure "RTN","DGPFHLQ4",27,0) ; "RTN","DGPFHLQ4",28,0) N DGFS ;field separator "RTN","DGPFHLQ4",29,0) N DGCS ;component separator "RTN","DGPFHLQ4",30,0) N DGRS ;repitition separator "RTN","DGPFHLQ4",31,0) N DGSS ;sub-component separator "RTN","DGPFHLQ4",32,0) N DGCURLIN ;current line "RTN","DGPFHLQ4",33,0) ; "RTN","DGPFHLQ4",34,0) S DGFS=DGHL("FS") "RTN","DGPFHLQ4",35,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLQ4",36,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLQ4",37,0) S DGSS=$E(DGHL("ECH"),4) "RTN","DGPFHLQ4",38,0) S DGCURLIN=0 "RTN","DGPFHLQ4",39,0) ; "RTN","DGPFHLQ4",40,0) ;loop through the message segments and retrieve the field data "RTN","DGPFHLQ4",41,0) F D Q:'DGCURLIN "RTN","DGPFHLQ4",42,0) . N DGSEG "RTN","DGPFHLQ4",43,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLQ4",44,0) . Q:'DGCURLIN "RTN","DGPFHLQ4",45,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGSS,DGROOT,.DGMSG)") "RTN","DGPFHLQ4",46,0) Q "RTN","DGPFHLQ4",47,0) ; "RTN","DGPFHLQ4",48,0) MSH(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ4",49,0) ; "RTN","DGPFHLQ4",50,0) ; Input: "RTN","DGPFHLQ4",51,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ4",52,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",53,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",54,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",55,0) ; "RTN","DGPFHLQ4",56,0) ; Output: "RTN","DGPFHLQ4",57,0) ; DGORF - array of ORF results "RTN","DGPFHLQ4",58,0) ; "SNDFAC" - sending facility "RTN","DGPFHLQ4",59,0) ; "RCVFAC" - receiving facility "RTN","DGPFHLQ4",60,0) ; "MSGDTM" - message creation date/time in FileMan format "RTN","DGPFHLQ4",61,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",62,0) ; "RTN","DGPFHLQ4",63,0) N DGARR "RTN","DGPFHLQ4",64,0) D MSH^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR) "RTN","DGPFHLQ4",65,0) I $D(DGARR) M @DGORF=DGARR "RTN","DGPFHLQ4",66,0) Q "RTN","DGPFHLQ4",67,0) ; "RTN","DGPFHLQ4",68,0) MSA(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ4",69,0) ; "RTN","DGPFHLQ4",70,0) ; Input: "RTN","DGPFHLQ4",71,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ4",72,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",73,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",74,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",75,0) ; "RTN","DGPFHLQ4",76,0) ; Output: "RTN","DGPFHLQ4",77,0) ; DGORF - array of ORF results "RTN","DGPFHLQ4",78,0) ; "ACKCODE" - Acknowledgment code "RTN","DGPFHLQ4",79,0) ; "MSGID" - Message Control ID of the message being ACK'ed "RTN","DGPFHLQ4",80,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",81,0) ; "RTN","DGPFHLQ4",82,0) N DGARR "RTN","DGPFHLQ4",83,0) D MSA^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR) "RTN","DGPFHLQ4",84,0) I $D(DGARR) M @DGORF=DGARR "RTN","DGPFHLQ4",85,0) Q "RTN","DGPFHLQ4",86,0) ; "RTN","DGPFHLQ4",87,0) ERR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ4",88,0) ; "RTN","DGPFHLQ4",89,0) ; Input: "RTN","DGPFHLQ4",90,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ4",91,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",92,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",93,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",94,0) ; "RTN","DGPFHLQ4",95,0) ; Output: "RTN","DGPFHLQ4",96,0) ; DGORF - array of ORF results "RTN","DGPFHLQ4",97,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",98,0) ; "RTN","DGPFHLQ4",99,0) N DGARR "RTN","DGPFHLQ4",100,0) D ERR^DGPFHLU4(.DGSEG,DGCS,DGRS,DGSS,.DGARR,.DGERR) "RTN","DGPFHLQ4",101,0) I $D(DGARR) M @DGORF=DGARR "RTN","DGPFHLQ4",102,0) Q "RTN","DGPFHLQ4",103,0) ; "RTN","DGPFHLQ4",104,0) QRD(DGSEG,DGCS,DGRS,DGSS,DGQRY,DGERR) ; "RTN","DGPFHLQ4",105,0) ; "RTN","DGPFHLQ4",106,0) ; Input: "RTN","DGPFHLQ4",107,0) ; DGSEG - MSH segment field array "RTN","DGPFHLQ4",108,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",109,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",110,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",111,0) ; "RTN","DGPFHLQ4",112,0) ; Output: "RTN","DGPFHLQ4",113,0) ; DGQRY("ICN") - Patient's Integrated Control Number "RTN","DGPFHLQ4",114,0) ; DGQRY("QID") - Query ID "RTN","DGPFHLQ4",115,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",116,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ4",117,0) ; "RTN","DGPFHLQ4",118,0) S @DGQRY@("QID")=$G(DGSEG(4)) "RTN","DGPFHLQ4",119,0) S @DGQRY@("ICN")=+$P($G(DGSEG(8)),DGCS,1) "RTN","DGPFHLQ4",120,0) Q "RTN","DGPFHLQ4",121,0) ; "RTN","DGPFHLQ4",122,0) OBR(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ4",123,0) ; "RTN","DGPFHLQ4",124,0) ; Input: "RTN","DGPFHLQ4",125,0) ; DGSEG - OBR segment field array "RTN","DGPFHLQ4",126,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",127,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",128,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",129,0) ; "RTN","DGPFHLQ4",130,0) ; Output: "RTN","DGPFHLQ4",131,0) ; DGORF(setid,"FLAG") - FLAG NAME (.02) field, file #26.13 "RTN","DGPFHLQ4",132,0) ; DGORF(setid,"OWNER") - OWNER SITE (.04) field, file #26.13 "RTN","DGPFHLQ4",133,0) ; DGORF(setid,"ORIGSITE") - ORIGINATING SITE (.05) field, file #26.13 "RTN","DGPFHLQ4",134,0) ; DGORF("SETID") - OBR segment Set ID "RTN","DGPFHLQ4",135,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",136,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ4",137,0) N DGSETID ;OBR segment Set ID "RTN","DGPFHLQ4",138,0) ; "RTN","DGPFHLQ4",139,0) S (@DGORF@("SETID"),DGSETID)=+$G(DGSEG(1)) "RTN","DGPFHLQ4",140,0) I DGSETID>0 D "RTN","DGPFHLQ4",141,0) . S @DGORF@(DGSETID,"FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15," "RTN","DGPFHLQ4",142,0) . S @DGORF@(DGSETID,"OWNER")=$$IEN^XUAF4($G(DGSEG(20))) "RTN","DGPFHLQ4",143,0) . S @DGORF@(DGSETID,"ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21))) "RTN","DGPFHLQ4",144,0) Q "RTN","DGPFHLQ4",145,0) ; "RTN","DGPFHLQ4",146,0) OBX(DGSEG,DGCS,DGRS,DGSS,DGORF,DGERR) ; "RTN","DGPFHLQ4",147,0) ; "RTN","DGPFHLQ4",148,0) ; Input: "RTN","DGPFHLQ4",149,0) ; DGSEG - OBX segment field array "RTN","DGPFHLQ4",150,0) ; DGCS - HL7 component separator "RTN","DGPFHLQ4",151,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLQ4",152,0) ; DGSS - HL7 sub-component separator "RTN","DGPFHLQ4",153,0) ; "RTN","DGPFHLQ4",154,0) ; Output: "RTN","DGPFHLQ4",155,0) ; DGORF(setid,"NARR",line) - ASSIGNMENT NARRATIVE (1) field, "RTN","DGPFHLQ4",156,0) ; file #26.13 "RTN","DGPFHLQ4",157,0) ; DGORF(setid,assigndt,"ACTION") - ACTION (.03) field, "RTN","DGPFHLQ4",158,0) ; file #26.14 "RTN","DGPFHLQ4",159,0) ; DGORF(setid,assigndt,"COMMENT",line) - HISTORY COMMENTS (1) field, "RTN","DGPFHLQ4",160,0) ; file #26.14 "RTN","DGPFHLQ4",161,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLQ4",162,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLQ4",163,0) ; "RTN","DGPFHLQ4",164,0) N DGADT ;assignment date "RTN","DGPFHLQ4",165,0) N DGI "RTN","DGPFHLQ4",166,0) N DGLINE ;text line counter "RTN","DGPFHLQ4",167,0) N DGRSLT "RTN","DGPFHLQ4",168,0) N DGSETID ;OBR segment Set ID "RTN","DGPFHLQ4",169,0) ; "RTN","DGPFHLQ4",170,0) S DGSETID=+$G(@DGORF@("SETID")) "RTN","DGPFHLQ4",171,0) Q:(DGSETID'>0) "RTN","DGPFHLQ4",172,0) ; "RTN","DGPFHLQ4",173,0) ; Narrative Observation Identifier "RTN","DGPFHLQ4",174,0) I $P(DGSEG(3),DGCS,1)="N" D "RTN","DGPFHLQ4",175,0) . S DGLINE=$O(@DGORF@(DGSETID,"NARR",""),-1) "RTN","DGPFHLQ4",176,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLQ4",177,0) . . S @DGORF@(DGSETID,"NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLQ4",178,0) ; "RTN","DGPFHLQ4",179,0) ; Status Observation Identifier "RTN","DGPFHLQ4",180,0) I $P(DGSEG(3),DGCS,1)="S" D "RTN","DGPFHLQ4",181,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L") "RTN","DGPFHLQ4",182,0) . Q:(+DGADT'>0) "RTN","DGPFHLQ4",183,0) . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT) "RTN","DGPFHLQ4",184,0) . S @DGORF@(DGSETID,DGADT,"ACTION")=+DGRSLT "RTN","DGPFHLQ4",185,0) ; "RTN","DGPFHLQ4",186,0) ; Comment Observation Identifier "RTN","DGPFHLQ4",187,0) I $P(DGSEG(3),DGCS,1)="C" D "RTN","DGPFHLQ4",188,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L") "RTN","DGPFHLQ4",189,0) . Q:(+DGADT'>0) "RTN","DGPFHLQ4",190,0) . S DGLINE=$O(@DGORF@(DGSETID,DGADT,"COMMENT",""),-1) "RTN","DGPFHLQ4",191,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLQ4",192,0) . . S @DGORF@(DGSETID,DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLQ4",193,0) Q "RTN","DGPFHLR") 0^4^B69390340 "RTN","DGPFHLR",1,0) DGPFHLR ;ALB/RPM - PRF HL7 RECEIVE DRIVERS ; 8/14/06 12:01pm "RTN","DGPFHLR",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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 DGORU "RTN","DGPFHLR",72,0) N DGSEGERR "RTN","DGPFHLR",73,0) N DGSTOERR ;store error array "RTN","DGPFHLR",74,0) N DGACKTYP "RTN","DGPFHLR",75,0) ; "RTN","DGPFHLR",76,0) S DGORU=$NA(^TMP("DGPF",$J)) "RTN","DGPFHLR",77,0) K @DGORU "RTN","DGPFHLR",78,0) D PARSORU^DGPFHLU(DGWRK,.DGHL,DGORU,.DGSEGERR) "RTN","DGPFHLR",79,0) ; "RTN","DGPFHLR",80,0) I '$D(DGSEGERR),$$STOORU(DGORU,.DGSTOERR) D "RTN","DGPFHLR",81,0) . S DGACKTYP="AA" "RTN","DGPFHLR",82,0) E D "RTN","DGPFHLR",83,0) . S DGACKTYP="AE" "RTN","DGPFHLR",84,0) ; "RTN","DGPFHLR",85,0) D SNDACK^DGPFHLS(DGACKTYP,DGMIEN,.DGHL,.DGSEGERR,.DGSTOERR) "RTN","DGPFHLR",86,0) ; "RTN","DGPFHLR",87,0) ;cleanup "RTN","DGPFHLR",88,0) K @DGORU "RTN","DGPFHLR",89,0) Q "RTN","DGPFHLR",90,0) ; "RTN","DGPFHLR",91,0) STOORU(DGORU,DGERR) ;store ORU data array "RTN","DGPFHLR",92,0) ; "RTN","DGPFHLR",93,0) ; Input: "RTN","DGPFHLR",94,0) ; DGORU - parsed ORU segment data array "RTN","DGPFHLR",95,0) ; "RTN","DGPFHLR",96,0) ; Output: "RTN","DGPFHLR",97,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFHLR",98,0) ; DGERR - defined on failure "RTN","DGPFHLR",99,0) ; "RTN","DGPFHLR",100,0) N DGADT ;assignment date "RTN","DGPFHLR",101,0) N DGCNT ;count of assignment histories sent "RTN","DGPFHLR",102,0) N DGPFA ;assignment data array "RTN","DGPFHLR",103,0) N DGPFAH ;assignment history data array "RTN","DGPFHLR",104,0) N DGSINGLE ;flag to indicate a single history update "RTN","DGPFHLR",105,0) ; "RTN","DGPFHLR",106,0) ; "RTN","DGPFHLR",107,0) S DGPFA("SNDFAC")=$G(@DGORU@("SNDFAC")) "RTN","DGPFHLR",108,0) S DGPFA("DFN")=$G(@DGORU@("DFN")) "RTN","DGPFHLR",109,0) S DGPFA("FLAG")=$G(@DGORU@("FLAG")) "RTN","DGPFHLR",110,0) ; "RTN","DGPFHLR",111,0) ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop "RTN","DGPFHLR",112,0) S DGPFA("STATUS")="" "RTN","DGPFHLR",113,0) S DGPFA("OWNER")=$G(@DGORU@("OWNER")) "RTN","DGPFHLR",114,0) S DGPFA("ORIGSITE")=$G(@DGORU@("ORIGSITE")) "RTN","DGPFHLR",115,0) M DGPFA("NARR")=@DGORU@("NARR") "RTN","DGPFHLR",116,0) ; "RTN","DGPFHLR",117,0) ;count number of assignment histories sent "RTN","DGPFHLR",118,0) S (DGADT,DGCNT)=0 "RTN","DGPFHLR",119,0) F S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT S DGCNT=DGCNT+1 "RTN","DGPFHLR",120,0) S DGSINGLE=$S(DGCNT>1:0,1:1) "RTN","DGPFHLR",121,0) S DGADT=0 "RTN","DGPFHLR",122,0) ; "RTN","DGPFHLR",123,0) ;process only the last history action when assignment already exists "RTN","DGPFHLR",124,0) I 'DGSINGLE,$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG")) D "RTN","DGPFHLR",125,0) . S DGADT=+$O(@DGORU@($O(@DGORU@(9999999.999999),-1)),-1) "RTN","DGPFHLR",126,0) . S DGSINGLE=1 "RTN","DGPFHLR",127,0) ; "RTN","DGPFHLR",128,0) F S DGADT=$O(@DGORU@(DGADT)) Q:'DGADT D Q:$D(DGERR) "RTN","DGPFHLR",129,0) . N DGPFAH ;assignment history data array "RTN","DGPFHLR",130,0) . ; "RTN","DGPFHLR",131,0) . S DGPFAH("ASSIGNDT")=DGADT "RTN","DGPFHLR",132,0) . S DGPFAH("ACTION")=$G(@DGORU@(DGADT,"ACTION")) "RTN","DGPFHLR",133,0) . S DGPFAH("ENTERBY")=.5 ;POSTMASTER "RTN","DGPFHLR",134,0) . S DGPFAH("APPRVBY")=.5 ;POSTMASTER "RTN","DGPFHLR",135,0) . M DGPFAH("COMMENT")=@DGORU@(DGADT,"COMMENT") "RTN","DGPFHLR",136,0) . ; "RTN","DGPFHLR",137,0) . ;calculate the assignment STATUS from the ACTION "RTN","DGPFHLR",138,0) . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION")) "RTN","DGPFHLR",139,0) . ;validate before filing for single updates and new assignments "RTN","DGPFHLR",140,0) . I DGSINGLE!(DGPFAH("ACTION")=1) D "RTN","DGPFHLR",141,0) . . I $$STOHL7^DGPFAA3(.DGPFA,.DGPFAH,"DGERR") "RTN","DGPFHLR",142,0) . ;otherwise, just file it "RTN","DGPFHLR",143,0) . E D "RTN","DGPFHLR",144,0) . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR) "RTN","DGPFHLR",145,0) ; "RTN","DGPFHLR",146,0) ;convert dialog to dialog code "RTN","DGPFHLR",147,0) I $D(DGERR) S DGERR=$G(DGERR("DIERR",1)) "RTN","DGPFHLR",148,0) ; "RTN","DGPFHLR",149,0) Q '$D(DGERR) "RTN","DGPFHLR",150,0) ; "RTN","DGPFHLR",151,0) RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01) "RTN","DGPFHLR",152,0) ; "RTN","DGPFHLR",153,0) ; Input: "RTN","DGPFHLR",154,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",155,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",156,0) ; DGHL - HL environment array "RTN","DGPFHLR",157,0) ; "RTN","DGPFHLR",158,0) ; Output: "RTN","DGPFHLR",159,0) ; none "RTN","DGPFHLR",160,0) ; "RTN","DGPFHLR",161,0) N DGACK ;ACK data array "RTN","DGPFHLR",162,0) N DGERR ;error array "RTN","DGPFHLR",163,0) N DGLIEN ;HL7 transmission log IEN "RTN","DGPFHLR",164,0) ; "RTN","DGPFHLR",165,0) D PARSACK^DGPFHLU4(DGWRK,.DGHL,.DGACK,.DGERR) "RTN","DGPFHLR",166,0) S DGLIEN=$$FNDLOG^DGPFHLL(26.17,$G(DGACK("MSGID"))) "RTN","DGPFHLR",167,0) Q:'DGLIEN "RTN","DGPFHLR",168,0) ; "RTN","DGPFHLR",169,0) I $G(DGACK("ACKCODE"))="AA" D "RTN","DGPFHLR",170,0) . D STOSTAT^DGPFHLL(26.17,DGLIEN,"A",.DGERR) "RTN","DGPFHLR",171,0) E D "RTN","DGPFHLR",172,0) . ;update transmission log status (REJECTED) and process error "RTN","DGPFHLR",173,0) . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RJ",.DGERR) "RTN","DGPFHLR",174,0) . D PROCERR^DGPFHLU5(DGLIEN,.DGACK,.DGERR) "RTN","DGPFHLR",175,0) Q "RTN","DGPFHLR",176,0) ; "RTN","DGPFHLR",177,0) RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02) "RTN","DGPFHLR",178,0) ; "RTN","DGPFHLR",179,0) ; Input: "RTN","DGPFHLR",180,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",181,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",182,0) ; DGHL - HL environment array "RTN","DGPFHLR",183,0) ; "RTN","DGPFHLR",184,0) ; Output: "RTN","DGPFHLR",185,0) ; none "RTN","DGPFHLR",186,0) ; "RTN","DGPFHLR",187,0) N DGDFN "RTN","DGPFHLR",188,0) N DGDFNERR "RTN","DGPFHLR",189,0) N DGQRY "RTN","DGPFHLR",190,0) N DGQRYERR "RTN","DGPFHLR",191,0) N DGSEGERR "RTN","DGPFHLR",192,0) ; "RTN","DGPFHLR",193,0) D PARSQRY^DGPFHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR) "RTN","DGPFHLR",194,0) S DGDFN=$$GETDFN^DGPFUT2(DGQRY("ICN"),"DGDFNERR") "RTN","DGPFHLR",195,0) I DGDFN'>0,$G(DGDFNERR("DIERR",1))]"" D "RTN","DGPFHLR",196,0) . S DGQRYERR=DGDFNERR("DIERR",1) "RTN","DGPFHLR",197,0) D SNDORF^DGPFHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR) "RTN","DGPFHLR",198,0) Q "RTN","DGPFHLR",199,0) ; "RTN","DGPFHLR",200,0) RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R04) "RTN","DGPFHLR",201,0) ; "RTN","DGPFHLR",202,0) ; Input: "RTN","DGPFHLR",203,0) ; DGWRK - name of work global containing segments "RTN","DGPFHLR",204,0) ; DGMIEN - IEN of message entry in file #773 "RTN","DGPFHLR",205,0) ; DGHL - HL environment array "RTN","DGPFHLR",206,0) ; "RTN","DGPFHLR",207,0) ; Output: "RTN","DGPFHLR",208,0) ; none "RTN","DGPFHLR",209,0) ; "RTN","DGPFHLR",210,0) N DGDFN ;pointer to PATIENT (#2) file "RTN","DGPFHLR",211,0) N DGLIEN ;HL7 query log IEN "RTN","DGPFHLR",212,0) N DGORF ;ORF data array root "RTN","DGPFHLR",213,0) N DGERR ;parser error array "RTN","DGPFHLR",214,0) N DGSTAT ;query log status "RTN","DGPFHLR",215,0) ; "RTN","DGPFHLR",216,0) S DGORF=$NA(^TMP("DGPF",$J)) "RTN","DGPFHLR",217,0) K @DGORF "RTN","DGPFHLR",218,0) D PARSORF^DGPFHLQ4(DGWRK,.DGHL,DGORF,.DGERR) "RTN","DGPFHLR",219,0) S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN"))) "RTN","DGPFHLR",220,0) ; "RTN","DGPFHLR",221,0) ;successful query "RTN","DGPFHLR",222,0) I $G(@DGORF@("ACKCODE"))="AA" D "RTN","DGPFHLR",223,0) . S DGSTAT=$S(+$O(@DGORF@(0))>0:"A",1:"AN") "RTN","DGPFHLR",224,0) . ; "RTN","DGPFHLR",225,0) . ;REJECT when filer fails; otherwise mark event as COMPLETE "RTN","DGPFHLR",226,0) . I '$$STOORF(DGDFN,DGORF) D "RTN","DGPFHLR",227,0) . . S DGSTAT="RJ" "RTN","DGPFHLR",228,0) . . S DGERR($O(DGERR(""),-1)+1)=261120 ;Unable to file "RTN","DGPFHLR",229,0) . E D STOEVNT^DGPFHLL1(DGDFN,"C") "RTN","DGPFHLR",230,0) ; "RTN","DGPFHLR",231,0) ;failed query "RTN","DGPFHLR",232,0) I $G(@DGORF@("ACKCODE"))'="AA" S DGSTAT="RJ" "RTN","DGPFHLR",233,0) ; "RTN","DGPFHLR",234,0) ;find and update query log status "RTN","DGPFHLR",235,0) S DGLIEN=$$FNDLOG^DGPFHLL(26.19,$G(@DGORF@("MSGID"))) "RTN","DGPFHLR",236,0) I DGLIEN D STOSTAT^DGPFHLL(26.19,DGLIEN,DGSTAT,.DGERR) "RTN","DGPFHLR",237,0) ; "RTN","DGPFHLR",238,0) ;purge PRF HL7 QUERY LOG when status is COMPLETE "RTN","DGPFHLR",239,0) I $$GETSTAT^DGPFHLL1(DGDFN)="C" D PRGQLOG^DGPFHLL($$FNDEVNT^DGPFHLL1(DGDFN)) "RTN","DGPFHLR",240,0) ; "RTN","DGPFHLR",241,0) ;cleanup "RTN","DGPFHLR",242,0) K @DGORF "RTN","DGPFHLR",243,0) Q "RTN","DGPFHLR",244,0) ; "RTN","DGPFHLR",245,0) STOORF(DGDFN,DGORF,DGERR) ;store ORF data "RTN","DGPFHLR",246,0) ; "RTN","DGPFHLR",247,0) ; Input: "RTN","DGPFHLR",248,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFHLR",249,0) ; DGORF - parsed ORF segments data array "RTN","DGPFHLR",250,0) ; "RTN","DGPFHLR",251,0) ; Output: "RTN","DGPFHLR",252,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFHLR",253,0) ; DGERR - defined on failure "RTN","DGPFHLR",254,0) ; "RTN","DGPFHLR",255,0) N DGADT ;activity date ("ASSIGNDT") "RTN","DGPFHLR",256,0) N DGPFA ;assignment data array "RTN","DGPFHLR",257,0) N DGPFAH ;assignment history data array "RTN","DGPFHLR",258,0) N DGSET ;set id to represent a single PRF assignment "RTN","DGPFHLR",259,0) ; "RTN","DGPFHLR",260,0) ; "RTN","DGPFHLR",261,0) S DGSET=0 "RTN","DGPFHLR",262,0) F S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET D "RTN","DGPFHLR",263,0) . N DGPFA ;assignment data array "RTN","DGPFHLR",264,0) . ; "RTN","DGPFHLR",265,0) . S DGPFA("DFN")=DGDFN "RTN","DGPFHLR",266,0) . S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG")) "RTN","DGPFHLR",267,0) . Q:DGPFA("FLAG")']"" "RTN","DGPFHLR",268,0) . ; "RTN","DGPFHLR",269,0) . ;prevent overwriting existing assignments "RTN","DGPFHLR",270,0) . Q:$$FNDASGN^DGPFAA(DGPFA("DFN"),DGPFA("FLAG")) "RTN","DGPFHLR",271,0) . ; "RTN","DGPFHLR",272,0) . ;init STATUS as a placeholder, $$STATUS^DGPFUT sets value in loop "RTN","DGPFHLR",273,0) . S DGPFA("STATUS")="" "RTN","DGPFHLR",274,0) . S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER")) "RTN","DGPFHLR",275,0) . S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE")) "RTN","DGPFHLR",276,0) . M DGPFA("NARR")=@DGORF@(DGSET,"NARR") "RTN","DGPFHLR",277,0) . S DGADT=0 ;each DGADT represents a single PRF history action "RTN","DGPFHLR",278,0) . F S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT D Q:$D(DGERR) "RTN","DGPFHLR",279,0) . . N DGPFAH ;assignment history data array "RTN","DGPFHLR",280,0) . . ; "RTN","DGPFHLR",281,0) . . S DGPFAH("ASSIGNDT")=DGADT "RTN","DGPFHLR",282,0) . . S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION")) "RTN","DGPFHLR",283,0) . . S DGPFAH("ENTERBY")=.5 ;POSTMASTER "RTN","DGPFHLR",284,0) . . S DGPFAH("APPRVBY")=.5 ;POSTMASTER "RTN","DGPFHLR",285,0) . . M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT") "RTN","DGPFHLR",286,0) . . ; "RTN","DGPFHLR",287,0) . . ;calculate the assignment STATUS from the ACTION "RTN","DGPFHLR",288,0) . . S DGPFA("STATUS")=$$STATUS^DGPFUT(DGPFAH("ACTION")) "RTN","DGPFHLR",289,0) . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGERR) "RTN","DGPFHLR",290,0) Q '$D(DGERR) "RTN","DGPFHLRT") 0^30^B4258248 "RTN","DGPFHLRT",1,0) DGPFHLRT ;ALB/RPM - PRF HL7 MESSAGE RETRANSMIT ; 7/18/06 10:49am "RTN","DGPFHLRT",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "RTN","DGPFHLRT",3,0) ;This routine generates a QRY~R02 HL7 message for all Incomplete "RTN","DGPFHLRT",4,0) ;status PRF HL7 EVENT (#26.21) file patient query records. "RTN","DGPFHLRT",5,0) ; "RTN","DGPFHLRT",6,0) Q ;no direct entry "RTN","DGPFHLRT",7,0) ; "RTN","DGPFHLRT",8,0) RUNQRY ;Generate new PRF QRY~R02 HL7 Query for a patient "RTN","DGPFHLRT",9,0) ;This procedure scans all entries in the ASTAT index of the PRF HL7 "RTN","DGPFHLRT",10,0) ;EVENT (#26.21) file, looking for INCOMPLETE status HL7 query records "RTN","DGPFHLRT",11,0) ; "RTN","DGPFHLRT",12,0) N DGASGN ;array of Category I assignment ien's "RTN","DGPFHLRT",13,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFHLRT",14,0) N DGLIEN ;PRF HL7 EVENT (#26.21) file IEN "RTN","DGPFHLRT",15,0) N DGPFL ;array of event data fields "RTN","DGPFHLRT",16,0) ; "RTN","DGPFHLRT",17,0) S DGLIEN=0 "RTN","DGPFHLRT",18,0) F S DGLIEN=$O(^DGPF(26.21,"ASTAT","I",DGLIEN)) Q:'DGLIEN D "RTN","DGPFHLRT",19,0) . K DGPFL,DGASGN "RTN","DGPFHLRT",20,0) . Q:'$$GETEVNT^DGPFHLL1(DGLIEN,.DGPFL) "RTN","DGPFHLRT",21,0) . ; "RTN","DGPFHLRT",22,0) . Q:($P($G(DGPFL("STAT")),U,1)'="I") "RTN","DGPFHLRT",23,0) . ; "RTN","DGPFHLRT",24,0) . S DGDFN=$P($G(DGPFL("DFN")),U,1) "RTN","DGPFHLRT",25,0) . Q:DGDFN']"" "RTN","DGPFHLRT",26,0) . ; "RTN","DGPFHLRT",27,0) . ;If patient already has the total possible number of Cat I flags, "RTN","DGPFHLRT",28,0) . ;then mark the query event file as COMPLETE and quit. "RTN","DGPFHLRT",29,0) . I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1)=$$CNTRECS^DGPFUT1(26.15) D Q "RTN","DGPFHLRT",30,0) . . D STOEVNT^DGPFHLL1(DGDFN,"C") "RTN","DGPFHLRT",31,0) . ; "RTN","DGPFHLRT",32,0) . ;mark the event in ERROR when attempt limit is reached and quit "RTN","DGPFHLRT",33,0) . I $$QRYCNT(DGLIEN)+1>$$TRYLIMIT() D Q "RTN","DGPFHLRT",34,0) . . D STOEVNT^DGPFHLL1(DGDFN,"E") "RTN","DGPFHLRT",35,0) . ; "RTN","DGPFHLRT",36,0) . ;run query in deferred mode "RTN","DGPFHLRT",37,0) . I $$SNDQRY^DGPFHLS(DGDFN,2) "RTN","DGPFHLRT",38,0) . ; "RTN","DGPFHLRT",39,0) Q "RTN","DGPFHLRT",40,0) ; "RTN","DGPFHLRT",41,0) QRYCNT(DGEVNT) ;get number of logged query attempts "RTN","DGPFHLRT",42,0) ;This function counts the number of entries in the PRF HL7 QUERY LOG "RTN","DGPFHLRT",43,0) ;(#26.19) file for a given PRF HL7 EVENT. "RTN","DGPFHLRT",44,0) ; "RTN","DGPFHLRT",45,0) ; Input: "RTN","DGPFHLRT",46,0) ; DGEVNT - pointer to PRF HL7 EVENT (#26.21) file "RTN","DGPFHLRT",47,0) ; "RTN","DGPFHLRT",48,0) ; Function value - number of logged query attempts "RTN","DGPFHLRT",49,0) ; "RTN","DGPFHLRT",50,0) N DGCNT "RTN","DGPFHLRT",51,0) N DGLIEN "RTN","DGPFHLRT",52,0) ; "RTN","DGPFHLRT",53,0) S DGEVNT=+$G(DGEVNT) "RTN","DGPFHLRT",54,0) S DGCNT=0 "RTN","DGPFHLRT",55,0) S DGLIEN=0 "RTN","DGPFHLRT",56,0) F S DGLIEN=$O(^DGPF(26.19,"C",DGEVNT,DGLIEN)) Q:'DGLIEN D "RTN","DGPFHLRT",57,0) . S DGCNT=DGCNT+1 "RTN","DGPFHLRT",58,0) ; "RTN","DGPFHLRT",59,0) Q DGCNT "RTN","DGPFHLRT",60,0) ; "RTN","DGPFHLRT",61,0) TRYLIMIT() ;get PRF Query Try Limit parameter value "RTN","DGPFHLRT",62,0) ; "RTN","DGPFHLRT",63,0) ; Input: none "RTN","DGPFHLRT",64,0) ; "RTN","DGPFHLRT",65,0) ; Output: "RTN","DGPFHLRT",66,0) ; Function value - DGPF QUERY TRY LIMIT parameter [DEFAULT=5] "RTN","DGPFHLRT",67,0) ; "RTN","DGPFHLRT",68,0) N DGVAL "RTN","DGPFHLRT",69,0) S DGVAL=$$GET^XPAR("PKG","DGPF QUERY TRY LIMIT",1,"Q") "RTN","DGPFHLRT",70,0) Q $S(DGVAL="":5,1:DGVAL) "RTN","DGPFHLS") 0^5^B55420041 "RTN","DGPFHLS",1,0) DGPFHLS ;ALB/RPM - PRF HL7 SEND DRIVERS ; 7/31/06 10:10am "RTN","DGPFHLS",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "RTN","DGPFHLS",3,0) ; "RTN","DGPFHLS",4,0) SNDORU(DGPFIEN,DGPFHARR,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) ; DGPFHARR - (optional) array of assignment history IENs from the "RTN","DGPFHLS",17,0) ; PRF ASSIGNMENT HISTORY (#26.14) file to "RTN","DGPFHLS",18,0) ; include in ORU. "RTN","DGPFHLS",19,0) ; format: DGPFHARR(assignment_date_time)=IEN "RTN","DGPFHLS",20,0) ; assignment_date_time in FM format "RTN","DGPFHLS",21,0) ; [default = $$GETLAST^DGPFAAH(DGPFIEN)] "RTN","DGPFHLS",22,0) ; DGFAC - (optional) array of message destination facilities "RTN","DGPFHLS",23,0) ; passed by reference "RTN","DGPFHLS",24,0) ; format: DGFAC(#)=station# "RTN","DGPFHLS",25,0) ; "RTN","DGPFHLS",26,0) ; Output: "RTN","DGPFHLS",27,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLS",28,0) ; "RTN","DGPFHLS",29,0) N DGHLEID ;event protocol ID "RTN","DGPFHLS",30,0) N DGHL ;VistA HL7 environment array "RTN","DGPFHLS",31,0) N DGHLROOT ;message array location "RTN","DGPFHLS",32,0) N DGPFA ;assignment data array "RTN","DGPFHLS",33,0) N DGPFAH ;assignment history data array "RTN","DGPFHLS",34,0) N DGPFHIEN ;assignment history IEN "RTN","DGPFHLS",35,0) N DGRSLT ;function value "RTN","DGPFHLS",36,0) ; "RTN","DGPFHLS",37,0) S DGRSLT=0 "RTN","DGPFHLS",38,0) S DGHLROOT=$NA(^TMP("PRFORU",$J)) "RTN","DGPFHLS",39,0) K @DGHLROOT "RTN","DGPFHLS",40,0) ; "RTN","DGPFHLS",41,0) I +$G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D "RTN","DGPFHLS",42,0) . ; "RTN","DGPFHLS",43,0) . ;retrieve assignment record "RTN","DGPFHLS",44,0) . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA) "RTN","DGPFHLS",45,0) . ; "RTN","DGPFHLS",46,0) . ;set up default history IEN array "RTN","DGPFHLS",47,0) . I '$O(DGPFHARR(0)) D "RTN","DGPFHLS",48,0) . . N DGPFAH "RTN","DGPFHLS",49,0) . . S DGPFHIEN=$$GETLAST^DGPFAAH(DGPFIEN) "RTN","DGPFHLS",50,0) . . Q:'$$GETHIST^DGPFAAH(DGPFHIEN,.DGPFAH) "RTN","DGPFHLS",51,0) . . S DGPFHARR(+$G(DGPFAH("ASSIGNDT")))=DGPFHIEN "RTN","DGPFHLS",52,0) . Q:'$O(DGPFHARR(0)) "RTN","DGPFHLS",53,0) . ; "RTN","DGPFHLS",54,0) . ;retrieve treating facilities when no destination is provided "RTN","DGPFHLS",55,0) . I $G(DGFAC(1))'>0 D TFL^VAFCTFU1(.DGFAC,+$G(DGPFA("DFN"))) "RTN","DGPFHLS",56,0) . Q:$G(DGFAC(1))'>0 "RTN","DGPFHLS",57,0) . ; "RTN","DGPFHLS",58,0) . ;initialize VistA HL7 environment "RTN","DGPFHLS",59,0) . S DGHLEID=$$INIT^DGPFHLUT("DGPF PRF ORU/R01 EVENT",.DGHL) "RTN","DGPFHLS",60,0) . Q:'DGHLEID "RTN","DGPFHLS",61,0) . ; "RTN","DGPFHLS",62,0) . ;build ORU segments array "RTN","DGPFHLS",63,0) . S DGPFHIEN=$$BLDORU^DGPFHLU(.DGPFA,.DGPFHARR,.DGHL,DGHLROOT) "RTN","DGPFHLS",64,0) . Q:'DGPFHIEN "RTN","DGPFHLS",65,0) . ; "RTN","DGPFHLS",66,0) . ;transmit and log messages "RTN","DGPFHLS",67,0) . Q:'$$XMIT^DGPFHLU6(DGPFHIEN,DGHLEID,.DGFAC,DGHLROOT,.DGHL) "RTN","DGPFHLS",68,0) . ; "RTN","DGPFHLS",69,0) . ;success "RTN","DGPFHLS",70,0) . S DGRSLT=1 "RTN","DGPFHLS",71,0) ; "RTN","DGPFHLS",72,0) ;cleanup "RTN","DGPFHLS",73,0) K @DGHLROOT "RTN","DGPFHLS",74,0) Q DGRSLT "RTN","DGPFHLS",75,0) ; "RTN","DGPFHLS",76,0) SNDACK(DGACKTYP,DGMIEN,DGHL,DGSEGERR,DGSTOERR) ;Send ACK Message Type (ACK~R01) "RTN","DGPFHLS",77,0) ;This procedure assumes the the VistA HL7 environment is providing the "RTN","DGPFHLS",78,0) ;environment variables and will produce a fatal error if they are "RTN","DGPFHLS",79,0) ;missing. "RTN","DGPFHLS",80,0) ; "RTN","DGPFHLS",81,0) ; Input: "RTN","DGPFHLS",82,0) ; DGACKTYP - (required) ACK message type ("AA","AE") "RTN","DGPFHLS",83,0) ; DGMIEN - (required) IEN of message entry in file #773 "RTN","DGPFHLS",84,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLS",85,0) ; DGSEGERR - (optional) Errors found during parsing "RTN","DGPFHLS",86,0) ; DGSTOERR - (optional) Errors during data storage "RTN","DGPFHLS",87,0) ; "RTN","DGPFHLS",88,0) ; Output: "RTN","DGPFHLS",89,0) ; none "RTN","DGPFHLS",90,0) ; "RTN","DGPFHLS",91,0) N DGHLROOT "RTN","DGPFHLS",92,0) N DGHLERR "RTN","DGPFHLS",93,0) ; "RTN","DGPFHLS",94,0) Q:($G(DGACKTYP)']"") "RTN","DGPFHLS",95,0) Q:('+$G(DGMIEN)) "RTN","DGPFHLS",96,0) ; "RTN","DGPFHLS",97,0) S DGHLROOT=$NA(^TMP("HLA",$J)) "RTN","DGPFHLS",98,0) K @DGHLROOT "RTN","DGPFHLS",99,0) ; "RTN","DGPFHLS",100,0) ;build ACK segments array "RTN","DGPFHLS",101,0) I $$BLDACK^DGPFHLU4(DGACKTYP,DGHLROOT,.DGHL,.DGSEGERR,.DGSTOERR) D "RTN","DGPFHLS",102,0) . ; "RTN","DGPFHLS",103,0) . ;generate the message "RTN","DGPFHLS",104,0) . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR) "RTN","DGPFHLS",105,0) ; "RTN","DGPFHLS",106,0) ;cleanup "RTN","DGPFHLS",107,0) K @DGHLROOT "RTN","DGPFHLS",108,0) Q "RTN","DGPFHLS",109,0) ; "RTN","DGPFHLS",110,0) SNDQRY(DGDFN,DGMODE,DGFAC) ;Send QRY Message Types (QRY~R02) "RTN","DGPFHLS",111,0) ;This function transmits a PRF Query (QRY~R02) HL7 message to a given "RTN","DGPFHLS",112,0) ;patient's treating facility. "RTN","DGPFHLS",113,0) ; "RTN","DGPFHLS",114,0) ; Input: "RTN","DGPFHLS",115,0) ; DGDFN - (required) pointer to patient in PATIENT (#2) file "RTN","DGPFHLS",116,0) ; DGMODE - (optional) type of HL7 connection to use ("1" - direct "RTN","DGPFHLS",117,0) ; connection, "2" - deferred connection [default], "RTN","DGPFHLS",118,0) ; "3" - direct connection/display mode) "RTN","DGPFHLS",119,0) ; DGFAC - (optional) station number of query destination. "RTN","DGPFHLS",120,0) ; [default - most recent unqueried treating facility] "RTN","DGPFHLS",121,0) ; "RTN","DGPFHLS",122,0) ; Output: "RTN","DGPFHLS",123,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLS",124,0) ; "RTN","DGPFHLS",125,0) N DGEVNT "RTN","DGPFHLS",126,0) N DGHLROOT "RTN","DGPFHLS",127,0) N DGHLLNK "RTN","DGPFHLS",128,0) N DGHL "RTN","DGPFHLS",129,0) N DGICN "RTN","DGPFHLS",130,0) N DGLSQ "RTN","DGPFHLS",131,0) N DGMSG "RTN","DGPFHLS",132,0) N DGMSGID "RTN","DGPFHLS",133,0) N DGNXTF "RTN","DGPFHLS",134,0) N DGRSLT "RTN","DGPFHLS",135,0) N HLL "RTN","DGPFHLS",136,0) N DGHLEID "RTN","DGPFHLS",137,0) N DGHLRSLT "RTN","DGPFHLS",138,0) ; "RTN","DGPFHLS",139,0) ;the following HL* variables are created by DIRECT^HLMA "RTN","DGPFHLS",140,0) N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN "RTN","DGPFHLS",141,0) N HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ "RTN","DGPFHLS",142,0) N HLQUIT "RTN","DGPFHLS",143,0) ; "RTN","DGPFHLS",144,0) S DGMODE=+$G(DGMODE) "RTN","DGPFHLS",145,0) S DGFAC=$G(DGFAC) "RTN","DGPFHLS",146,0) S DGRSLT=0 "RTN","DGPFHLS",147,0) S DGHLROOT=$NA(^TMP("HLS",$J)) "RTN","DGPFHLS",148,0) K @DGHLROOT "RTN","DGPFHLS",149,0) ; "RTN","DGPFHLS",150,0) I +$G(DGDFN)>0,$D(^DPT(DGDFN,0)) D "RTN","DGPFHLS",151,0) . ; "RTN","DGPFHLS",152,0) . ;ICN must be national "RTN","DGPFHLS",153,0) . Q:'$$MPIOK^DGPFUT(DGDFN,.DGICN) "RTN","DGPFHLS",154,0) . ; "RTN","DGPFHLS",155,0) . ;find event, get last site queried and next treating facility "RTN","DGPFHLS",156,0) . S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN) "RTN","DGPFHLS",157,0) . I 'DGEVNT,DGMODE'=3 D ;no event and not display? create it! "RTN","DGPFHLS",158,0) . . D STOEVNT^DGPFHLL1(DGDFN) "RTN","DGPFHLS",159,0) . . S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN) "RTN","DGPFHLS",160,0) . S DGLSQ=$$GETLSQ^DGPFHLL(DGEVNT) "RTN","DGPFHLS",161,0) . S DGNXTF=$$GETNXTF^DGPFUT(DGDFN,DGLSQ) "RTN","DGPFHLS",162,0) . ; "RTN","DGPFHLS",163,0) . ;determine treating facility institution number to query "RTN","DGPFHLS",164,0) . S DGFAC=$S(DGFAC]"":$$IEN^XUAF4(DGFAC),DGNXTF:DGNXTF,DGLSQ&('DGNXTF):$$GETNXTF^DGPFUT(DGDFN),1:0) "RTN","DGPFHLS",165,0) . ; "RTN","DGPFHLS",166,0) . ;mark query event COMPLETE and return SUCCESS when no non-local "RTN","DGPFHLS",167,0) . ;treating facilities are found and no previous queries have been run. "RTN","DGPFHLS",168,0) . I DGFAC'>0,'DGLSQ D "RTN","DGPFHLS",169,0) . . D STOEVNT^DGPFHLL1(DGDFN,"C") "RTN","DGPFHLS",170,0) . . S DGRSLT=1 "RTN","DGPFHLS",171,0) . Q:(DGFAC'>0) "RTN","DGPFHLS",172,0) . ; "RTN","DGPFHLS",173,0) . ;retrieve treating facility HL Logical Link and build HLL array "RTN","DGPFHLS",174,0) . S DGHLLNK=$$GETLINK^DGPFHLUT(DGFAC) "RTN","DGPFHLS",175,0) . Q:(DGHLLNK=0) "RTN","DGPFHLS",176,0) . S HLL("LINKS",1)="DGPF PRF ORF/R04 SUBSC"_U_DGHLLNK "RTN","DGPFHLS",177,0) . ; "RTN","DGPFHLS",178,0) . ;initialize VistA HL7 environment "RTN","DGPFHLS",179,0) . S DGHLEID=$$INIT^DGPFHLUT("DGPF PRF QRY/R02 EVENT",.DGHL) "RTN","DGPFHLS",180,0) . Q:'DGHLEID "RTN","DGPFHLS",181,0) . ; "RTN","DGPFHLS",182,0) . ;build QRY segments array "RTN","DGPFHLS",183,0) . Q:'$$BLDQRY^DGPFHLQ(DGDFN,DGICN,DGHLROOT,.DGHL) "RTN","DGPFHLS",184,0) . ; "RTN","DGPFHLS",185,0) . ;display busy message to interactive users when direct-connect "RTN","DGPFHLS",186,0) . I DGMODE=1!(DGMODE=3),$E($G(IOST),1,2)="C-" D "RTN","DGPFHLS",187,0) . . S DGMSG(1)="Attempting to connect to "_$P($$NS^XUAF4(DGFAC),U) "RTN","DGPFHLS",188,0) . . S DGMSG(2)="to search for Patient Record Flag Assignments." "RTN","DGPFHLS",189,0) . . S DGMSG(3)="This request may take sometime, please be patient ..." "RTN","DGPFHLS",190,0) . . D EN^DDIOL(.DGMSG) "RTN","DGPFHLS",191,0) . ; "RTN","DGPFHLS",192,0) . ;generate HL7 message "RTN","DGPFHLS",193,0) . I DGMODE=1!(DGMODE=3) D ;generate direct-connect HL7 message "RTN","DGPFHLS",194,0) . . D DIRECT^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"","") "RTN","DGPFHLS",195,0) . . ;The DIRECT^HLMA API contains a bug that causes the message ID "RTN","DGPFHLS",196,0) . . ;returned to be based on the HL7 MESSAGE TEXT (#772) file IEN and "RTN","DGPFHLS",197,0) . . ;not the HL7 MESSAGE ADMINISTRATION (#773) file IEN. Therefore, "RTN","DGPFHLS",198,0) . . ;the following call to $$CONVMID is required to convert the "RTN","DGPFHLS",199,0) . . ;message ID to the value stored in file #773. "RTN","DGPFHLS",200,0) . . S DGMSGID=$$CONVMID^DGPFHLUT($P(DGHLRSLT,U)) "RTN","DGPFHLS",201,0) . . I DGMODE=1,DGMSGID>0 D STOQXMIT^DGPFHLL(DGEVNT,DGMSGID,DGFAC) "RTN","DGPFHLS",202,0) . . I HLMTIEN,DGMODE'=3 D RCV^DGPFHLR "RTN","DGPFHLS",203,0) . . I DGMODE=3 D DISPLAY^DGPFHLUQ(HLMTIEN,DGHLRSLT) "RTN","DGPFHLS",204,0) . . ;success "RTN","DGPFHLS",205,0) . . I '+$P(DGHLRSLT,U,2) S DGRSLT=1 "RTN","DGPFHLS",206,0) . ; "RTN","DGPFHLS",207,0) . E D ;generate deferred HL7 message "RTN","DGPFHLS",208,0) . . D GENERATE^HLMA(DGHLEID,"GM",1,.DGHLRSLT,"","") "RTN","DGPFHLS",209,0) . . I $P(DGHLRSLT,U)>0 D STOQXMIT^DGPFHLL(DGEVNT,$P(DGHLRSLT,U),DGFAC) "RTN","DGPFHLS",210,0) . . ;success "RTN","DGPFHLS",211,0) . . I '+$P(DGHLRSLT,U,2) S DGRSLT=1 "RTN","DGPFHLS",212,0) ; "RTN","DGPFHLS",213,0) ;cleanup "RTN","DGPFHLS",214,0) K @DGHLROOT "RTN","DGPFHLS",215,0) Q DGRSLT "RTN","DGPFHLS",216,0) ; "RTN","DGPFHLS",217,0) SNDORF(DGQRY,DGMIEN,DGHL,DGDFN,DGSEGERR,DGQRYERR) ;Send ORF Message Type (ORF~R04) "RTN","DGPFHLS",218,0) ;This procedure assumes the the VistA HL7 environment is providing the "RTN","DGPFHLS",219,0) ;environment variables and will produce a fatal error if they are "RTN","DGPFHLS",220,0) ;missing. "RTN","DGPFHLS",221,0) ; "RTN","DGPFHLS",222,0) ; Input: "RTN","DGPFHLS",223,0) ; DGQRY - (required) Array of QRY parsing results "RTN","DGPFHLS",224,0) ; DGMIEN - (required) IEN of message entry in file #773 "RTN","DGPFHLS",225,0) ; DGHL - (required) HL7 environment array "RTN","DGPFHLS",226,0) ; DGDFN - (required) Pointer to patient in PATIENT (#2) file "RTN","DGPFHLS",227,0) ; DGSEGERR - (optional) Errors found during parsing "RTN","DGPFHLS",228,0) ; DGQRYERR - (optional) Errors found during query "RTN","DGPFHLS",229,0) ; "RTN","DGPFHLS",230,0) ; Output: "RTN","DGPFHLS",231,0) ; none "RTN","DGPFHLS",232,0) ; "RTN","DGPFHLS",233,0) N DGHLROOT "RTN","DGPFHLS",234,0) N DGHLERR "RTN","DGPFHLS",235,0) ; "RTN","DGPFHLS",236,0) Q:('$D(DGQRY)) "RTN","DGPFHLS",237,0) Q:('+$G(DGMIEN)) "RTN","DGPFHLS",238,0) ; "RTN","DGPFHLS",239,0) S DGHLROOT=$NA(^TMP("HLA",$J)) "RTN","DGPFHLS",240,0) K @DGHLROOT "RTN","DGPFHLS",241,0) ; "RTN","DGPFHLS",242,0) ;build ORF segments array "RTN","DGPFHLS",243,0) I $$BLDORF^DGPFHLQ(DGHLROOT,.DGHL,DGDFN,.DGQRY,.DGSEGERR,.DGQRYERR) D "RTN","DGPFHLS",244,0) . ; "RTN","DGPFHLS",245,0) . ;generate the message "RTN","DGPFHLS",246,0) . D GENACK^HLMA1(DGHL("EID"),DGMIEN,DGHL("EIDS"),"GM",1,.DGHLERR) "RTN","DGPFHLS",247,0) ; "RTN","DGPFHLS",248,0) ;cleanup "RTN","DGPFHLS",249,0) K @DGHLROOT "RTN","DGPFHLS",250,0) Q "RTN","DGPFHLU") 0^6^B34815804 "RTN","DGPFHLU",1,0) DGPFHLU ;ALB/RPM - PRF HL7 ORU/ACK PROCESSING ; 6/21/06 10:27am "RTN","DGPFHLU",2,0) ;;5.3;Registration;**425,718,650**;Aug 13, 1993;Build 3 "RTN","DGPFHLU",3,0) ; "RTN","DGPFHLU",4,0) BLDORU(DGPFA,DGHARR,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) ; DGHARR - (required) Assignment history IENs array "RTN","DGPFHLU",9,0) ; DGHL - (required) HL7 Kernel array passed by reference "RTN","DGPFHLU",10,0) ; DGROOT - (required) Closed root segment storage array name "RTN","DGPFHLU",11,0) ; "RTN","DGPFHLU",12,0) ; Output: "RTN","DGPFHLU",13,0) ; Function Value - IEN of last assignment history included in "RTN","DGPFHLU",14,0) ; message segments, 0 on failure "RTN","DGPFHLU",15,0) ; DGROOT - array of HL7 segments "RTN","DGPFHLU",16,0) ; "RTN","DGPFHLU",17,0) N DGADT ;assignment date "RTN","DGPFHLU",18,0) N DGHIEN ;function value "RTN","DGPFHLU",19,0) N DGLDT ;last assignment date "RTN","DGPFHLU",20,0) N DGPFAH ;assignment history data array "RTN","DGPFHLU",21,0) N DGSEG ;segment counter "RTN","DGPFHLU",22,0) N DGSEGSTR ;formatted segment string "RTN","DGPFHLU",23,0) N DGSET ;set id "RTN","DGPFHLU",24,0) N DGSTR ;field string "RTN","DGPFHLU",25,0) N DGTROOT ;text root "RTN","DGPFHLU",26,0) ; "RTN","DGPFHLU",27,0) S DGHIEN=0 "RTN","DGPFHLU",28,0) S DGSEG=0 "RTN","DGPFHLU",29,0) ; "RTN","DGPFHLU",30,0) I $D(DGPFA),$D(DGHARR),$G(DGROOT)]"" D "RTN","DGPFHLU",31,0) . ; "RTN","DGPFHLU",32,0) . ;build PID "RTN","DGPFHLU",33,0) . S DGSTR="1,2,3,5,7,8,19" "RTN","DGPFHLU",34,0) . S DGSEGSTR=$$EN^VAFHLPID(+DGPFA("DFN"),DGSTR,1,1) "RTN","DGPFHLU",35,0) . Q:(DGSEGSTR="") "RTN","DGPFHLU",36,0) . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",37,0) . ; "RTN","DGPFHLU",38,0) . ;build OBR "RTN","DGPFHLU",39,0) . S DGLDT=+$O(DGHARR(""),-1) ;get last assignment date "RTN","DGPFHLU",40,0) . Q:'$$GETHIST^DGPFAAH(DGHARR(DGLDT),.DGPFAH) ;load asgn hx array "RTN","DGPFHLU",41,0) . S DGSET=1 "RTN","DGPFHLU",42,0) . S DGSTR="1,4,7,20,21" "RTN","DGPFHLU",43,0) . S DGSEGSTR=$$OBR^DGPFHLU1(DGSET,.DGPFA,.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLU",44,0) . Q:(DGSEGSTR="") "RTN","DGPFHLU",45,0) . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",46,0) . ; "RTN","DGPFHLU",47,0) . ;start OBX segments "RTN","DGPFHLU",48,0) . S DGSET=0 "RTN","DGPFHLU",49,0) . ; "RTN","DGPFHLU",50,0) . ;build narrative OBX segments "RTN","DGPFHLU",51,0) . S DGTROOT="DGPFA(""NARR"")" "RTN","DGPFHLU",52,0) . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"N",.DGPFAH,.DGHL,.DGSEG,.DGSET) "RTN","DGPFHLU",53,0) . ; "RTN","DGPFHLU",54,0) . ;for each history build status & comment OBX segments "RTN","DGPFHLU",55,0) . S DGADT=0 "RTN","DGPFHLU",56,0) . F S DGADT=$O(DGHARR(DGADT)) Q:'DGADT D Q:'DGHIEN "RTN","DGPFHLU",57,0) . . N DGPFAH "RTN","DGPFHLU",58,0) . . S DGHIEN=0 "RTN","DGPFHLU",59,0) . . Q:'$$GETHIST^DGPFAAH(DGHARR(DGADT),.DGPFAH) "RTN","DGPFHLU",60,0) . . ; "RTN","DGPFHLU",61,0) . . ;build status OBX segment "RTN","DGPFHLU",62,0) . . S DGSTR="1,2,3,5,11,14" "RTN","DGPFHLU",63,0) . . S DGSET=DGSET+1 "RTN","DGPFHLU",64,0) . . S DGSEGSTR=$$OBX^DGPFHLU2(DGSET,"S","",$P($G(DGPFAH("ACTION")),U,2),.DGPFAH,DGSTR,.DGHL) "RTN","DGPFHLU",65,0) . . Q:(DGSEGSTR="") "RTN","DGPFHLU",66,0) . . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGSEGSTR "RTN","DGPFHLU",67,0) . . ; "RTN","DGPFHLU",68,0) . . ;build review comment OBX segments "RTN","DGPFHLU",69,0) . . S DGTROOT="DGPFAH(""COMMENT"")" "RTN","DGPFHLU",70,0) . . Q:'$$BLDOBXTX^DGPFHLU2(DGROOT,DGTROOT,"C",.DGPFAH,.DGHL,.DGSEG,.DGSET) "RTN","DGPFHLU",71,0) . . ; "RTN","DGPFHLU",72,0) . . ;success "RTN","DGPFHLU",73,0) . . S DGHIEN=DGHARR(DGADT) "RTN","DGPFHLU",74,0) ; "RTN","DGPFHLU",75,0) Q DGHIEN "RTN","DGPFHLU",76,0) ; "RTN","DGPFHLU",77,0) PARSORU(DGWRK,DGHL,DGROOT,DGPFERR) ;Parse ORU~R01 Message/Segments "RTN","DGPFHLU",78,0) ; "RTN","DGPFHLU",79,0) ; Input: "RTN","DGPFHLU",80,0) ; DGWRK - Closed root work global reference "RTN","DGPFHLU",81,0) ; DGHL - HL7 environment array "RTN","DGPFHLU",82,0) ; DGROOT - Closed root ORU results array name "RTN","DGPFHLU",83,0) ; "RTN","DGPFHLU",84,0) ; Output: "RTN","DGPFHLU",85,0) ; DGROOT - ORU results array "RTN","DGPFHLU",86,0) ; Subscript Field name Fld# File# "RTN","DGPFHLU",87,0) ; ----------------------- -------------------- ---- ----- "RTN","DGPFHLU",88,0) ; "SNDFAC" N/A N/A N/A "RTN","DGPFHLU",89,0) ; "DFN" PATIENT NAME .01 26.13 "RTN","DGPFHLU",90,0) ; "FLAG" FLAG NAME .02 26.13 "RTN","DGPFHLU",91,0) ; "OWNER" OWNER SITE .04 26.13 "RTN","DGPFHLU",92,0) ; "ORIGSITE" ORIGINATING SITE .05 26.13 "RTN","DGPFHLU",93,0) ; "NARR",line ASSIGNMENT NARRATIVE 1 26.13 "RTN","DGPFHLU",94,0) ; assigndt,"ACTION" ACTION .03 26.13 "RTN","DGPFHLU",95,0) ; assigndt,"COMMENT",line HISTORY COMMENTS 1 26.14 "RTN","DGPFHLU",96,0) ; DGPFERR - Undefined on success, ERR segment data array on failure "RTN","DGPFHLU",97,0) ; Format: DGPFERR(seg_id,sequence,fld_pos)=error_code "RTN","DGPFHLU",98,0) ; "RTN","DGPFHLU",99,0) N DGFS ;field separator "RTN","DGPFHLU",100,0) N DGCS ;component separator "RTN","DGPFHLU",101,0) N DGRS ;repetition separator "RTN","DGPFHLU",102,0) N DGCURLIN ;current segment line "RTN","DGPFHLU",103,0) N DGSEG ;segment field data array "RTN","DGPFHLU",104,0) N DGERR ;error processing array "RTN","DGPFHLU",105,0) ; "RTN","DGPFHLU",106,0) S DGFS=DGHL("FS") "RTN","DGPFHLU",107,0) S DGCS=$E(DGHL("ECH"),1) "RTN","DGPFHLU",108,0) S DGRS=$E(DGHL("ECH"),2) "RTN","DGPFHLU",109,0) S DGCURLIN=0 "RTN","DGPFHLU",110,0) ; "RTN","DGPFHLU",111,0) ;loop through message segments and retrieve field data "RTN","DGPFHLU",112,0) F D Q:'DGCURLIN "RTN","DGPFHLU",113,0) . N DGSEG "RTN","DGPFHLU",114,0) . S DGCURLIN=$$NXTSEG^DGPFHLUT(DGWRK,DGCURLIN,DGFS,.DGSEG) "RTN","DGPFHLU",115,0) . Q:'DGCURLIN "RTN","DGPFHLU",116,0) . D @(DGSEG("TYPE")_"(.DGSEG,DGCS,DGRS,DGROOT,.DGPFERR)") "RTN","DGPFHLU",117,0) ; "RTN","DGPFHLU",118,0) MSH(DGSEG,DGCS,DGRS,DGORU,DGERR) ; "RTN","DGPFHLU",119,0) ; "RTN","DGPFHLU",120,0) ; Input: "RTN","DGPFHLU",121,0) ; DGSEG - MSH segment field array "RTN","DGPFHLU",122,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",123,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",124,0) ; DGORU - Closed root ORU results array name "RTN","DGPFHLU",125,0) ; "RTN","DGPFHLU",126,0) ; Output: "RTN","DGPFHLU",127,0) ; DGORU - ORU results array "RTN","DGPFHLU",128,0) ; Subscript "RTN","DGPFHLU",129,0) ; --------- "RTN","DGPFHLU",130,0) ; "SNDFAC" "RTN","DGPFHLU",131,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",132,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",133,0) ; "RTN","DGPFHLU",134,0) S @DGORU@("SNDFAC")=$$IEN^XUAF4($P(DGSEG(4),DGCS,1)) "RTN","DGPFHLU",135,0) Q "RTN","DGPFHLU",136,0) ; "RTN","DGPFHLU",137,0) PID(DGSEG,DGCS,DGRS,DGORU,DGERR) ; "RTN","DGPFHLU",138,0) ; "RTN","DGPFHLU",139,0) ; Input: "RTN","DGPFHLU",140,0) ; DGSEG - PID segment field array "RTN","DGPFHLU",141,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",142,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",143,0) ; DGORU - Closed root ORU results array name "RTN","DGPFHLU",144,0) ; "RTN","DGPFHLU",145,0) ; Output: "RTN","DGPFHLU",146,0) ; DGORU - ORU results array "RTN","DGPFHLU",147,0) ; Subscript "RTN","DGPFHLU",148,0) ; --------- "RTN","DGPFHLU",149,0) ; "DFN" "RTN","DGPFHLU",150,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",151,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",152,0) ; "RTN","DGPFHLU",153,0) N DGARR "RTN","DGPFHLU",154,0) N DGDFNERR "RTN","DGPFHLU",155,0) N DGICN "RTN","DGPFHLU",156,0) ; "RTN","DGPFHLU",157,0) S DGICN=+$P(DGSEG(3),DGCS,1) "RTN","DGPFHLU",158,0) S DGARR("DFN")=$$GETDFN^DGPFUT2(DGICN,"DGDFNERR") "RTN","DGPFHLU",159,0) I 'DGARR("DFN"),$G(DGDFNERR("DIERR",1))]"" D "RTN","DGPFHLU",160,0) . S DGERR("PID",DGSEG(1),3)=DGDFNERR("DIERR",1) ;no match "RTN","DGPFHLU",161,0) ; "RTN","DGPFHLU",162,0) ;load results array "RTN","DGPFHLU",163,0) S @DGORU@("DFN")=DGARR("DFN") "RTN","DGPFHLU",164,0) Q "RTN","DGPFHLU",165,0) ; "RTN","DGPFHLU",166,0) OBR(DGSEG,DGCS,DGRS,DGORU,DGERR) ; "RTN","DGPFHLU",167,0) ; "RTN","DGPFHLU",168,0) ; Input: "RTN","DGPFHLU",169,0) ; DGSEG - OBR segment field array "RTN","DGPFHLU",170,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",171,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",172,0) ; DGORU - Closed root ORU results array name "RTN","DGPFHLU",173,0) ; "RTN","DGPFHLU",174,0) ; Output: "RTN","DGPFHLU",175,0) ; DGORU - ORU results array "RTN","DGPFHLU",176,0) ; Subscript "RTN","DGPFHLU",177,0) ; ---------------- "RTN","DGPFHLU",178,0) ; "FLAG" "RTN","DGPFHLU",179,0) ; "OWNER" "RTN","DGPFHLU",180,0) ; "ORIGSITE" "RTN","DGPFHLU",181,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",182,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",183,0) ; "RTN","DGPFHLU",184,0) N DGARR "RTN","DGPFHLU",185,0) ; "RTN","DGPFHLU",186,0) S DGARR("FLAG")=$P($G(DGSEG(4)),DGCS,1)_";DGPF(26.15," "RTN","DGPFHLU",187,0) I '$$TESTVAL^DGPFUT(26.13,.02,DGARR("FLAG")) D "RTN","DGPFHLU",188,0) . S DGERR("OBR",DGSEG(1),4)=261111 ;invalid flag "RTN","DGPFHLU",189,0) ; "RTN","DGPFHLU",190,0) S DGARR("OWNER")=$$IEN^XUAF4(DGSEG(20)) "RTN","DGPFHLU",191,0) I (DGARR("OWNER")="")!('$$TESTVAL^DGPFUT(26.13,.04,DGARR("OWNER"))) D "RTN","DGPFHLU",192,0) . S DGERR("OBR",DGSEG(1),20)=261126 ;invalid owner site "RTN","DGPFHLU",193,0) ; "RTN","DGPFHLU",194,0) S DGARR("ORIGSITE")=$$IEN^XUAF4($G(DGSEG(21))) "RTN","DGPFHLU",195,0) I DGARR("ORIGSITE")="" S DGARR("ORIGSITE")=@DGORU@("SNDFAC") "RTN","DGPFHLU",196,0) I (DGARR("ORIGSITE")="")!('$$TESTVAL^DGPFUT(26.13,.05,DGARR("ORIGSITE"))) D "RTN","DGPFHLU",197,0) . S DGERR("OBR",DGSEG(1),21)=261125 ;invalid originating site "RTN","DGPFHLU",198,0) ; "RTN","DGPFHLU",199,0) ;load results array "RTN","DGPFHLU",200,0) M @DGORU=DGARR "RTN","DGPFHLU",201,0) Q "RTN","DGPFHLU",202,0) ; "RTN","DGPFHLU",203,0) OBX(DGSEG,DGCS,DGRS,DGORU,DGERR) ; "RTN","DGPFHLU",204,0) ; "RTN","DGPFHLU",205,0) ; Input: "RTN","DGPFHLU",206,0) ; DGSEG - OBX segment field array "RTN","DGPFHLU",207,0) ; DGCS - HL7 component separator "RTN","DGPFHLU",208,0) ; DGRS - HL7 repetition separator "RTN","DGPFHLU",209,0) ; DGORU - Closed root ORU results array name "RTN","DGPFHLU",210,0) ; "RTN","DGPFHLU",211,0) ; Output: "RTN","DGPFHLU",212,0) ; DGORU - ORU results array "RTN","DGPFHLU",213,0) ; Subscript "RTN","DGPFHLU",214,0) ; ----------------------- "RTN","DGPFHLU",215,0) ; "NARR",line "RTN","DGPFHLU",216,0) ; assigndt,"ACTION" "RTN","DGPFHLU",217,0) ; assigndt,"COMMENT",line "RTN","DGPFHLU",218,0) ; DGERR - undefined on success, error array on failure "RTN","DGPFHLU",219,0) ; format: DGERR(seg_id,sequence,fld_pos)=error code "RTN","DGPFHLU",220,0) ; "RTN","DGPFHLU",221,0) N DGADT ;assignment date "RTN","DGPFHLU",222,0) N DGI "RTN","DGPFHLU",223,0) N DGLINE ;word processing line count "RTN","DGPFHLU",224,0) N DGRSLT "RTN","DGPFHLU",225,0) ; "RTN","DGPFHLU",226,0) ; Narrative Observation Identifier "RTN","DGPFHLU",227,0) I $P(DGSEG(3),DGCS,1)="N" D "RTN","DGPFHLU",228,0) . S DGLINE=$O(@DGORU@("NARR",""),-1) "RTN","DGPFHLU",229,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLU",230,0) . . S @DGORU@("NARR",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLU",231,0) ; "RTN","DGPFHLU",232,0) ; Status Observation Identifier "RTN","DGPFHLU",233,0) I $P(DGSEG(3),DGCS,1)="S" D "RTN","DGPFHLU",234,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L") "RTN","DGPFHLU",235,0) . Q:+DGADT'>0 "RTN","DGPFHLU",236,0) . D CHK^DIE(26.14,.03,,DGSEG(5),.DGRSLT) "RTN","DGPFHLU",237,0) . S @DGORU@(DGADT,"ACTION")=+DGRSLT "RTN","DGPFHLU",238,0) ; "RTN","DGPFHLU",239,0) ; Comment Observation Identifier "RTN","DGPFHLU",240,0) I $P(DGSEG(3),DGCS,1)="C" D "RTN","DGPFHLU",241,0) . S DGADT=$$HL7TFM^XLFDT(DGSEG(14),"L") "RTN","DGPFHLU",242,0) . Q:+DGADT'>0 "RTN","DGPFHLU",243,0) . S DGLINE=$O(@DGORU@(DGADT,"COMMENT",""),-1) "RTN","DGPFHLU",244,0) . F DGI=1:1:$L(DGSEG(5),DGRS) D "RTN","DGPFHLU",245,0) . . S @DGORU@(DGADT,"COMMENT",DGLINE+DGI,0)=$P(DGSEG(5),DGRS,DGI) "RTN","DGPFHLU",246,0) Q "RTN","DGPFHLU3") 0^14^B31915353 "RTN","DGPFHLU3",1,0) DGPFHLU3 ;ALB/RPM - PRF HL7 BUILD MSA/ERR SEGMENTS ; 3/03/03 "RTN","DGPFHLU3",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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) ; "RTN","DGPFHLU3",54,0) S DGRSLT=0 "RTN","DGPFHLU3",55,0) I $G(DGFLD)]"",$G(DGACK)]"",+$G(DGID) D "RTN","DGPFHLU3",56,0) . F DGCOD="AA","AE","AR","CA","CE","CR" S DGACKS(DGCOD)="" "RTN","DGPFHLU3",57,0) . ; "RTN","DGPFHLU3",58,0) . ; seq 1 Acknowledgment Code "RTN","DGPFHLU3",59,0) . I DGFLD[",1," D "RTN","DGPFHLU3",60,0) . . S DGVAL(1)=$S($D(DGACKS(DGACK)):DGACK,1:"") "RTN","DGPFHLU3",61,0) . Q:(DGVAL(1)="") ;required field "RTN","DGPFHLU3",62,0) . ; "RTN","DGPFHLU3",63,0) . ; seq 2 Message Control ID "RTN","DGPFHLU3",64,0) . I DGFLD[",2," D "RTN","DGPFHLU3",65,0) . . S DGVAL(2)=DGID "RTN","DGPFHLU3",66,0) . Q:(DGVAL(2)="") ;required field "RTN","DGPFHLU3",67,0) . ; "RTN","DGPFHLU3",68,0) . ; seq 3 Text Message "RTN","DGPFHLU3",69,0) . I DGFLD[",3," D "RTN","DGPFHLU3",70,0) . . S DGVAL(3)=$G(DGTEXT) "RTN","DGPFHLU3",71,0) . ; "RTN","DGPFHLU3",72,0) . ; seq 4 Expected Sequence Number "RTN","DGPFHLU3",73,0) . I DGFLD[",4," D "RTN","DGPFHLU3",74,0) . . S DGVAL(4)=$G(DGESN) "RTN","DGPFHLU3",75,0) . ; "RTN","DGPFHLU3",76,0) . ; seq 5 Delayed Acknowledgment Type "RTN","DGPFHLU3",77,0) . I DGFLD[",5," D "RTN","DGPFHLU3",78,0) . . S DGDAT=$G(DGDAT) "RTN","DGPFHLU3",79,0) . . S DGVAL(5)=$S(DGDAT="D":DGDAT,DGDAT="F":DGDAT,1:"") "RTN","DGPFHLU3",80,0) . ; "RTN","DGPFHLU3",81,0) . ; seq 6 Error Condition "RTN","DGPFHLU3",82,0) . I DGFLD[",6," D "RTN","DGPFHLU3",83,0) . . S DGVAL(6,1,1)=DGERR "RTN","DGPFHLU3",84,0) . . S DGVAL(6,1,2)=$$EZBLD^DIALOG(DGERR) "RTN","DGPFHLU3",85,0) . . S DGVAL(6,1,3)="L" "RTN","DGPFHLU3",86,0) . S DGRSLT=1 "RTN","DGPFHLU3",87,0) I 'DGRSLT K DGVAL "RTN","DGPFHLU3",88,0) Q DGRSLT "RTN","DGPFHLU3",89,0) ; "RTN","DGPFHLU3",90,0) ERR(DGSEG,DGSEQ,DGPOS,DGCOD,DGFLD,DGHL) ;ERR segment API "RTN","DGPFHLU3",91,0) ; "RTN","DGPFHLU3",92,0) ; Input: "RTN","DGPFHLU3",93,0) ; DGSEG - (required) Segment ID "RTN","DGPFHLU3",94,0) ; DGSEQ - (required) Sequence "RTN","DGPFHLU3",95,0) ; DGPOS - (required) Field position "RTN","DGPFHLU3",96,0) ; DGCOD - (required) Error code "RTN","DGPFHLU3",97,0) ; DGFLD - (optional) List of comma-separated fields (sequence #'s) "RTN","DGPFHLU3",98,0) ; to include. Defaults to all required fields (1). "RTN","DGPFHLU3",99,0) ; DGHL - (required) HL7 Environment array "RTN","DGPFHLU3",100,0) ; "RTN","DGPFHLU3",101,0) ; Output: "RTN","DGPFHLU3",102,0) ; Function value - ERR segment on success, "" on failure "RTN","DGPFHLU3",103,0) ; "RTN","DGPFHLU3",104,0) N DGERR "RTN","DGPFHLU3",105,0) N DGVAL "RTN","DGPFHLU3",106,0) ; "RTN","DGPFHLU3",107,0) S DGERR="" "RTN","DGPFHLU3",108,0) I $G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"",$G(DGHL("ECH"))]"" D "RTN","DGPFHLU3",109,0) . S DGFLD=$$CKSTR^DGPFHLUT("1",DGFLD) ;validate field string "RTN","DGPFHLU3",110,0) . S DGFLD=","_DGFLD_"," "RTN","DGPFHLU3",111,0) . I $$ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,.DGVAL) D "RTN","DGPFHLU3",112,0) . . S DGERR=$$BLDSEG^DGPFHLUT("ERR",.DGVAL,.DGHL) "RTN","DGPFHLU3",113,0) Q DGERR "RTN","DGPFHLU3",114,0) ; "RTN","DGPFHLU3",115,0) ERRVAL(DGFLD,DGSEG,DGSEQ,DGPOS,DGCOD,DGVAL) ;build ERR value array "RTN","DGPFHLU3",116,0) ; "RTN","DGPFHLU3",117,0) ; Input: "RTN","DGPFHLU3",118,0) ; DGFLD - (required) Field string "RTN","DGPFHLU3",119,0) ; DGSEG - (required) Segment ID "RTN","DGPFHLU3",120,0) ; DGSEQ - (required) Sequence "RTN","DGPFHLU3",121,0) ; DGPOS - (required) Field position "RTN","DGPFHLU3",122,0) ; DGCOD - (required) Error code "RTN","DGPFHLU3",123,0) ; "RTN","DGPFHLU3",124,0) ; Output: "RTN","DGPFHLU3",125,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFHLU3",126,0) ; DGVAL - ERR field array [SUB1:field, SUB2:repetition, "RTN","DGPFHLU3",127,0) ; SUB3:component, SUB4:sub-component] "RTN","DGPFHLU3",128,0) N DGRSLT "RTN","DGPFHLU3",129,0) ; "RTN","DGPFHLU3",130,0) S DGRSLT=0 "RTN","DGPFHLU3",131,0) I $G(DGFLD)]"",$G(DGSEG)]"",+$G(DGSEQ),+$G(DGPOS),$G(DGCOD)]"" D "RTN","DGPFHLU3",132,0) . I DGFLD[",1," D "RTN","DGPFHLU3",133,0) . . S DGVAL(1,1,1)=DGSEG "RTN","DGPFHLU3",134,0) . . S DGVAL(1,1,2)=DGSEQ "RTN","DGPFHLU3",135,0) . . S DGVAL(1,1,3)=DGPOS "RTN","DGPFHLU3",136,0) . . S DGVAL(1,1,4,1)=DGCOD "RTN","DGPFHLU3",137,0) . . S DGVAL(1,1,4,2)=$$EZBLD^DIALOG(DGCOD) "RTN","DGPFHLU3",138,0) . . S DGVAL(1,1,4,3)="L" "RTN","DGPFHLU3",139,0) . S DGRSLT=1 "RTN","DGPFHLU3",140,0) Q DGRSLT "RTN","DGPFHLU3",141,0) ; "RTN","DGPFHLU3",142,0) BLDVA086(DGTBL) ;build error code/text array for table VA086 "RTN","DGPFHLU3",143,0) ; "RTN","DGPFHLU3",144,0) ; Input: "RTN","DGPFHLU3",145,0) ; none "RTN","DGPFHLU3",146,0) ; "RTN","DGPFHLU3",147,0) ; Output: "RTN","DGPFHLU3",148,0) ; DGTBL - error code array subscripted by code containing error text "RTN","DGPFHLU3",149,0) ; "RTN","DGPFHLU3",150,0) N DGI "RTN","DGPFHLU3",151,0) N DGLINE "RTN","DGPFHLU3",152,0) N DGCOD "RTN","DGPFHLU3",153,0) N DGTXT "RTN","DGPFHLU3",154,0) N DGDESC "RTN","DGPFHLU3",155,0) ; "RTN","DGPFHLU3",156,0) F DGI=1:1 S DGLINE=$T(ERRTBL+DGI) Q:DGLINE="" D "RTN","DGPFHLU3",157,0) . S DGCOD=$P(DGLINE,";",3) "RTN","DGPFHLU3",158,0) . S DGTXT=$P(DGLINE,";",4) "RTN","DGPFHLU3",159,0) . S DGDESC=$P(DGLINE,";",5) "RTN","DGPFHLU3",160,0) . S DGTBL(DGCOD)=DGTXT "RTN","DGPFHLU3",161,0) . S DGTBL(DGCOD,"DESC")=DGDESC "RTN","DGPFHLU3",162,0) Q "RTN","DGPFHLU3",163,0) ; "RTN","DGPFHLU3",164,0) ERRTBL ;VA086 Error Code Table;error code;error text "RTN","DGPFHLU3",165,0) ;;FE;Filer Error;An error occurred at the remote site when attempting to add, update or retrieve assignment data. "RTN","DGPFHLU3",166,0) ;;IF;Invalid Patient Record Flag;The transmitted Patient Record Flag is not defined at the remote site. "RTN","DGPFHLU3",167,0) ;;IID;Invalid Observation ID;The transmitted observation ID is not "N"arrative, "S"tatus or "C"omment. "RTN","DGPFHLU3",168,0) ;;IOR;Invalid Originating Site;The originating site of the transmission is not defined at the remote site. "RTN","DGPFHLU3",169,0) ;;IOW;Invalid Owner Site;The transmitted owning site is not defined at the remote site. "RTN","DGPFHLU3",170,0) ;;NM;No Match;No patient was found that correlates to the transmitted ICN, DOB and SSN. "RTN","DGPFHLU3",171,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","DGPFHLU5") 0^15^B49294437 "RTN","DGPFHLU5",1,0) DGPFHLU5 ;ALB/RPM - PRF HL7 ACK PROCESSING ; 6/21/06 10:18am "RTN","DGPFHLU5",2,0) ;;5.3;Registration;**425,718,650**;Aug 13, 1993;Build 3 "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)=error_code) "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 DGXMTXT ;mailman msg text array "RTN","DGPFHLU5",19,0) ; "RTN","DGPFHLU5",20,0) I +$G(DGLIEN),$D(DGACK),$D(DGERR) D "RTN","DGPFHLU5",21,0) . ; "RTN","DGPFHLU5",22,0) . ;retrieve the HL7 transmission log values "RTN","DGPFHLU5",23,0) . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFHLU5",24,0) . ; "RTN","DGPFHLU5",25,0) . ;retrieve assignment history values "RTN","DGPFHLU5",26,0) . Q:'$$GETHIST^DGPFAAH(+$G(DGPFL("ASGNHIST")),.DGPFAH) "RTN","DGPFHLU5",27,0) . ; "RTN","DGPFHLU5",28,0) . ;retransmit and quit if dialog error code "Assignment not found" "RTN","DGPFHLU5",29,0) . I $$FNDDIA(261102,.DGERR) D Q "RTN","DGPFHLU5",30,0) . . ;transmit all assignment records to rejecting site "RTN","DGPFHLU5",31,0) . . Q:'$$XMIT^DGPFLMT5(+$G(DGPFAH("ASSIGN")),$P($G(DGPFL("SITE")),U)) "RTN","DGPFHLU5",32,0) . . ;update HL7 transmission log status (RE-TRANSMITTED) "RTN","DGPFHLU5",33,0) . . D STOSTAT^DGPFHLL(26.17,DGLIEN,"RT") "RTN","DGPFHLU5",34,0) . ; "RTN","DGPFHLU5",35,0) . ;retrieve assignment values "RTN","DGPFHLU5",36,0) . Q:'$$GETASGN^DGPFAA(+$G(DGPFAH("ASSIGN")),.DGPFA) "RTN","DGPFHLU5",37,0) . ; "RTN","DGPFHLU5",38,0) . S DGXMTXT=$NA(^TMP("DGPFERR",$J)) "RTN","DGPFHLU5",39,0) . K @DGXMTXT "RTN","DGPFHLU5",40,0) . ; "RTN","DGPFHLU5",41,0) . ;create message text array "RTN","DGPFHLU5",42,0) . D BLDMSG(.DGPFA,.DGACK,.DGERR,DGXMTXT) "RTN","DGPFHLU5",43,0) . ; "RTN","DGPFHLU5",44,0) . ;send the notification message "RTN","DGPFHLU5",45,0) . D SEND(DGXMTXT) "RTN","DGPFHLU5",46,0) . ; "RTN","DGPFHLU5",47,0) . ;cleanup "RTN","DGPFHLU5",48,0) . K @DGXMTXT "RTN","DGPFHLU5",49,0) Q "RTN","DGPFHLU5",50,0) ; "RTN","DGPFHLU5",51,0) BLDMSG(DGPFA,DGACK,DGERR,DGXMTXT) ;build MailMan message array "RTN","DGPFHLU5",52,0) ; "RTN","DGPFHLU5",53,0) ; Supported DBIA #2171: The supported DBIA is uses to access Kernel "RTN","DGPFHLU5",54,0) ; APIs for retrieving Station numbers and names "RTN","DGPFHLU5",55,0) ; from the INSTITUTION (#4) file. "RTN","DGPFHLU5",56,0) ; Supported DBIA #2701: The supported DBIA is used to access MPI APIs "RTN","DGPFHLU5",57,0) ; for retrieving an ICN for a given DFN. "RTN","DGPFHLU5",58,0) ; "RTN","DGPFHLU5",59,0) ; Input: "RTN","DGPFHLU5",60,0) ; DGPFA - assignment data array "RTN","DGPFHLU5",61,0) ; DGACK - array of ACK data "RTN","DGPFHLU5",62,0) ; DGERR - array of parsed errors (ex: DGERR(1)=error_code) "RTN","DGPFHLU5",63,0) ; "RTN","DGPFHLU5",64,0) ; Output: "RTN","DGPFHLU5",65,0) ; DGXMTXT - array of MailMan text lines "RTN","DGPFHLU5",66,0) ; "RTN","DGPFHLU5",67,0) N DGCNT ;error count "RTN","DGPFHLU5",68,0) N DGCOD ;error code "RTN","DGPFHLU5",69,0) N DGDEM ;patient demographics array "RTN","DGPFHLU5",70,0) N DGDFN ;pointer to PATIENT (#2) file "RTN","DGPFHLU5",71,0) N DGDLG ;DIALOG array "RTN","DGPFHLU5",72,0) N DGFAC ;facility data array from XUAF4 call "RTN","DGPFHLU5",73,0) N DGI ;generic counter "RTN","DGPFHLU5",74,0) N DGICN ;integrated control number "RTN","DGPFHLU5",75,0) N DGLIN ;line counter "RTN","DGPFHLU5",76,0) N DGMAX ;maximum line length "RTN","DGPFHLU5",77,0) N DGSITE ;results of VASITE call "RTN","DGPFHLU5",78,0) N DGSNDSTA ;sending station number "RTN","DGPFHLU5",79,0) N DGSNDNAM ;sending station name "RTN","DGPFHLU5",80,0) N DGTBL ;error code table array "RTN","DGPFHLU5",81,0) ; "RTN","DGPFHLU5",82,0) S DGDFN=+$G(DGPFA("DFN")) "RTN","DGPFHLU5",83,0) Q:(DGDFN'>0) "RTN","DGPFHLU5",84,0) ; "RTN","DGPFHLU5",85,0) ;retrieve patient demographics "RTN","DGPFHLU5",86,0) Q:'$$GETPAT^DGPFUT2(DGDFN,.DGDEM) "RTN","DGPFHLU5",87,0) S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFHLU5",88,0) S DGICN=$S(+DGICN>0:DGICN,1:$P(DGICN,U,2)) "RTN","DGPFHLU5",89,0) ; "RTN","DGPFHLU5",90,0) ;load error code table "RTN","DGPFHLU5",91,0) D BLDVA086^DGPFHLU3(.DGTBL) "RTN","DGPFHLU5",92,0) ; "RTN","DGPFHLU5",93,0) S DGLIN=0 "RTN","DGPFHLU5",94,0) S DGMAX=65 "RTN","DGPFHLU5",95,0) S DGSITE=$$SITE^VASITE() "RTN","DGPFHLU5",96,0) S DGSNDSTA=$G(DGACK("SNDFAC")) "RTN","DGPFHLU5",97,0) D F4^XUAF4(DGSNDSTA,.DGFAC,"","") "RTN","DGPFHLU5",98,0) S DGSNDNAM=$S(DGFAC>0:$G(DGFAC("NAME")),1:"") "RTN","DGPFHLU5",99,0) ; "RTN","DGPFHLU5",100,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",101,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",102,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",103,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",104,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",105,0) D ADDLINE("Message Control ID#: "_$G(DGACK("MSGID")),4,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",106,0) D ADDLINE("Receiving Facility name: "_DGSNDNAM_" ("_DGSNDSTA_")",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",107,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",108,0) D ADDLINE("Flag Name: "_$P($G(DGPFA("FLAG")),U,2),14,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",109,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",110,0) D ADDLINE("Patient Name: "_DGDEM("NAME"),11,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",111,0) D ADDLINE("Social Security #: "_DGDEM("SSN"),6,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",112,0) D ADDLINE("Date of Birth: "_$$FMTE^XLFDT(DGDEM("DOB"),"2D"),10,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",113,0) D ADDLINE("Integrated Control #: "_DGICN,3,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",114,0) D ADDLINE("Owning Site: "_$P($G(DGPFA("OWNER")),U,2)_" ("_$$STA^XUAF4($P($G(DGPFA("OWNER")),U))_")",12,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",115,0) D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",116,0) ; "RTN","DGPFHLU5",117,0) ;loop through each error "RTN","DGPFHLU5",118,0) S DGCNT=0 "RTN","DGPFHLU5",119,0) F S DGCNT=$O(DGERR(DGCNT)) Q:'DGCNT D "RTN","DGPFHLU5",120,0) . K DGDLG "RTN","DGPFHLU5",121,0) . S DGCOD=DGERR(DGCNT) "RTN","DGPFHLU5",122,0) . ; "RTN","DGPFHLU5",123,0) . ;assume numeric error code is a DIALOG "RTN","DGPFHLU5",124,0) . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGDLG","S") "RTN","DGPFHLU5",125,0) . I $D(DGDLG) D FORMAT^DGPFLMT4(.DGDLG,DGMAX-12) "RTN","DGPFHLU5",126,0) . ; "RTN","DGPFHLU5",127,0) . ;if not a DIALOG, then is it a table entry? "RTN","DGPFHLU5",128,0) . I '$D(DGDLG),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGDLG(1)=DGTBL(DGCOD,"DESC") "RTN","DGPFHLU5",129,0) . ; "RTN","DGPFHLU5",130,0) . ;not a DIALOG or table entry - then error is unknown "RTN","DGPFHLU5",131,0) . I '$D(DGDLG) S DGDLG(1)="Unknown Error code: '"_DGCOD_"'" "RTN","DGPFHLU5",132,0) . ; "RTN","DGPFHLU5",133,0) . ;error header "RTN","DGPFHLU5",134,0) . D ADDLINE("Reason#: "_DGCNT,0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",135,0) . ; "RTN","DGPFHLU5",136,0) . ;loop through error text array "RTN","DGPFHLU5",137,0) . S DGI=0 "RTN","DGPFHLU5",138,0) . F S DGI=$O(DGDLG(DGI)) Q:'DGI D "RTN","DGPFHLU5",139,0) . . D ADDLINE(DGDLG(DGI),12,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",140,0) . ; "RTN","DGPFHLU5",141,0) . ;error separator "RTN","DGPFHLU5",142,0) . D ADDLINE("",0,DGMAX,.DGLIN,DGXMTXT) "RTN","DGPFHLU5",143,0) ; "RTN","DGPFHLU5",144,0) Q "RTN","DGPFHLU5",145,0) ; "RTN","DGPFHLU5",146,0) ADDLINE(DGTEXT,DGINDENT,DGMAXLEN,DGCNT,DGXMTXT) ;add text line to message array "RTN","DGPFHLU5",147,0) ; "RTN","DGPFHLU5",148,0) ; Input: "RTN","DGPFHLU5",149,0) ; DGTEXT - text string "RTN","DGPFHLU5",150,0) ; DGINDENT - number of spaces to insert at start of line "RTN","DGPFHLU5",151,0) ; DGMAXLEN - maximum desired line length (default: 60) "RTN","DGPFHLU5",152,0) ; DGCNT - line number passed by reference "RTN","DGPFHLU5",153,0) ; "RTN","DGPFHLU5",154,0) ; Output: "RTN","DGPFHLU5",155,0) ; DGXMTXT - array of text strings "RTN","DGPFHLU5",156,0) ; "RTN","DGPFHLU5",157,0) N DGAVAIL ;available space for text "RTN","DGPFHLU5",158,0) N DGLINE ;truncated text "RTN","DGPFHLU5",159,0) N DGLOC ;location of space character "RTN","DGPFHLU5",160,0) N DGPAD ;space indent "RTN","DGPFHLU5",161,0) ; "RTN","DGPFHLU5",162,0) S DGTEXT=$G(DGTEXT) "RTN","DGPFHLU5",163,0) S DGINDENT=+$G(DGINDENT) "RTN","DGPFHLU5",164,0) S DGMAXLEN=+$G(DGMAXLEN) "RTN","DGPFHLU5",165,0) S:'DGMAXLEN DGMAXLEN=60 "RTN","DGPFHLU5",166,0) I DGINDENT>(DGMAXLEN-1) S DGINDENT=0 "RTN","DGPFHLU5",167,0) S DGCNT=$G(DGCNT,0) ;default to 0 "RTN","DGPFHLU5",168,0) ; "RTN","DGPFHLU5",169,0) S DGPAD=$$REPEAT^XLFSTR(" ",DGINDENT) "RTN","DGPFHLU5",170,0) ; "RTN","DGPFHLU5",171,0) ;determine available space for text "RTN","DGPFHLU5",172,0) S DGAVAIL=(DGMAXLEN-DGINDENT) "RTN","DGPFHLU5",173,0) F D Q:('$L(DGTEXT)) "RTN","DGPFHLU5",174,0) . ; "RTN","DGPFHLU5",175,0) . ;find potential line break "RTN","DGPFHLU5",176,0) . S DGLOC=$L($E(DGTEXT,1,DGAVAIL)," ") "RTN","DGPFHLU5",177,0) . ; "RTN","DGPFHLU5",178,0) . ;break a line that is too long when it has potential line breaks "RTN","DGPFHLU5",179,0) . I $L(DGTEXT)>DGAVAIL,DGLOC D "RTN","DGPFHLU5",180,0) . . S DGLINE=$P(DGTEXT," ",1,$S(DGLOC>1:DGLOC-1,1:1)) "RTN","DGPFHLU5",181,0) . . S DGTEXT=$P(DGTEXT," ",$S(DGLOC>1:DGLOC,1:DGLOC+1),$L(DGTEXT," ")) "RTN","DGPFHLU5",182,0) . E D "RTN","DGPFHLU5",183,0) . . S DGLINE=DGTEXT,DGTEXT="" "RTN","DGPFHLU5",184,0) . ; "RTN","DGPFHLU5",185,0) . S DGCNT=DGCNT+1 "RTN","DGPFHLU5",186,0) . S @DGXMTXT@(DGCNT)=DGPAD_DGLINE "RTN","DGPFHLU5",187,0) Q "RTN","DGPFHLU5",188,0) ; "RTN","DGPFHLU5",189,0) SEND(DGXMTXT) ;send the MailMan message "RTN","DGPFHLU5",190,0) ; "RTN","DGPFHLU5",191,0) ; Input: "RTN","DGPFHLU5",192,0) ; DGXMTXT - name of message text array in closed format "RTN","DGPFHLU5",193,0) ; "RTN","DGPFHLU5",194,0) ; Output: "RTN","DGPFHLU5",195,0) ; none "RTN","DGPFHLU5",196,0) ; "RTN","DGPFHLU5",197,0) N DIFROM ;protect FM package "RTN","DGPFHLU5",198,0) N XMDUZ ;sender "RTN","DGPFHLU5",199,0) N XMSUB ;message subject "RTN","DGPFHLU5",200,0) N XMTEXT ;name of message text array in open format "RTN","DGPFHLU5",201,0) N XMY ;recipient array "RTN","DGPFHLU5",202,0) N XMZ ;returned message number "RTN","DGPFHLU5",203,0) ; "RTN","DGPFHLU5",204,0) S XMDUZ="Patient Record Flag Module" "RTN","DGPFHLU5",205,0) S XMSUB="PRF MESSAGE TRANSMISSION ERROR" "RTN","DGPFHLU5",206,0) S XMTEXT=$$OREF^DILF(DGXMTXT) "RTN","DGPFHLU5",207,0) S XMY("G.DGPF HL7 TRANSMISSION ERRORS")="" "RTN","DGPFHLU5",208,0) D ^XMD "RTN","DGPFHLU5",209,0) Q "RTN","DGPFHLU5",210,0) ; "RTN","DGPFHLU5",211,0) FNDDIA(DGDIA,DGERR) ;find dialog code "RTN","DGPFHLU5",212,0) ;This function searches an array for a specific DIALOG (#.84) code. "RTN","DGPFHLU5",213,0) ; "RTN","DGPFHLU5",214,0) ; Input: (required) "RTN","DGPFHLU5",215,0) ; DGDIA - dialog error code "RTN","DGPFHLU5",216,0) ; DGERR - array of parsed errors (ex: DGERR(1)=error_code) "RTN","DGPFHLU5",217,0) ; "RTN","DGPFHLU5",218,0) ; Output: "RTN","DGPFHLU5",219,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFHLU5",220,0) ; "RTN","DGPFHLU5",221,0) N DGI ;generic counter "RTN","DGPFHLU5",222,0) N DGRSLT ;function value "RTN","DGPFHLU5",223,0) S (DGI,DGRSLT)=0 "RTN","DGPFHLU5",224,0) ; "RTN","DGPFHLU5",225,0) I +$G(DGDIA),$D(DGERR) D "RTN","DGPFHLU5",226,0) . F S DGI=$O(DGERR(DGI)) Q:'DGI D Q:DGRSLT "RTN","DGPFHLU5",227,0) . . I $G(DGERR(DGI))=DGDIA S DGRSLT=1 "RTN","DGPFHLU5",228,0) ; "RTN","DGPFHLU5",229,0) Q DGRSLT "RTN","DGPFHLUQ") 0^46^B40674346 "RTN","DGPFHLUQ",1,0) DGPFHLUQ ;ALB/RPM - PRF HL7 INTERACTIVE QUERY ; 8/24/06 "RTN","DGPFHLUQ",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFHLUQ",3,0) ; "RTN","DGPFHLUQ",4,0) Q ;no direct entry "RTN","DGPFHLUQ",5,0) ; "RTN","DGPFHLUQ",6,0) EN ;entry point "RTN","DGPFHLUQ",7,0) ;This procedure prompts the user to select a patient and the facility "RTN","DGPFHLUQ",8,0) ;that they wish to check for existing Category I patient record flags. "RTN","DGPFHLUQ",9,0) ;An HL7 query is then sent to the selected facility. "RTN","DGPFHLUQ",10,0) ; "RTN","DGPFHLUQ",11,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFHLUQ",12,0) N DGFAC ;selected facility "RTN","DGPFHLUQ",13,0) N DGTF ;array of treating facilities "RTN","DGPFHLUQ",14,0) N DGPAT ;selected patient "RTN","DGPFHLUQ",15,0) N DGRSLT ;result of query call "RTN","DGPFHLUQ",16,0) ; "RTN","DGPFHLUQ",17,0) ;select patient "RTN","DGPFHLUQ",18,0) W !! "RTN","DGPFHLUQ",19,0) D SELPAT^DGPFUT1(.DGPAT) "RTN","DGPFHLUQ",20,0) Q:+$G(DGPAT)'>0 "RTN","DGPFHLUQ",21,0) S DGDFN=+DGPAT "RTN","DGPFHLUQ",22,0) ; "RTN","DGPFHLUQ",23,0) ;build list of valid query facilities "RTN","DGPFHLUQ",24,0) I '$$BLDTFL^DGPFUT2(DGDFN,.DGTF) D Q "RTN","DGPFHLUQ",25,0) . N DGLINE "RTN","DGPFHLUQ",26,0) . S DGLINE(1)="" "RTN","DGPFHLUQ",27,0) . S DGLINE(3)="* No treating facilities are available to query. *" "RTN","DGPFHLUQ",28,0) . S $P(DGLINE(2),"*",$L(DGLINE(3)))="*" "RTN","DGPFHLUQ",29,0) . S DGLINE(4)=DGLINE(2) "RTN","DGPFHLUQ",30,0) . S DGLINE(5)="" "RTN","DGPFHLUQ",31,0) . D EN^DDIOL(.DGLINE) "RTN","DGPFHLUQ",32,0) . I $$CONTINUE^DGPFUT() "RTN","DGPFHLUQ",33,0) ; "RTN","DGPFHLUQ",34,0) ;select facility "RTN","DGPFHLUQ",35,0) S DGFAC=$$ANSWER^DGPFUT("Select facility to query",$P($$NS^XUAF4($$GETNXTF^DGPFUT(DGDFN)),U),"P^4:EMZ","","I $D(DGTF(+Y))") "RTN","DGPFHLUQ",36,0) Q:DGFAC'>0 "RTN","DGPFHLUQ",37,0) S DGFAC=$$STA^XUAF4(DGFAC) "RTN","DGPFHLUQ",38,0) ; "RTN","DGPFHLUQ",39,0) ;send query and build display "RTN","DGPFHLUQ",40,0) S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,3,DGFAC) "RTN","DGPFHLUQ",41,0) ; "RTN","DGPFHLUQ",42,0) Q "RTN","DGPFHLUQ",43,0) ; "RTN","DGPFHLUQ",44,0) ; "RTN","DGPFHLUQ",45,0) DISPLAY(DGMTIEN,DGRESULT) ;DISPLAY RESULTS "RTN","DGPFHLUQ",46,0) ;This procedure is the entry point called from SNDQRY^DGPFHLS that "RTN","DGPFHLUQ",47,0) ;parses and displays the returned Response to Observation Query "RTN","DGPFHLUQ",48,0) ;(ORF~R04) HL7 message. "RTN","DGPFHLUQ",49,0) ; "RTN","DGPFHLUQ",50,0) ; Input: "RTN","DGPFHLUQ",51,0) ; DGMTIEN - if positive a response was returned from destination; "RTN","DGPFHLUQ",52,0) ; otherwise, no response was returned "RTN","DGPFHLUQ",53,0) ; DGRESULT - result parameter from HLMA call "RTN","DGPFHLUQ",54,0) ; "RTN","DGPFHLUQ",55,0) ; Output: none "RTN","DGPFHLUQ",56,0) ; "RTN","DGPFHLUQ",57,0) N DGANS ;pause response "RTN","DGPFHLUQ",58,0) N DGCNT ;continuation node counter "RTN","DGPFHLUQ",59,0) N DGERR ;parsed message error results array "RTN","DGPFHLUQ",60,0) N DGFACNAM ;facility name "RTN","DGPFHLUQ",61,0) N DGORF ;parsed data array name "RTN","DGPFHLUQ",62,0) N DGSEGCNT ;segment counter "RTN","DGPFHLUQ",63,0) N DGSTA ;station number "RTN","DGPFHLUQ",64,0) N DGTEXT ;message text array "RTN","DGPFHLUQ",65,0) N DGWRK ;HL7 segments array name "RTN","DGPFHLUQ",66,0) ; "RTN","DGPFHLUQ",67,0) ;if HL7 package reports failure, notify user and quit "RTN","DGPFHLUQ",68,0) I +$G(DGMTIEN)<1!(+$P($G(DGRESULT),U,2)) D Q "RTN","DGPFHLUQ",69,0) . K DGTEXT "RTN","DGPFHLUQ",70,0) . S DGTEXT(1)="The facility failed to respond to the query request." "RTN","DGPFHLUQ",71,0) . D SHOWMSG(.DGTEXT,"*") "RTN","DGPFHLUQ",72,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") "RTN","DGPFHLUQ",73,0) ; "RTN","DGPFHLUQ",74,0) S DGWRK=$NA(^TMP("DGPFHL7",$J)) "RTN","DGPFHLUQ",75,0) K @DGWRK "RTN","DGPFHLUQ",76,0) S DGORF=$NA(^TMP("DGPF",$J)) "RTN","DGPFHLUQ",77,0) K @DGORF "RTN","DGPFHLUQ",78,0) ; "RTN","DGPFHLUQ",79,0) ;load work global with segments "RTN","DGPFHLUQ",80,0) F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","DGPFHLUQ",81,0) . S DGCNT=0 "RTN","DGPFHLUQ",82,0) . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE "RTN","DGPFHLUQ",83,0) . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D "RTN","DGPFHLUQ",84,0) . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT) "RTN","DGPFHLUQ",85,0) ; "RTN","DGPFHLUQ",86,0) ;parse segments and load into data array "RTN","DGPFHLUQ",87,0) D PARSORF^DGPFHLQ4(DGWRK,.HL,DGORF,.DGERR) "RTN","DGPFHLUQ",88,0) ; "RTN","DGPFHLUQ",89,0) ;get facility name from message "RTN","DGPFHLUQ",90,0) S DGSTA=$G(@DGORF@("SNDFAC")) "RTN","DGPFHLUQ",91,0) S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4(DGSTA)) "RTN","DGPFHLUQ",92,0) ; "RTN","DGPFHLUQ",93,0) ;when assignments are returned, file any that are missing locally "RTN","DGPFHLUQ",94,0) ;and display all returned assignments "RTN","DGPFHLUQ",95,0) I $O(@DGORF@(0)) D "RTN","DGPFHLUQ",96,0) . ; "RTN","DGPFHLUQ",97,0) . N DGDFN ;patient "RTN","DGPFHLUQ",98,0) . N DGFLG ;flag name "RTN","DGPFHLUQ",99,0) . N DGI ;generic index "RTN","DGPFHLUQ",100,0) . N DGPRE ;list of flag assignments prior to filing "RTN","DGPFHLUQ",101,0) . N DGPRECNT ;count of flag assignments prior to filing "RTN","DGPFHLUQ",102,0) . N DGPST ;list of flag assignments following filing "RTN","DGPFHLUQ",103,0) . ; "RTN","DGPFHLUQ",104,0) . S DGDFN=$$GETDFN^MPIF001(+$G(@DGORF@("ICN"))) "RTN","DGPFHLUQ",105,0) . ; "RTN","DGPFHLUQ",106,0) . ;get list of existing Cat I assignments "RTN","DGPFHLUQ",107,0) . S DGPRECNT=$$GETFNAME(DGDFN,.DGPRE) "RTN","DGPFHLUQ",108,0) . ; "RTN","DGPFHLUQ",109,0) . ;store the returned assignments "RTN","DGPFHLUQ",110,0) . I $$STOORF^DGPFHLR(DGDFN,DGORF) ;naked IF "RTN","DGPFHLUQ",111,0) . ; "RTN","DGPFHLUQ",112,0) . ;get updated list of Cat I assignments and notify user when "RTN","DGPFHLUQ",113,0) . ;assignments are added "RTN","DGPFHLUQ",114,0) . I $$GETFNAME(DGDFN,.DGPST)>DGPRECNT D "RTN","DGPFHLUQ",115,0) . . K DGTEXT "RTN","DGPFHLUQ",116,0) . . ; "RTN","DGPFHLUQ",117,0) . . ;remove pre-existing flags from assignment list "RTN","DGPFHLUQ",118,0) . . S DGFLG="" "RTN","DGPFHLUQ",119,0) . . F S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" K:$D(DGPRE(DGFLG)) DGPST(DGFLG) "RTN","DGPFHLUQ",120,0) . . ;build user message "RTN","DGPFHLUQ",121,0) . . S DGTEXT(1)="The following Category I Patient Record Flag Assignments" "RTN","DGPFHLUQ",122,0) . . S DGTEXT(2)="were returned and filed on your system:" "RTN","DGPFHLUQ",123,0) . . S DGFLG="" "RTN","DGPFHLUQ",124,0) . . F DGI=3:1 S DGFLG=$O(DGPST(DGFLG)) Q:DGFLG="" D "RTN","DGPFHLUQ",125,0) . . . S DGTEXT(DGI)=" "_DGFLG "RTN","DGPFHLUQ",126,0) . . D SHOWMSG(.DGTEXT,"*") "RTN","DGPFHLUQ",127,0) . . S DGANS=$$ANSWER^DGPFUT("Enter RETURN to view query results","","E") "RTN","DGPFHLUQ",128,0) . ; "RTN","DGPFHLUQ",129,0) . ;display query results "RTN","DGPFHLUQ",130,0) . I +$G(DGANS)>-1 D EN^DGPFLMQ(DGORF) "RTN","DGPFHLUQ",131,0) ; "RTN","DGPFHLUQ",132,0) ;otherwise notify user that none were found "RTN","DGPFHLUQ",133,0) E D "RTN","DGPFHLUQ",134,0) . K DGTEXT "RTN","DGPFHLUQ",135,0) . S DGTEXT(1)="No Category I Patient Record Flag Assignments found for" "RTN","DGPFHLUQ",136,0) . S DGTEXT(2)="this patient at "_DGFACNAM_" ("_DGSTA_")." "RTN","DGPFHLUQ",137,0) . D SHOWMSG(.DGTEXT,"*") "RTN","DGPFHLUQ",138,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") "RTN","DGPFHLUQ",139,0) ; "RTN","DGPFHLUQ",140,0) ;cleanup "RTN","DGPFHLUQ",141,0) K @DGWRK "RTN","DGPFHLUQ",142,0) K @DGORF "RTN","DGPFHLUQ",143,0) Q "RTN","DGPFHLUQ",144,0) ; "RTN","DGPFHLUQ",145,0) GETFNAME(DGDFN,DGFLGS) ;get list of assigned flag names "RTN","DGPFHLUQ",146,0) ; "RTN","DGPFHLUQ",147,0) ; Input: "RTN","DGPFHLUQ",148,0) ; DGDFN "RTN","DGPFHLUQ",149,0) ; "RTN","DGPFHLUQ",150,0) ; Output: "RTN","DGPFHLUQ",151,0) ; Function value - count of assigned flag names "RTN","DGPFHLUQ",152,0) ; DGFLGS - array of assigned flag names "RTN","DGPFHLUQ",153,0) ; Ex. DGFLGS("FLAGNAME")="" "RTN","DGPFHLUQ",154,0) ; "RTN","DGPFHLUQ",155,0) N DGASGN ;PRF assignments array "RTN","DGPFHLUQ",156,0) N DGCNT ;assigned flag name count "RTN","DGPFHLUQ",157,0) N DGPFA ;assignment data array "RTN","DGPFHLUQ",158,0) N DGIEN ;assignment record# "RTN","DGPFHLUQ",159,0) ; "RTN","DGPFHLUQ",160,0) S DGCNT=0 "RTN","DGPFHLUQ",161,0) I $$GETALL^DGPFAA(DGDFN,.DGASGN,"",1) D "RTN","DGPFHLUQ",162,0) . S DGIEN=0 "RTN","DGPFHLUQ",163,0) . F S DGIEN=$O(DGASGN(DGIEN)) Q:'DGIEN D "RTN","DGPFHLUQ",164,0) . . I $$GETASGN^DGPFAA(DGIEN,.DGPFA) D "RTN","DGPFHLUQ",165,0) . . . S DGFLGS($P(DGPFA("FLAG"),U,2))="" "RTN","DGPFHLUQ",166,0) . . . S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",167,0) Q DGCNT "RTN","DGPFHLUQ",168,0) ; "RTN","DGPFHLUQ",169,0) SHOWMSG(DGTEXT,DGBCHAR) ;format and display user message "RTN","DGPFHLUQ",170,0) ; "RTN","DGPFHLUQ",171,0) ; Input: "RTN","DGPFHLUQ",172,0) ; DGTEXT - array of lines to display "RTN","DGPFHLUQ",173,0) ; DGBCHAR - border character (optional [DEFAULT="*"]) "RTN","DGPFHLUQ",174,0) ; "RTN","DGPFHLUQ",175,0) ; Output: none "RTN","DGPFHLUQ",176,0) ; "RTN","DGPFHLUQ",177,0) N DGBLNK ;blank line "RTN","DGPFHLUQ",178,0) N DGBORDER ;border string "RTN","DGPFHLUQ",179,0) N DGCNT ;line counter "RTN","DGPFHLUQ",180,0) N DGI ;generic index "RTN","DGPFHLUQ",181,0) N DGLEN ;line length "RTN","DGPFHLUQ",182,0) N DGLINE ;formatted text line "RTN","DGPFHLUQ",183,0) N DGMAX ;max line length "RTN","DGPFHLUQ",184,0) ; "RTN","DGPFHLUQ",185,0) S DGBCHAR=$S($G(DGBCHAR)?1.ANP:$E(DGBCHAR),1:"*") "RTN","DGPFHLUQ",186,0) ;determine max line length "RTN","DGPFHLUQ",187,0) S (DGI,DGCNT,DGMAX)=0 "RTN","DGPFHLUQ",188,0) F S DGI=$O(DGTEXT(DGI)) Q:'DGI D "RTN","DGPFHLUQ",189,0) . S DGLEN=$L(DGTEXT(DGI)) "RTN","DGPFHLUQ",190,0) . I DGLEN>(IOM-4) D "RTN","DGPFHLUQ",191,0) . . S DGTEXT(DGI+.1)=$E(DGTEXT(DGI),IOM-3,DGLEN) "RTN","DGPFHLUQ",192,0) . . S DGTEXT(DGI)=$E(DGTEXT(DGI),1,IOM-4) "RTN","DGPFHLUQ",193,0) . . S DGLEN=IOM-4 "RTN","DGPFHLUQ",194,0) . S:DGLEN>DGMAX DGMAX=DGLEN "RTN","DGPFHLUQ",195,0) S $P(DGBLNK," ",DGMAX+1)="" "RTN","DGPFHLUQ",196,0) S $P(DGBORDER,DGBCHAR,DGMAX+5)="" "RTN","DGPFHLUQ",197,0) S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",198,0) S DGLINE(DGCNT)="" "RTN","DGPFHLUQ",199,0) S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",200,0) S DGLINE(DGCNT)=DGBORDER "RTN","DGPFHLUQ",201,0) S DGI=0 "RTN","DGPFHLUQ",202,0) F S DGI=$O(DGTEXT(DGI)) Q:'DGI D "RTN","DGPFHLUQ",203,0) . S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",204,0) . S DGLINE(DGCNT)=DGBCHAR_" "_DGTEXT(DGI)_$E(DGBLNK,1,$L(DGBLNK)-$L(DGTEXT(DGI)))_" "_DGBCHAR "RTN","DGPFHLUQ",205,0) S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",206,0) S DGLINE(DGCNT)=DGBORDER "RTN","DGPFHLUQ",207,0) S DGCNT=DGCNT+1 "RTN","DGPFHLUQ",208,0) S DGLINE(DGCNT)="" "RTN","DGPFHLUQ",209,0) D EN^DDIOL(.DGLINE) "RTN","DGPFHLUQ",210,0) ; "RTN","DGPFHLUQ",211,0) Q "RTN","DGPFHLUT") 0^35^B36458354 "RTN","DGPFHLUT",1,0) DGPFHLUT ;ALB/RPM - PRF HL7 UTILITIES ; 5/31/05 3:45pm "RTN","DGPFHLUT",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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","DGPFHLUT",240,0) ; "RTN","DGPFHLUT",241,0) CONVMID(DGID) ;convert #772 msgid to #773 msgid "RTN","DGPFHLUT",242,0) ;This function takes the HL7 message ID from the DIRECT^HLMA API result, "RTN","DGPFHLUT",243,0) ;which is based on the HL7 MESSAGE TEXT (#772) file IEN and converts it "RTN","DGPFHLUT",244,0) ;into a message ID based on the HL7 MESSAGE ADMINISTRATION (#773) file. "RTN","DGPFHLUT",245,0) ; "RTN","DGPFHLUT",246,0) ; Integration Agreements: "RTN","DGPFHLUT",247,0) ; #4564 - allows access to the "C" index of HL7 MESSAGE TEXT (#772) "RTN","DGPFHLUT",248,0) ; #4669 - allows access to the "B" index and MESSAGE ID (#2) field "RTN","DGPFHLUT",249,0) ; of HL7 MESSAGE ADMINISTRATION (#773) file. "RTN","DGPFHLUT",250,0) ; Input: "RTN","DGPFHLUT",251,0) ; DGID - HL7 message id returned from DIRECT^HLMA "RTN","DGPFHLUT",252,0) ; "RTN","DGPFHLUT",253,0) ; Output: "RTN","DGPFHLUT",254,0) ; Function value - returns HL7 message control ID from HL MESSAGE "RTN","DGPFHLUT",255,0) ; ADMINISTRATION (#773) file on success; "RTN","DGPFHLUT",256,0) ; 0 on failure "RTN","DGPFHLUT",257,0) ; "RTN","DGPFHLUT",258,0) N DG772 ;HL7 MESSAGE TEXT (#772) file IEN "RTN","DGPFHLUT",259,0) N DG773 ;HL7 MESSAGE ADMINISTRATION (#773) file IEN "RTN","DGPFHLUT",260,0) N DGERR ;FM error array "RTN","DGPFHLUT",261,0) N DGMCID ;message ID "RTN","DGPFHLUT",262,0) ; "RTN","DGPFHLUT",263,0) S DG772=+$O(^HL(772,"C",+$G(DGID),0)) "RTN","DGPFHLUT",264,0) S DG773=+$O(^HLMA("B",DG772,0)) "RTN","DGPFHLUT",265,0) S DGMCID=+$$GET1^DIQ(773,DG773_",",2,"I","","DGERR") "RTN","DGPFHLUT",266,0) Q $S(DGMCID&('$D(DGERR)):DGMCID,1:0) "RTN","DGPFLF3") 0^29^B47245932 "RTN","DGPFLF3",1,0) DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 6/9/04 2:05pm "RTN","DGPFLF3",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3 "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 "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 DGQ ;quit flag "RTN","DGPFLF3",29,0) ; "RTN","DGPFLF3",30,0) ;init vars "RTN","DGPFLF3",31,0) S DGOK=1,(DGQ,DGABORT)=0 "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) ; "RTN","DGPFLF3",37,0) ;check flag category (only Category II flags can be created) "RTN","DGPFLF3",38,0) I DGCAT=1 D "RTN","DGPFLF3",39,0) . D BLD^DIALOG(261129,"Can not add 'Category I' flags.","","DGERR","F") "RTN","DGPFLF3",40,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLF3",41,0) . D PAUSE^VALM1 "RTN","DGPFLF3",42,0) . S DGOK=0 "RTN","DGPFLF3",43,0) ; "RTN","DGPFLF3",44,0) ;user prompts "RTN","DGPFLF3",45,0) D:DGOK "RTN","DGPFLF3",46,0) . ;-- init flag record and history arrays "RTN","DGPFLF3",47,0) . ; The DGPFLF array will contain 2 "^" pieces (internal^external) "RTN","DGPFLF3",48,0) . ; for a final full screen display before filing. "RTN","DGPFLF3",49,0) . K DGPFLF,DGPFLH "RTN","DGPFLF3",50,0) . ; "RTN","DGPFLF3",51,0) . ;-- prompt for flag name, quit if one not entered "RTN","DGPFLF3",52,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",53,0) . I DGASK=-1!(DGASK=0) S DGABORT=1 Q "RTN","DGPFLF3",54,0) . S DGPFLF("FLAG")=DGASK_U_DGASK "RTN","DGPFLF3",55,0) . ; "RTN","DGPFLF3",56,0) . ;-- prompt for status of the flag, quit if one not entered "RTN","DGPFLF3",57,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02") "RTN","DGPFLF3",58,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",59,0) . S DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK) "RTN","DGPFLF3",60,0) . ; "RTN","DGPFLF3",61,0) . ;-- prompt for flag type, quit if one not entered "RTN","DGPFLF3",62,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03") "RTN","DGPFLF3",63,0) . I DGASK'>0 S DGABORT=1 Q "RTN","DGPFLF3",64,0) . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK) "RTN","DGPFLF3",65,0) . ; "RTN","DGPFLF3",66,0) . ;-- prompt for principal investigator(s) name for RESEARCH flag type "RTN","DGPFLF3",67,0) . I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(0,.DGPFLF) D Q:DGABORT "RTN","DGPFLF3",68,0) . . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1 "RTN","DGPFLF3",69,0) . ; "RTN","DGPFLF3",70,0) . ;-- prompt for review frequency, quit if user aborts "RTN","DGPFLF3",71,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X") "RTN","DGPFLF3",72,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",73,0) . S DGPFLF("REVFREQ")=DGASK_U_DGASK "RTN","DGPFLF3",74,0) . S DGRDAY=DGASK "RTN","DGPFLF3",75,0) . I DGASK=0 D "RTN","DGPFLF3",76,0) . . ;-- if review frequency=0, don't ask notification/review group "RTN","DGPFLF3",77,0) . . ; reset both fields "RTN","DGPFLF3",78,0) . . S DGPFLF("NOTIDAYS")=0_U_0 "RTN","DGPFLF3",79,0) . . S DGPFLF("REVGRP")=""_U_"" "RTN","DGPFLF3",80,0) . . ; "RTN","DGPFLF3",81,0) . E D Q:DGABORT ;continue to prompt user and check abort logic "RTN","DGPFLF3",82,0) . . ; "RTN","DGPFLF3",83,0) . . ;-- prompt for notification days "RTN","DGPFLF3",84,0) . . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X") "RTN","DGPFLF3",85,0) . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",86,0) . . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK "RTN","DGPFLF3",87,0) . . ; "RTN","DGPFLF3",88,0) . . S DGQ=0 "RTN","DGPFLF3",89,0) . . F D Q:(DGQ!DGABORT) "RTN","DGPFLF3",90,0) . . . ;-- prompt for review mail group name, optional entry "RTN","DGPFLF3",91,0) . . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06") "RTN","DGPFLF3",92,0) . . . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",93,0) . . . I DGASK'>0 D Q "RTN","DGPFLF3",94,0) . . . . W !," >>> You've entered the Review Frequency and Notification Days," "RTN","DGPFLF3",95,0) . . . . W !," now enter a Review Mail Group or abort this process.",*7 "RTN","DGPFLF3",96,0) . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLF3",97,0) . . . ; "RTN","DGPFLF3",98,0) . . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK) "RTN","DGPFLF3",99,0) . . . S DGQ=1 ;set entry, quit "RTN","DGPFLF3",100,0) . ; "RTN","DGPFLF3",101,0) . ;-- prompt for associated TIU PN Title, quit if one not entered "RTN","DGPFLF3",102,0) . ; There is a DD screen on the (#.07) field - using IA #4380 "RTN","DGPFLF3",103,0) . ; to only display Category II PN Titles not already associated "RTN","DGPFLF3",104,0) . ; with a Category II (Local) Record Flag name. "RTN","DGPFLF3",105,0) . ; "RTN","DGPFLF3",106,0) . S DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title","","26.11,.07") "RTN","DGPFLF3",107,0) . I DGASK<0 S DGABORT=1 Q "RTN","DGPFLF3",108,0) . S DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK) "RTN","DGPFLF3",109,0) . ; "RTN","DGPFLF3",110,0) . ;-- have user enter flag description text (required) "RTN","DGPFLF3",111,0) . S DGCKWP=0 "RTN","DGPFLF3",112,0) . S DGWPROOT=$NA(^TMP($J,"DGPFDESC")) "RTN","DGPFLF3",113,0) . K @DGWPROOT "RTN","DGPFLF3",114,0) . F D Q:(DGCKWP!DGABORT) "RTN","DGPFLF3",115,0) . . W !,"Enter the description for this new record flag:" ;needed for line editor "RTN","DGPFLF3",116,0) . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLF3",117,0) . . S DIWETXT="Patient Record Flag - Flag Description Text" "RTN","DGPFLF3",118,0) . . S DIWESUB="Flag Description Text" "RTN","DGPFLF3",119,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLF3",120,0) . . S DWPK=1 ;if line editor, don't join line "RTN","DGPFLF3",121,0) . . D EN^DIWE "RTN","DGPFLF3",122,0) . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q "RTN","DGPFLF3",123,0) . . W !,"Flag Description Text is required!",!,*7 "RTN","DGPFLF3",124,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLF3",125,0) . ; "RTN","DGPFLF3",126,0) . ;-- quit if required flag description not entered "RTN","DGPFLF3",127,0) . Q:DGABORT "RTN","DGPFLF3",128,0) . ; "RTN","DGPFLF3",129,0) . ;-- place flag description text into assignment array "RTN","DGPFLF3",130,0) . M DGPFLF("DESC")=@DGWPROOT K @DGWPROOT "RTN","DGPFLF3",131,0) . ; "RTN","DGPFLF3",132,0) . ;-- setup remaining flag history array nodes for filing "RTN","DGPFLF3",133,0) . ; note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1 "RTN","DGPFLF3",134,0) . S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLF3",135,0) . S DGPFLH("ENTERBY")=DUZ ;current user "RTN","DGPFLF3",136,0) . S DGPFLH("REASON",1,0)="New Local Patient Record Flag entered." "RTN","DGPFLF3",137,0) . ; "RTN","DGPFLF3",138,0) . ;-- re-display user's answers on full screen "RTN","DGPFLF3",139,0) . D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0)) "RTN","DGPFLF3",140,0) . ; "RTN","DGPFLF3",141,0) . W !,*7 "RTN","DGPFLF3",142,0) . I $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0 S DGABORT=1 Q "RTN","DGPFLF3",143,0) . ; "RTN","DGPFLF3",144,0) . W !,"Filing the new local record flag..." "RTN","DGPFLF3",145,0) . ; "RTN","DGPFLF3",146,0) . ;-- file both the (#26.11) & (#26.12) entries "RTN","DGPFLF3",147,0) . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR) "RTN","DGPFLF3",148,0) . ; "RTN","DGPFLF3",149,0) . W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7 "RTN","DGPFLF3",150,0) . ; "RTN","DGPFLF3",151,0) . D PAUSE^VALM1 "RTN","DGPFLF3",152,0) ; "RTN","DGPFLF3",153,0) I DGABORT D "RTN","DGPFLF3",154,0) . W !," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7 "RTN","DGPFLF3",155,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause "RTN","DGPFLF3",156,0) ; "RTN","DGPFLF3",157,0) ;re-build list of local record flags "RTN","DGPFLF3",158,0) D BLD^DGPFLF "RTN","DGPFLF3",159,0) ; "RTN","DGPFLF3",160,0) ;return to LM (refresh screen) "RTN","DGPFLF3",161,0) S VALMBCK="R" "RTN","DGPFLF3",162,0) Q "RTN","DGPFLF4") 0^25^B26165641 "RTN","DGPFLF4",1,0) DGPFLF4 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 4/15/04 12:15pm "RTN","DGPFLF4",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3 "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 "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 DGQ,DGSUB ;counters and quit flag "RTN","DGPFLF4",29,0) ; "RTN","DGPFLF4",30,0) ;init vars "RTN","DGPFLF4",31,0) S (DGABORT,DGLOCK,DGRESULT,DGQ,DGSUB)=0 "RTN","DGPFLF4",32,0) S DGOK=1,(DGSEL,DGIDXIEN)="" "RTN","DGPFLF4",33,0) ; "RTN","DGPFLF4",34,0) ;set screen to full scrolling region "RTN","DGPFLF4",35,0) D FULL^VALM1 "RTN","DGPFLF4",36,0) W ! "RTN","DGPFLF4",37,0) ; "RTN","DGPFLF4",38,0) ;check flag category (only Category II flags can be edited) "RTN","DGPFLF4",39,0) I DGCAT=1 D "RTN","DGPFLF4",40,0) . D BLD^DIALOG(261129,"Can not edit 'Category I' flags.","","DGERR","F") "RTN","DGPFLF4",41,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLF4",42,0) . D PAUSE^VALM1 "RTN","DGPFLF4",43,0) . S DGOK=0 "RTN","DGPFLF4",44,0) ; "RTN","DGPFLF4",45,0) ;init flag record and history arrays "RTN","DGPFLF4",46,0) ; The DGPFLF array will contain 2 "^" pieces (internal^external) "RTN","DGPFLF4",47,0) ; for a final full screen display before filing. "RTN","DGPFLF4",48,0) K DGPFLF,DGPFLH,DGPFORIG "RTN","DGPFLF4",49,0) ; "RTN","DGPFLF4",50,0) ;allow user to select a single flag for editing "RTN","DGPFLF4",51,0) D:DGOK "RTN","DGPFLF4",52,0) . S DGOK=0,VALMBCK="" "RTN","DGPFLF4",53,0) . D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLF4",54,0) . Q:'$D(VALMY) "RTN","DGPFLF4",55,0) . S DGSEL=$O(VALMY("")) "RTN","DGPFLF4",56,0) . Q:DGSEL']"" "RTN","DGPFLF4",57,0) . Q:'$D(@VALMAR@("IDX",DGSEL)) "RTN","DGPFLF4",58,0) . S DGIDXIEN=$G(@VALMAR@("IDX",DGSEL)) "RTN","DGPFLF4",59,0) . ; lock flag record "RTN","DGPFLF4",60,0) . S DGLOCK=$$LOCKLF^DGPFALF1(DGIDXIEN) "RTN","DGPFLF4",61,0) . I 'DGLOCK D Q "RTN","DGPFLF4",62,0) . . X DGMSG "RTN","DGPFLF4",63,0) . . W !?7,"Unable to Lock Flag, another User is Editing this Flag.",*7 "RTN","DGPFLF4",64,0) . . D PAUSE^VALM1 "RTN","DGPFLF4",65,0) . ; "RTN","DGPFLF4",66,0) . ; call api to get record back in array DGPFLF "RTN","DGPFLF4",67,0) . I '$$GETLF^DGPFALF($P(DGIDXIEN,";"),.DGPFLF) D Q "RTN","DGPFLF4",68,0) . . X DGMSG "RTN","DGPFLF4",69,0) . . W !?7,"No Local Flag record data found. Please check your selection.",*7 "RTN","DGPFLF4",70,0) . . D PAUSE^VALM1 "RTN","DGPFLF4",71,0) . ; "RTN","DGPFLF4",72,0) . M DGPFORIG=DGPFLF ;save original array to compare for edits later "RTN","DGPFLF4",73,0) . S DGOK=1 "RTN","DGPFLF4",74,0) ; "RTN","DGPFLF4",75,0) ;Call DGPFLF5 for user prompts to edit fields "RTN","DGPFLF4",76,0) ; - split from this one due to size "RTN","DGPFLF4",77,0) I DGOK D "RTN","DGPFLF4",78,0) . D EFCONT^DGPFLF5(.DGPFLF,.DGPFLH,.DGPFORIG,.DGABORT,DGIDXIEN) "RTN","DGPFLF4",79,0) . Q:DGABORT "RTN","DGPFLF4",80,0) . ; "RTN","DGPFLF4",81,0) . ;check to see if user changed anything "RTN","DGPFLF4",82,0) . S DGSUB="",DGQ=0 "RTN","DGPFLF4",83,0) . I $G(DGPFLF("OLDFLAG"))]"" S DGQ=1 ;flag name has changed "RTN","DGPFLF4",84,0) . I 'DGQ D "RTN","DGPFLF4",85,0) . . F DGSUB="STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE" D Q:DGQ "RTN","DGPFLF4",86,0) . . . I DGPFLF(DGSUB)'=DGPFORIG(DGSUB) S DGQ=1 "RTN","DGPFLF4",87,0) . . Q:DGQ "RTN","DGPFLF4",88,0) . . ; "RTN","DGPFLF4",89,0) . . ;was description modified? "RTN","DGPFLF4",90,0) . . I $O(DGPFLF("DESC",""),-1)'=$O(DGPFORIG("DESC",""),-1) S DGQ=1 "RTN","DGPFLF4",91,0) . . Q:DGQ "RTN","DGPFLF4",92,0) . . ; "RTN","DGPFLF4",93,0) . . S DGSUB=0 "RTN","DGPFLF4",94,0) . . F S DGSUB=$O(DGPFLF("DESC",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFLF4",95,0) . . . I DGPFLF("DESC",DGSUB,0)'=$G(DGPFORIG("DESC",DGSUB,0)) S DGQ=1 "RTN","DGPFLF4",96,0) . . Q:DGQ "RTN","DGPFLF4",97,0) . . ; "RTN","DGPFLF4",98,0) . . S DGSUB=0 "RTN","DGPFLF4",99,0) . . F S DGSUB=$O(DGPFLF("PRININV",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFLF4",100,0) . . . I DGPFLF("PRININV",DGSUB,0)'=$G(DGPFORIG("PRININV",DGSUB,0)) S DGQ=1 "RTN","DGPFLF4",101,0) . ; "RTN","DGPFLF4",102,0) . I 'DGQ D Q "RTN","DGPFLF4",103,0) . . W !!," >>> No edits to "_$P(DGPFLF("FLAG"),U,2)_" were found." "RTN","DGPFLF4",104,0) . . S DGABORT=1 "RTN","DGPFLF4",105,0) . ; "RTN","DGPFLF4",106,0) . K DGPFORIG ;kill array - no longer needed "RTN","DGPFLF4",107,0) . ; "RTN","DGPFLF4",108,0) . ;re-display user's answers on full screen "RTN","DGPFLF4",109,0) . D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0)) "RTN","DGPFLF4",110,0) . ; "RTN","DGPFLF4",111,0) . ;file the edits "RTN","DGPFLF4",112,0) . W !,*7 "RTN","DGPFLF4",113,0) . I $$ANSWER^DGPFUT("Would you like to file the local record flag changes","YES","Y")'>0 S DGABORT=1 Q "RTN","DGPFLF4",114,0) . ; "RTN","DGPFLF4",115,0) . W !,"Updating the local record flag..." "RTN","DGPFLF4",116,0) . ; "RTN","DGPFLF4",117,0) . ;setup remaining flag history array nodes for filing "RTN","DGPFLF4",118,0) . ;note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1 "RTN","DGPFLF4",119,0) . S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLF4",120,0) . S DGPFLH("ENTERBY")=DUZ ;current user "RTN","DGPFLF4",121,0) . ; "RTN","DGPFLF4",122,0) . ;file both the (#26.11) & (#26.12) entries "RTN","DGPFLF4",123,0) . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR) "RTN","DGPFLF4",124,0) . ; "RTN","DGPFLF4",125,0) . W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7 "RTN","DGPFLF4",126,0) . ; "RTN","DGPFLF4",127,0) . D PAUSE^VALM1 "RTN","DGPFLF4",128,0) ; "RTN","DGPFLF4",129,0) I DGLOCK,$$UNLOCK^DGPFALF1(DGIDXIEN) "RTN","DGPFLF4",130,0) ; "RTN","DGPFLF4",131,0) I DGABORT D "RTN","DGPFLF4",132,0) . W !!," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7 "RTN","DGPFLF4",133,0) . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause "RTN","DGPFLF4",134,0) ; "RTN","DGPFLF4",135,0) ;re-build list of local record flags "RTN","DGPFLF4",136,0) D BLD^DGPFLF "RTN","DGPFLF4",137,0) ; "RTN","DGPFLF4",138,0) ;return to LM (refresh screen) "RTN","DGPFLF4",139,0) S VALMBCK="R" "RTN","DGPFLF4",140,0) Q "RTN","DGPFLF4",141,0) ; "RTN","DGPFLMA2") 0^7^B50998481 "RTN","DGPFLMA2",1,0) DGPFLMA2 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/12/06 12:46pm "RTN","DGPFLMA2",2,0) ;;5.3;Registration;**425,623,554,650**;Aug 13, 1993;Build 3 "RTN","DGPFLMA2",3,0) ; "RTN","DGPFLMA2",4,0) ;no direct entry "RTN","DGPFLMA2",5,0) QUIT "RTN","DGPFLMA2",6,0) ; "RTN","DGPFLMA2",7,0) AF ;Entry point for DGPF ASSIGN FLAG action protocol. "RTN","DGPFLMA2",8,0) ; "RTN","DGPFLMA2",9,0) ; Input: "RTN","DGPFLMA2",10,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFLMA2",11,0) ; "RTN","DGPFLMA2",12,0) ; Output: "RTN","DGPFLMA2",13,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMA2",14,0) ; "RTN","DGPFLMA2",15,0) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call "RTN","DGPFLMA2",16,0) N DGABORT ;abort flag for entering assignment narrative "RTN","DGPFLMA2",17,0) N DGFAC ;pointer to INSTITUTION (#4) file "RTN","DGPFLMA2",18,0) N DGOK ;ok flag for entering assignment narrative "RTN","DGPFLMA2",19,0) N DGPFA ;assignment array "RTN","DGPFLMA2",20,0) N DGPFAH ;assignment history array "RTN","DGPFLMA2",21,0) N DGRDAT ;results of review date calculation "RTN","DGPFLMA2",22,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA2",23,0) N DGERR ;if unable to add assignment "RTN","DGPFLMA2",24,0) N DGPFERR ;if error returned from STOALL "RTN","DGPFLMA2",25,0) ; "RTN","DGPFLMA2",26,0) ;set screen to full scroll region "RTN","DGPFLMA2",27,0) D FULL^VALM1 "RTN","DGPFLMA2",28,0) ; "RTN","DGPFLMA2",29,0) ;quit if patient not selected "RTN","DGPFLMA2",30,0) I '$G(DGDFN) D Q "RTN","DGPFLMA2",31,0) . D BLD^DIALOG(261129,"Patient has not been selected.","","DGERR","F") "RTN","DGPFLMA2",32,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMA2",33,0) . D PAUSE^VALM1 "RTN","DGPFLMA2",34,0) . S VALMBCK="R" "RTN","DGPFLMA2",35,0) ; "RTN","DGPFLMA2",36,0) ;is user's DUZ(2) an enabled Division for PRF ASSIGNMENT OWNERSHIP "RTN","DGPFLMA2",37,0) I '$D(^DG(40.8,"APRF",+$G(DUZ(2)))) D Q "RTN","DGPFLMA2",38,0) . D BLD^DIALOG(261129,"Your Division, "_$$STA^XUAF4($G(DUZ(2)))_", is not enabled for PRF Assignment Ownership.","","DGERR","F") "RTN","DGPFLMA2",39,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMA2",40,0) . D PAUSE^VALM1 "RTN","DGPFLMA2",41,0) . S VALMBCK="R" "RTN","DGPFLMA2",42,0) ; "RTN","DGPFLMA2",43,0) D ;drops out of DO block on assignment failure "RTN","DGPFLMA2",44,0) . ; "RTN","DGPFLMA2",45,0) . ;init assignment and history arrays "RTN","DGPFLMA2",46,0) . K DGPFA,DGPFAH "RTN","DGPFLMA2",47,0) . ; "RTN","DGPFLMA2",48,0) . ;get patient DFN into assignment array "RTN","DGPFLMA2",49,0) . S DGPFA("DFN")=$G(DGDFN) "RTN","DGPFLMA2",50,0) . Q:'DGPFA("DFN") "RTN","DGPFLMA2",51,0) . ; "RTN","DGPFLMA2",52,0) . ;select flag for assignment "RTN","DGPFLMA2",53,0) . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02") "RTN","DGPFLMA2",54,0) . Q:(DGPFA("FLAG")'>0) "RTN","DGPFLMA2",55,0) . ; "RTN","DGPFLMA2",56,0) . ;National ICN when Cat I assignment? "RTN","DGPFLMA2",57,0) . I $P(DGPFA("FLAG"),U)["26.15",'$$MPIOK^DGPFUT(DGPFA("DFN")) D Q "RTN","DGPFLMA2",58,0) . . W !!,"Unable to proceed with flag assignment..." "RTN","DGPFLMA2",59,0) . . D BLD^DIALOG(261132,"","","DGERR","F") "RTN","DGPFLMA2",60,0) . . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMA2",61,0) . . D PAUSE^VALM1 "RTN","DGPFLMA2",62,0) . ; "RTN","DGPFLMA2",63,0) . ;run query for Cat I assignments "RTN","DGPFLMA2",64,0) . I $P(DGPFA("FLAG"),U)["26.15",$$GETSTAT^DGPFHLL1(DGDFN)'="C" D "RTN","DGPFLMA2",65,0) . . N DGDIFF ;difference between pre and post query count "RTN","DGPFLMA2",66,0) . . N DGFLGCNT ;total count of Cat I flags "RTN","DGPFLMA2",67,0) . . N DGPRECNT ;pre-query count of Cat I assignments "RTN","DGPFLMA2",68,0) . . N DGPSTCNT ;post-query count of Cat I assignments "RTN","DGPFLMA2",69,0) . . ; "RTN","DGPFLMA2",70,0) . . ;get count of current assignments "RTN","DGPFLMA2",71,0) . . S (DGPRECNT,DGPSTCNT)=$$GETALL^DGPFAA(DGDFN,,,1) "RTN","DGPFLMA2",72,0) . . ; "RTN","DGPFLMA2",73,0) . . ;get total count of possible Category I flags "RTN","DGPFLMA2",74,0) . . S DGFLGCNT=$$CNTRECS^DGPFUT1(26.15) "RTN","DGPFLMA2",75,0) . . ; "RTN","DGPFLMA2",76,0) . . ;stop if all flags are assigned "RTN","DGPFLMA2",77,0) . . Q:DGPRECNT=DGFLGCNT "RTN","DGPFLMA2",78,0) . . ; "RTN","DGPFLMA2",79,0) . . ;execute the query...stop on failure "RTN","DGPFLMA2",80,0) . . Q:'$$SNDQRY^DGPFHLS(DGDFN,1,.DGFAC) "RTN","DGPFLMA2",81,0) . . ; "RTN","DGPFLMA2",82,0) . . ;recheck current assignment count "RTN","DGPFLMA2",83,0) . . S DGPSTCNT=$$GETALL^DGPFAA(DGDFN,,,1) "RTN","DGPFLMA2",84,0) . . S DGDIFF=DGPSTCNT-DGPRECNT "RTN","DGPFLMA2",85,0) . . W !!," ",$S(DGDIFF=1:"A ",DGDIFF>1:"",1:"No ")_"Category I patient record flag assignment"_$S(DGDIFF>1!('DGDIFF):"s were",1:" was")_" returned" "RTN","DGPFLMA2",86,0) . . W !," from "_$P($$NS^XUAF4($G(DGFAC)),U)_$S(DGDIFF:" and filed on your system.",1:".") "RTN","DGPFLMA2",87,0) . . W ! "RTN","DGPFLMA2",88,0) . . ; "RTN","DGPFLMA2",89,0) . . ;re-build list when flag assignments have been added "RTN","DGPFLMA2",90,0) . . I DGDIFF D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA2",91,0) . ; "RTN","DGPFLMA2",92,0) . ;ok to add new assignment? "RTN","DGPFLMA2",93,0) . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),"DGERR") D Q "RTN","DGPFLMA2",94,0) . . W !!,"Unable to proceed with flag assignment..." "RTN","DGPFLMA2",95,0) . . D MSG^DIALOG("WE","","",5,"DGERR") "RTN","DGPFLMA2",96,0) . . D PAUSE^VALM1 "RTN","DGPFLMA2",97,0) . ; "RTN","DGPFLMA2",98,0) . ;prompt for owner site "RTN","DGPFLMA2",99,0) . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Enter Owner Site",$$EXTERNAL^DILFD(26.13,.04,"",DUZ(2),"DGERR"),"P^4:EMZ","","I $D(^DG(40.8,""APRF"",+Y)),$$TF^XUAF4(+Y)") "RTN","DGPFLMA2",100,0) . Q:(DGPFA("OWNER")'>0) "RTN","DGPFLMA2",101,0) . ; "RTN","DGPFLMA2",102,0) . ;prompt user for approved by person, quit if not selected "RTN","DGPFLMA2",103,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA2",104,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA2",105,0) . ; "RTN","DGPFLMA2",106,0) . ;have user enter assignment narrative text (required) "RTN","DGPFLMA2",107,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA2",108,0) . S DGWPROOT=$NA(^TMP($J,"DGPFNARR")) "RTN","DGPFLMA2",109,0) . K @DGWPROOT "RTN","DGPFLMA2",110,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA2",111,0) . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor "RTN","DGPFLMA2",112,0) . . S DIC=$$OREF^DILF(DGWPROOT) "RTN","DGPFLMA2",113,0) . . S DIWETXT="Patient Record Flag - Assignment Narrative Text" "RTN","DGPFLMA2",114,0) . . S DIWESUB="Assignment Narrative Text" "RTN","DGPFLMA2",115,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA2",116,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA2",117,0) . . D EN^DIWE "RTN","DGPFLMA2",118,0) . . I $$CKWP^DGPFUT(DGWPROOT) S DGOK=1 Q "RTN","DGPFLMA2",119,0) . . W !,"Assignment Narrative Text is required!",*7 "RTN","DGPFLMA2",120,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA2",121,0) . . ; "RTN","DGPFLMA2",122,0) . ;quit if required assignment narrative not entered "RTN","DGPFLMA2",123,0) . Q:$G(DGABORT) "RTN","DGPFLMA2",124,0) . ; "RTN","DGPFLMA2",125,0) . ;place assignment narrative text into assignment array "RTN","DGPFLMA2",126,0) . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT "RTN","DGPFLMA2",127,0) . ; "RTN","DGPFLMA2",128,0) . ;setup remaining assignment and history array nodes for filing "RTN","DGPFLMA2",129,0) . S DGPFA("STATUS")=1 ;active "RTN","DGPFLMA2",130,0) . S DGPFA("ORIGSITE")=DUZ(2) ;current user's login site "RTN","DGPFLMA2",131,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA2",132,0) . S DGPFAH("ACTION")=1 ;new assignment "RTN","DGPFLMA2",133,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA2",134,0) . S DGPFAH("COMMENT",1,0)="New record flag assignment." "RTN","DGPFLMA2",135,0) . ; "RTN","DGPFLMA2",136,0) . ;calculate the default review date "RTN","DGPFLMA2",137,0) . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT")) "RTN","DGPFLMA2",138,0) . ; "RTN","DGPFLMA2",139,0) . ;prompt for review date on valid default review date, otherwise null "RTN","DGPFLMA2",140,0) . I DGRDAT>0 D "RTN","DGPFLMA2",141,0) . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX") "RTN","DGPFLMA2",142,0) . E S DGPFA("REVIEWDT")="" "RTN","DGPFLMA2",143,0) . Q:DGPFA("REVIEWDT")<0 "RTN","DGPFLMA2",144,0) . ; "RTN","DGPFLMA2",145,0) . ;display flag assignment review screen to user "RTN","DGPFLMA2",146,0) . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,"",XQY0,XQORNOD(0)) "RTN","DGPFLMA2",147,0) . ; "RTN","DGPFLMA2",148,0) . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0 "RTN","DGPFLMA2",149,0) . ; "RTN","DGPFLMA2",150,0) . ;file the assignment and history using STOALL api "RTN","DGPFLMA2",151,0) . W !,"Filing the patient's new record flag assignment..." "RTN","DGPFLMA2",152,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA2",153,0) . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.") "RTN","DGPFLMA2",154,0) . ; "RTN","DGPFLMA2",155,0) . ;send HL7 message if adding an assignment to a CAT I flag "RTN","DGPFLMA2",156,0) . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA2",157,0) . . W !?5,"Message sent...updating patient's sites of record." "RTN","DGPFLMA2",158,0) . ; "RTN","DGPFLMA2",159,0) . D PAUSE^VALM1 "RTN","DGPFLMA2",160,0) . ; "RTN","DGPFLMA2",161,0) . ;re-build list of flag assignments for patient "RTN","DGPFLMA2",162,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA2",163,0) ; "RTN","DGPFLMA2",164,0) S VALMBCK="R" "RTN","DGPFLMA2",165,0) ; "RTN","DGPFLMA2",166,0) Q "RTN","DGPFLMA3") 0^8^B70378995 "RTN","DGPFLMA3",1,0) DGPFLMA3 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/2/05 3:24pm "RTN","DGPFLMA3",2,0) ;;5.3;Registration;**425,623,554,650**;Aug 13, 1993;Build 3 "RTN","DGPFLMA3",3,0) ; "RTN","DGPFLMA3",4,0) ;no direct entry "RTN","DGPFLMA3",5,0) QUIT "RTN","DGPFLMA3",6,0) ; "RTN","DGPFLMA3",7,0) EF ;Entry point for DGPF EDIT FLAG ASSIGNMENT action protocol. "RTN","DGPFLMA3",8,0) ; "RTN","DGPFLMA3",9,0) ; Input: None "RTN","DGPFLMA3",10,0) ; "RTN","DGPFLMA3",11,0) ; Output: "RTN","DGPFLMA3",12,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMA3",13,0) ; "RTN","DGPFLMA3",14,0) ;input vars for EN^DIWE call "RTN","DGPFLMA3",15,0) N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK "RTN","DGPFLMA3",16,0) N DGAROOT ;assignment narrative word processing root "RTN","DGPFLMA3",17,0) N DGCROOT ;assignment history comment word processing root "RTN","DGPFLMA3",18,0) N DGABORT ;abort flag for entering assignment narrative "RTN","DGPFLMA3",19,0) N DGASK ;return value from $$ANSWER^DGPFUT call "RTN","DGPFLMA3",20,0) N DGOK ;ok flag for entering assignment narrative "RTN","DGPFLMA3",21,0) N DGCODE ;action code "RTN","DGPFLMA3",22,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFLMA3",23,0) N DGIEN ;assignment ien "RTN","DGPFLMA3",24,0) N DGPFA ;assignment array "RTN","DGPFLMA3",25,0) N DGPFAH ;assignment history array "RTN","DGPFLMA3",26,0) N DGPFERR ;if error returned from STOALL api call "RTN","DGPFLMA3",27,0) N DGQ ;quit var for narrative edit "RTN","DGPFLMA3",28,0) N DGRDAT ;review date "RTN","DGPFLMA3",29,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA3",30,0) N DGERR ;error if unable to edit assignment "RTN","DGPFLMA3",31,0) N DGETEXT ;error text "RTN","DGPFLMA3",32,0) N DGSUB ;for loop var "RTN","DGPFLMA3",33,0) N SEL ;user selection (list item) "RTN","DGPFLMA3",34,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMA3",35,0) ; "RTN","DGPFLMA3",36,0) ;set screen to full scroll region "RTN","DGPFLMA3",37,0) D FULL^VALM1 "RTN","DGPFLMA3",38,0) ; "RTN","DGPFLMA3",39,0) ;quit if selected action is not appropriate "RTN","DGPFLMA3",40,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMA3",41,0) . I '$G(DGDFN) S DGETEXT(1)="Patient has not been selected." "RTN","DGPFLMA3",42,0) . E S DGETEXT(1)="Patient has no record flag assignments." "RTN","DGPFLMA3",43,0) . D BLD^DIALOG(261129,.DGETEXT,"","DGERR","F") "RTN","DGPFLMA3",44,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMA3",45,0) . D PAUSE^VALM1 "RTN","DGPFLMA3",46,0) . S VALMBCK="R" "RTN","DGPFLMA3",47,0) ; "RTN","DGPFLMA3",48,0) ;allow user to select a SINGLE flag assignment for editing "RTN","DGPFLMA3",49,0) S (DGIEN,VALMBCK)="" "RTN","DGPFLMA3",50,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMA3",51,0) ; "RTN","DGPFLMA3",52,0) ;process user selection "RTN","DGPFLMA3",53,0) S SEL=$O(VALMY("")) "RTN","DGPFLMA3",54,0) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D "RTN","DGPFLMA3",55,0) . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U) "RTN","DGPFLMA3",56,0) . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2) "RTN","DGPFLMA3",57,0) . ; "RTN","DGPFLMA3",58,0) . ;attempt to obtain lock on assignment record "RTN","DGPFLMA3",59,0) . I '$$LOCK^DGPFAA3(DGIEN) D Q "RTN","DGPFLMA3",60,0) . . W !!,"Record flag assignment currently in use, can not be edited!" "RTN","DGPFLMA3",61,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",62,0) . ; "RTN","DGPFLMA3",63,0) . ;init word processing arrays "RTN","DGPFLMA3",64,0) . S DGAROOT=$NA(^TMP($J,"DGPFNARR")) "RTN","DGPFLMA3",65,0) . S DGCROOT=$NA(^TMP($J,"DGPFCMNT")) "RTN","DGPFLMA3",66,0) . K @DGAROOT,@DGCROOT "RTN","DGPFLMA3",67,0) . ; "RTN","DGPFLMA3",68,0) . ;get assignment into DGPFA array "RTN","DGPFLMA3",69,0) . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q "RTN","DGPFLMA3",70,0) . . W !!,"Unable to retrieve the record flag assignment selected." "RTN","DGPFLMA3",71,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",72,0) . ; "RTN","DGPFLMA3",73,0) . ;is assignment edit allowed? "RTN","DGPFLMA3",74,0) . I '$$EDTOK^DGPFAA2(.DGPFA,DUZ(2),"DGERR") D Q "RTN","DGPFLMA3",75,0) . . W !!,"Assignment can not be edited..." "RTN","DGPFLMA3",76,0) . . D MSG^DIALOG("WE","","",5,"DGERR") "RTN","DGPFLMA3",77,0) . . D PAUSE^VALM1 "RTN","DGPFLMA3",78,0) . ; "RTN","DGPFLMA3",79,0) . ;-if assigment is active, set available action codes to Continue "RTN","DGPFLMA3",80,0) . ; and Inactivate; else set code to Reactivate "RTN","DGPFLMA3",81,0) . ;-if Local Flag or PRF Phase 2 active, add Entered in Error code "RTN","DGPFLMA3",82,0) . I +DGPFA("STATUS")=1 D "RTN","DGPFLMA3",83,0) . . S DGCODE="S^C:Continue Assignment;I:Inactivate Assignment" "RTN","DGPFLMA3",84,0) . . I $$P2ON^DGPFPARM()!(DGPFA("FLAG")[26.11) S DGCODE=DGCODE_";E:Entered in Error" "RTN","DGPFLMA3",85,0) . E S DGCODE="S^R:Reactivate Assignment" "RTN","DGPFLMA3",86,0) . ; "RTN","DGPFLMA3",87,0) . ;prompt user for assignment action, quit if no action selected "RTN","DGPFLMA3",88,0) . S DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE) "RTN","DGPFLMA3",89,0) . Q:(DGPFAH("ACTION")=-1) "RTN","DGPFLMA3",90,0) . S DGPFAH("ACTION")=$S(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4,DGPFAH("ACTION")="E":5) "RTN","DGPFLMA3",91,0) . ; "RTN","DGPFLMA3",92,0) . ;if assignment action is 'Inactivate' or 'Entered in Error', "RTN","DGPFLMA3",93,0) . ;set status to 'Inactive'. default='Active'. "RTN","DGPFLMA3",94,0) . S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1) "RTN","DGPFLMA3",95,0) . ; "RTN","DGPFLMA3",96,0) . ;if action is not 'Inactivate', then prompt user to edit the narr "RTN","DGPFLMA3",97,0) . S (DGABORT,DGOK,DGQ)=0 "RTN","DGPFLMA3",98,0) . I (DGPFAH("ACTION")'=3) D "RTN","DGPFLMA3",99,0) . . F D Q:(DGOK!DGABORT!DGQ) "RTN","DGPFLMA3",100,0) . . . ; if action code not 'Entered in Error', can't force edit "RTN","DGPFLMA3",101,0) . . . I DGPFAH("ACTION")'=5 D Q:(DGQ!DGABORT) "RTN","DGPFLMA3",102,0) . . . . S DGASK=$$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y") "RTN","DGPFLMA3",103,0) . . . . I DGASK<0 S DGABORT=1 Q ;abort edit action "RTN","DGPFLMA3",104,0) . . . . I DGASK'=1 S DGQ=1 Q "RTN","DGPFLMA3",105,0) . . . ; "RTN","DGPFLMA3",106,0) . . . ;--edit narrative - only '5;Entered in Error' Required "RTN","DGPFLMA3",107,0) . . . ;--edit the assignment narrative "RTN","DGPFLMA3",108,0) . . . S DGAROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT) "RTN","DGPFLMA3",109,0) . . . S DIC=$$OREF^DILF(DGAROOT) "RTN","DGPFLMA3",110,0) . . . S DIWETXT="Patient Record Flag - Assignment Narrative Text" "RTN","DGPFLMA3",111,0) . . . S DIWESUB="Assignment Narrative Text" "RTN","DGPFLMA3",112,0) . . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA3",113,0) . . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA3",114,0) . . . D EN^DIWE "RTN","DGPFLMA3",115,0) . . . I '$$CKWP^DGPFUT(DGAROOT) D Q "RTN","DGPFLMA3",116,0) . . . . W !,"Assignment Narrative Text is required!",*7 "RTN","DGPFLMA3",117,0) . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA3",118,0) . . . ;if number of text lines not the same, a change was made "RTN","DGPFLMA3",119,0) . . . I $O(DGPFA("NARR",""),-1)'=$O(@DGAROOT@(""),-1) S DGOK=1 Q "RTN","DGPFLMA3",120,0) . . . ;now check for a difference in text line content "RTN","DGPFLMA3",121,0) . . . S DGSUB=0 "RTN","DGPFLMA3",122,0) . . . F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:DGSUB="" D Q:DGOK "RTN","DGPFLMA3",123,0) . . . . I DGPFA("NARR",DGSUB,0)'=@DGAROOT@(DGSUB,0) S DGOK=1 "RTN","DGPFLMA3",124,0) . . . Q:DGOK "RTN","DGPFLMA3",125,0) . . . I 'DGOK,(DGPFAH("ACTION")=5) D Q ;required edit "RTN","DGPFLMA3",126,0) . . . . W !!,"No editing was found to the Narrative text." "RTN","DGPFLMA3",127,0) . . . . W !,"For 'Entered in Error' Action, you must edit the Assignment Narrative Text.",*7,! "RTN","DGPFLMA3",128,0) . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA3",129,0) . . . S DGOK=1 "RTN","DGPFLMA3",130,0) . ; "RTN","DGPFLMA3",131,0) . Q:$G(DGABORT) "RTN","DGPFLMA3",132,0) . ; "RTN","DGPFLMA3",133,0) . ;if narrative edited, place new narrative into DGPFA array "RTN","DGPFLMA3",134,0) . I $G(DGOK) D "RTN","DGPFLMA3",135,0) . . K DGPFA("NARR") ;remove old narrative text "RTN","DGPFLMA3",136,0) . . M DGPFA("NARR")=@DGAROOT K @DGAROOT "RTN","DGPFLMA3",137,0) . ; "RTN","DGPFLMA3",138,0) . ;prompt user for 'Approved By' person, quit if not selected "RTN","DGPFLMA3",139,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA3",140,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA3",141,0) . ; "RTN","DGPFLMA3",142,0) . ;have user enter the edit reason/history comments (required) "RTN","DGPFLMA3",143,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA3",144,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA3",145,0) . . W !!,"Enter the reason for editing this assignment:" ;needed for line editor "RTN","DGPFLMA3",146,0) . . S DIC=$$OREF^DILF(DGCROOT) "RTN","DGPFLMA3",147,0) . . S DIWETXT="Patient Record Flag - Edit Reason Text" "RTN","DGPFLMA3",148,0) . . S DIWESUB="Edit Reason Text" "RTN","DGPFLMA3",149,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA3",150,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA3",151,0) . . D EN^DIWE "RTN","DGPFLMA3",152,0) . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q "RTN","DGPFLMA3",153,0) . . W !,"Edit Reason is required!",*7 "RTN","DGPFLMA3",154,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA3",155,0) . ; "RTN","DGPFLMA3",156,0) . ;quit if required edit reason/history comments not entered "RTN","DGPFLMA3",157,0) . Q:$G(DGABORT) "RTN","DGPFLMA3",158,0) . ; "RTN","DGPFLMA3",159,0) . ;place comments into history array "RTN","DGPFLMA3",160,0) . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT "RTN","DGPFLMA3",161,0) . ; "RTN","DGPFLMA3",162,0) . ;setup remaining assignment history nodes for filing "RTN","DGPFLMA3",163,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA3",164,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA3",165,0) . ; "RTN","DGPFLMA3",166,0) . ;calculate the default review date "RTN","DGPFLMA3",167,0) . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT")) "RTN","DGPFLMA3",168,0) . ; "RTN","DGPFLMA3",169,0) . ;prompt for review date when valid default review date and ACTIVE "RTN","DGPFLMA3",170,0) . ;status, otherwise null "RTN","DGPFLMA3",171,0) . I DGRDAT>0,DGPFA("STATUS")=1 D "RTN","DGPFLMA3",172,0) . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX") "RTN","DGPFLMA3",173,0) . E S DGPFA("REVIEWDT")="" "RTN","DGPFLMA3",174,0) . Q:DGPFA("REVIEWDT")<0 "RTN","DGPFLMA3",175,0) . ; "RTN","DGPFLMA3",176,0) . ;display flag assignment review screen to user "RTN","DGPFLMA3",177,0) . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0)) "RTN","DGPFLMA3",178,0) . ; "RTN","DGPFLMA3",179,0) . Q:$$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0 "RTN","DGPFLMA3",180,0) . ; "RTN","DGPFLMA3",181,0) . ;file the assignment and history using STOALL api "RTN","DGPFLMA3",182,0) . W !,"Updating the patient's record flag assignment..." "RTN","DGPFLMA3",183,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA3",184,0) . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.") "RTN","DGPFLMA3",185,0) . ; "RTN","DGPFLMA3",186,0) . ;send HL7 message if editing assignment to a CAT I flag "RTN","DGPFLMA3",187,0) . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA3",188,0) . . W !?5,"Message sent...updating patient's sites of record." "RTN","DGPFLMA3",189,0) . ; "RTN","DGPFLMA3",190,0) . D PAUSE^VALM1 "RTN","DGPFLMA3",191,0) . ; "RTN","DGPFLMA3",192,0) . ;re-build list of flag assignments for patient "RTN","DGPFLMA3",193,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA3",194,0) ; "RTN","DGPFLMA3",195,0) ;release lock after edit "RTN","DGPFLMA3",196,0) D UNLOCK^DGPFAA3(DGIEN) "RTN","DGPFLMA3",197,0) ; "RTN","DGPFLMA3",198,0) ;return to LM (refresh screen) "RTN","DGPFLMA3",199,0) S VALMBCK="R" "RTN","DGPFLMA3",200,0) ; "RTN","DGPFLMA3",201,0) Q "RTN","DGPFLMA4") 0^9^B39834723 "RTN","DGPFLMA4",1,0) DGPFLMA4 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 10/18/06 9:41am "RTN","DGPFLMA4",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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 DGINST ;institution ien "RTN","DGPFLMA4",21,0) N DGPFA ;assignment array "RTN","DGPFLMA4",22,0) N DGPFAH ;assignment history array "RTN","DGPFLMA4",23,0) N DGRESULT ;result of STOALL api call "RTN","DGPFLMA4",24,0) N DGERR ;error if unable to edit assignment "RTN","DGPFLMA4",25,0) N DGETEXT ;error text "RTN","DGPFLMA4",26,0) N DGPFERR ;if error returned from STOALL api call "RTN","DGPFLMA4",27,0) N DGOWN ;valid owner list array "RTN","DGPFLMA4",28,0) N SEL ;user selection (list item) "RTN","DGPFLMA4",29,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMA4",30,0) ; "RTN","DGPFLMA4",31,0) ;set screen to full scroll region "RTN","DGPFLMA4",32,0) D FULL^VALM1 "RTN","DGPFLMA4",33,0) ; "RTN","DGPFLMA4",34,0) ;quit if selected action is not appropriate "RTN","DGPFLMA4",35,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMA4",36,0) . I '$G(DGDFN) S DGETEXT(1)="Patient has not been selected." "RTN","DGPFLMA4",37,0) . E S DGETEXT(1)="Patient has no record flag assignments." "RTN","DGPFLMA4",38,0) . D BLD^DIALOG(261129,.DGETEXT,"","DGERR","F") "RTN","DGPFLMA4",39,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMA4",40,0) . D PAUSE^VALM1 "RTN","DGPFLMA4",41,0) . S VALMBCK="R" "RTN","DGPFLMA4",42,0) ; "RTN","DGPFLMA4",43,0) ;allow user to select a SINGLE flag assignment for ownership change "RTN","DGPFLMA4",44,0) S (DGIEN,VALMBCK)="" "RTN","DGPFLMA4",45,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMA4",46,0) ; "RTN","DGPFLMA4",47,0) ;process user selection "RTN","DGPFLMA4",48,0) S SEL=$O(VALMY("")) "RTN","DGPFLMA4",49,0) I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D "RTN","DGPFLMA4",50,0) . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U) "RTN","DGPFLMA4",51,0) . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2) "RTN","DGPFLMA4",52,0) . ; "RTN","DGPFLMA4",53,0) . ;attempt to obtain lock on assignment record "RTN","DGPFLMA4",54,0) . I '$$LOCK^DGPFAA3(DGIEN) D Q "RTN","DGPFLMA4",55,0) . . W !!,"Record flag assignment currently in use, can not be edited!",*7 "RTN","DGPFLMA4",56,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",57,0) . ; "RTN","DGPFLMA4",58,0) . ;get assignment into DGPFA array "RTN","DGPFLMA4",59,0) . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q "RTN","DGPFLMA4",60,0) . . W !!,"Unable to retrieve the record flag assignment selected.",*7 "RTN","DGPFLMA4",61,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",62,0) . ; "RTN","DGPFLMA4",63,0) . ;can site change ownership of the assignment? "RTN","DGPFLMA4",64,0) . I '$$CHGOWN^DGPFAA2(.DGPFA,$G(DUZ(2)),"DGERR") D Q "RTN","DGPFLMA4",65,0) . . W !!,"Changing the ownership of this record flag assignment not allowed...",*7 "RTN","DGPFLMA4",66,0) . . D MSG^DIALOG("WE","","",5,"DGERR") "RTN","DGPFLMA4",67,0) . . D PAUSE^VALM1 "RTN","DGPFLMA4",68,0) . ; "RTN","DGPFLMA4",69,0) . ;prompt for new OWNER SITE of the assignment "RTN","DGPFLMA4",70,0) . ; "RTN","DGPFLMA4",71,0) . ;-create selection list of enabled division owners "RTN","DGPFLMA4",72,0) . S DGINST=0 "RTN","DGPFLMA4",73,0) . F S DGINST=$O(^DG(40.8,"APRF",DGINST)) Q:'DGINST D "RTN","DGPFLMA4",74,0) . . I $$TF^XUAF4(DGINST) S DGOWN(DGINST)="" "RTN","DGPFLMA4",75,0) . ; "RTN","DGPFLMA4",76,0) . ;-add treating facilities to selection list for Cat I assignments "RTN","DGPFLMA4",77,0) . I $G(DGPFA("FLAG"))["26.15",$$BLDTFL^DGPFUT2(DGDFN,.DGOWN) "RTN","DGPFLMA4",78,0) . ; "RTN","DGPFLMA4",79,0) . ;-remove existing owner from selection list "RTN","DGPFLMA4",80,0) . K DGOWN(+$G(DGPFA("OWNER"))) "RTN","DGPFLMA4",81,0) . ; "RTN","DGPFLMA4",82,0) . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Select new owner site for this record flag assignment","","P^4:EMZ","","I $D(DGOWN(+Y))") "RTN","DGPFLMA4",83,0) . Q:(DGPFA("OWNER")'>0) "RTN","DGPFLMA4",84,0) . ; "RTN","DGPFLMA4",85,0) . ;prompt for APPROVED BY person "RTN","DGPFLMA4",86,0) . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ") "RTN","DGPFLMA4",87,0) . Q:(DGPFAH("APPRVBY")'>0) "RTN","DGPFLMA4",88,0) . ; "RTN","DGPFLMA4",89,0) . ;allow user to enter HISTORY COMMENTS (edit reason) "RTN","DGPFLMA4",90,0) . S DGCROOT=$NA(^TMP($J,"DGPFCMNT")) ;init WP array for hist comments "RTN","DGPFLMA4",91,0) . K @DGCROOT "RTN","DGPFLMA4",92,0) . S (DGABORT,DGOK)=0 "RTN","DGPFLMA4",93,0) . F D Q:(DGOK!DGABORT) "RTN","DGPFLMA4",94,0) . . W !!,"Enter the reason for editing this assignment:" ;needed for line editor "RTN","DGPFLMA4",95,0) . . S @DGCROOT@(1,0)="Change of flag assignment ownership. " "RTN","DGPFLMA4",96,0) . . S DIC=$$OREF^DILF(DGCROOT) "RTN","DGPFLMA4",97,0) . . S DIWETXT="Enter the reason for record flag assignment ownership change:" "RTN","DGPFLMA4",98,0) . . S DIWESUB="Change of Ownership Reason" "RTN","DGPFLMA4",99,0) . . S DWLW=75 ;max # of chars allowed to be stored on WP global node "RTN","DGPFLMA4",100,0) . . S DWPK=1 ;if line editor, don't join lines "RTN","DGPFLMA4",101,0) . . S DDWC="E" ;initially place cursor at end of line 1 "RTN","DGPFLMA4",102,0) . . D EN^DIWE "RTN","DGPFLMA4",103,0) . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q "RTN","DGPFLMA4",104,0) . . W !,"The reason for editing this record flag assignment is required!",*7 "RTN","DGPFLMA4",105,0) . . I '$$CONTINUE^DGPFUT() S DGABORT=1 "RTN","DGPFLMA4",106,0) . ; "RTN","DGPFLMA4",107,0) . ;quit if required HISTORY COMMENTS not entered "RTN","DGPFLMA4",108,0) . Q:$G(DGABORT) "RTN","DGPFLMA4",109,0) . ; "RTN","DGPFLMA4",110,0) . ;place HISTORY COMMENTS into history array "RTN","DGPFLMA4",111,0) . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT "RTN","DGPFLMA4",112,0) . ; "RTN","DGPFLMA4",113,0) . ;setup remaining assignment history array nodes for filing "RTN","DGPFLMA4",114,0) . S DGPFAH("ACTION")=2 ;continue "RTN","DGPFLMA4",115,0) . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time "RTN","DGPFLMA4",116,0) . S DGPFAH("ENTERBY")=DUZ ;current user "RTN","DGPFLMA4",117,0) . ; "RTN","DGPFLMA4",118,0) . ;relinquishing ownership should remove existing review date when "RTN","DGPFLMA4",119,0) . ;new owner is not a local division "RTN","DGPFLMA4",120,0) . I '$D(^DG(40.8,"APRF",DGPFA("OWNER"))) S DGPFA("REVIEWDT")="" "RTN","DGPFLMA4",121,0) . ; "RTN","DGPFLMA4",122,0) . ;display flag assignment review screen to user "RTN","DGPFLMA4",123,0) . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0)) "RTN","DGPFLMA4",124,0) . ; "RTN","DGPFLMA4",125,0) . ;ask user if ok to file ownership change "RTN","DGPFLMA4",126,0) . Q:$$ANSWER^DGPFUT("Would you like to file the assignment ownership change","YES","Y")'>0 "RTN","DGPFLMA4",127,0) . ; "RTN","DGPFLMA4",128,0) . ;file the assignment and history using STOALL api "RTN","DGPFLMA4",129,0) . W !!,"Updating the ownership of this patient's record flag assignment..." "RTN","DGPFLMA4",130,0) . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR) "RTN","DGPFLMA4",131,0) . W !?5,"Update was "_$S(+$G(DGRESULT):"successful",1:"not successful")_"." "RTN","DGPFLMA4",132,0) . ; "RTN","DGPFLMA4",133,0) . ;send HL7 ORU msg if editing assignment to a Cat I flag "RTN","DGPFLMA4",134,0) . I +$G(DGRESULT),$G(DGPFA("FLAG"))["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D "RTN","DGPFLMA4",135,0) . . W !?5,"Message sent...updating patient's sites of record." "RTN","DGPFLMA4",136,0) . ; "RTN","DGPFLMA4",137,0) . D PAUSE^VALM1 "RTN","DGPFLMA4",138,0) . ; "RTN","DGPFLMA4",139,0) . ;rebuild list of flag assignments for patient "RTN","DGPFLMA4",140,0) . D BLDLIST^DGPFLMU(DGDFN) "RTN","DGPFLMA4",141,0) . ; "RTN","DGPFLMA4",142,0) . ;release lock after CO edit "RTN","DGPFLMA4",143,0) . D UNLOCK^DGPFAA3(DGIEN) "RTN","DGPFLMA4",144,0) ; "RTN","DGPFLMA4",145,0) ;return to LM (refresh screen) "RTN","DGPFLMA4",146,0) S VALMBCK="R" "RTN","DGPFLMA4",147,0) ; "RTN","DGPFLMA4",148,0) Q "RTN","DGPFLMQ") 0^42^B591948 "RTN","DGPFLMQ",1,0) DGPFLMQ ;ALB/RPM - PRF QUERY LISTMAN SCREEN ; 1/24/06 13:47 "RTN","DGPFLMQ",2,0) ;;5.3;Registration;**650**;Aug 13,1993;Build 3 "RTN","DGPFLMQ",3,0) ; "RTN","DGPFLMQ",4,0) Q ;no direct entry "RTN","DGPFLMQ",5,0) ; "RTN","DGPFLMQ",6,0) EN(DGORF) ;Main entry point for DGPF RECORD FLAG QUERY list. "RTN","DGPFLMQ",7,0) ; "RTN","DGPFLMQ",8,0) ; Input: "RTN","DGPFLMQ",9,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ",10,0) ; "RTN","DGPFLMQ",11,0) ; Output: None "RTN","DGPFLMQ",12,0) ; "RTN","DGPFLMQ",13,0) Q:$G(DGORF)="" "RTN","DGPFLMQ",14,0) ; "RTN","DGPFLMQ",15,0) ;display wait msg to user "RTN","DGPFLMQ",16,0) D WAIT^DICD "RTN","DGPFLMQ",17,0) ; "RTN","DGPFLMQ",18,0) ;invoke list manager and load list template "RTN","DGPFLMQ",19,0) D EN^VALM("DGPF RECORD FLAG QUERY") "RTN","DGPFLMQ",20,0) Q "RTN","DGPFLMQ",21,0) ; "RTN","DGPFLMQ",22,0) ; "RTN","DGPFLMQ",23,0) HDR ;Header Code "RTN","DGPFLMQ",24,0) D BLDHDR^DGPFLMQ1(DGORF,.VALMHDR) Q "RTN","DGPFLMQ",25,0) Q "RTN","DGPFLMQ",26,0) ; "RTN","DGPFLMQ",27,0) INIT ;Init variables and list array "RTN","DGPFLMQ",28,0) D BLDLIST^DGPFLMQ1(DGORF) "RTN","DGPFLMQ",29,0) Q "RTN","DGPFLMQ",30,0) ; "RTN","DGPFLMQ",31,0) HELP ;Help Code "RTN","DGPFLMQ",32,0) N X "RTN","DGPFLMQ",33,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMQ",34,0) Q "RTN","DGPFLMQ",35,0) ; "RTN","DGPFLMQ",36,0) ; "RTN","DGPFLMQ",37,0) EXIT ;Exit Code "RTN","DGPFLMQ",38,0) ; "RTN","DGPFLMQ",39,0) D CLEAN^VALM10 "RTN","DGPFLMQ",40,0) D CLEAR^VALM1 "RTN","DGPFLMQ",41,0) Q "RTN","DGPFLMQ",42,0) ; "RTN","DGPFLMQ",43,0) ; "RTN","DGPFLMQ",44,0) EXPND ;Expand Code "RTN","DGPFLMQ",45,0) Q "RTN","DGPFLMQ1") 0^44^B22327142 "RTN","DGPFLMQ1",1,0) DGPFLMQ1 ;ALB/RPM - PRF QUERY LISTMAN SCREEN BUILDER; 6/19/06 "RTN","DGPFLMQ1",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMQ1",3,0) ; "RTN","DGPFLMQ1",4,0) Q ;no direct entry "RTN","DGPFLMQ1",5,0) ; "RTN","DGPFLMQ1",6,0) BLDHDR(DGORF,DGPFHDR) ;build VALMHDR array "RTN","DGPFLMQ1",7,0) ;This procedure builds the VALMHDR array to display the ListMan header. "RTN","DGPFLMQ1",8,0) ; "RTN","DGPFLMQ1",9,0) ; Supported DBIA #2701: The supported DBIA is used to access the "RTN","DGPFLMQ1",10,0) ; MPI functions to retrieve the ICN and CMOR. "RTN","DGPFLMQ1",11,0) ; "RTN","DGPFLMQ1",12,0) ; Input: "RTN","DGPFLMQ1",13,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ1",14,0) ; DGPFHDR - header array passed by reference "RTN","DGPFLMQ1",15,0) ; "RTN","DGPFLMQ1",16,0) ; Output: "RTN","DGPFLMQ1",17,0) ; DGPFHDR - header array "RTN","DGPFLMQ1",18,0) ; "RTN","DGPFLMQ1",19,0) N DGDFN ;pointer to patient in PATIENT (#2) file "RTN","DGPFLMQ1",20,0) N DGFACNAM ;facility name "RTN","DGPFLMQ1",21,0) N DGICN ;Integrated Control Number "RTN","DGPFLMQ1",22,0) N DGPFPAT ;Patient identifying info "RTN","DGPFLMQ1",23,0) ; "RTN","DGPFLMQ1",24,0) S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN"))) "RTN","DGPFLMQ1",25,0) ; "RTN","DGPFLMQ1",26,0) ;retrieve patient identifying info "RTN","DGPFLMQ1",27,0) I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT) "RTN","DGPFLMQ1",28,0) ; "RTN","DGPFLMQ1",29,0) ;set 1st line of header "RTN","DGPFLMQ1",30,0) S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" " "RTN","DGPFLMQ1",31,0) S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80) "RTN","DGPFLMQ1",32,0) S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80) "RTN","DGPFLMQ1",33,0) ; "RTN","DGPFLMQ1",34,0) ;set 2nd line of header "RTN","DGPFLMQ1",35,0) S DGICN=$G(@DGORF@("ICN")) "RTN","DGPFLMQ1",36,0) S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN) "RTN","DGPFLMQ1",37,0) S DGPFHDR(2)=" ICN: "_DGICN "RTN","DGPFLMQ1",38,0) S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4($G(@DGORF@("SNDFAC")))) "RTN","DGPFLMQ1",39,0) S DGPFHDR(2)=$$SETSTR^VALM1("FACILITY QUERIED: "_DGFACNAM,DGPFHDR(2),41,27) "RTN","DGPFLMQ1",40,0) Q "RTN","DGPFLMQ1",41,0) ; "RTN","DGPFLMQ1",42,0) ; "RTN","DGPFLMQ1",43,0) BLDLIST(DGORF) ;build list of returned assignments "RTN","DGPFLMQ1",44,0) ; "RTN","DGPFLMQ1",45,0) ; Input: "RTN","DGPFLMQ1",46,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ1",47,0) ; "RTN","DGPFLMQ1",48,0) ; Output: none "RTN","DGPFLMQ1",49,0) ; "RTN","DGPFLMQ1",50,0) D CLEAN^VALM10 "RTN","DGPFLMQ1",51,0) N DGSET ;flag assignment indicator "RTN","DGPFLMQ1",52,0) ; "RTN","DGPFLMQ1",53,0) ; "RTN","DGPFLMQ1",54,0) S DGSET=0,VALMCNT=0 "RTN","DGPFLMQ1",55,0) F S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET D "RTN","DGPFLMQ1",56,0) . S VALMCNT=VALMCNT+1 "RTN","DGPFLMQ1",57,0) . N DGPFA ;assignment data array "RTN","DGPFLMQ1",58,0) . ; "RTN","DGPFLMQ1",59,0) . ;load assignment data array "RTN","DGPFLMQ1",60,0) . D LDASGN^DGPFLMQ2(DGSET,DGORF,.DGPFA) "RTN","DGPFLMQ1",61,0) . ; "RTN","DGPFLMQ1",62,0) . S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date "RTN","DGPFLMQ1",63,0) . ; "RTN","DGPFLMQ1",64,0) . ;get most recent assignment history to calculate current status "RTN","DGPFLMQ1",65,0) . S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1) "RTN","DGPFLMQ1",66,0) . S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION"))) "RTN","DGPFLMQ1",67,0) . S DGPFA("NUMACT")=$$NUMACT(DGSET,DGORF) "RTN","DGPFLMQ1",68,0) . ; "RTN","DGPFLMQ1",69,0) . ;build Assignment line "RTN","DGPFLMQ1",70,0) . D BLDLIN(VALMCNT,.DGPFA,DGSET) "RTN","DGPFLMQ1",71,0) ; "RTN","DGPFLMQ1",72,0) Q "RTN","DGPFLMQ1",73,0) ; "RTN","DGPFLMQ1",74,0) ; "RTN","DGPFLMQ1",75,0) BLDLIN(DGLNUM,DGPFA,DGSET) ;build and format lines "RTN","DGPFLMQ1",76,0) ;This procedure will build and setup ListMan lines and array. "RTN","DGPFLMQ1",77,0) ; "RTN","DGPFLMQ1",78,0) ; Input: "RTN","DGPFLMQ1",79,0) ; DGLNUM - line number "RTN","DGPFLMQ1",80,0) ; DGPFA - array containing assignment, passed by reference "RTN","DGPFLMQ1",81,0) ; DGSET - set id representing a single PRF assignment "RTN","DGPFLMQ1",82,0) ; "RTN","DGPFLMQ1",83,0) ; Output: None "RTN","DGPFLMQ1",84,0) ; "RTN","DGPFLMQ1",85,0) N DGTXT ;used as temporary text field "RTN","DGPFLMQ1",86,0) N DGLINE ;string to insert field data "RTN","DGPFLMQ1",87,0) S DGLINE="" ;init "RTN","DGPFLMQ1",88,0) S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3) "RTN","DGPFLMQ1",89,0) ; "RTN","DGPFLMQ1",90,0) ;flag name "RTN","DGPFLMQ1",91,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG"))) "RTN","DGPFLMQ1",92,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG") "RTN","DGPFLMQ1",93,0) ; "RTN","DGPFLMQ1",94,0) ;initial assignment date "RTN","DGPFLMQ1",95,0) S DGTXT=$$FDATE^VALM1(+$G(DGPFA("INITASSIGN"))) "RTN","DGPFLMQ1",96,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE") "RTN","DGPFLMQ1",97,0) ; "RTN","DGPFLMQ1",98,0) ;status/active (yes/no) "RTN","DGPFLMQ1",99,0) S DGTXT=$P($G(DGPFA("STATUS")),U) "RTN","DGPFLMQ1",100,0) S DGTXT=$S(DGTXT=1:"YES",1:"NO") "RTN","DGPFLMQ1",101,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS") "RTN","DGPFLMQ1",102,0) ; "RTN","DGPFLMQ1",103,0) ;# of actions "RTN","DGPFLMQ1",104,0) S DGTXT=DGPFA("NUMACT") "RTN","DGPFLMQ1",105,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ACTION CNT") "RTN","DGPFLMQ1",106,0) ; "RTN","DGPFLMQ1",107,0) ;owner site "RTN","DGPFLMQ1",108,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER"))) "RTN","DGPFLMQ1",109,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE") "RTN","DGPFLMQ1",110,0) ; "RTN","DGPFLMQ1",111,0) ;construct initial list array and "IDX" "RTN","DGPFLMQ1",112,0) D SET^VALM10(DGLNUM,DGLINE,+$G(DGSET)) "RTN","DGPFLMQ1",113,0) ; "RTN","DGPFLMQ1",114,0) Q "RTN","DGPFLMQ1",115,0) ; "RTN","DGPFLMQ1",116,0) NUMACT(DGSET,DGORF) ;count actions "RTN","DGPFLMQ1",117,0) ;This function counts the number of assignment actions for a given "RTN","DGPFLMQ1",118,0) ;flag assignment. "RTN","DGPFLMQ1",119,0) ; "RTN","DGPFLMQ1",120,0) ; Input: "RTN","DGPFLMQ1",121,0) ; DGSET - set id representing a single PRF assignment "RTN","DGPFLMQ1",122,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ1",123,0) ; "RTN","DGPFLMQ1",124,0) ; Output: "RTN","DGPFLMQ1",125,0) ; Function value - count of assignment actions "RTN","DGPFLMQ1",126,0) ; "RTN","DGPFLMQ1",127,0) N DGADT ;assignment date "RTN","DGPFLMQ1",128,0) N DGCNT ;function value "RTN","DGPFLMQ1",129,0) ; "RTN","DGPFLMQ1",130,0) S DGADT=0,DGCNT=0 "RTN","DGPFLMQ1",131,0) F S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT S DGCNT=DGCNT+1 "RTN","DGPFLMQ1",132,0) ; "RTN","DGPFLMQ1",133,0) Q DGCNT "RTN","DGPFLMQ1",134,0) ; "RTN","DGPFLMQ1",135,0) ; "RTN","DGPFLMQ1",136,0) DR ;Display Query Results action "RTN","DGPFLMQ1",137,0) ;This procedure is called by the DGPF DISPLAY QUERY RESULTS action "RTN","DGPFLMQ1",138,0) ;protocol. "RTN","DGPFLMQ1",139,0) ; "RTN","DGPFLMQ1",140,0) ; Input: "RTN","DGPFLMQ1",141,0) ; DGORF - parsed ORF segments data array passed globally "RTN","DGPFLMQ1",142,0) ; "RTN","DGPFLMQ1",143,0) ; Output: "RTN","DGPFLMQ1",144,0) ; VALMBCK - 'R'= refresh screen "RTN","DGPFLMQ1",145,0) ; "RTN","DGPFLMQ1",146,0) N DGSET ;flag assignment indicator "RTN","DGPFLMQ1",147,0) N SEL ;user selection "RTN","DGPFLMQ1",148,0) N VALMY ;output of EN^VALM2 call, array of user selected entries "RTN","DGPFLMQ1",149,0) ; "RTN","DGPFLMQ1",150,0) ;set screen to full scroll region "RTN","DGPFLMQ1",151,0) D FULL^VALM1 "RTN","DGPFLMQ1",152,0) ; "RTN","DGPFLMQ1",153,0) ;is action selection allowed? "RTN","DGPFLMQ1",154,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMQ1",155,0) . W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7 "RTN","DGPFLMQ1",156,0) . W !?6,"There are no record flag assignment query results for this patient." "RTN","DGPFLMQ1",157,0) . D PAUSE^VALM1 "RTN","DGPFLMQ1",158,0) . S VALMBCK="R" "RTN","DGPFLMQ1",159,0) ; "RTN","DGPFLMQ1",160,0) ;ask user to select a single assignment for detail display "RTN","DGPFLMQ1",161,0) S (SEL,VALMBCK)="" "RTN","DGPFLMQ1",162,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMQ1",163,0) ; "RTN","DGPFLMQ1",164,0) ;process user selection "RTN","DGPFLMQ1",165,0) S SEL=$O(VALMY("")) "RTN","DGPFLMQ1",166,0) I SEL,$D(@VALMAR@("IDX",SEL)) D "RTN","DGPFLMQ1",167,0) . S DGSET=$O(@VALMAR@("IDX",SEL,"")) "RTN","DGPFLMQ1",168,0) . ;-display query result flag assignment details "RTN","DGPFLMQ1",169,0) . N VALMHDR "RTN","DGPFLMQ1",170,0) . D EN^DGPFLMQD(DGSET,DGORF) "RTN","DGPFLMQ1",171,0) ; "RTN","DGPFLMQ1",172,0) ;return to LM (refresh screen) "RTN","DGPFLMQ1",173,0) S VALMBCK="R" "RTN","DGPFLMQ1",174,0) Q "RTN","DGPFLMQ2") 0^45^B39288801 "RTN","DGPFLMQ2",1,0) DGPFLMQ2 ;ALB/RPM - PRF HL7 QUERY RESULTS DISPLAY UTILITIES ; 1/25/06 11:24 "RTN","DGPFLMQ2",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMQ2",3,0) ; "RTN","DGPFLMQ2",4,0) Q ;no direct entry "RTN","DGPFLMQ2",5,0) ; "RTN","DGPFLMQ2",6,0) EN(DGARY,DGSET,DGCNT) ;display ORF query results "RTN","DGPFLMQ2",7,0) ; "RTN","DGPFLMQ2",8,0) ; Input: "RTN","DGPFLMQ2",9,0) ; DGARY - global array subscript "RTN","DGPFLMQ2",10,0) ; DGSET - set id representing a single PRF assignment "RTN","DGPFLMQ2",11,0) ; "RTN","DGPFLMQ2",12,0) ; Output: "RTN","DGPFLMQ2",13,0) ; DGCNT - number of lines in list, pass by reference "RTN","DGPFLMQ2",14,0) ; "RTN","DGPFLMQ2",15,0) N DGADT ;assignment date "RTN","DGPFLMQ2",16,0) N DGHISCNT ;history action counter "RTN","DGPFLMQ2",17,0) N DGLINE ;list line counter "RTN","DGPFLMQ2",18,0) N DGPFA ;assignment data array "RTN","DGPFLMQ2",19,0) N DGPFAH ;assignment history data array "RTN","DGPFLMQ2",20,0) ; "RTN","DGPFLMQ2",21,0) S (DGLINE,VALMBEG)=1 "RTN","DGPFLMQ2",22,0) S DGCNT=0 "RTN","DGPFLMQ2",23,0) ; "RTN","DGPFLMQ2",24,0) ;load assignment data array "RTN","DGPFLMQ2",25,0) D LDASGN(DGSET,DGORF,.DGPFA) "RTN","DGPFLMQ2",26,0) S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date "RTN","DGPFLMQ2",27,0) ; "RTN","DGPFLMQ2",28,0) ;get most recent assignment history to calculate current status "RTN","DGPFLMQ2",29,0) S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1) "RTN","DGPFLMQ2",30,0) S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION"))) "RTN","DGPFLMQ2",31,0) ; "RTN","DGPFLMQ2",32,0) ;build Assignment Details area "RTN","DGPFLMQ2",33,0) D ASGN(DGARY,.DGPFA,.DGLINE,.DGCNT) "RTN","DGPFLMQ2",34,0) ; "RTN","DGPFLMQ2",35,0) ;build Assignment History heading "RTN","DGPFLMQ2",36,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",37,0) D SET(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,.DGCNT) "RTN","DGPFLMQ2",38,0) D SET(DGARY,DGLINE,"",30,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMQ2",39,0) ; "RTN","DGPFLMQ2",40,0) S DGHISCNT=0 "RTN","DGPFLMQ2",41,0) S DGADT=9999999.999999 ;each DGADT represents a single PRF history action "RTN","DGPFLMQ2",42,0) F S DGADT=$O(@DGORF@(DGSET,DGADT),-1) Q:'DGADT D "RTN","DGPFLMQ2",43,0) . N DGPFAH ;assignment history data array "RTN","DGPFLMQ2",44,0) . S DGHISCNT=DGHISCNT+1 "RTN","DGPFLMQ2",45,0) . ; "RTN","DGPFLMQ2",46,0) . ;load assignment history data array "RTN","DGPFLMQ2",47,0) . D LDHIST(DGSET,DGADT,DGORF,.DGPFAH) "RTN","DGPFLMQ2",48,0) . ; "RTN","DGPFLMQ2",49,0) . ;build History Details area "RTN","DGPFLMQ2",50,0) . D HIST(DGARY,.DGPFAH,.DGLINE,DGHISCNT,.DGCNT) "RTN","DGPFLMQ2",51,0) S ^TMP(DGARY,$J,"SET")=DGSET "RTN","DGPFLMQ2",52,0) Q "RTN","DGPFLMQ2",53,0) ; "RTN","DGPFLMQ2",54,0) ; "RTN","DGPFLMQ2",55,0) LDASGN(DGSET,DGORF,DGPFA) ;load assignment data array "RTN","DGPFLMQ2",56,0) ; "RTN","DGPFLMQ2",57,0) ; Input: "RTN","DGPFLMQ2",58,0) ; DGSET - set id representing a single PRF assignment "RTN","DGPFLMQ2",59,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ2",60,0) ; "RTN","DGPFLMQ2",61,0) ; Output: "RTN","DGPFLMQ2",62,0) ; DGPFA - assignment data array "RTN","DGPFLMQ2",63,0) ; "RTN","DGPFLMQ2",64,0) S DGPFA("DFN")=+$$GETDFN^MPIF001($G(@DGORF@("ICN"))) "RTN","DGPFLMQ2",65,0) S DGPFA("FLAG")=$G(@DGORF@(DGSET,"FLAG")) "RTN","DGPFLMQ2",66,0) Q:DGPFA("FLAG")']"" "RTN","DGPFLMQ2",67,0) ; "RTN","DGPFLMQ2",68,0) ;init STATUS as a placeholder, set value following history retrieval "RTN","DGPFLMQ2",69,0) S DGPFA("STATUS")="" "RTN","DGPFLMQ2",70,0) S DGPFA("OWNER")=$G(@DGORF@(DGSET,"OWNER")) "RTN","DGPFLMQ2",71,0) S DGPFA("ORIGSITE")=$G(@DGORF@(DGSET,"ORIGSITE")) "RTN","DGPFLMQ2",72,0) M DGPFA("NARR")=@DGORF@(DGSET,"NARR") "RTN","DGPFLMQ2",73,0) ; "RTN","DGPFLMQ2",74,0) Q "RTN","DGPFLMQ2",75,0) ; "RTN","DGPFLMQ2",76,0) ; "RTN","DGPFLMQ2",77,0) LDHIST(DGSET,DGADT,DGORF,DGPFAH) ;load assignment history data array "RTN","DGPFLMQ2",78,0) ; "RTN","DGPFLMQ2",79,0) ; Input: "RTN","DGPFLMQ2",80,0) ; DGSET - set id representing a single PRF assignment "RTN","DGPFLMQ2",81,0) ; DGADT - assignment date "RTN","DGPFLMQ2",82,0) ; DGORF - parsed ORF segments data array "RTN","DGPFLMQ2",83,0) ; "RTN","DGPFLMQ2",84,0) ; Output: "RTN","DGPFLMQ2",85,0) ; DGPFAH - assignment history data array "RTN","DGPFLMQ2",86,0) ; "RTN","DGPFLMQ2",87,0) S DGPFAH("ASSIGNDT")=DGADT "RTN","DGPFLMQ2",88,0) S DGPFAH("ACTION")=$G(@DGORF@(DGSET,DGADT,"ACTION")) "RTN","DGPFLMQ2",89,0) S DGPFAH("ENTERBY")=.5 ;POSTMASTER "RTN","DGPFLMQ2",90,0) S DGPFAH("APPRVBY")=.5 ;POSTMASTER "RTN","DGPFLMQ2",91,0) M DGPFAH("COMMENT")=@DGORF@(DGSET,DGADT,"COMMENT") "RTN","DGPFLMQ2",92,0) Q "RTN","DGPFLMQ2",93,0) ; "RTN","DGPFLMQ2",94,0) ; "RTN","DGPFLMQ2",95,0) ASGN(DGARY,DGPFA,DGLINE,DGCNT) ;format assignment details "RTN","DGPFLMQ2",96,0) ;This procedure will build and format the lines of FLAG ASSIGNMENT "RTN","DGPFLMQ2",97,0) ;details. "RTN","DGPFLMQ2",98,0) ; "RTN","DGPFLMQ2",99,0) ; Input: "RTN","DGPFLMQ2",100,0) ; DGARY - global array subscript "RTN","DGPFLMQ2",101,0) ; DGPFA - assignment array, pass by reference "RTN","DGPFLMQ2",102,0) ; DGLINE - line counter, pass by reference "RTN","DGPFLMQ2",103,0) ; "RTN","DGPFLMQ2",104,0) ; Output: "RTN","DGPFLMQ2",105,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMQ2",106,0) ; "RTN","DGPFLMQ2",107,0) ;temporary variables used "RTN","DGPFLMQ2",108,0) N DGSUB "RTN","DGPFLMQ2",109,0) N DGTMP "RTN","DGPFLMQ2",110,0) N DGTXT "RTN","DGPFLMQ2",111,0) ; "RTN","DGPFLMQ2",112,0) ;set flag name "RTN","DGPFLMQ2",113,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG"))) "RTN","DGPFLMQ2",114,0) I DGTXT="" S DGTXT="**FLAG not defined**" "RTN","DGPFLMQ2",115,0) D SET(DGARY,DGLINE,"Flag Name: "_DGTXT,12,,,.DGCNT) "RTN","DGPFLMQ2",116,0) ; "RTN","DGPFLMQ2",117,0) ;set flag assignment status "RTN","DGPFLMQ2",118,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",119,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.03,"F",$G(DGPFA("STATUS"))) "RTN","DGPFLMQ2",120,0) D SET(DGARY,DGLINE,"Assignment Status: "_DGTXT,4,,,.DGCNT) "RTN","DGPFLMQ2",121,0) ; "RTN","DGPFLMQ2",122,0) ;set initial assignment date "RTN","DGPFLMQ2",123,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",124,0) S DGTXT=$$FDTTM^VALM1($P(+$G(DGPFA("INITASSIGN")),U)) "RTN","DGPFLMQ2",125,0) D SET(DGARY,DGLINE,"Initial Assignment: "_DGTXT,3,,,.DGCNT) "RTN","DGPFLMQ2",126,0) ; "RTN","DGPFLMQ2",127,0) ;set owner site "RTN","DGPFLMQ2",128,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",129,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER"))) "RTN","DGPFLMQ2",130,0) D SET(DGARY,DGLINE,"Owner Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),11,,,.DGCNT) "RTN","DGPFLMQ2",131,0) ; "RTN","DGPFLMQ2",132,0) ;set originating site "RTN","DGPFLMQ2",133,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",134,0) S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("ORIGSITE"))) "RTN","DGPFLMQ2",135,0) D SET(DGARY,DGLINE,"Originating Site: "_DGTXT_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),5,,,.DGCNT) "RTN","DGPFLMQ2",136,0) ; "RTN","DGPFLMQ2",137,0) ;set assignment narrative "RTN","DGPFLMQ2",138,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",139,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMQ2",140,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",141,0) D SET(DGARY,DGLINE,"Record Flag Assignment Narrative:",1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMQ2",142,0) I '$D(DGPFA("NARR",1,0)) D Q "RTN","DGPFLMQ2",143,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",144,0) . D SET(DGARY,DGLINE,"No Narrative Text",1,,,.DGCNT) "RTN","DGPFLMQ2",145,0) S (DGSUB,DGTMP)="" "RTN","DGPFLMQ2",146,0) F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:'DGSUB D "RTN","DGPFLMQ2",147,0) . S DGTMP=$G(DGPFA("NARR",DGSUB,0)) "RTN","DGPFLMQ2",148,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",149,0) . D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT) "RTN","DGPFLMQ2",150,0) ; "RTN","DGPFLMQ2",151,0) ;set blank lines "RTN","DGPFLMQ2",152,0) S DGLINE=DGLINE+2 "RTN","DGPFLMQ2",153,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMQ2",154,0) ; "RTN","DGPFLMQ2",155,0) Q "RTN","DGPFLMQ2",156,0) ; "RTN","DGPFLMQ2",157,0) ; "RTN","DGPFLMQ2",158,0) HIST(DGARY,DGPFAH,DGLINE,DGHISCNT,DGCNT) ;format history details "RTN","DGPFLMQ2",159,0) ;This procedure will build and format the lines of FLAG ASSIGNMENT "RTN","DGPFLMQ2",160,0) ;HISTORY details. "RTN","DGPFLMQ2",161,0) ; "RTN","DGPFLMQ2",162,0) ; Input: "RTN","DGPFLMQ2",163,0) ; DGARY - global array subscript "RTN","DGPFLMQ2",164,0) ; DGPFAH - assignment history array, pass by reference "RTN","DGPFLMQ2",165,0) ; DGLINE - line counter, pass by reference "RTN","DGPFLMQ2",166,0) ; DGHISCNT - counter of history record "RTN","DGPFLMQ2",167,0) ; "RTN","DGPFLMQ2",168,0) ; Output: "RTN","DGPFLMQ2",169,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMQ2",170,0) ; "RTN","DGPFLMQ2",171,0) ;temporary variables used "RTN","DGPFLMQ2",172,0) N DGTMP "RTN","DGPFLMQ2",173,0) N DGSUB "RTN","DGPFLMQ2",174,0) ; "RTN","DGPFLMQ2",175,0) ;set blank line "RTN","DGPFLMQ2",176,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",177,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMQ2",178,0) ; "RTN","DGPFLMQ2",179,0) ;add an additional blank line except on the first history "RTN","DGPFLMQ2",180,0) I DGHISCNT>1 D "RTN","DGPFLMQ2",181,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",182,0) . D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMQ2",183,0) ; "RTN","DGPFLMQ2",184,0) ;set action "RTN","DGPFLMQ2",185,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",186,0) S DGTMP=DGHISCNT_"." "RTN","DGPFLMQ2",187,0) D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMQ2",188,0) D SET(DGARY,DGLINE,"Action: "_$$EXTERNAL^DILFD(26.14,.03,"F",$G(DGPFAH("ACTION"))),10,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMQ2",189,0) ; "RTN","DGPFLMQ2",190,0) ;set assignment date "RTN","DGPFLMQ2",191,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",192,0) D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT) "RTN","DGPFLMQ2",193,0) ; "RTN","DGPFLMQ2",194,0) ;set history comments "RTN","DGPFLMQ2",195,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",196,0) D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT) "RTN","DGPFLMQ2",197,0) S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",198,0) D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT) "RTN","DGPFLMQ2",199,0) I $D(DGPFAH("COMMENT",1,0)) D "RTN","DGPFLMQ2",200,0) . S (DGSUB,DGTMP)="" "RTN","DGPFLMQ2",201,0) . F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D "RTN","DGPFLMQ2",202,0) .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0)) "RTN","DGPFLMQ2",203,0) .. S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",204,0) .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT) "RTN","DGPFLMQ2",205,0) E D "RTN","DGPFLMQ2",206,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMQ2",207,0) . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT) "RTN","DGPFLMQ2",208,0) ; "RTN","DGPFLMQ2",209,0) Q "RTN","DGPFLMQ2",210,0) ; "RTN","DGPFLMQ2",211,0) ; "RTN","DGPFLMQ2",212,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","DGPFLMQ2",213,0) ; "RTN","DGPFLMQ2",214,0) ; Input: "RTN","DGPFLMQ2",215,0) ; DGARY - global array subscript "RTN","DGPFLMQ2",216,0) ; DGLINE - line number "RTN","DGPFLMQ2",217,0) ; DGTEXT - text "RTN","DGPFLMQ2",218,0) ; DGCOL - starting column "RTN","DGPFLMQ2",219,0) ; DGON - highlighting on "RTN","DGPFLMQ2",220,0) ; DGOFF - highlighting off "RTN","DGPFLMQ2",221,0) ; "RTN","DGPFLMQ2",222,0) ; Output: "RTN","DGPFLMQ2",223,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMQ2",224,0) ; "RTN","DGPFLMQ2",225,0) N DGX ;temp variable for line of display text "RTN","DGPFLMQ2",226,0) ; "RTN","DGPFLMQ2",227,0) S DGCNT=DGLINE "RTN","DGPFLMQ2",228,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLMQ2",229,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLMQ2",230,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLMQ2",231,0) Q "RTN","DGPFLMQD") 0^43^B1208744 "RTN","DGPFLMQD",1,0) DGPFLMQD ;ALB/RPM - PRF QUERY RESULTS DETAIL LM SCREEN ; 1/26/06 11:43 "RTN","DGPFLMQD",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMQD",3,0) ; "RTN","DGPFLMQD",4,0) Q ;no direct entry "RTN","DGPFLMQD",5,0) ; "RTN","DGPFLMQD",6,0) EN(DGSET,DGORF) ;Main entry point for DGPF QUERY DETAIL list template. "RTN","DGPFLMQD",7,0) ; "RTN","DGPFLMQD",8,0) ; Input: "RTN","DGPFLMQD",9,0) ; DGSET - query result assignment ID "RTN","DGPFLMQD",10,0) ; DGORF - array of parsed query results "RTN","DGPFLMQD",11,0) ; "RTN","DGPFLMQD",12,0) ; Output: None "RTN","DGPFLMQD",13,0) ; "RTN","DGPFLMQD",14,0) ;quit if required input parameters not defined "RTN","DGPFLMQD",15,0) Q:'$G(DGSET) "RTN","DGPFLMQD",16,0) Q:$G(DGORF)="" "RTN","DGPFLMQD",17,0) ; "RTN","DGPFLMQD",18,0) ;display wait msg to user "RTN","DGPFLMQD",19,0) D WAIT^DICD "RTN","DGPFLMQD",20,0) ; "RTN","DGPFLMQD",21,0) ;invoke list manager and load list template "RTN","DGPFLMQD",22,0) D EN^VALM("DGPF QUERY DETAIL") "RTN","DGPFLMQD",23,0) Q "RTN","DGPFLMQD",24,0) ; "RTN","DGPFLMQD",25,0) ; "RTN","DGPFLMQD",26,0) HDR ;Header Code "RTN","DGPFLMQD",27,0) ; "RTN","DGPFLMQD",28,0) D BLDHDR^DGPFLMQ1(DGORF,.VALMHDR) "RTN","DGPFLMQD",29,0) Q "RTN","DGPFLMQD",30,0) ; "RTN","DGPFLMQD",31,0) ; "RTN","DGPFLMQD",32,0) INIT ;Init variables and list array "RTN","DGPFLMQD",33,0) ; "RTN","DGPFLMQD",34,0) D BLD "RTN","DGPFLMQD",35,0) Q "RTN","DGPFLMQD",36,0) ; "RTN","DGPFLMQD",37,0) ; "RTN","DGPFLMQD",38,0) BLD ;Build record flag detail LM screen "RTN","DGPFLMQD",39,0) ; "RTN","DGPFLMQD",40,0) D CLEAN^VALM10 "RTN","DGPFLMQD",41,0) K VALMHDR "RTN","DGPFLMQD",42,0) K ^TMP("DGPFQDET",$J) "RTN","DGPFLMQD",43,0) ; "RTN","DGPFLMQD",44,0) ;init number of lines in list "RTN","DGPFLMQD",45,0) S VALMCNT=0 "RTN","DGPFLMQD",46,0) ; "RTN","DGPFLMQD",47,0) ;build header "RTN","DGPFLMQD",48,0) D HDR "RTN","DGPFLMQD",49,0) ; "RTN","DGPFLMQD",50,0) ;build list area for record flag detail "RTN","DGPFLMQD",51,0) D EN^DGPFLMQ2("DGPFQDET",DGSET,.VALMCNT) "RTN","DGPFLMQD",52,0) ; "RTN","DGPFLMQD",53,0) Q "RTN","DGPFLMQD",54,0) ; "RTN","DGPFLMQD",55,0) ; "RTN","DGPFLMQD",56,0) HELP ;Help Code "RTN","DGPFLMQD",57,0) N X "RTN","DGPFLMQD",58,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMQD",59,0) Q "RTN","DGPFLMQD",60,0) ; "RTN","DGPFLMQD",61,0) ; "RTN","DGPFLMQD",62,0) EXIT ;Exit Code "RTN","DGPFLMQD",63,0) D CLEAN^VALM10 "RTN","DGPFLMQD",64,0) D CLEAR^VALM1 "RTN","DGPFLMQD",65,0) K ^TMP("DGPFQDET",$J) "RTN","DGPFLMQD",66,0) Q "RTN","DGPFLMQD",67,0) ; "RTN","DGPFLMQD",68,0) ; "RTN","DGPFLMQD",69,0) EXPND ;Expand Code "RTN","DGPFLMQD",70,0) Q "RTN","DGPFLMT") 0^17^B2035581 "RTN","DGPFLMT",1,0) DGPFLMT ;ALB/RBS - PRF TRANSMISSION ERRORS LM SCREEN ; 4/27/05 12:00pm "RTN","DGPFLMT",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT",3,0) ; "RTN","DGPFLMT",4,0) ;- no direct entry "RTN","DGPFLMT",5,0) QUIT "RTN","DGPFLMT",6,0) ; "RTN","DGPFLMT",7,0) ; "RTN","DGPFLMT",8,0) EN ;Main entry point for DGPF TRANSMISSION ERRORS option. "RTN","DGPFLMT",9,0) ; "RTN","DGPFLMT",10,0) ; Input: None "RTN","DGPFLMT",11,0) ; Output: None "RTN","DGPFLMT",12,0) ; "RTN","DGPFLMT",13,0) ;invoke DGPF TRANSMISSION ERRORS list template "RTN","DGPFLMT",14,0) N DGSRTBY "RTN","DGPFLMT",15,0) ;- sort list (default="N"=Patient Name, also "E"=Date Error Received) "RTN","DGPFLMT",16,0) S DGSRTBY="N" "RTN","DGPFLMT",17,0) ; "RTN","DGPFLMT",18,0) D EN^VALM("DGPF TRANSMISSION ERRORS") "RTN","DGPFLMT",19,0) Q "RTN","DGPFLMT",20,0) ; "RTN","DGPFLMT",21,0) ; "RTN","DGPFLMT",22,0) HDR ;Header Code "RTN","DGPFLMT",23,0) N DGHDR "RTN","DGPFLMT",24,0) S DGHDR="List Sorted By: "_$S($G(DGSRTBY)="N":"Patient Name",1:"Date Error Received") "RTN","DGPFLMT",25,0) S VALMHDR(1)="" "RTN","DGPFLMT",26,0) S VALMHDR(1)=$$SETSTR^VALM1(DGHDR,VALMHDR(1),1,$L(DGHDR)) "RTN","DGPFLMT",27,0) Q "RTN","DGPFLMT",28,0) ; "RTN","DGPFLMT",29,0) ; "RTN","DGPFLMT",30,0) INIT ;Init variables and list array "RTN","DGPFLMT",31,0) D BLD "RTN","DGPFLMT",32,0) Q "RTN","DGPFLMT",33,0) ; "RTN","DGPFLMT",34,0) ; "RTN","DGPFLMT",35,0) BLD ;Build HL7 Transmission Log "RJ" Rejected Status message list "RTN","DGPFLMT",36,0) D CLEAN^VALM10 "RTN","DGPFLMT",37,0) K DGARY,VALMHDR "RTN","DGPFLMT",38,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLMT",39,0) ; "RTN","DGPFLMT",40,0) ;- init array that will contain list of items to display "RTN","DGPFLMT",41,0) S DGARY="DGPFLMT" "RTN","DGPFLMT",42,0) K ^TMP(DGARY,$J) "RTN","DGPFLMT",43,0) ; "RTN","DGPFLMT",44,0) ;build header area "RTN","DGPFLMT",45,0) D HDR "RTN","DGPFLMT",46,0) ; "RTN","DGPFLMT",47,0) ;init # of lines in list "RTN","DGPFLMT",48,0) S VALMCNT=0 "RTN","DGPFLMT",49,0) ; "RTN","DGPFLMT",50,0) ;- call to build list area for error messages "RTN","DGPFLMT",51,0) D EN^DGPFLMT1(DGARY,DGSRTBY,.VALMCNT) "RTN","DGPFLMT",52,0) Q "RTN","DGPFLMT",53,0) ; "RTN","DGPFLMT",54,0) ; "RTN","DGPFLMT",55,0) HELP ;Help Code "RTN","DGPFLMT",56,0) N X "RTN","DGPFLMT",57,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMT",58,0) Q "RTN","DGPFLMT",59,0) ; "RTN","DGPFLMT",60,0) ; "RTN","DGPFLMT",61,0) EXIT ;Exit Code "RTN","DGPFLMT",62,0) D CLEAN^VALM10 "RTN","DGPFLMT",63,0) D CLEAR^VALM1 "RTN","DGPFLMT",64,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLMT",65,0) K ^TMP(DGARY,$J) "RTN","DGPFLMT",66,0) K DGARY "RTN","DGPFLMT",67,0) K DGSRTBY "RTN","DGPFLMT",68,0) Q "RTN","DGPFLMT",69,0) ; "RTN","DGPFLMT",70,0) ; "RTN","DGPFLMT",71,0) EXPND ;Expand Code "RTN","DGPFLMT",72,0) Q "RTN","DGPFLMT1") 0^18^B55169432 "RTN","DGPFLMT1",1,0) DGPFLMT1 ;ALB/RBS - PRF TRANSMISSION ERRORS BUILD LIST AREA ; 6/10/05 11:38am "RTN","DGPFLMT1",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT1",3,0) ; "RTN","DGPFLMT1",4,0) ;no direct entry "RTN","DGPFLMT1",5,0) QUIT "RTN","DGPFLMT1",6,0) ; "RTN","DGPFLMT1",7,0) ; "RTN","DGPFLMT1",8,0) EN(DGARY,DGSRTBY,DGCNT) ;Entry point to build list area "RTN","DGPFLMT1",9,0) ; "RTN","DGPFLMT1",10,0) ;The following input variables are 'system wide variables' in the "RTN","DGPFLMT1",11,0) ;DGPF TRANSMISSION ERRORS List Manager screen: "RTN","DGPFLMT1",12,0) ; "RTN","DGPFLMT1",13,0) ; Input: "RTN","DGPFLMT1",14,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",15,0) ; DGSRTBY - list sort by criteria "RTN","DGPFLMT1",16,0) ; "N" = Patient Name "RTN","DGPFLMT1",17,0) ; "D" = Date/Time Error Received "RTN","DGPFLMT1",18,0) ; Output: "RTN","DGPFLMT1",19,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",20,0) ; DGARY - ^TMP(DGARY,$J) - display list "RTN","DGPFLMT1",21,0) ; - ^TMP("DGPFSORT",$J) - used to create final DGARY list "RTN","DGPFLMT1",22,0) ; "RTN","DGPFLMT1",23,0) ;display wait msg "RTN","DGPFLMT1",24,0) D WAIT^DICD "RTN","DGPFLMT1",25,0) ; "RTN","DGPFLMT1",26,0) ;retrieve and sort "RTN","DGPFLMT1",27,0) D GET(DGSRTBY) "RTN","DGPFLMT1",28,0) ; "RTN","DGPFLMT1",29,0) ;build list "RTN","DGPFLMT1",30,0) D BLD(DGARY,DGSRTBY,.DGCNT) "RTN","DGPFLMT1",31,0) ; "RTN","DGPFLMT1",32,0) ;if no entries in list, display message "RTN","DGPFLMT1",33,0) I 'DGCNT D "RTN","DGPFLMT1",34,0) . D SET(DGARY,1,"",1,,,.DGCNT) "RTN","DGPFLMT1",35,0) . D SET(DGARY,2,"There are no transmission error messages on file.",3,$G(IOINHI),$G(IOINORM),.DGCNT) "RTN","DGPFLMT1",36,0) ; "RTN","DGPFLMT1",37,0) Q "RTN","DGPFLMT1",38,0) ; "RTN","DGPFLMT1",39,0) ; "RTN","DGPFLMT1",40,0) GET(DGSRTBY) ;Get "RJ" status entries. "RTN","DGPFLMT1",41,0) ; "RTN","DGPFLMT1",42,0) ; Input: "RTN","DGPFLMT1",43,0) ; DGSRTBY - list sort by value "RTN","DGPFLMT1",44,0) ; "RTN","DGPFLMT1",45,0) ; Output: "RTN","DGPFLMT1",46,0) ; ^TMP("DGPFSORT",$J,0,,,)="" "RTN","DGPFLMT1",47,0) ; "RTN","DGPFLMT1",48,0) ;The 0 node is created to group each patient's PRF Assignment record "RTN","DGPFLMT1",49,0) ;with each Site Transmitted To that is rejecting the update with all "RTN","DGPFLMT1",50,0) ;of the pointed to HL7 transmission log records. "RTN","DGPFLMT1",51,0) ;Only the most recent transmission log entry will be displayed. "RTN","DGPFLMT1",52,0) ; "RTN","DGPFLMT1",53,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",54,0) N DGDAT ;original transmission date "RTN","DGPFLMT1",55,0) N DGLIEN ;HL7 log record ien "RTN","DGPFLMT1",56,0) N DGPFA ;assignment array "RTN","DGPFLMT1",57,0) N DGPFAH ;assignment history data array "RTN","DGPFLMT1",58,0) N DGPFL ;HL7 transmission log data array "RTN","DGPFLMT1",59,0) N DGPFPAT ;patient data array "RTN","DGPFLMT1",60,0) N DGSITE ;site transmitted to ien "RTN","DGPFLMT1",61,0) N DGSSN ;patient ssn "RTN","DGPFLMT1",62,0) ; "RTN","DGPFLMT1",63,0) ;loop through ASTAT index of transmission date/times "RTN","DGPFLMT1",64,0) S DGDAT=0 "RTN","DGPFLMT1",65,0) F S DGDAT=$O(^DGPF(26.17,"ASTAT",DGDAT)) Q:'DGDAT D "RTN","DGPFLMT1",66,0) . Q:'$D(^DGPF(26.17,"ASTAT",DGDAT,"RJ")) "RTN","DGPFLMT1",67,0) . S DGLIEN=0 "RTN","DGPFLMT1",68,0) . F S DGLIEN=$O(^DGPF(26.17,"ASTAT",DGDAT,"RJ",DGLIEN)) Q:'DGLIEN D "RTN","DGPFLMT1",69,0) . . K DGPFL,DGPFAH "RTN","DGPFLMT1",70,0) . . ;- retrieve HL7 log data "RTN","DGPFLMT1",71,0) . . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFLMT1",72,0) . . Q:'+DGPFL("ASGNHIST") "RTN","DGPFLMT1",73,0) . . S DGSITE=$P($G(DGPFL("SITE")),U,1) "RTN","DGPFLMT1",74,0) . . Q:DGSITE']"" "RTN","DGPFLMT1",75,0) . . ;- retrieve assignment history data to get PRF Assignment ien "RTN","DGPFLMT1",76,0) . . Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFLMT1",77,0) . . S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1) "RTN","DGPFLMT1",78,0) . . Q:'DGAIEN "RTN","DGPFLMT1",79,0) . . ; "RTN","DGPFLMT1",80,0) . . ;- create 0 node by patient assignment, site ien and log ien "RTN","DGPFLMT1",81,0) . . S ^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,DGLIEN)="" "RTN","DGPFLMT1",82,0) ; "RTN","DGPFLMT1",83,0) Q:'$O(^TMP("DGPFSORT",$J,0,"")) ;quit if nothing setup "RTN","DGPFLMT1",84,0) ; "RTN","DGPFLMT1",85,0) ;- now loop the sorted 0 node and only use the most recent HL7 error "RTN","DGPFLMT1",86,0) ; record to create the List Manager display temp file. "RTN","DGPFLMT1",87,0) ; "RTN","DGPFLMT1",88,0) S DGAIEN=0 "RTN","DGPFLMT1",89,0) F S DGAIEN=$O(^TMP("DGPFSORT",$J,0,DGAIEN)) Q:DGAIEN="" D "RTN","DGPFLMT1",90,0) . S DGSITE=0 "RTN","DGPFLMT1",91,0) . F S DGSITE=$O(^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE)) Q:DGSITE="" D "RTN","DGPFLMT1",92,0) . . K DGPFL,DGPFAH,DGPFA,DGPFPAT "RTN","DGPFLMT1",93,0) . . S DGLIEN=0 ;- get most recent record ien "RTN","DGPFLMT1",94,0) . . S DGLIEN=$O(^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,""),-1) "RTN","DGPFLMT1",95,0) . . Q:DGLIEN="" "RTN","DGPFLMT1",96,0) . . ;- retrieve HL7 log data "RTN","DGPFLMT1",97,0) . . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFLMT1",98,0) . . ;- retrieve assignment file data to get Owner Site "RTN","DGPFLMT1",99,0) . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFLMT1",100,0) . . ;- retrive patient data to get ssn "RTN","DGPFLMT1",101,0) . . Q:'$$GETPAT^DGPFUT2(+DGPFA("DFN"),.DGPFPAT) "RTN","DGPFLMT1",102,0) . . S DGSSN=$G(DGPFPAT("SSN")) S:'DGSSN DGSSN="UNKNOWN" "RTN","DGPFLMT1",103,0) . . ;- add ssn to existing array "RTN","DGPFLMT1",104,0) . . S DGPFA("SSN")=DGSSN "RTN","DGPFLMT1",105,0) . . ;- retrieve assignment history data "RTN","DGPFLMT1",106,0) . . Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFLMT1",107,0) . . ; "RTN","DGPFLMT1",108,0) . . ;- setup output array "RTN","DGPFLMT1",109,0) . . D SORT(DGLIEN,DGSRTBY,.DGPFA,.DGPFAH,.DGPFL) "RTN","DGPFLMT1",110,0) ; "RTN","DGPFLMT1",111,0) Q "RTN","DGPFLMT1",112,0) ; "RTN","DGPFLMT1",113,0) ; "RTN","DGPFLMT1",114,0) SORT(DGLIEN,DGSRTBY,DGPFA,DGPFAH,DGPFL) ;Setup output global "RTN","DGPFLMT1",115,0) ; "RTN","DGPFLMT1",116,0) ; Input: "RTN","DGPFLMT1",117,0) ; DGLIEN - ien of HL7 log record "RTN","DGPFLMT1",118,0) ; DGSRTBY - list sort value "RTN","DGPFLMT1",119,0) ; DGPFA - assignment array "RTN","DGPFLMT1",120,0) ; DGPFAH - assignment history array "RTN","DGPFLMT1",121,0) ; DGPFL - HL7 log array "RTN","DGPFLMT1",122,0) ; "RTN","DGPFLMT1",123,0) ; Output: "RTN","DGPFLMT1",124,0) ; ^TMP("DGPFSORT",$J,1,<>,<>,<>,<>) = data string values "RTN","DGPFLMT1",125,0) ; Subscript's (,<>,) are as follows for each sort by: "RTN","DGPFLMT1",126,0) ; "RTN","DGPFLMT1",127,0) ; - SORT="N" - list by : "RTN","DGPFLMT1",128,0) ; ,1,,,,) "RTN","DGPFLMT1",129,0) ; "RTN","DGPFLMT1",130,0) ; - SORT="D" - list by : "RTN","DGPFLMT1",131,0) ; ,1,,,,) "RTN","DGPFLMT1",132,0) ; "RTN","DGPFLMT1",133,0) ; - The 6 data string values are as follows: (^ - up-arrow delimited) "RTN","DGPFLMT1",134,0) ; ^^^^^ "RTN","DGPFLMT1",135,0) ; "RTN","DGPFLMT1",136,0) N DGACKDT ;d/t error msg received "RTN","DGPFLMT1",137,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",138,0) N DGPNAME ;patient name "RTN","DGPFLMT1",139,0) N DGSITE ;site transmitted to ien "RTN","DGPFLMT1",140,0) N DGSTRING ;detail line "RTN","DGPFLMT1",141,0) N DGSUB ;subscript var "RTN","DGPFLMT1",142,0) ; "RTN","DGPFLMT1",143,0) ;- subscript setup "RTN","DGPFLMT1",144,0) S DGACKDT=$P($G(DGPFL("ACKDT")),U,1) "RTN","DGPFLMT1",145,0) S:DGACKDT="" DGACKDT="UNKNOWN" "RTN","DGPFLMT1",146,0) S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1) "RTN","DGPFLMT1",147,0) S:DGAIEN="" DGAIEN="UNKNOWN" "RTN","DGPFLMT1",148,0) S DGPNAME=$P($G(DGPFA("DFN")),U,2) "RTN","DGPFLMT1",149,0) S:DGPNAME="" DGPNAME="UNKNOWN" "RTN","DGPFLMT1",150,0) S DGSITE=$P($G(DGPFL("SITE")),U,1) "RTN","DGPFLMT1",151,0) ; "RTN","DGPFLMT1",152,0) ;- data string setup - "RTN","DGPFLMT1",153,0) S DGSTRING=$P($G(DGPFA("DFN")),U,1)_U_DGPNAME_U_$P($G(DGPFA("SSN")),U,1)_U_DGACKDT_U_$P($G(DGPFL("SITE")),U,2)_U_$P($G(DGPFA("OWNER")),U,2) "RTN","DGPFLMT1",154,0) ; "RTN","DGPFLMT1",155,0) ;- patient name sort "RTN","DGPFLMT1",156,0) I DGSRTBY="N" S DGSUB=DGPNAME "RTN","DGPFLMT1",157,0) ;- date/time error received type sort "RTN","DGPFLMT1",158,0) I DGSRTBY="D" S DGSUB=DGACKDT "RTN","DGPFLMT1",159,0) ; "RTN","DGPFLMT1",160,0) S ^TMP("DGPFSORT",$J,1,DGSUB,DGAIEN,DGSITE,DGLIEN)=DGSTRING "RTN","DGPFLMT1",161,0) Q "RTN","DGPFLMT1",162,0) ; "RTN","DGPFLMT1",163,0) ; "RTN","DGPFLMT1",164,0) BLD(DGARY,DGSRTBY,DGCNT) ;Build list area "RTN","DGPFLMT1",165,0) ; "RTN","DGPFLMT1",166,0) ; Input: "RTN","DGPFLMT1",167,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",168,0) ; DGSRTBY - list sort by value "RTN","DGPFLMT1",169,0) ; "RTN","DGPFLMT1",170,0) ; Output: "RTN","DGPFLMT1",171,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",172,0) ; DGARY - display list - ^TMP(DGARY,$J) "RTN","DGPFLMT1",173,0) ; "RTN","DGPFLMT1",174,0) N DGACKDT ;d/t error msg received "RTN","DGPFLMT1",175,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",176,0) N DGLIEN ;log record ien "RTN","DGPFLMT1",177,0) N DGLINE ;line counter "RTN","DGPFLMT1",178,0) N DGOWNER ;owner of assignment "RTN","DGPFLMT1",179,0) N DGPNAME ;patient name "RTN","DGPFLMT1",180,0) N DGSIEN ;site ien "RTN","DGPFLMT1",181,0) N DGSITE ;site transmitted to name "RTN","DGPFLMT1",182,0) N DGSSN ;patient ssn "RTN","DGPFLMT1",183,0) N DGSTRING ;detail line "RTN","DGPFLMT1",184,0) N DGSUB ;loop var "RTN","DGPFLMT1",185,0) N DGTEMP ;sort array root "RTN","DGPFLMT1",186,0) ; "RTN","DGPFLMT1",187,0) S DGTEMP=$NA(^TMP("DGPFSORT",$J,1)) "RTN","DGPFLMT1",188,0) S DGSUB="",DGLINE=0 "RTN","DGPFLMT1",189,0) ; "RTN","DGPFLMT1",190,0) F S DGSUB=$O(@DGTEMP@(DGSUB)) Q:DGSUB="" D "RTN","DGPFLMT1",191,0) . S DGAIEN=0 "RTN","DGPFLMT1",192,0) . F S DGAIEN=$O(@DGTEMP@(DGSUB,DGAIEN)) Q:'DGAIEN D "RTN","DGPFLMT1",193,0) . . S DGSIEN=0 "RTN","DGPFLMT1",194,0) . . F S DGSIEN=$O(@DGTEMP@(DGSUB,DGAIEN,DGSIEN)) Q:'DGSIEN D "RTN","DGPFLMT1",195,0) . . . S DGLIEN=0 "RTN","DGPFLMT1",196,0) . . . F S DGLIEN=$O(@DGTEMP@(DGSUB,DGAIEN,DGSIEN,DGLIEN)) Q:'DGLIEN D "RTN","DGPFLMT1",197,0) . . . . ;- get data fields "RTN","DGPFLMT1",198,0) . . . . S DGSTRING=$G(@DGTEMP@(DGSUB,DGAIEN,DGSIEN,DGLIEN)) "RTN","DGPFLMT1",199,0) . . . . S DGPNAME=$E($P(DGSTRING,U,2),1,27) "RTN","DGPFLMT1",200,0) . . . . S DGSSN=$E($P(DGSTRING,U,3),6,9) "RTN","DGPFLMT1",201,0) . . . . S DGACKDT=$E($$FDTTM^VALM1($P(DGSTRING,U,4)),1,8) "RTN","DGPFLMT1",202,0) . . . . S DGSITE=$E($P(DGSTRING,U,5),1,14) "RTN","DGPFLMT1",203,0) . . . . S DGOWNER=$E($P(DGSTRING,U,6),1,14) "RTN","DGPFLMT1",204,0) . . . . ;- increment line counter "RTN","DGPFLMT1",205,0) . . . . S DGLINE=DGLINE+1 "RTN","DGPFLMT1",206,0) . . . . ;- set line into list area "RTN","DGPFLMT1",207,0) . . . . D SET(DGARY,DGLINE,DGLINE,1,,,.DGCNT) "RTN","DGPFLMT1",208,0) . . . . D SET(DGARY,DGLINE,DGPNAME,6,,,.DGCNT) "RTN","DGPFLMT1",209,0) . . . . D SET(DGARY,DGLINE,DGSSN,35,,,.DGCNT) "RTN","DGPFLMT1",210,0) . . . . D SET(DGARY,DGLINE,DGACKDT,41,,,.DGCNT) "RTN","DGPFLMT1",211,0) . . . . D SET(DGARY,DGLINE,DGSITE,51,,,.DGCNT) "RTN","DGPFLMT1",212,0) . . . . D SET(DGARY,DGLINE,DGOWNER,67,,,.DGCNT) "RTN","DGPFLMT1",213,0) . . . . ; "RTN","DGPFLMT1",214,0) . . . . ;- associate "IDX" list item entry with the pointer's "RTN","DGPFLMT1",215,0) . . . . ; back to ^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,DGLIEN) global: "RTN","DGPFLMT1",216,0) . . . . ; ^^^^pat name^site name "RTN","DGPFLMT1",217,0) . . . . S ^TMP(DGARY,$J,"IDX",DGLINE,DGLINE)=DGAIEN_U_DGSIEN_U_DGLIEN_U_$P(DGSTRING,U,1)_U_DGPNAME_U_$P(DGSTRING,U,5) "RTN","DGPFLMT1",218,0) ; "RTN","DGPFLMT1",219,0) ;cleanup temp sort global "RTN","DGPFLMT1",220,0) K @DGTEMP "RTN","DGPFLMT1",221,0) Q "RTN","DGPFLMT1",222,0) ; "RTN","DGPFLMT1",223,0) ; "RTN","DGPFLMT1",224,0) SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;Setup display detail lines "RTN","DGPFLMT1",225,0) ; "RTN","DGPFLMT1",226,0) ; Input: "RTN","DGPFLMT1",227,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",228,0) ; DGLINE - line number "RTN","DGPFLMT1",229,0) ; DGTEXT - text "RTN","DGPFLMT1",230,0) ; DGCOL - starting column "RTN","DGPFLMT1",231,0) ; DGON - highlighting on "RTN","DGPFLMT1",232,0) ; DGOFF - highlighting off "RTN","DGPFLMT1",233,0) ; "RTN","DGPFLMT1",234,0) ; Output: "RTN","DGPFLMT1",235,0) ; DGARY - temp global array of LM detail lines "RTN","DGPFLMT1",236,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",237,0) ; "RTN","DGPFLMT1",238,0) N DGX ;string to insert new text into "RTN","DGPFLMT1",239,0) ; "RTN","DGPFLMT1",240,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLMT1",241,0) S DGCNT=DGLINE "RTN","DGPFLMT1",242,0) ; "RTN","DGPFLMT1",243,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLMT1",244,0) ; "RTN","DGPFLMT1",245,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLMT1",246,0) ; "RTN","DGPFLMT1",247,0) Q "RTN","DGPFLMT2") 0^19^B24050413 "RTN","DGPFLMT2",1,0) DGPFLMT2 ;ALB/RBS - PRF TRANSMISSION ERRORS LM PROTOCOL ACTIONS ; 6/24/05 12:20pm "RTN","DGPFLMT2",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT2",3,0) ; "RTN","DGPFLMT2",4,0) ;no direct entry "RTN","DGPFLMT2",5,0) QUIT "RTN","DGPFLMT2",6,0) ; "RTN","DGPFLMT2",7,0) ; "RTN","DGPFLMT2",8,0) SL ;Entry point for DGPF TRANSMIT SORT LIST action protocol. "RTN","DGPFLMT2",9,0) ; "RTN","DGPFLMT2",10,0) ;The following Input variable is a 'system wide variable' in the "RTN","DGPFLMT2",11,0) ;DGPF TRANSMISSION ERRORS List Manager screen: "RTN","DGPFLMT2",12,0) ; "RTN","DGPFLMT2",13,0) ; Input: "RTN","DGPFLMT2",14,0) ; DGSRTBY - list sort by criteria "RTN","DGPFLMT2",15,0) ; "N" = Patient Name "RTN","DGPFLMT2",16,0) ; "D" = Date/Time Error Received "RTN","DGPFLMT2",17,0) ; Output: "RTN","DGPFLMT2",18,0) ; DGSRTBY - list sort by criteria "RTN","DGPFLMT2",19,0) ; VALMBCK - 'R' = refresh screen "RTN","DGPFLMT2",20,0) ; "RTN","DGPFLMT2",21,0) ;is action selection allowed? "RTN","DGPFLMT2",22,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMT2",23,0) . W ! "RTN","DGPFLMT2",24,0) . D BLD^DIALOG(261129," There are no transmission error records to display.","","DGERR","F") "RTN","DGPFLMT2",25,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMT2",26,0) . D WAIT^VALM1 "RTN","DGPFLMT2",27,0) . S VALMBCK="R" "RTN","DGPFLMT2",28,0) ; "RTN","DGPFLMT2",29,0) ;change sort (flip / flop) "RTN","DGPFLMT2",30,0) S DGSRTBY=$S($G(DGSRTBY)="N":"D",1:"N") "RTN","DGPFLMT2",31,0) ; "RTN","DGPFLMT2",32,0) ;re-build list for sort criteria "RTN","DGPFLMT2",33,0) D BLD^DGPFLMT "RTN","DGPFLMT2",34,0) ; "RTN","DGPFLMT2",35,0) ;return to LM (refresh screen) "RTN","DGPFLMT2",36,0) S VALMBCK="R" "RTN","DGPFLMT2",37,0) Q "RTN","DGPFLMT2",38,0) ; "RTN","DGPFLMT2",39,0) ; "RTN","DGPFLMT2",40,0) RM ;Entry point for DGPF TRANSMIT REJECT MESSAGE action protocol. "RTN","DGPFLMT2",41,0) ; "RTN","DGPFLMT2",42,0) ; Input: None "RTN","DGPFLMT2",43,0) ; Output: VALMBCK - 'R' = refresh screen "RTN","DGPFLMT2",44,0) ; "RTN","DGPFLMT2",45,0) N DGERR ;if error returned "RTN","DGPFLMT2",46,0) N DGDFN ;patient dfn "RTN","DGPFLMT2",47,0) N DGPFIEN ;ien of record in PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFLMT2",48,0) N DGSEL ;user selection "RTN","DGPFLMT2",49,0) N VALMY ;array output of EN^VALM2 call of user selected entry(s) "RTN","DGPFLMT2",50,0) ; "RTN","DGPFLMT2",51,0) S (DGSEL,DGPFIEN)="" "RTN","DGPFLMT2",52,0) ; "RTN","DGPFLMT2",53,0) ;- if user selected RM Retransmit Message action while in the "RTN","DGPFLMT2",54,0) ; VM View Message details action, use the single entry value at "RTN","DGPFLMT2",55,0) ; the ^TMP("DGPFSORT",$J,"SELECTION",) node for retransmission. "RTN","DGPFLMT2",56,0) ;- Note, this temp node gets deleted after the RM action processes. "RTN","DGPFLMT2",57,0) ; "RTN","DGPFLMT2",58,0) S DGSEL=+$O(^TMP("DGPFSORT",$J,"SELECTION","")) "RTN","DGPFLMT2",59,0) S:DGSEL VALMY(DGSEL)="" "RTN","DGPFLMT2",60,0) ; "RTN","DGPFLMT2",61,0) ;- if no single entry found, is action selection allowed? "RTN","DGPFLMT2",62,0) ;- Note, this check will also stop the user from trying to retransmit "RTN","DGPFLMT2",63,0) ; a single selection multiple times from the VM View Message action. "RTN","DGPFLMT2",64,0) ; "RTN","DGPFLMT2",65,0) I 'DGSEL,'$D(@VALMAR@("IDX")) D "RTN","DGPFLMT2",66,0) . W ! "RTN","DGPFLMT2",67,0) . D BLD^DIALOG(261129," There are no transmission error messages to select.","","DGERR","F") "RTN","DGPFLMT2",68,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMT2",69,0) . D WAIT^VALM1 "RTN","DGPFLMT2",70,0) . ;- else, if no single entry found, prompt user for selection(s) "RTN","DGPFLMT2",71,0) E D:'DGSEL "RTN","DGPFLMT2",72,0) . D EN^VALM2($G(XQORNOD(0))) "RTN","DGPFLMT2",73,0) . S DGSEL=$O(VALMY("")) "RTN","DGPFLMT2",74,0) ; "RTN","DGPFLMT2",75,0) ;- call to retransmit error message(s) "RTN","DGPFLMT2",76,0) I DGSEL D "RTN","DGPFLMT2",77,0) . ; "RTN","DGPFLMT2",78,0) . I $$EN^DGPFLMT5(.VALMY) "RTN","DGPFLMT2",79,0) . ; "RTN","DGPFLMT2",80,0) . D WAIT^VALM1 "RTN","DGPFLMT2",81,0) . ; "RTN","DGPFLMT2",82,0) . ;- don't re-build list if $D(^TMP("DGPFSORT",$J,"SELECTION")) "RTN","DGPFLMT2",83,0) . ; because this RM action is being called from the VM action. "RTN","DGPFLMT2",84,0) . ; "RTN","DGPFLMT2",85,0) . D:'$D(^TMP("DGPFSORT",$J,"SELECTION")) BLD^DGPFLMT "RTN","DGPFLMT2",86,0) . ; "RTN","DGPFLMT2",87,0) . ;- always clean up single entry so it can't be selected again "RTN","DGPFLMT2",88,0) . K ^TMP("DGPFSORT",$J,"SELECTION") "RTN","DGPFLMT2",89,0) ; "RTN","DGPFLMT2",90,0) ;return to LM (refresh screen) "RTN","DGPFLMT2",91,0) S VALMBCK="R" "RTN","DGPFLMT2",92,0) Q "RTN","DGPFLMT2",93,0) ; "RTN","DGPFLMT2",94,0) ; "RTN","DGPFLMT2",95,0) VM ;Entry point for DGPF TRANSMIT VIEW MESSAGE action protocol. "RTN","DGPFLMT2",96,0) ; "RTN","DGPFLMT2",97,0) ; Input: None "RTN","DGPFLMT2",98,0) ; Output: VALMBCK - 'R' = refresh screen "RTN","DGPFLMT2",99,0) ; "RTN","DGPFLMT2",100,0) N DGERR ;if error returned "RTN","DGPFLMT2",101,0) N DGDFN ;patient dfn "RTN","DGPFLMT2",102,0) N DGPFIEN ;ien of record in PRF HL7 TRANSMISSION LOG (#26.17) file "RTN","DGPFLMT2",103,0) N DGSEL ;user selection "RTN","DGPFLMT2",104,0) N VALMY ;output of EN^VALM2 call, array of user selected entry "RTN","DGPFLMT2",105,0) ; "RTN","DGPFLMT2",106,0) ;is action selection allowed? "RTN","DGPFLMT2",107,0) I '$D(@VALMAR@("IDX")) D Q "RTN","DGPFLMT2",108,0) . W ! "RTN","DGPFLMT2",109,0) . D BLD^DIALOG(261129," There are no transmission error records to display.","","DGERR","F") "RTN","DGPFLMT2",110,0) . D MSG^DIALOG("WE","","","","DGERR") W *7 "RTN","DGPFLMT2",111,0) . D WAIT^VALM1 "RTN","DGPFLMT2",112,0) . S VALMBCK="R" "RTN","DGPFLMT2",113,0) ; "RTN","DGPFLMT2",114,0) ;ask user to select a single error for displaying details "RTN","DGPFLMT2",115,0) S (DGSEL,DGPFIEN)="" "RTN","DGPFLMT2",116,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","DGPFLMT2",117,0) ; "RTN","DGPFLMT2",118,0) ;process user selection "RTN","DGPFLMT2",119,0) S DGSEL=$O(VALMY("")) "RTN","DGPFLMT2",120,0) I DGSEL,$D(@VALMAR@("IDX",DGSEL,DGSEL)) D "RTN","DGPFLMT2",121,0) . S DGPFIEN=$P($G(@VALMAR@("IDX",DGSEL,DGSEL)),U,3) "RTN","DGPFLMT2",122,0) . S DGDFN=$P($G(@VALMAR@("IDX",DGSEL,DGSEL)),U,4) "RTN","DGPFLMT2",123,0) . ; "RTN","DGPFLMT2",124,0) . ;- capture user single selection in ^TMP() global - "RTN","DGPFLMT2",125,0) . ; This is used to determine if the user selected to retransmit a "RTN","DGPFLMT2",126,0) . ; single record entry by selecting the Retransmit Message action "RTN","DGPFLMT2",127,0) . ; while in the View Message action. "RTN","DGPFLMT2",128,0) . ; If undefined after returning from the View Message action, then "RTN","DGPFLMT2",129,0) . ; the user did use the Retransmit Message action. "RTN","DGPFLMT2",130,0) . ; This would require Quiting the View Message screen back to the "RTN","DGPFLMT2",131,0) . ; main screen and doing a rebuild of all display and sort files. "RTN","DGPFLMT2",132,0) . ; "RTN","DGPFLMT2",133,0) . S ^TMP("DGPFSORT",$J,"SELECTION",DGSEL)=$G(@VALMAR@("IDX",DGSEL,DGSEL)) "RTN","DGPFLMT2",134,0) . ; "RTN","DGPFLMT2",135,0) . ;- call to display error message details "RTN","DGPFLMT2",136,0) . D EN^DGPFLMT3(DGDFN,DGPFIEN) "RTN","DGPFLMT2",137,0) . ; "RTN","DGPFLMT2",138,0) . ;clean-up user single selection when exiting this action. "RTN","DGPFLMT2",139,0) . K ^TMP("DGPFSORT",$J,"SELECTION") "RTN","DGPFLMT2",140,0) ; "RTN","DGPFLMT2",141,0) ;- re-build and display list "RTN","DGPFLMT2",142,0) D BLD^DGPFLMT "RTN","DGPFLMT2",143,0) ; "RTN","DGPFLMT2",144,0) ;return to LM (refresh screen) "RTN","DGPFLMT2",145,0) S VALMBCK="R" "RTN","DGPFLMT2",146,0) Q "RTN","DGPFLMT3") 0^20^B6275876 "RTN","DGPFLMT3",1,0) DGPFLMT3 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE LM SCREEN ; 4/27/05 1:05pm "RTN","DGPFLMT3",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT3",3,0) ; "RTN","DGPFLMT3",4,0) ;no direct entry "RTN","DGPFLMT3",5,0) QUIT "RTN","DGPFLMT3",6,0) ; "RTN","DGPFLMT3",7,0) ; "RTN","DGPFLMT3",8,0) EN(DGDFN,DGPFIEN) ;Entry point of DGPF TRANSMIT VIEW MESSAGE list template. "RTN","DGPFLMT3",9,0) ; "RTN","DGPFLMT3",10,0) ; Input: "RTN","DGPFLMT3",11,0) ; DGDFN - ien of PATIENT (#2) file "RTN","DGPFLMT3",12,0) ; DGPFIEN - ien of PRF HL7 TRANSMISSION LOG (#26.17) record "RTN","DGPFLMT3",13,0) ; "RTN","DGPFLMT3",14,0) ; Output: None "RTN","DGPFLMT3",15,0) ; "RTN","DGPFLMT3",16,0) ;quit if required input parameters not defined "RTN","DGPFLMT3",17,0) Q:'$G(DGDFN) "RTN","DGPFLMT3",18,0) Q:'$G(DGPFIEN) "RTN","DGPFLMT3",19,0) ; "RTN","DGPFLMT3",20,0) ;display wait msg to user "RTN","DGPFLMT3",21,0) D WAIT^DICD "RTN","DGPFLMT3",22,0) ; "RTN","DGPFLMT3",23,0) ;invoke list template "RTN","DGPFLMT3",24,0) D EN^VALM("DGPF TRANSMIT VIEW MESSAGE") "RTN","DGPFLMT3",25,0) Q "RTN","DGPFLMT3",26,0) ; "RTN","DGPFLMT3",27,0) ; "RTN","DGPFLMT3",28,0) HDR ;Header Code - build patient header detail area "RTN","DGPFLMT3",29,0) D HDRBLD(DGDFN,.VALMHDR) "RTN","DGPFLMT3",30,0) Q "RTN","DGPFLMT3",31,0) ; "RTN","DGPFLMT3",32,0) ; "RTN","DGPFLMT3",33,0) HDRBLD(DGDFN,DGPFHDR) ;This procedure builds the List Manager header. "RTN","DGPFLMT3",34,0) ; "RTN","DGPFLMT3",35,0) ; Supported DBIA #2701: $$GETICN^MPIF001 "RTN","DGPFLMT3",36,0) ; The supported DBIA is used to access the MPI functions to "RTN","DGPFLMT3",37,0) ; retrieve the ICN. "RTN","DGPFLMT3",38,0) ; "RTN","DGPFLMT3",39,0) ; Input: "RTN","DGPFLMT3",40,0) ; DGDFN - internal entry number of PATIENT (#2) file "RTN","DGPFLMT3",41,0) ; DGPFHDR - header array passed by reference "RTN","DGPFLMT3",42,0) ; "RTN","DGPFLMT3",43,0) ; Output: "RTN","DGPFLMT3",44,0) ; DGPFHDR - header array (VALMHDR) "RTN","DGPFLMT3",45,0) ; "RTN","DGPFLMT3",46,0) N DGICN ;national integrated control number "RTN","DGPFLMT3",47,0) N DGPFPAT ;patient identifying info array "RTN","DGPFLMT3",48,0) ; "RTN","DGPFLMT3",49,0) ;get patient identifying info "RTN","DGPFLMT3",50,0) I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT) "RTN","DGPFLMT3",51,0) ; "RTN","DGPFLMT3",52,0) ;set 1st line of header "RTN","DGPFLMT3",53,0) S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" " "RTN","DGPFLMT3",54,0) S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80) "RTN","DGPFLMT3",55,0) S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80) "RTN","DGPFLMT3",56,0) ; "RTN","DGPFLMT3",57,0) ;set 2nd line of header "RTN","DGPFLMT3",58,0) S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFLMT3",59,0) S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN) "RTN","DGPFLMT3",60,0) S DGPFHDR(2)=" ICN: "_DGICN "RTN","DGPFLMT3",61,0) Q "RTN","DGPFLMT3",62,0) ; "RTN","DGPFLMT3",63,0) ; "RTN","DGPFLMT3",64,0) INIT ;Init variables and list array "RTN","DGPFLMT3",65,0) D BLD "RTN","DGPFLMT3",66,0) Q "RTN","DGPFLMT3",67,0) ; "RTN","DGPFLMT3",68,0) ; "RTN","DGPFLMT3",69,0) BLD ;Build error message detail screen (list area) "RTN","DGPFLMT3",70,0) D CLEAN^VALM10 "RTN","DGPFLMT3",71,0) K VALMHDR "RTN","DGPFLMT3",72,0) K ^TMP("DGPFVDET",$J) "RTN","DGPFLMT3",73,0) ; "RTN","DGPFLMT3",74,0) ;init number of lines in list "RTN","DGPFLMT3",75,0) S VALMCNT=0 "RTN","DGPFLMT3",76,0) ; "RTN","DGPFLMT3",77,0) ;build header "RTN","DGPFLMT3",78,0) D HDR "RTN","DGPFLMT3",79,0) ; "RTN","DGPFLMT3",80,0) ;build list area for error message detail "RTN","DGPFLMT3",81,0) D EN^DGPFLMT4("DGPFVDET",DGPFIEN,.VALMCNT) "RTN","DGPFLMT3",82,0) ; "RTN","DGPFLMT3",83,0) I 'VALMCNT D "RTN","DGPFLMT3",84,0) . D SET^DGPFLMT1("DGPFVDET",1,"",1,,,.VALMCNT) "RTN","DGPFLMT3",85,0) . D SET^DGPFLMT1("DGPFVDET",2,"...Sorry, no PRF assignment record details were found to display.",4,$G(IOINHI),$G(IOINORM),.VALMCNT) "RTN","DGPFLMT3",86,0) ; "RTN","DGPFLMT3",87,0) Q "RTN","DGPFLMT3",88,0) ; "RTN","DGPFLMT3",89,0) ; "RTN","DGPFLMT3",90,0) HELP ;Help Code "RTN","DGPFLMT3",91,0) N X "RTN","DGPFLMT3",92,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMT3",93,0) Q "RTN","DGPFLMT3",94,0) ; "RTN","DGPFLMT3",95,0) ; "RTN","DGPFLMT3",96,0) EXIT ;Exit Code "RTN","DGPFLMT3",97,0) D CLEAN^VALM10 "RTN","DGPFLMT3",98,0) D CLEAR^VALM1 "RTN","DGPFLMT3",99,0) K ^TMP("DGPFVDET",$J) "RTN","DGPFLMT3",100,0) Q "RTN","DGPFLMT3",101,0) ; "RTN","DGPFLMT3",102,0) ; "RTN","DGPFLMT3",103,0) EXPND ;Expand Code "RTN","DGPFLMT3",104,0) Q "RTN","DGPFLMT4") 0^21^B29251148 "RTN","DGPFLMT4",1,0) DGPFLMT4 ;ALB/RBS - PRF TRANSMIT VIEW MESSAGE BUILD LIST AREA ; 10/19/06 10:59am "RTN","DGPFLMT4",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT4",3,0) ; "RTN","DGPFLMT4",4,0) ;no direct entry "RTN","DGPFLMT4",5,0) QUIT "RTN","DGPFLMT4",6,0) ; "RTN","DGPFLMT4",7,0) ; "RTN","DGPFLMT4",8,0) EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build error detail list area. "RTN","DGPFLMT4",9,0) ; "RTN","DGPFLMT4",10,0) ; Input: "RTN","DGPFLMT4",11,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT4",12,0) ; DGPFIEN - IEN of record "RTN","DGPFLMT4",13,0) ; "RTN","DGPFLMT4",14,0) ; Output: "RTN","DGPFLMT4",15,0) ; DGCNT - number of display lines, pass by reference (VALMCNT) "RTN","DGPFLMT4",16,0) ; "RTN","DGPFLMT4",17,0) ;quit if required input paramater not passed "RTN","DGPFLMT4",18,0) Q:'$G(DGPFIEN) "RTN","DGPFLMT4",19,0) ; "RTN","DGPFLMT4",20,0) S:$G(DGARY)="" DGARY="DGPFVDET" "RTN","DGPFLMT4",21,0) ; "RTN","DGPFLMT4",22,0) N DGAIEN ;assignment ien "RTN","DGPFLMT4",23,0) N DGCOD ;error code "RTN","DGPFLMT4",24,0) N DGLI ;dialog text line number "RTN","DGPFLMT4",25,0) N DGPFA ;assignment array "RTN","DGPFLMT4",26,0) N DGPFAH ;assignment history data array "RTN","DGPFLMT4",27,0) N DGPFL ;HL7 transmission log data array "RTN","DGPFLMT4",28,0) N DGLINE ;line counter "RTN","DGPFLMT4",29,0) N DGSUB ;subscript var "RTN","DGPFLMT4",30,0) N DGPFL ;HL7 transmission log data array "RTN","DGPFLMT4",31,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFLMT4",32,0) N DGTBL ;error code table array "RTN","DGPFLMT4",33,0) N DGTEMP ;array returned from BLD^DIALOG with error msg text "RTN","DGPFLMT4",34,0) ; "RTN","DGPFLMT4",35,0) ;init variables "RTN","DGPFLMT4",36,0) S DGLINE=0 "RTN","DGPFLMT4",37,0) K DGPFA,DGPFAH,DGPFL,DGTBL "RTN","DGPFLMT4",38,0) ; "RTN","DGPFLMT4",39,0) ;retrieve HL7 log data "RTN","DGPFLMT4",40,0) Q:'$$GETLOG^DGPFHLL(DGPFIEN,.DGPFL) "RTN","DGPFLMT4",41,0) Q:'+DGPFL("ASGNHIST") "RTN","DGPFLMT4",42,0) ;retrieve assignment history data to get PRF Assignment ien "RTN","DGPFLMT4",43,0) Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFLMT4",44,0) S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1) "RTN","DGPFLMT4",45,0) Q:'DGAIEN "RTN","DGPFLMT4",46,0) Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFLMT4",47,0) ; "RTN","DGPFLMT4",48,0) ;set Error Received D/T "RTN","DGPFLMT4",49,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",50,0) D SET^DGPFLMT1(DGARY,DGLINE,"Error Received D/T: "_$$FDTTM^VALM1($P($G(DGPFL("ACKDT")),U,1)),10,,,.DGCNT) "RTN","DGPFLMT4",51,0) ; "RTN","DGPFLMT4",52,0) ;set Message Control ID "RTN","DGPFLMT4",53,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",54,0) D SET^DGPFLMT1(DGARY,DGLINE,"Message Control ID: "_$P($G(DGPFL("MSGID")),U,2),10,,,.DGCNT) "RTN","DGPFLMT4",55,0) ; "RTN","DGPFLMT4",56,0) ;set Flag Name "RTN","DGPFLMT4",57,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",58,0) D SET^DGPFLMT1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFA("FLAG")),U,2),19,,,.DGCNT) "RTN","DGPFLMT4",59,0) ; "RTN","DGPFLMT4",60,0) ;set Owner Site "RTN","DGPFLMT4",61,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",62,0) D SET^DGPFLMT1(DGARY,DGLINE,"Owner Site: "_$P($G(DGPFA("OWNER")),U,2),18,,,.DGCNT) "RTN","DGPFLMT4",63,0) ; "RTN","DGPFLMT4",64,0) ;set Assignment Transmitted To "RTN","DGPFLMT4",65,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",66,0) D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmitted To: "_$P($G(DGPFL("SITE")),U,2),3,,,.DGCNT) "RTN","DGPFLMT4",67,0) ; "RTN","DGPFLMT4",68,0) ;set Assignment Transmission Date/Time "RTN","DGPFLMT4",69,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",70,0) D SET^DGPFLMT1(DGARY,DGLINE,"Assignment Transmission D/T: "_$$FDTTM^VALM1($P($G(DGPFL("TRANSDT")),U,1)),1,,,.DGCNT) "RTN","DGPFLMT4",71,0) ; "RTN","DGPFLMT4",72,0) ;set blank line "RTN","DGPFLMT4",73,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",74,0) D SET^DGPFLMT1(DGARY,DGLINE," ",1,,,.DGCNT) "RTN","DGPFLMT4",75,0) ; "RTN","DGPFLMT4",76,0) ;set Rejection Reason "RTN","DGPFLMT4",77,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",78,0) D SET^DGPFLMT1(DGARY,DGLINE,"Rejection Reason(s): ",1,,,.DGCNT) "RTN","DGPFLMT4",79,0) ; "RTN","DGPFLMT4",80,0) ;set underline "RTN","DGPFLMT4",81,0) S DGLINE=DGLINE+1 "RTN","DGPFLMT4",82,0) D SET^DGPFLMT1(DGARY,DGLINE,"--------------------",1,,,.DGCNT) "RTN","DGPFLMT4",83,0) ; "RTN","DGPFLMT4",84,0) ;set no error code message "RTN","DGPFLMT4",85,0) I $O(DGPFL("ERROR",""))="" D Q "RTN","DGPFLMT4",86,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMT4",87,0) . D SET^DGPFLMT1(DGARY,DGLINE,">>> There are no Rejection Reason codes on file.",1,,,.DGCNT) "RTN","DGPFLMT4",88,0) ; "RTN","DGPFLMT4",89,0) ;load error code table "RTN","DGPFLMT4",90,0) D BLDVA086^DGPFHLU3(.DGTBL) "RTN","DGPFLMT4",91,0) ; "RTN","DGPFLMT4",92,0) ;loop and set error msg text lines "RTN","DGPFLMT4",93,0) S DGSUB=0 "RTN","DGPFLMT4",94,0) F S DGSUB=$O(DGPFL("ERROR",DGSUB)) Q:'DGSUB D "RTN","DGPFLMT4",95,0) . Q:$G(DGPFL("ERROR",DGSUB))']"" "RTN","DGPFLMT4",96,0) . K DGTEMP "RTN","DGPFLMT4",97,0) . S DGCOD=DGPFL("ERROR",DGSUB) "RTN","DGPFLMT4",98,0) . ;assume numeric error code is a DIALOG "RTN","DGPFLMT4",99,0) . I DGCOD?1N.N D BLD^DIALOG(DGCOD,"","","DGTEMP") "RTN","DGPFLMT4",100,0) . I $D(DGTEMP) D FORMAT(.DGTEMP,70) "RTN","DGPFLMT4",101,0) . ;if not a DIALOG, then is it a table entry? "RTN","DGPFLMT4",102,0) . I '$D(DGTEMP),DGCOD]"",$D(DGTBL(DGCOD,"DESC")) S DGTEMP(1)=DGTBL(DGCOD,"DESC") D FORMAT(.DGTEMP,70) "RTN","DGPFLMT4",103,0) . ;not a DIALOG or table entry - then error is unknown "RTN","DGPFLMT4",104,0) . I '$D(DGTEMP) S DGTEMP(1)="Unknown Error code: '"_DGCOD_"'" "RTN","DGPFLMT4",105,0) . ; "RTN","DGPFLMT4",106,0) . F DGLI=1:1 Q:'$D(DGTEMP(DGLI)) S DGLINE=DGLINE+1 D "RTN","DGPFLMT4",107,0) . . I DGLI=1 D SET^DGPFLMT1(DGARY,DGLINE,DGSUB_". "_DGTEMP(DGLI),1,,,.DGCNT) "RTN","DGPFLMT4",108,0) . . E D SET^DGPFLMT1(DGARY,DGLINE," "_DGTEMP(DGLI),1,,,.DGCNT) "RTN","DGPFLMT4",109,0) ; "RTN","DGPFLMT4",110,0) Q "RTN","DGPFLMT4",111,0) ; "RTN","DGPFLMT4",112,0) FORMAT(DGTEXT,DGMAX) ;format text lines to length "RTN","DGPFLMT4",113,0) ;This procedure formats an array of text lines to be less than a "RTN","DGPFLMT4",114,0) ;given maximum length. "RTN","DGPFLMT4",115,0) ; "RTN","DGPFLMT4",116,0) ; Supported DBIA: #10104 - $$TRIM^XLFSTR Kernel api to trim spaces "RTN","DGPFLMT4",117,0) ; "RTN","DGPFLMT4",118,0) ; Input: "RTN","DGPFLMT4",119,0) ; DGTEXT - (required) array of text lines (passed by reference) "RTN","DGPFLMT4",120,0) ; DGMAX - (optional) maximum line length (default = 75) "RTN","DGPFLMT4",121,0) ; "RTN","DGPFLMT4",122,0) ; Output: "RTN","DGPFLMT4",123,0) ; DGTEXT - re-formatted array of text lines "RTN","DGPFLMT4",124,0) ; "RTN","DGPFLMT4",125,0) Q:'$D(DGTEXT) "RTN","DGPFLMT4",126,0) ; "RTN","DGPFLMT4",127,0) N DGARRY ;temp array for re-formatting "RTN","DGPFLMT4",128,0) N DGI ;loop var "RTN","DGPFLMT4",129,0) N DGLN ;line counter var "RTN","DGPFLMT4",130,0) N DGMORE ;leftover words "RTN","DGPFLMT4",131,0) N DGNEWLN ;new text line "RTN","DGPFLMT4",132,0) N DGOLDLN ;original text line "RTN","DGPFLMT4",133,0) N DGSPOT ;position of text line to break at "RTN","DGPFLMT4",134,0) ; "RTN","DGPFLMT4",135,0) S:'+$G(DGMAX) DGMAX=75 "RTN","DGPFLMT4",136,0) ; "RTN","DGPFLMT4",137,0) S (DGI,DGLN,DGMORE,DGNEWLN,DGOLDLN,DGSPOT)="" "RTN","DGPFLMT4",138,0) ; "RTN","DGPFLMT4",139,0) F DGI=1:1 S DGOLDLN=$G(DGTEXT(DGI)) Q:'$L(DGOLDLN)&'$L(DGMORE) D "RTN","DGPFLMT4",140,0) . I DGOLDLN'?1.P S DGOLDLN=$$TRIM^XLFSTR(DGOLDLN) "RTN","DGPFLMT4",141,0) . I $L(DGOLDLN)'>DGMAX,'$L(DGMORE) D Q "RTN","DGPFLMT4",142,0) . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN "RTN","DGPFLMT4",143,0) . ; "RTN","DGPFLMT4",144,0) . I $L(DGMORE),(DGOLDLN?1.P!('$L(DGOLDLN))) D Q "RTN","DGPFLMT4",145,0) . . S DGLN=DGLN+1,DGARRY(DGLN)=DGMORE,DGMORE="" "RTN","DGPFLMT4",146,0) . . S:$L(DGOLDLN) DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN "RTN","DGPFLMT4",147,0) . ; "RTN","DGPFLMT4",148,0) . S:$L(DGMORE) DGOLDLN=DGMORE_" "_DGOLDLN,DGMORE="" "RTN","DGPFLMT4",149,0) . ; "RTN","DGPFLMT4",150,0) . I $L(DGOLDLN)>DGMAX F D Q:'$L(DGOLDLN) "RTN","DGPFLMT4",151,0) . . S DGSPOT=$L($E(DGOLDLN,1,DGMAX)," ") "RTN","DGPFLMT4",152,0) . . S DGNEWLN=$P(DGOLDLN," ",1,$S(DGSPOT>1:DGSPOT-1,1:1)) "RTN","DGPFLMT4",153,0) . . S DGLN=DGLN+1,DGARRY(DGLN)=DGNEWLN,DGNEWLN="" "RTN","DGPFLMT4",154,0) . . S DGMORE=$P(DGOLDLN," ",$S(DGSPOT>1:DGSPOT,1:DGSPOT+1),$L(DGOLDLN," ")) "RTN","DGPFLMT4",155,0) . . I $L(DGMORE)>DGMAX S DGOLDLN=DGMORE,DGMORE="" "RTN","DGPFLMT4",156,0) . . E S DGOLDLN="" "RTN","DGPFLMT4",157,0) . E D "RTN","DGPFLMT4",158,0) . . S DGLN=DGLN+1,DGARRY(DGLN)=DGOLDLN "RTN","DGPFLMT4",159,0) ; "RTN","DGPFLMT4",160,0) I $D(DGARRY) K DGTEXT M DGTEXT=DGARRY "RTN","DGPFLMT4",161,0) Q "RTN","DGPFLMT5") 0^22^B10105469 "RTN","DGPFLMT5",1,0) DGPFLMT5 ;ALB/RBS - PRF TRANSMIT REJECT MESSAGE PROCESSING ; 7/12/06 09:30am "RTN","DGPFLMT5",2,0) ;;5.3;Registration;**650**;Aug 13, 1993;Build 3 "RTN","DGPFLMT5",3,0) ; "RTN","DGPFLMT5",4,0) ;no direct entry "RTN","DGPFLMT5",5,0) QUIT "RTN","DGPFLMT5",6,0) ; "RTN","DGPFLMT5",7,0) ; "RTN","DGPFLMT5",8,0) EN(DGVALMY) ;Entry point to retransmit rejected messages "RTN","DGPFLMT5",9,0) ;This function will retransmit all user selected "RJ" Rejected status "RTN","DGPFLMT5",10,0) ;entries of the PRF HL7 TRANSMISSION LOG (#26.17) file to the "RTN","DGPFLMT5",11,0) ;Treating Facility that rejected it. "RTN","DGPFLMT5",12,0) ; "RTN","DGPFLMT5",13,0) ; Input: "RTN","DGPFLMT5",14,0) ; DGVALMY - VALMY array of user selections, pass by reference "RTN","DGPFLMT5",15,0) ; "RTN","DGPFLMT5",16,0) ; Output: "RTN","DGPFLMT5",17,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFLMT5",18,0) ; "RTN","DGPFLMT5",19,0) ;- Use the 0 node sort file for all retransmission processing: "RTN","DGPFLMT5",20,0) ; ^TMP("DGPFSORT",$J,0,,,)="" "RTN","DGPFLMT5",21,0) ; Each patient's PRF Assignment record is grouped with all of the "RTN","DGPFLMT5",22,0) ; Treating Facilities that logged a rejected HL7 transmission entry. "RTN","DGPFLMT5",23,0) ; "RTN","DGPFLMT5",24,0) N DGAIEN ;assignment ien "RTN","DGPFLMT5",25,0) N DGFAC ;destination station number "RTN","DGPFLMT5",26,0) N DGHLIEN ;loop var "RTN","DGPFLMT5",27,0) N DGNODE ;"IDX" data string "RTN","DGPFLMT5",28,0) N DGRSLT ;function value "RTN","DGPFLMT5",29,0) N DGSEL ;user selection "RTN","DGPFLMT5",30,0) N DGSITE ;site transmitted to ien "RTN","DGPFLMT5",31,0) ; "RTN","DGPFLMT5",32,0) ;set screen to full scroll region "RTN","DGPFLMT5",33,0) D FULL^VALM1 "RTN","DGPFLMT5",34,0) W ! "RTN","DGPFLMT5",35,0) ; "RTN","DGPFLMT5",36,0) ;- Use the "IDX" selection entry to get the assignment info "RTN","DGPFLMT5",37,0) ; ^^^^^ "RTN","DGPFLMT5",38,0) ; "RTN","DGPFLMT5",39,0) S DGRSLT=0 "RTN","DGPFLMT5",40,0) I $O(DGVALMY(""))'="" D "RTN","DGPFLMT5",41,0) . S DGSEL=0 "RTN","DGPFLMT5",42,0) . F S DGSEL=$O(DGVALMY(DGSEL)) Q:'DGSEL D "RTN","DGPFLMT5",43,0) . . S DGNODE=$G(^TMP("DGPFLMT",$J,"IDX",DGSEL,DGSEL)) "RTN","DGPFLMT5",44,0) . . Q:'DGNODE "RTN","DGPFLMT5",45,0) . . S DGAIEN=$P(DGNODE,U,1) "RTN","DGPFLMT5",46,0) . . Q:'DGAIEN "RTN","DGPFLMT5",47,0) . . S DGSITE=$P(DGNODE,U,2) "RTN","DGPFLMT5",48,0) . . Q:'DGSITE "RTN","DGPFLMT5",49,0) . . ; "RTN","DGPFLMT5",50,0) . . ;- retransmit assignment - "RTN","DGPFLMT5",51,0) . . ; display patient name and site transmitted to failure & success "RTN","DGPFLMT5",52,0) . . ; "RTN","DGPFLMT5",53,0) . . I '$$XMIT(DGAIEN,DGSITE) D Q "RTN","DGPFLMT5",54,0) . . . W !,">>>",?5,DGSEL,". ",$P(DGNODE,U,5),"...failed to retransmit to...",$P(DGNODE,U,6) "RTN","DGPFLMT5",55,0) . . E W !?5,DGSEL,". ",$P(DGNODE,U,5),"...was retransmitted to...",$P(DGNODE,U,6) "RTN","DGPFLMT5",56,0) . . ; "RTN","DGPFLMT5",57,0) . . ;- Now set all of the Assignment's HL7 transmission log entry's "RTN","DGPFLMT5",58,0) . . ; to "RT" RE-TRANSMITTED status. "RTN","DGPFLMT5",59,0) . . ;- loop ^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,n) nodes "RTN","DGPFLMT5",60,0) . . S DGHLIEN=0 "RTN","DGPFLMT5",61,0) . . F S DGHLIEN=$O(^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,DGHLIEN)) Q:'DGHLIEN D "RTN","DGPFLMT5",62,0) . . . ;- update HL7 transmission log entry status "RTN","DGPFLMT5",63,0) . . . ; "RTN","DGPFLMT5",64,0) . . . D STOSTAT^DGPFHLL(26.17,DGHLIEN,"RT") "RTN","DGPFLMT5",65,0) . . ; "RTN","DGPFLMT5",66,0) . . S DGRSLT=1 "RTN","DGPFLMT5",67,0) ; "RTN","DGPFLMT5",68,0) Q DGRSLT "RTN","DGPFLMT5",69,0) ; "RTN","DGPFLMT5",70,0) XMIT(DGAIEN,DGSITE) ;call out to retransmit "RTN","DGPFLMT5",71,0) ;This function is used to call the PRF (ORU~R01) function to transmit "RTN","DGPFLMT5",72,0) ;a patient's Assignment record and all History records to a single "RTN","DGPFLMT5",73,0) ;Treating Facility. "RTN","DGPFLMT5",74,0) ; "RTN","DGPFLMT5",75,0) ; Supported DBIA #2171: $$STA^XUAF4 "RTN","DGPFLMT5",76,0) ; This supported DBIA is used to access the Kernel API to convert "RTN","DGPFLMT5",77,0) ; a station number to an INSTITUTION (#4) file IEN. "RTN","DGPFLMT5",78,0) ; "RTN","DGPFLMT5",79,0) ; Input: (required) "RTN","DGPFLMT5",80,0) ; DGAIEN - assignment ien "RTN","DGPFLMT5",81,0) ; DGSITE - site transmitted to ien "RTN","DGPFLMT5",82,0) ; "RTN","DGPFLMT5",83,0) ; Output: "RTN","DGPFLMT5",84,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFLMT5",85,0) ; "RTN","DGPFLMT5",86,0) N DGFAC ;destination station number array "RTN","DGPFLMT5",87,0) N DGHIENS ;array of assignment history ien's "RTN","DGPFLMT5",88,0) N DGRSLT ;function value "RTN","DGPFLMT5",89,0) S DGRSLT=0 "RTN","DGPFLMT5",90,0) ; "RTN","DGPFLMT5",91,0) I +$G(DGAIEN)>0 D "RTN","DGPFLMT5",92,0) . K DGFAC,DGHIENS "RTN","DGPFLMT5",93,0) . ; "RTN","DGPFLMT5",94,0) . ;convert institution# to station# "RTN","DGPFLMT5",95,0) . S DGFAC(1)=$$STA^XUAF4(DGSITE) "RTN","DGPFLMT5",96,0) . Q:'DGFAC(1) "RTN","DGPFLMT5",97,0) . ; "RTN","DGPFLMT5",98,0) . ;get all assignment history ien's "RTN","DGPFLMT5",99,0) . Q:'$$GETALLDT^DGPFAAH(DGAIEN,.DGHIENS) "RTN","DGPFLMT5",100,0) . ; "RTN","DGPFLMT5",101,0) . ;build and transmit the new message "RTN","DGPFLMT5",102,0) . Q:'$$SNDORU^DGPFHLS(DGAIEN,.DGHIENS,.DGFAC) "RTN","DGPFLMT5",103,0) . ; "RTN","DGPFLMT5",104,0) . S DGRSLT=1 "RTN","DGPFLMT5",105,0) ; "RTN","DGPFLMT5",106,0) Q DGRSLT "RTN","DGPFLMU") 0^33^B16582926 "RTN","DGPFLMU",1,0) DGPFLMU ;ALB/KCL - PRF ASSIGNMENT LISTMAN UTILITIES ; 3/06/06 3:39pm "RTN","DGPFLMU",2,0) ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3 "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 DGPFA ;assignment data array "RTN","DGPFLMU",52,0) N DGPFAH ;assignment history data array "RTN","DGPFLMU",53,0) N DGPTR ;pointer to last assignment history record "RTN","DGPFLMU",54,0) N DGTXT ;msg text if no assignments for patient "RTN","DGPFLMU",55,0) ; "RTN","DGPFLMU",56,0) ;kill data and video cntrl arrays associated with active list "RTN","DGPFLMU",57,0) D CLEAN^VALM10 "RTN","DGPFLMU",58,0) ; "RTN","DGPFLMU",59,0) ;if no assignments, display msg, quit "RTN","DGPFLMU",60,0) K DGIENS "RTN","DGPFLMU",61,0) I '$$GETALL^DGPFAA(DGDFN,.DGIENS) D Q "RTN","DGPFLMU",62,0) . S DGTXT=" Selected patient has no record flag assignments on file." "RTN","DGPFLMU",63,0) . D SET^VALM10(1,"") "RTN","DGPFLMU",64,0) . D SET^VALM10(2,DGTXT) "RTN","DGPFLMU",65,0) . D CNTRL^VALM10(2,4,$L(DGTXT),$G(IOINHI),$G(IOINORM)) "RTN","DGPFLMU",66,0) . S VALMCNT=2 "RTN","DGPFLMU",67,0) ; "RTN","DGPFLMU",68,0) ;if assignments, get data and build list "RTN","DGPFLMU",69,0) S DGIEN=0,VALMCNT=0 "RTN","DGPFLMU",70,0) F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D "RTN","DGPFLMU",71,0) . ;-get assignment "RTN","DGPFLMU",72,0) . K DGPFA "RTN","DGPFLMU",73,0) . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFLMU",74,0) . ;-get initial assignment history "RTN","DGPFLMU",75,0) . K DGPFAH "RTN","DGPFLMU",76,0) . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFLMU",77,0) . ;-get 'initial assignment' date "RTN","DGPFLMU",78,0) . S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFLMU",79,0) . Q:'DGPFAH("INITASSIGN") "RTN","DGPFLMU",80,0) . ;-increment line number count "RTN","DGPFLMU",81,0) . S VALMCNT=VALMCNT+1 "RTN","DGPFLMU",82,0) . ;-build list "RTN","DGPFLMU",83,0) . D BLDLIN(VALMCNT,.DGPFA,.DGPFAH,DGIEN) "RTN","DGPFLMU",84,0) ; "RTN","DGPFLMU",85,0) Q "RTN","DGPFLMU",86,0) ; "RTN","DGPFLMU",87,0) ; "RTN","DGPFLMU",88,0) BLDLIN(DGLNUM,DGPFA,DGPFAH,DGIEN) ;This procedure will build and setup ListMan lines and array. "RTN","DGPFLMU",89,0) ; "RTN","DGPFLMU",90,0) ; Input: "RTN","DGPFLMU",91,0) ; DGLNUM - line number "RTN","DGPFLMU",92,0) ; DGPFA - array containing assignment, passed by reference "RTN","DGPFLMU",93,0) ; DGPFAH - array containing assignment history, passed by reference "RTN","DGPFLMU",94,0) ; DGIEN - internal entry number of assignment "RTN","DGPFLMU",95,0) ; "RTN","DGPFLMU",96,0) ; Output: None "RTN","DGPFLMU",97,0) ; "RTN","DGPFLMU",98,0) N DGTXT ;used as temporary text field "RTN","DGPFLMU",99,0) N DGLINE ;string to insert field data "RTN","DGPFLMU",100,0) S DGLINE="" ;init "RTN","DGPFLMU",101,0) S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3) "RTN","DGPFLMU",102,0) ; "RTN","DGPFLMU",103,0) ;flag name "RTN","DGPFLMU",104,0) S DGTXT=$P($G(DGPFA("FLAG")),U,2) "RTN","DGPFLMU",105,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG") "RTN","DGPFLMU",106,0) ; "RTN","DGPFLMU",107,0) ;initial assignment date "RTN","DGPFLMU",108,0) S DGTXT=$$FDATE^VALM1(+$G(DGPFAH("INITASSIGN"))) "RTN","DGPFLMU",109,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE") "RTN","DGPFLMU",110,0) ; "RTN","DGPFLMU",111,0) ;review date "RTN","DGPFLMU",112,0) S DGTXT=+$G(DGPFA("REVIEWDT")) "RTN","DGPFLMU",113,0) S DGTXT=$S(DGTXT:$$FDATE^VALM1(DGTXT),1:"N/A") "RTN","DGPFLMU",114,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"REVIEW DATE") "RTN","DGPFLMU",115,0) ; "RTN","DGPFLMU",116,0) ;status/active (yes/no) "RTN","DGPFLMU",117,0) S DGTXT=$P($G(DGPFA("STATUS")),U) "RTN","DGPFLMU",118,0) S DGTXT=$S(DGTXT=1:"YES",1:"NO") "RTN","DGPFLMU",119,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS") "RTN","DGPFLMU",120,0) ; "RTN","DGPFLMU",121,0) ;local (yes/no) "RTN","DGPFLMU",122,0) S DGTXT="NO" "RTN","DGPFLMU",123,0) I $P($G(DGPFA("FLAG")),U)["26.11" S DGTXT="YES" "RTN","DGPFLMU",124,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"LOCAL") "RTN","DGPFLMU",125,0) ; "RTN","DGPFLMU",126,0) ;owner site "RTN","DGPFLMU",127,0) S DGTXT=$P($G(DGPFA("OWNER")),U,2) "RTN","DGPFLMU",128,0) S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE") "RTN","DGPFLMU",129,0) ; "RTN","DGPFLMU",130,0) ;construct initial list array "RTN","DGPFLMU",131,0) D SET^VALM10(DGLNUM,DGLINE,DGLNUM) "RTN","DGPFLMU",132,0) ; "RTN","DGPFLMU",133,0) ;set assignment ien and pt DFN into index "RTN","DGPFLMU",134,0) S @VALMAR@("IDX",DGLNUM,DGLNUM)=$G(DGIEN)_U_+$G(DGPFA("DFN")) "RTN","DGPFLMU",135,0) ; "RTN","DGPFLMU",136,0) Q "RTN","DGPFLMU1") 0^34^B45355090 "RTN","DGPFLMU1",1,0) DGPFLMU1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL LM UTILITIES CONT ; 10/12/05 10:26am "RTN","DGPFLMU1",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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,.DGPFA,.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)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U)),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)_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U)),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,DGPFA,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) ; DGPFA - assignment array, pass by reference "RTN","DGPFLMU1",157,0) ; DGLINE - line counter "RTN","DGPFLMU1",158,0) ; DGHISCNT - counter of history record "RTN","DGPFLMU1",159,0) ; "RTN","DGPFLMU1",160,0) ; Output: "RTN","DGPFLMU1",161,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",162,0) ; "RTN","DGPFLMU1",163,0) ;temporary variables used "RTN","DGPFLMU1",164,0) N DGTMP "RTN","DGPFLMU1",165,0) N DGSUB "RTN","DGPFLMU1",166,0) ; "RTN","DGPFLMU1",167,0) ;set blank line "RTN","DGPFLMU1",168,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",169,0) D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",170,0) ; "RTN","DGPFLMU1",171,0) ;add an additional blank line except on the first history "RTN","DGPFLMU1",172,0) I DGHISCNT>1 D "RTN","DGPFLMU1",173,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",174,0) . D SET(DGARY,DGLINE,"",1,,,.DGCNT) "RTN","DGPFLMU1",175,0) ; "RTN","DGPFLMU1",176,0) ;set action "RTN","DGPFLMU1",177,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",178,0) S DGTMP=DGHISCNT_"." "RTN","DGPFLMU1",179,0) D SET(DGARY,DGLINE,DGTMP,1,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",180,0) D SET(DGARY,DGLINE,"Action: "_$P($G(DGPFAH("ACTION")),U,2),10,IORVON,IORVOFF,.DGCNT) "RTN","DGPFLMU1",181,0) ; "RTN","DGPFLMU1",182,0) ;set assignment date "RTN","DGPFLMU1",183,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",184,0) D SET(DGARY,DGLINE,"Action Date: "_$$FDTTM^VALM1($P($G(DGPFAH("ASSIGNDT")),U)),5,,,.DGCNT) "RTN","DGPFLMU1",185,0) ; "RTN","DGPFLMU1",186,0) ;set entered by "RTN","DGPFLMU1",187,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",188,0) D SET(DGARY,DGLINE,"Entered By: "_$P($G(DGPFAH("ENTERBY")),U,2),6,,,.DGCNT) "RTN","DGPFLMU1",189,0) ; "RTN","DGPFLMU1",190,0) ;set approved by "RTN","DGPFLMU1",191,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",192,0) D SET(DGARY,DGLINE,"Approved By: "_$P($G(DGPFAH("APPRVBY")),U,2),5,,,.DGCNT) "RTN","DGPFLMU1",193,0) ; "RTN","DGPFLMU1",194,0) ;set progress note linked "RTN","DGPFLMU1",195,0) I $D(^DG(40.8,"AD",+$P($G(DGPFA("OWNER")),U))) D "RTN","DGPFLMU1",196,0) . Q:+$G(DGPFAH("ACTION"))=5 ;don't display ENTERED IN ERROR action "RTN","DGPFLMU1",197,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",198,0) . D SET(DGARY,DGLINE,"Progress Note: "_$P($G(DGPFAH("TIULINK")),U,2),3,,,.DGCNT) "RTN","DGPFLMU1",199,0) ; "RTN","DGPFLMU1",200,0) ;set history comments "RTN","DGPFLMU1",201,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",202,0) D SET(DGARY,DGLINE,"Action Comments:",1,,,.DGCNT) "RTN","DGPFLMU1",203,0) S DGLINE=DGLINE+1 "RTN","DGPFLMU1",204,0) D SET(DGARY,DGLINE,"----------------",1,,,.DGCNT) "RTN","DGPFLMU1",205,0) I $D(DGPFAH("COMMENT",1,0)) D "RTN","DGPFLMU1",206,0) . S (DGSUB,DGTMP)="" "RTN","DGPFLMU1",207,0) . F S DGSUB=$O(DGPFAH("COMMENT",DGSUB)) Q:'DGSUB D "RTN","DGPFLMU1",208,0) .. S DGTMP=$G(DGPFAH("COMMENT",DGSUB,0)) "RTN","DGPFLMU1",209,0) .. S DGLINE=DGLINE+1 "RTN","DGPFLMU1",210,0) .. D SET(DGARY,DGLINE,DGTMP,1,,,.DGCNT) "RTN","DGPFLMU1",211,0) E D "RTN","DGPFLMU1",212,0) . S DGLINE=DGLINE+1 "RTN","DGPFLMU1",213,0) . D SET(DGARY,DGLINE,"No Comments on file.",1,,,.DGCNT) "RTN","DGPFLMU1",214,0) ; "RTN","DGPFLMU1",215,0) Q "RTN","DGPFLMU1",216,0) ; "RTN","DGPFLMU1",217,0) ; "RTN","DGPFLMU1",218,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",219,0) ; "RTN","DGPFLMU1",220,0) ; Input: "RTN","DGPFLMU1",221,0) ; DGARY - global array subscript "RTN","DGPFLMU1",222,0) ; DGLINE - line number "RTN","DGPFLMU1",223,0) ; DGTEXT - text "RTN","DGPFLMU1",224,0) ; DGCOL - starting column "RTN","DGPFLMU1",225,0) ; DGON - highlighting on "RTN","DGPFLMU1",226,0) ; DGOFF - highlighting off "RTN","DGPFLMU1",227,0) ; "RTN","DGPFLMU1",228,0) ; Output: "RTN","DGPFLMU1",229,0) ; DGCNT - number of lines in the list, pass by reference "RTN","DGPFLMU1",230,0) ; "RTN","DGPFLMU1",231,0) N DGX ;temp variable for line of display text "RTN","DGPFLMU1",232,0) ; "RTN","DGPFLMU1",233,0) S DGCNT=DGLINE "RTN","DGPFLMU1",234,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLMU1",235,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLMU1",236,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLMU1",237,0) Q "RTN","DGPFRAL1") 0^41^B71862269 "RTN","DGPFRAL1",1,0) DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm "RTN","DGPFRAL1",2,0) ;;5.3;Registration;**554,650**;Aug 13, 1993;Build 3 "RTN","DGPFRAL1",3,0) ; "RTN","DGPFRAL1",4,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRAL1",5,0) ;assignment history records that are not linked to a progress note. "RTN","DGPFRAL1",6,0) ; "RTN","DGPFRAL1",7,0) ; Input: The following sort array contains the report parameters: "RTN","DGPFRAL1",8,0) ; DGSORT("DGCAT") = Flag Category to report on "RTN","DGPFRAL1",9,0) ; = 1:National, 2:Local, 3:Both "RTN","DGPFRAL1",10,0) ; DGSORT("DGBEG") = Beginning date to report on "RTN","DGPFRAL1",11,0) ; DGSORT("DGEND") = Ending date to report on "RTN","DGPFRAL1",12,0) ; "RTN","DGPFRAL1",13,0) ; Output: A formatted report of patient Assignment History Actions "RTN","DGPFRAL1",14,0) ; that are not linked to a TIU Progress Note. "RTN","DGPFRAL1",15,0) ; "RTN","DGPFRAL1",16,0) ;- no direct entry "RTN","DGPFRAL1",17,0) QUIT "RTN","DGPFRAL1",18,0) ; "RTN","DGPFRAL1",19,0) START ; compile and print report "RTN","DGPFRAL1",20,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGPFRAL1",21,0) N DGLIST ;temp global name used for report list "RTN","DGPFRAL1",22,0) S DGLIST=$NA(^TMP("DGPFRAL1",$J)) "RTN","DGPFRAL1",23,0) K @DGLIST "RTN","DGPFRAL1",24,0) D LOOP(.DGSORT,DGLIST) "RTN","DGPFRAL1",25,0) D PRINT(.DGSORT,DGLIST) "RTN","DGPFRAL1",26,0) K @DGLIST "RTN","DGPFRAL1",27,0) D EXIT "RTN","DGPFRAL1",28,0) Q "RTN","DGPFRAL1",29,0) ; "RTN","DGPFRAL1",30,0) LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list "RTN","DGPFRAL1",31,0) ; Input: "RTN","DGPFRAL1",32,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",33,0) ; DGLIST - temp global name "RTN","DGPFRAL1",34,0) ; "RTN","DGPFRAL1",35,0) ; Output: "RTN","DGPFRAL1",36,0) ; ^TMP("DGPFRAL1",$J) - temp global containing report output "RTN","DGPFRAL1",37,0) ; "RTN","DGPFRAL1",38,0) N DGBEG ;beginning date "RTN","DGPFRAL1",39,0) N DGC ;var used to check which category is being reported on "RTN","DGPFRAL1",40,0) N DGCAT ;flag category "RTN","DGPFRAL1",41,0) N DGCATG ;category 1 or 2 "RTN","DGPFRAL1",42,0) N DGCNT ;flag counter "RTN","DGPFRAL1",43,0) N DGDFN ;pointer to patient being reported on "RTN","DGPFRAL1",44,0) N DGDFNLST ;array of dfn's assigned to the flag "RTN","DGPFRAL1",45,0) N DGEND ;ending date "RTN","DGPFRAL1",46,0) N DGHIENS ;array subscripted by assignment history date "RTN","DGPFRAL1",47,0) N DGIEN ;assignment ien "RTN","DGPFRAL1",48,0) N DGPAT ;patient data array "RTN","DGPFRAL1",49,0) N DGPFA ;assignment data array "RTN","DGPFRAL1",50,0) N DGQ ;quit var "RTN","DGPFRAL1",51,0) N DGSUB ;loop flag "RTN","DGPFRAL1",52,0) N DGX ;loop var "RTN","DGPFRAL1",53,0) ; "RTN","DGPFRAL1",54,0) ; setup variables equal to user input parameter subscripts "RTN","DGPFRAL1",55,0) ; "DGCAT", "DGBEG", "DGEND" "RTN","DGPFRAL1",56,0) S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX) "RTN","DGPFRAL1",57,0) S DGC=$S(+DGCAT=3:0,1:+DGCAT) "RTN","DGPFRAL1",58,0) S:DGC DGC=$S(DGC=1:26.15,1:26.11) "RTN","DGPFRAL1",59,0) ; "RTN","DGPFRAL1",60,0) ; loop assignment variable pointer flag x-ref file to run report "RTN","DGPFRAL1",61,0) S (DGDFN,DGIEN)="",(DGQ,DGSUB,DGCNT)=0 "RTN","DGPFRAL1",62,0) F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRAL1",63,0) . I DGC,DGSUB'[DGC Q ;not correct file based on category "RTN","DGPFRAL1",64,0) . S DGCATG=$S(DGSUB[26.15:1,1:2) "RTN","DGPFRAL1",65,0) . K DGDFNLST "RTN","DGPFRAL1",66,0) . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) "RTN","DGPFRAL1",67,0) . Q:'DGCNT "RTN","DGPFRAL1",68,0) . S DGDFN="" "RTN","DGPFRAL1",69,0) . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D "RTN","DGPFRAL1",70,0) . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN="" "RTN","DGPFRAL1",71,0) . . ; get assignment record "RTN","DGPFRAL1",72,0) . . K DGPFA "RTN","DGPFRAL1",73,0) . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRAL1",74,0) . . ; check if calling site is owner site "RTN","DGPFRAL1",75,0) . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) "RTN","DGPFRAL1",76,0) . . ; "RTN","DGPFRAL1",77,0) . . ;filter patient when last action is ENTERED IN ERROR "RTN","DGPFRAL1",78,0) . . Q:$$ENTINERR(DGIEN) "RTN","DGPFRAL1",79,0) . . ; "RTN","DGPFRAL1",80,0) . . ;action ien array subscripted by assignment history date "RTN","DGPFRAL1",81,0) . . K DGHIENS "RTN","DGPFRAL1",82,0) . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS) "RTN","DGPFRAL1",83,0) . . ; check if any Action's fall within the Begin and End dates "RTN","DGPFRAL1",84,0) . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'DGEND) K DGHIENS(DGX) "RTN","DGPFRAL1",88,0) . . . Q:'$O(DGHIENS("")) "RTN","DGPFRAL1",89,0) . . . ; "RTN","DGPFRAL1",90,0) . . . ; get patient demographics "RTN","DGPFRAL1",91,0) . . . K DGPAT "RTN","DGPFRAL1",92,0) . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT) "RTN","DGPFRAL1",93,0) . . . ; "RTN","DGPFRAL1",94,0) . . . ; call to build temp global "RTN","DGPFRAL1",95,0) . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST) "RTN","DGPFRAL1",96,0) ; "RTN","DGPFRAL1",97,0) Q "RTN","DGPFRAL1",98,0) ; "RTN","DGPFRAL1",99,0) BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder "RTN","DGPFRAL1",100,0) ; Input: "RTN","DGPFRAL1",101,0) ; DGPFA - array of assignment record data "RTN","DGPFRAL1",102,0) ; DGPAT - array of patient demographics "RTN","DGPFRAL1",103,0) ; DGHIENS - array of history action IEN's sorted by d/t "RTN","DGPFRAL1",104,0) ; DGCATG - category of flag 1=National, 2=Local "RTN","DGPFRAL1",105,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",106,0) ; "RTN","DGPFRAL1",107,0) ; Output: "RTN","DGPFRAL1",108,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRAL1",109,0) ; "RTN","DGPFRAL1",110,0) N DGACTDT ;initial entry date "RTN","DGPFRAL1",111,0) N DGFGNM ;flag name "RTN","DGPFRAL1",112,0) N DGHIEN ;assignment ien "RTN","DGPFRAL1",113,0) N DGLINE ;report detail line "RTN","DGPFRAL1",114,0) N DGLNCNT ;unique subscript counter "RTN","DGPFRAL1",115,0) N DGPDFN ;pointer to patient "RTN","DGPFRAL1",116,0) N DGPFAH ;assignment history record data "RTN","DGPFRAL1",117,0) N DGPNM ;patient name "RTN","DGPFRAL1",118,0) ; "RTN","DGPFRAL1",119,0) ; loop all assignment history ien's "RTN","DGPFRAL1",120,0) S DGHIEN="",DGLNCNT=0 "RTN","DGPFRAL1",121,0) F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D "RTN","DGPFRAL1",122,0) . ; get assignment history record "RTN","DGPFRAL1",123,0) . K DGPFAH "RTN","DGPFRAL1",124,0) . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH) "RTN","DGPFRAL1",125,0) . Q:+$G(DGPFAH("TIULINK")) ;progress note pointer is setup "RTN","DGPFRAL1",126,0) . Q:+$G(DGPFAH("ACTION"))=5 ;don't report on ENTERED IN ERROR action "RTN","DGPFRAL1",127,0) . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT")) "RTN","DGPFRAL1",128,0) . S DGPNM=DGPAT("NAME") "RTN","DGPFRAL1",129,0) . S:DGPNM']"" DGPNM="MISSING PATIENT NAME" "RTN","DGPFRAL1",130,0) . S DGPDFN=$P(DGPFA("DFN"),U) "RTN","DGPFRAL1",131,0) . S DGFGNM=$P(DGPFA("FLAG"),U,2) "RTN","DGPFRAL1",132,0) . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME" "RTN","DGPFRAL1",133,0) . S DGLINE=DGPAT("SSN")_U_$E(DGFGNM,1,17)_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT "RTN","DGPFRAL1",134,0) . S DGLNCNT=DGLNCNT+1 "RTN","DGPFRAL1",135,0) . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE "RTN","DGPFRAL1",136,0) ; "RTN","DGPFRAL1",137,0) Q "RTN","DGPFRAL1",138,0) ; "RTN","DGPFRAL1",139,0) PRINT(DGSORT,DGLIST) ;output report "RTN","DGPFRAL1",140,0) ; Input: "RTN","DGPFRAL1",141,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",142,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",143,0) ; "RTN","DGPFRAL1",144,0) ; Output: Formatted report to user selected device "RTN","DGPFRAL1",145,0) ; "RTN","DGPFRAL1",146,0) N DGCAT ;flag category "RTN","DGPFRAL1",147,0) N DGCNT ;counter of detail lines "RTN","DGPFRAL1",148,0) N DGDFN ;ien of patient "RTN","DGPFRAL1",149,0) N DGDT ;date time report printed "RTN","DGPFRAL1",150,0) N DGFG ;flag name "RTN","DGPFRAL1",151,0) N DGGRAND ;flag to print grand totals "RTN","DGPFRAL1",152,0) N DGLINE ;string of hyphens (80) for report header format "RTN","DGPFRAL1",153,0) N DGLN ;loop var "RTN","DGPFRAL1",154,0) N DGNAM ;patient name "RTN","DGPFRAL1",155,0) N DGODFN ;print loop var flag "RTN","DGPFRAL1",156,0) N DGOFG ;print loop var flag "RTN","DGPFRAL1",157,0) N DGPCAT ;print form of category "RTN","DGPFRAL1",158,0) N DGPAGE ;page counter "RTN","DGPFRAL1",159,0) N DGQ ;quit flag "RTN","DGPFRAL1",160,0) N DGSTR ;string of detail line to display "RTN","DGPFRAL1",161,0) N X,Y "RTN","DGPFRAL1",162,0) ; "RTN","DGPFRAL1",163,0) S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",81)="" "RTN","DGPFRAL1",164,0) S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2) "RTN","DGPFRAL1",165,0) S (DGCAT,DGPCAT)=+DGSORT("DGCAT") "RTN","DGPFRAL1",166,0) ; "RTN","DGPFRAL1",167,0) I $O(@DGLIST@(""))="" D Q "RTN","DGPFRAL1",168,0) . D HEAD "RTN","DGPFRAL1",169,0) . W !!," >>> No Record Flag Assignments were found using the report criteria.",! "RTN","DGPFRAL1",170,0) ; "RTN","DGPFRAL1",171,0) ; loop and print report "RTN","DGPFRAL1",172,0) S (DGCAT,DGFG,DGNAM,DGDFN,DGODFN,DGOFG,DGLN,DGSTR)="" "RTN","DGPFRAL1",173,0) F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ "RTN","DGPFRAL1",174,0) . D HEAD S DGCNT=0 "RTN","DGPFRAL1",175,0) . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ "RTN","DGPFRAL1",176,0) .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ "RTN","DGPFRAL1",177,0) ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGPFRAL1",178,0) .... F S DGLN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ "RTN","DGPFRAL1",179,0) ..... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) "RTN","DGPFRAL1",180,0) ..... W ! "RTN","DGPFRAL1",181,0) ..... I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD S DGODFN="" W ! "RTN","DGPFRAL1",182,0) ..... ; - write name and ssn once "RTN","DGPFRAL1",183,0) ..... I DGODFN'=DGDFN S DGODFN=DGDFN,DGOFG=DGFG D "RTN","DGPFRAL1",184,0) ...... W $E(DGNAM,1,18),?20,$P(DGSTR,U),?32,$E($P(DGSTR,U,2),1,17) "RTN","DGPFRAL1",185,0) ..... ; - write new flag name "RTN","DGPFRAL1",186,0) ..... I DGOFG'=DGFG S DGOFG=DGFG W ?32,$E($P(DGSTR,U,2),1,17) "RTN","DGPFRAL1",187,0) ..... ; - write action detail "RTN","DGPFRAL1",188,0) ..... W ?51,$P(DGSTR,U,3),?69,$P(DGSTR,U,4) "RTN","DGPFRAL1",189,0) ..... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1 "RTN","DGPFRAL1",190,0) . Q:DGQ "RTN","DGPFRAL1",191,0) . I DGCNT D "RTN","DGPFRAL1",192,0) .. W !!,"Total Actions not Linked for Category "_$S(DGCAT=1:"I",1:"II")_": ",?46,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRAL1",193,0) .. S DGCNT=0,DGODFN="" "RTN","DGPFRAL1",194,0) .. D:DGPCAT=3 PAUSE(.DGQ) "RTN","DGPFRAL1",195,0) ; "RTN","DGPFRAL1",196,0) ;Shutdown if stop task requested "RTN","DGPFRAL1",197,0) I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q "RTN","DGPFRAL1",198,0) ; "RTN","DGPFRAL1",199,0) I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories "RTN","DGPFRAL1",200,0) . S DGCAT=3,DGGRAND=1 "RTN","DGPFRAL1",201,0) . D HEAD "RTN","DGPFRAL1",202,0) . W !!,"REPORT SUMMARY:",!,"---------------" "RTN","DGPFRAL1",203,0) . F DGCAT=1,2,3 D "RTN","DGPFRAL1",204,0) .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT)) "RTN","DGPFRAL1",205,0) .. W:DGCAT=3 !?48,"-------" "RTN","DGPFRAL1",206,0) .. W !,"Total Actions not Linked for Category " "RTN","DGPFRAL1",207,0) .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":" "RTN","DGPFRAL1",208,0) .. W ?49,$J(+$G(DGCNT(DGCAT)),6) "RTN","DGPFRAL1",209,0) ; "RTN","DGPFRAL1",210,0) W !!,"" "RTN","DGPFRAL1",211,0) Q "RTN","DGPFRAL1",212,0) ; "RTN","DGPFRAL1",213,0) PAUSE(DGQ) ; pause screen display "RTN","DGPFRAL1",214,0) ; Input: "RTN","DGPFRAL1",215,0) ; DGQ - var used to quit report processing to user CRT "RTN","DGPFRAL1",216,0) ; Output: "RTN","DGPFRAL1",217,0) ; DGQ - passed by reference - 0 = Continue, 1 = Quit "RTN","DGPFRAL1",218,0) ; "RTN","DGPFRAL1",219,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","DGPFRAL1",220,0) Q "RTN","DGPFRAL1",221,0) ; "RTN","DGPFRAL1",222,0) HEAD ;Print/Display page header "RTN","DGPFRAL1",223,0) ; "RTN","DGPFRAL1",224,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q "RTN","DGPFRAL1",225,0) ; "RTN","DGPFRAL1",226,0) W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF "RTN","DGPFRAL1",227,0) ; "RTN","DGPFRAL1",228,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGPFRAL1",229,0) W !?25,"PATIENT RECORD FLAGS" "RTN","DGPFRAL1",230,0) W !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$G(DGPAGE) "RTN","DGPFRAL1",231,0) W !,"Report Selected: "_$S($G(DGPCAT)=1:"Category I (National)",$G(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRAL1",232,0) W !?5,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND"))) "RTN","DGPFRAL1",233,0) W ?50,"Printed: ",DGDT "RTN","DGPFRAL1",234,0) W !,DGLINE "RTN","DGPFRAL1",235,0) ; "RTN","DGPFRAL1",236,0) Q:DGGRAND "RTN","DGPFRAL1",237,0) ; "RTN","DGPFRAL1",238,0) W !!,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)") "RTN","DGPFRAL1",239,0) W !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE" "RTN","DGPFRAL1",240,0) W !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?69,"-----------" "RTN","DGPFRAL1",241,0) Q "RTN","DGPFRAL1",242,0) ; "RTN","DGPFRAL1",243,0) EXIT ; "RTN","DGPFRAL1",244,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRAL1",245,0) I '$D(ZTQUEUED) D "RTN","DGPFRAL1",246,0) . K %ZIS,POP "RTN","DGPFRAL1",247,0) . D ^%ZISC,HOME^%ZIS "RTN","DGPFRAL1",248,0) Q "RTN","DGPFRAL1",249,0) ; "RTN","DGPFRAL1",250,0) ENTINERR(DGIEN) ;is last action ENTERED IN ERROR "RTN","DGPFRAL1",251,0) ; Input: "RTN","DGPFRAL1",252,0) ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFRAL1",253,0) ; "RTN","DGPFRAL1",254,0) ; Output: "RTN","DGPFRAL1",255,0) ; Function Value - Return 1 on success, 0 on failure "RTN","DGPFRAL1",256,0) ; "RTN","DGPFRAL1",257,0) N DGPFAH "RTN","DGPFRAL1",258,0) ; "RTN","DGPFRAL1",259,0) I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFRAL1",260,0) Q +$G(DGPFAH("ACTION"))=5 "RTN","DGPFUT") 0^27^B38902808 "RTN","DGPFUT",1,0) DGPFUT ;ALB/RPM - PRF UTILITIES ; 6/7/05 3:13pm "RTN","DGPFUT",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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,DGDIRS) ;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) ; DGDIRS - DIR("S") string "RTN","DGPFUT",14,0) ; "RTN","DGPFUT",15,0) ; Output "RTN","DGPFUT",16,0) ; Function Value - Internal value returned from ^DIR or -1 if user "RTN","DGPFUT",17,0) ; up-arrows, double up-arrows or the read times out. "RTN","DGPFUT",18,0) ; "RTN","DGPFUT",19,0) ; DIR(0) type Results "RTN","DGPFUT",20,0) ; ------------ ------------------------------- "RTN","DGPFUT",21,0) ; DD IEN of selected entry "RTN","DGPFUT",22,0) ; Pointer IEN of selected entry "RTN","DGPFUT",23,0) ; Set of Codes Internal value of code "RTN","DGPFUT",24,0) ; Yes/No 0 for No, 1 for Yes "RTN","DGPFUT",25,0) ; "RTN","DGPFUT",26,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables "RTN","DGPFUT",27,0) ; "RTN","DGPFUT",28,0) S DIR(0)=DGDIR0 "RTN","DGPFUT",29,0) S DIR("A")=$G(DGDIRA) "RTN","DGPFUT",30,0) I $G(DGDIRB)]"" S DIR("B")=DGDIRB "RTN","DGPFUT",31,0) I $D(DGDIRH) S DIR("?")=DGDIRH "RTN","DGPFUT",32,0) I $G(DGDIRS)]"" S DIR("S")=DGDIRS "RTN","DGPFUT",33,0) D ^DIR "RTN","DGPFUT",34,0) Q $S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,X="@":"@",1:$P(Y,U)) "RTN","DGPFUT",35,0) ; "RTN","DGPFUT",36,0) CONTINUE() ;pause display "RTN","DGPFUT",37,0) ; "RTN","DGPFUT",38,0) ; Input: none "RTN","DGPFUT",39,0) ; "RTN","DGPFUT",40,0) ; Output: 1 - continue "RTN","DGPFUT",41,0) ; 0 - quit "RTN","DGPFUT",42,0) ; "RTN","DGPFUT",43,0) N DIR,Y "RTN","DGPFUT",44,0) S DIR(0)="E" D ^DIR "RTN","DGPFUT",45,0) Q $S(Y'=1:0,1:1) "RTN","DGPFUT",46,0) ; "RTN","DGPFUT",47,0) VALID(DGRTN,DGFILE,DGIP,DGERR) ;validate input values before filing "RTN","DGPFUT",48,0) ; "RTN","DGPFUT",49,0) ; Input: "RTN","DGPFUT",50,0) ; DGRTN - (required) Routine name that contains $TEXT table "RTN","DGPFUT",51,0) ; DGFILE - (required) File number for input values "RTN","DGPFUT",52,0) ; DGIP - (required) Input value array "RTN","DGPFUT",53,0) ; DGERR - (optional) Returns error message passed by reference "RTN","DGPFUT",54,0) ; "RTN","DGPFUT",55,0) ; Output: "RTN","DGPFUT",56,0) ; Function Value - Returns 1 on all values valid, 0 on failure "RTN","DGPFUT",57,0) ; "RTN","DGPFUT",58,0) I $G(DGRTN)=""!('$G(DGFILE)) Q 0 "RTN","DGPFUT",59,0) N DGVLD ;function return value "RTN","DGPFUT",60,0) N DGFXR ;node name to field xref array "RTN","DGPFUT",61,0) N DGREQ ;array of required fields "RTN","DGPFUT",62,0) N DGWP ;word processing flag "RTN","DGPFUT",63,0) N DGN ;array node name "RTN","DGPFUT",64,0) ; "RTN","DGPFUT",65,0) S DGVLD=1 "RTN","DGPFUT",66,0) S DGN="" "RTN","DGPFUT",67,0) D BLDXR(DGRTN,.DGFXR) "RTN","DGPFUT",68,0) ; "RTN","DGPFUT",69,0) F S DGN=$O(DGFXR(DGN)) Q:DGN="" D Q:'DGVLD "RTN","DGPFUT",70,0) . S DGREQ=$P(DGFXR(DGN),U,2) "RTN","DGPFUT",71,0) . S DGWP=$P(DGFXR(DGN),U,3) "RTN","DGPFUT",72,0) . I DGREQ D ;required field check "RTN","DGPFUT",73,0) . . I DGWP,'$$CKWP("DGIP(DGN)") S DGVLD=0 Q "RTN","DGPFUT",74,0) . . I 'DGWP,$G(DGIP(DGN))']"" S DGVLD=0 Q "RTN","DGPFUT",75,0) . I 'DGVLD D Q "RTN","DGPFUT",76,0) . . S DGERR=$$GET1^DID(DGFILE,+DGFXR(DGN),,"LABEL")_" REQUIRED" "RTN","DGPFUT",77,0) . Q:DGWP ;don't check word processing fields for invalid values "RTN","DGPFUT",78,0) . ;check for invalid values "RTN","DGPFUT",79,0) . I '$$TESTVAL(DGFILE,+DGFXR(DGN),$P($G(DGIP(DGN)),U)) D Q "RTN","DGPFUT",80,0) . . S DGVLD=0,DGERR=$$GET1^DID(DGFILE,+DGFXR(DGN),,"LABEL")_" NOT VALID" "RTN","DGPFUT",81,0) Q DGVLD "RTN","DGPFUT",82,0) ; "RTN","DGPFUT",83,0) BLDXR(DGRTN,DGFLDA) ;build name/field xref array "RTN","DGPFUT",84,0) ;This procedure reads in the text from the XREF line tag of the DGRTN "RTN","DGPFUT",85,0) ;input parameter and loads name/field xref array with parsed line data. "RTN","DGPFUT",86,0) ; "RTN","DGPFUT",87,0) ; Input: "RTN","DGPFUT",88,0) ; DGRTN - (required) Routine name that contains the XREF line tag "RTN","DGPFUT",89,0) ; DGFLDA - (required) Array name for name/field xref passed by "RTN","DGPFUT",90,0) ; reference "RTN","DGPFUT",91,0) ; "RTN","DGPFUT",92,0) ; Output: "RTN","DGPFUT",93,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFUT",94,0) ; DGFLDA - Name/field xref array "RTN","DGPFUT",95,0) ; format: DGFLDA(subscript)=field#^required?^word proc? "RTN","DGPFUT",96,0) ; "RTN","DGPFUT",97,0) S DGRTN=$G(DGRTN) "RTN","DGPFUT",98,0) Q:DGRTN="" "RTN","DGPFUT",99,0) I $E(DGRTN,1)'="^" S DGRTN="^"_DGRTN "RTN","DGPFUT",100,0) Q:($T(@DGRTN)="") "RTN","DGPFUT",101,0) N DGTAG "RTN","DGPFUT",102,0) N DGOFF "RTN","DGPFUT",103,0) N DGLINE "RTN","DGPFUT",104,0) ; "RTN","DGPFUT",105,0) F DGOFF=1:1 S DGTAG="XREF+"_DGOFF_DGRTN,DGLINE=$T(@DGTAG) Q:DGLINE="" D "RTN","DGPFUT",106,0) . S DGFLDA($P(DGLINE,";",3))=$P(DGLINE,";",4)_U_+$P(DGLINE,";",5)_U_+$P(DGLINE,";",6) "RTN","DGPFUT",107,0) Q "RTN","DGPFUT",108,0) ; "RTN","DGPFUT",109,0) CKWP(DGROOT) ;ck word processing required fields "RTN","DGPFUT",110,0) ;This function verifies that at least one line in the word processing "RTN","DGPFUT",111,0) ;array contains text more than one space long. "RTN","DGPFUT",112,0) ; "RTN","DGPFUT",113,0) ; Input: "RTN","DGPFUT",114,0) ; DGROOT - (required) Word processing root "RTN","DGPFUT",115,0) ; "RTN","DGPFUT",116,0) ; Output: "RTN","DGPFUT",117,0) ; Function Value - Returns 1 on success, 0 on failure "RTN","DGPFUT",118,0) ; "RTN","DGPFUT",119,0) N DGLIN "RTN","DGPFUT",120,0) N DGRSLT "RTN","DGPFUT",121,0) S DGRSLT=0 "RTN","DGPFUT",122,0) I $D(@DGROOT) D "RTN","DGPFUT",123,0) . S DGLIN="" "RTN","DGPFUT",124,0) . F S DGLIN=$O(@DGROOT@(DGLIN)) Q:DGLIN="" D Q:DGRSLT "RTN","DGPFUT",125,0) . . I $G(@DGROOT@(DGLIN,0))]"",@DGROOT@(DGLIN,0)'=" " S DGRSLT=1 "RTN","DGPFUT",126,0) Q DGRSLT "RTN","DGPFUT",127,0) ; "RTN","DGPFUT",128,0) TESTVAL(DGFIL,DGFLD,DGVAL) ;validate individual value against field def "RTN","DGPFUT",129,0) ; "RTN","DGPFUT",130,0) ; Input: "RTN","DGPFUT",131,0) ; DGFIL - (required) File number "RTN","DGPFUT",132,0) ; DGFLD - (required) Field number "RTN","DGPFUT",133,0) ; DGVAL - (required) Field value to be validated "RTN","DGPFUT",134,0) ; "RTN","DGPFUT",135,0) ; Output: "RTN","DGPFUT",136,0) ; Function Value - Returns 1 if value is valid, 0 if value is invalid "RTN","DGPFUT",137,0) ; "RTN","DGPFUT",138,0) N DGVALEX ;external value after conversion "RTN","DGPFUT",139,0) N DGTYP ;field type "RTN","DGPFUT",140,0) N DGRSLT ;results of CHK^DIE "RTN","DGPFUT",141,0) N VALID ;function results "RTN","DGPFUT",142,0) ; "RTN","DGPFUT",143,0) S VALID=1 "RTN","DGPFUT",144,0) I $G(DGFIL)>0,($G(DGFLD)>0),($G(DGVAL)'="") D "RTN","DGPFUT",145,0) . S DGVALEX=$$EXTERNAL^DILFD(DGFIL,DGFLD,"F",DGVAL) "RTN","DGPFUT",146,0) . I DGVALEX="" S VALID=0 Q "RTN","DGPFUT",147,0) . I $$GET1^DID(DGFIL,DGFLD,"","TYPE")'["POINTER" D "RTN","DGPFUT",148,0) . . D CHK^DIE(DGFIL,DGFLD,,DGVALEX,.DGRSLT) I DGRSLT="^" S VALID=0 Q "RTN","DGPFUT",149,0) Q VALID "RTN","DGPFUT",150,0) ; "RTN","DGPFUT",151,0) STATUS(DGACT) ;calculate the assignment STATUS given an ACTION code "RTN","DGPFUT",152,0) ; "RTN","DGPFUT",153,0) ; Input: "RTN","DGPFUT",154,0) ; DGACT - (required) Action (.03) field value for PRF ASSIGNMENT "RTN","DGPFUT",155,0) ; HISTORY (#26.14) file in internal or external format "RTN","DGPFUT",156,0) ; "RTN","DGPFUT",157,0) ; Output: "RTN","DGPFUT",158,0) ; Function Value - Status value on success, -1 on failure "RTN","DGPFUT",159,0) ; "RTN","DGPFUT",160,0) N DGERR ;FM message root "RTN","DGPFUT",161,0) N DGRSLT ;CHK^DIE result array "RTN","DGPFUT",162,0) N DGSTAT ;calculated status value "RTN","DGPFUT",163,0) ; "RTN","DGPFUT",164,0) S DGSTAT=-1 "RTN","DGPFUT",165,0) I $G(DGACT)]"" D "RTN","DGPFUT",166,0) . I DGACT?1.N S DGACT=$$EXTERNAL^DILFD(26.14,.03,"F",DGACT,"DGERR") "RTN","DGPFUT",167,0) . Q:$D(DGERR) "RTN","DGPFUT",168,0) . D CHK^DIE(26.14,.03,"E",DGACT,.DGRSLT,"DGERR") "RTN","DGPFUT",169,0) . Q:$D(DGERR) "RTN","DGPFUT",170,0) . I DGRSLT(0)="INACTIVATE"!(DGRSLT(0)="ENTERED IN ERROR") S DGSTAT=0 "RTN","DGPFUT",171,0) . E S DGSTAT=1 "RTN","DGPFUT",172,0) Q DGSTAT "RTN","DGPFUT",173,0) ; "RTN","DGPFUT",174,0) MPIOK(DGDFN,DGICN) ;return national ICN "RTN","DGPFUT",175,0) ;This function verifies that a given patient has a valid national "RTN","DGPFUT",176,0) ;Integration Control Number. "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 and determine if ICN "RTN","DGPFUT",180,0) ; is local. "RTN","DGPFUT",181,0) ; "RTN","DGPFUT",182,0) ; Input: "RTN","DGPFUT",183,0) ; DGDFN - (required) IEN of patient in PATIENT (#2) file "RTN","DGPFUT",184,0) ; DGICN - (optional) passed by reference to contain national ICN "RTN","DGPFUT",185,0) ; "RTN","DGPFUT",186,0) ; Output: "RTN","DGPFUT",187,0) ; Function Value - 1 on valid national ICN; "RTN","DGPFUT",188,0) ; 0 on failure "RTN","DGPFUT",189,0) ; DGICN - Patient's Integrated Control Number "RTN","DGPFUT",190,0) ; "RTN","DGPFUT",191,0) N DGRSLT "RTN","DGPFUT",192,0) S DGRSLT=0 "RTN","DGPFUT",193,0) I $G(DGDFN)>0 D "RTN","DGPFUT",194,0) . S DGICN=$$GETICN^MPIF001(DGDFN) "RTN","DGPFUT",195,0) . ; "RTN","DGPFUT",196,0) . ;ICN must be valid "RTN","DGPFUT",197,0) . Q:(DGICN'>0) "RTN","DGPFUT",198,0) . ; "RTN","DGPFUT",199,0) . ;ICN must not be local "RTN","DGPFUT",200,0) . Q:$$IFLOCAL^MPIF001(DGDFN) "RTN","DGPFUT",201,0) . ; "RTN","DGPFUT",202,0) . S DGRSLT=1 "RTN","DGPFUT",203,0) Q DGRSLT "RTN","DGPFUT",204,0) ; "RTN","DGPFUT",205,0) GETNXTF(DGDFN,DGLTF) ;get previous treating facility "RTN","DGPFUT",206,0) ;This function will return the treating facility with a DATE LAST "RTN","DGPFUT",207,0) ;TREATED value immediately prior to the date for the treating facility "RTN","DGPFUT",208,0) ;passed as the second parameter. The most recent treating facility "RTN","DGPFUT",209,0) ;will be returned when the second parameter is missing, null, or zero. "RTN","DGPFUT",210,0) ; "RTN","DGPFUT",211,0) ; Input: "RTN","DGPFUT",212,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFUT",213,0) ; DGLTF - (optional) last treating facility [default=0] "RTN","DGPFUT",214,0) ; "RTN","DGPFUT",215,0) ; Output: "RTN","DGPFUT",216,0) ; Function value - previous facility as a pointer to INSTITUTION (#4) "RTN","DGPFUT",217,0) ; file on success; 0 on failure "RTN","DGPFUT",218,0) ; "RTN","DGPFUT",219,0) N DGARR ;fully subscripted array node "RTN","DGPFUT",220,0) N DGDARR ;date sorted treating facilities "RTN","DGPFUT",221,0) N DGINST ;institution pointer "RTN","DGPFUT",222,0) N DGNAM ;name of sorted treating facilities array "RTN","DGPFUT",223,0) N DGTFARR ;array of non-local treating facilities "RTN","DGPFUT",224,0) ; "RTN","DGPFUT",225,0) ; "RTN","DGPFUT",226,0) I $G(DGDFN)>0,$$BLDTFL^DGPFUT2(DGDFN,.DGTFARR) D "RTN","DGPFUT",227,0) . ; "RTN","DGPFUT",228,0) . ;validate last treating facility input parameter "RTN","DGPFUT",229,0) . S DGLTF=+$G(DGLTF) "RTN","DGPFUT",230,0) . S DGLTF=$S(DGLTF&($D(DGTFARR(DGLTF))):DGLTF,1:0) "RTN","DGPFUT",231,0) . ; "RTN","DGPFUT",232,0) . ;build date sorted list "RTN","DGPFUT",233,0) . S DGINST=0 "RTN","DGPFUT",234,0) . F S DGINST=$O(DGTFARR(DGINST)) Q:'DGINST D "RTN","DGPFUT",235,0) . . S DGDARR(DGTFARR(DGINST),DGINST)="" "RTN","DGPFUT",236,0) . ; "RTN","DGPFUT",237,0) . ;find entry for previous treating facility "RTN","DGPFUT",238,0) . S DGNAM="DGDARR" "RTN","DGPFUT",239,0) . S DGARR=$QUERY(@DGNAM@(""),-1) "RTN","DGPFUT",240,0) . I DGLTF,DGARR]"" D "RTN","DGPFUT",241,0) . . I $QS(DGARR,2)'=DGLTF D "RTN","DGPFUT",242,0) . . . F S DGARR=$QUERY(@DGARR,-1) Q:+$QS(DGARR,2)=DGLTF "RTN","DGPFUT",243,0) . . S DGARR=$QUERY(@DGARR,-1) "RTN","DGPFUT",244,0) ; "RTN","DGPFUT",245,0) Q $S($G(DGARR)]"":+$QS(DGARR,2),1:0) "RTN","DGPFUT",246,0) ; "RTN","DGPFUT",247,0) ISDIV(DGSITE) ;is site local division "RTN","DGPFUT",248,0) ; "RTN","DGPFUT",249,0) ; Input: "RTN","DGPFUT",250,0) ; DGSITE - pointer to INSTITUTION (#4) file "RTN","DGPFUT",251,0) ; "RTN","DGPFUT",252,0) ; Output: "RTN","DGPFUT",253,0) ; Function value - 1 on success; 0 on failure "RTN","DGPFUT",254,0) ; "RTN","DGPFUT",255,0) S DGSITE=+$G(DGSITE) "RTN","DGPFUT",256,0) Q $S($D(^DG(40.8,"AD",DGSITE)):1,1:0) "RTN","DGPFUT1") 0^32^B28564344 "RTN","DGPFUT1",1,0) DGPFUT1 ;ALB/RBS - PRF UTILITIES CONTINUED ; 6/9/06 10:56am "RTN","DGPFUT1",2,0) ;;5.3;Registration;**425,607,650**;Aug 13, 1993;Build 3 "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) N DGCNT ;flag display count "RTN","DGPFUT1",16,0) N DGRET ;return "RTN","DGPFUT1",17,0) ; "RTN","DGPFUT1",18,0) I $D(DDS) D CLRMSG^DDS "RTN","DGPFUT1",19,0) W:'$D(DDS) !! W ">>> Active Patient Record Flag(s):" "RTN","DGPFUT1",20,0) ; "RTN","DGPFUT1",21,0) ; setup for reverse video display "RTN","DGPFUT1",22,0) ; "RTN","DGPFUT1",23,0) S (IORVON,IORVOFF)="" "RTN","DGPFUT1",24,0) D:$D(IOST(0)) "RTN","DGPFUT1",25,0) . N X S X="IORVON;IORVOFF" D ENDR^%ZISS "RTN","DGPFUT1",26,0) ; "RTN","DGPFUT1",27,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFUT1",28,0) S DGCNT=0 "RTN","DGPFUT1",29,0) S DGPFIEN="" F S DGPFIEN=$O(DGPFAPI(DGPFIEN)) Q:DGPFIEN="" D "RTN","DGPFUT1",30,0) . I $D(DDS),DGCNT=4 D "RTN","DGPFUT1",31,0) . . W !,"Press RETURN to continue..." "RTN","DGPFUT1",32,0) . . R DGRET:$S('$D(DTIME):300,1:DTIME) "RTN","DGPFUT1",33,0) . . D CLRMSG^DDS "RTN","DGPFUT1",34,0) . . W ">>> Active Patient Record Flag(s):" "RTN","DGPFUT1",35,0) . . S DGCNT=0 "RTN","DGPFUT1",36,0) . S DGPFFLAG=$P($G(DGPFAPI(DGPFIEN,"FLAG")),U,2) "RTN","DGPFUT1",37,0) . Q:(DGPFFLAG'["") "RTN","DGPFUT1",38,0) . S DGPFCAT=$P($P($G(DGPFAPI(DGPFIEN,"CATEGORY")),U,2)," ") "RTN","DGPFUT1",39,0) . W !?5,IORVON,"<"_DGPFFLAG_">",IORVOFF,?45,"CATEGORY ",DGPFCAT "RTN","DGPFUT1",40,0) . S DGCNT=DGCNT+1 "RTN","DGPFUT1",41,0) W:'$D(DDS) ! "RTN","DGPFUT1",42,0) Q "RTN","DGPFUT1",43,0) ; "RTN","DGPFUT1",44,0) ASKDET() ;does user want to display flag details? "RTN","DGPFUT1",45,0) ; "RTN","DGPFUT1",46,0) ; Input: "RTN","DGPFUT1",47,0) ; None "RTN","DGPFUT1",48,0) ; "RTN","DGPFUT1",49,0) ; Output: "RTN","DGPFUT1",50,0) ; Function value - return 1 on YES; otherwise 0 "RTN","DGPFUT1",51,0) ; "RTN","DGPFUT1",52,0) N YN,%,%Y "RTN","DGPFUT1",53,0) F D Q:"^YN"[YN "RTN","DGPFUT1",54,0) . W !,"Do you wish to view active patient record flag details" "RTN","DGPFUT1",55,0) . S %=1 ;default to YES "RTN","DGPFUT1",56,0) . D YN^DICN "RTN","DGPFUT1",57,0) . S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?") "RTN","DGPFUT1",58,0) . I YN="?" D:$D(DDS) CLRMSG^DDS W !,"Enter either 'Y' or 'N'." "RTN","DGPFUT1",59,0) Q (YN="Y") "RTN","DGPFUT1",60,0) ; "RTN","DGPFUT1",61,0) DISPPRF(DGDFN) ; Patient Record Flags screen Display "RTN","DGPFUT1",62,0) ; "RTN","DGPFUT1",63,0) ; Supported References: "RTN","DGPFUT1",64,0) ; DBIA #10096 Z OPERATING SYSTEM FILE (%ZOSF) "RTN","DGPFUT1",65,0) ; DBIA #10150 ScreenMan API: Form Utilities "RTN","DGPFUT1",66,0) ; "RTN","DGPFUT1",67,0) ; Input: "RTN","DGPFUT1",68,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFUT1",69,0) ; "RTN","DGPFUT1",70,0) ; Output: "RTN","DGPFUT1",71,0) ; none "RTN","DGPFUT1",72,0) ; "RTN","DGPFUT1",73,0) ; patient ien not setup "RTN","DGPFUT1",74,0) S DGDFN=+$G(DGDFN) "RTN","DGPFUT1",75,0) Q:'DGDFN "RTN","DGPFUT1",76,0) ; "RTN","DGPFUT1",77,0) N DGPFAPI "RTN","DGPFUT1",78,0) ; "RTN","DGPFUT1",79,0) ; call API to get the display array for ALL Active Assignments "RTN","DGPFUT1",80,0) S DGPFAPI=$$GETACT^DGPFAPI(DGDFN,"DGPFAPI") ;DBIA #3860 "RTN","DGPFUT1",81,0) ; "RTN","DGPFUT1",82,0) ; quit if no Active Record Flags to display "RTN","DGPFUT1",83,0) Q:'+DGPFAPI "RTN","DGPFUT1",84,0) ; "RTN","DGPFUT1",85,0) ; call api to display Active Record Flags "RTN","DGPFUT1",86,0) D DISPACT(.DGPFAPI) "RTN","DGPFUT1",87,0) ; "RTN","DGPFUT1",88,0) ; prompt and display assignment details "RTN","DGPFUT1",89,0) I $$ASKDET() D EN^DGPFLMD(DGDFN,.DGPFAPI) ;ListMan "RTN","DGPFUT1",90,0) ; "RTN","DGPFUT1",91,0) ; cleanup display for ScreenMan "RTN","DGPFUT1",92,0) I $D(DDS) D D CLRMSG^DDS D REFRESH^DDSUTL "RTN","DGPFUT1",93,0) . ;set right margin to zero - needed for Cache "RTN","DGPFUT1",94,0) . N X "RTN","DGPFUT1",95,0) . S X=0 X ^%ZOSF("RM") "RTN","DGPFUT1",96,0) Q "RTN","DGPFUT1",97,0) ; "RTN","DGPFUT1",98,0) SELPAT(DGPAT) ;This procedure is used to perform a patient lookup for an existing patient in the PATIENT (#2) file. "RTN","DGPFUT1",99,0) ; "RTN","DGPFUT1",100,0) ; Input: None "RTN","DGPFUT1",101,0) ; "RTN","DGPFUT1",102,0) ; Output: "RTN","DGPFUT1",103,0) ; DGPAT - result array containing the patient selection on success, "RTN","DGPFUT1",104,0) ; pass by reference. Array will have same structure as the Y "RTN","DGPFUT1",105,0) ; variable returned by the ^DIC call. "RTN","DGPFUT1",106,0) ; Array Format: "RTN","DGPFUT1",107,0) ; ------------- "RTN","DGPFUT1",108,0) ; DGPAT = IEN of patient in PATIENT (#2) file on "RTN","DGPFUT1",109,0) ; success, -1 on failure "RTN","DGPFUT1",110,0) ; DGPAT(0) = zero node of entry selected "RTN","DGPFUT1",111,0) ; DGPAT(0,0) = external form of the .01 field of the entry "RTN","DGPFUT1",112,0) ; "RTN","DGPFUT1",113,0) ;- int input vars for ^DIC call "RTN","DGPFUT1",114,0) N DIC,DTOUT,DUPOT,X,Y "RTN","DGPFUT1",115,0) S DIC="^DPT(",DIC(0)="AEMQZV" "RTN","DGPFUT1",116,0) ; "RTN","DGPFUT1",117,0) ;- lookup patient "RTN","DGPFUT1",118,0) D ^DIC K DIC "RTN","DGPFUT1",119,0) ; "RTN","DGPFUT1",120,0) ;- result of lookup "RTN","DGPFUT1",121,0) S DGPAT=Y "RTN","DGPFUT1",122,0) ; "RTN","DGPFUT1",123,0) ;- if success, setup return array using output vars from ^DIC call "RTN","DGPFUT1",124,0) I (+DGPAT>0) D "RTN","DGPFUT1",125,0) . S DGPAT=+Y ;patient ien "RTN","DGPFUT1",126,0) . S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#2) file "RTN","DGPFUT1",127,0) . S DGPAT(0,0)=$G(Y(0,0)) ;external form of the .01 field "RTN","DGPFUT1",128,0) ; "RTN","DGPFUT1",129,0) Q "RTN","DGPFUT1",130,0) ; "RTN","DGPFUT1",131,0) GETFLAG(DGPFPTR,DGPFLAG) ;retrieve a single FLAG record "RTN","DGPFUT1",132,0) ; This function acts as a wrapper around the $$GETLF and $$GETNF "RTN","DGPFUT1",133,0) ; API's. Function will be used to obtain a single flag record from "RTN","DGPFUT1",134,0) ; either the PRF LOCAL FLAG (#26.11) file or the PRF NATIONAL FLAG "RTN","DGPFUT1",135,0) ; (#26.15) file depending on the value of the DGPFPTR input parameter. "RTN","DGPFUT1",136,0) ; "RTN","DGPFUT1",137,0) ; Input: "RTN","DGPFUT1",138,0) ; DGPFPTR - (required) IEN of patient record flag in PRF NATIONAL "RTN","DGPFUT1",139,0) ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file. "RTN","DGPFUT1",140,0) ; [ex: "1;DGPF(26.15,"] "RTN","DGPFUT1",141,0) ; "RTN","DGPFUT1",142,0) ; Output: "RTN","DGPFUT1",143,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFUT1",144,0) ; DGPFLAG - (required) result array passed by reference. See the "RTN","DGPFUT1",145,0) ; $$GETLF and $$GETNF for the result array structure. "RTN","DGPFUT1",146,0) ; "RTN","DGPFUT1",147,0) N RESULT ;returned function value "RTN","DGPFUT1",148,0) N DGPFIEN ;ien of PRF local or national flag file "RTN","DGPFUT1",149,0) N DGPFILE ;file # of PRF local or national flag file "RTN","DGPFUT1",150,0) ; "RTN","DGPFUT1",151,0) S RESULT=0 "RTN","DGPFUT1",152,0) ; "RTN","DGPFUT1",153,0) D "RTN","DGPFUT1",154,0) . ;-- quit if pointer is not valid "RTN","DGPFUT1",155,0) . Q:$G(DGPFPTR)']"" "RTN","DGPFUT1",156,0) . Q:'$$TESTVAL^DGPFUT(26.13,.02,DGPFPTR) "RTN","DGPFUT1",157,0) . ; "RTN","DGPFUT1",158,0) . ;-- get ien and file from pointer value "RTN","DGPFUT1",159,0) . S DGPFIEN=+$G(DGPFPTR) "RTN","DGPFUT1",160,0) . S DGPFILE=$P($G(DGPFPTR),";",2) "RTN","DGPFUT1",161,0) . ; "RTN","DGPFUT1",162,0) . ;-- if local flag file, get local flag into DGPFLAG array "RTN","DGPFUT1",163,0) . I DGPFILE["26.11" D "RTN","DGPFUT1",164,0) . . Q:'$$GETLF^DGPFALF(+DGPFIEN,.DGPFLAG) "RTN","DGPFUT1",165,0) . . S RESULT=1 ;success "RTN","DGPFUT1",166,0) . ; "RTN","DGPFUT1",167,0) . ;-- if national flag file, get national flag into DGPFLAG array "RTN","DGPFUT1",168,0) . I DGPFILE["26.15" D "RTN","DGPFUT1",169,0) . . Q:'$$GETNF^DGPFANF(+DGPFIEN,.DGPFLAG) "RTN","DGPFUT1",170,0) . . S RESULT=1 ;success "RTN","DGPFUT1",171,0) ; "RTN","DGPFUT1",172,0) Q RESULT "RTN","DGPFUT1",173,0) ; "RTN","DGPFUT1",174,0) PARENT(DGCHILD) ;lookup and return the parent of a child "RTN","DGPFUT1",175,0) ; "RTN","DGPFUT1",176,0) ; Input: "RTN","DGPFUT1",177,0) ; DGCHILD - pointer to INSTITUTION (#4) file "RTN","DGPFUT1",178,0) ; "RTN","DGPFUT1",179,0) ; Output: "RTN","DGPFUT1",180,0) ; Function value - INSTITUTION file pointer^institution name^station# "RTN","DGPFUT1",181,0) ; of parent facility on success; 0 on failure "RTN","DGPFUT1",182,0) ; "RTN","DGPFUT1",183,0) N DGPARENT ;function value "RTN","DGPFUT1",184,0) N DGPARR ;return array from XUAF4 "RTN","DGPFUT1",185,0) ; "RTN","DGPFUT1",186,0) S DGCHILD=+$G(DGCHILD) "RTN","DGPFUT1",187,0) D PARENT^XUAF4("DGPARR","`"_DGCHILD,"PARENT FACILITY") "RTN","DGPFUT1",188,0) S DGPARENT=+$O(DGPARR("P",0)) "RTN","DGPFUT1",189,0) I DGPARENT S DGPARENT=DGPARENT_U_$P(DGPARR("P",DGPARENT),U)_U_$P(DGPARR("P",DGPARENT),U,2) "RTN","DGPFUT1",190,0) Q DGPARENT "RTN","DGPFUT1",191,0) ; "RTN","DGPFUT1",192,0) FMTPRNT(DGCHILD) ;lookup and return parent of a child in display format "RTN","DGPFUT1",193,0) ; "RTN","DGPFUT1",194,0) ; Input: "RTN","DGPFUT1",195,0) ; DGCHILD - pointer to INSTITUTION (#4) file "RTN","DGPFUT1",196,0) ; "RTN","DGPFUT1",197,0) ; Output: "RTN","DGPFUT1",198,0) ; Function value - formatted name of parent institution on success; "RTN","DGPFUT1",199,0) ; null on failure "RTN","DGPFUT1",200,0) ; "RTN","DGPFUT1",201,0) N DGPARENT ;parent facility name "RTN","DGPFUT1",202,0) S DGCHILD=+$G(DGCHILD) "RTN","DGPFUT1",203,0) S DGPARENT=$P($$PARENT(DGCHILD),U,2) "RTN","DGPFUT1",204,0) Q $S(DGPARENT]"":"("_DGPARENT_")",1:"") "RTN","DGPFUT1",205,0) ; "RTN","DGPFUT1",206,0) CNTRECS(DGFILE) ;return number of records of a file "RTN","DGPFUT1",207,0) ; "RTN","DGPFUT1",208,0) ; Input: "RTN","DGPFUT1",209,0) ; DGFILE - (Required) file number to search "RTN","DGPFUT1",210,0) ; "RTN","DGPFUT1",211,0) ; Output: "RTN","DGPFUT1",212,0) ; Function Value - number of records found "RTN","DGPFUT1",213,0) ; "RTN","DGPFUT1",214,0) N DGCNT ;returned function value "RTN","DGPFUT1",215,0) N DGERR ;FM error message array "RTN","DGPFUT1",216,0) N DGLIST ;FM array of record ien's "RTN","DGPFUT1",217,0) ; "RTN","DGPFUT1",218,0) S DGCNT=0 "RTN","DGPFUT1",219,0) I $G(DGFILE)]"" D "RTN","DGPFUT1",220,0) . D LIST^DIC(DGFILE,"","@","Q","*","","","","","","DGLIST","DGERR") "RTN","DGPFUT1",221,0) . Q:$D(DGERR) "RTN","DGPFUT1",222,0) . S DGCNT=+$G(DGLIST("DILIST",0)) "RTN","DGPFUT1",223,0) Q DGCNT "RTN","DGPFUT2") 0^28^B44485554 "RTN","DGPFUT2",1,0) DGPFUT2 ;ALB/KCL - PRF UTILITIES CONTINUED ; 12/17/03 2:56pm "RTN","DGPFUT2",2,0) ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3 "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,DGEROOT) ;Used to convert an ICN to a DFN. "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) ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for "RTN","DGPFUT2",59,0) ; error dialog returned from BLD^DIALOG. If not passed, "RTN","DGPFUT2",60,0) ; error dialog is returned in ^TMP("DIERR",$J) global. "RTN","DGPFUT2",61,0) ; "RTN","DGPFUT2",62,0) ; Output: "RTN","DGPFUT2",63,0) ; Function Value - DFN on success, 0 on failure "RTN","DGPFUT2",64,0) ; DGEROOT() - error output array from BLD^DIALOG "RTN","DGPFUT2",65,0) ; "RTN","DGPFUT2",66,0) N DGDFN ;ptr to patient "RTN","DGPFUT2",67,0) N DIERR ;var returned from BLD^DIALOG "RTN","DGPFUT2",68,0) ; "RTN","DGPFUT2",69,0) ;init error output array if passed "RTN","DGPFUT2",70,0) S DGEROOT=$G(DGEROOT) "RTN","DGPFUT2",71,0) I DGEROOT]"" K @DGEROOT "RTN","DGPFUT2",72,0) ; "RTN","DGPFUT2",73,0) S DGDFN=+$$GETDFN^MPIF001(+$G(DGICN)) "RTN","DGPFUT2",74,0) I DGDFN'>0 D BLD^DIALOG(261127,,,DGEROOT,"F") "RTN","DGPFUT2",75,0) ; "RTN","DGPFUT2",76,0) Q $S(DGDFN'>0:0,1:DGDFN) "RTN","DGPFUT2",77,0) ; "RTN","DGPFUT2",78,0) SORT(DGPFARR) ;Re-sort of active record assignments by category then flag name "RTN","DGPFUT2",79,0) ; This function re-sorts the active record flag assignment list for a "RTN","DGPFUT2",80,0) ; patient by category (Cat I or Cat II) and then by flag name. "RTN","DGPFUT2",81,0) ; "RTN","DGPFUT2",82,0) ; Input: [Required] "RTN","DGPFUT2",83,0) ; DGPFARR - Closed root reference array name of active assignments "RTN","DGPFUT2",84,0) ; to be sorted "RTN","DGPFUT2",85,0) ; "RTN","DGPFUT2",86,0) ; Output: "RTN","DGPFUT2",87,0) ; Function Value - returns 1 on success, 0 on failure "RTN","DGPFUT2",88,0) ; "RTN","DGPFUT2",89,0) ; DGPFARR() - Closed Root reference name of re-sorted assignments "RTN","DGPFUT2",90,0) ; - Category I's will sort first in the returned array. "RTN","DGPFUT2",91,0) ; - Category II's will sort second. "RTN","DGPFUT2",92,0) ; "RTN","DGPFUT2",93,0) N DGCAT ;category "RTN","DGPFUT2",94,0) N DGINDX ;index array "RTN","DGPFUT2",95,0) N DGNAME ;flag name "RTN","DGPFUT2",96,0) N DGSORT ;re-sorted data array "RTN","DGPFUT2",97,0) N DGX ;generic counter "RTN","DGPFUT2",98,0) ; "RTN","DGPFUT2",99,0) ; check for input value - Quit if none found "RTN","DGPFUT2",100,0) Q:DGPFARR']"" 0 "RTN","DGPFUT2",101,0) Q:'$O(@DGPFARR@("")) 0 "RTN","DGPFUT2",102,0) ; "RTN","DGPFUT2",103,0) S DGSORT=$NA(^TMP("DGPFUT2",$J)) "RTN","DGPFUT2",104,0) K @DGSORT "RTN","DGPFUT2",105,0) ; "RTN","DGPFUT2",106,0) ;build index - ARRAY(Category (I or II),Flag Name)=sort number "RTN","DGPFUT2",107,0) S DGX=0 "RTN","DGPFUT2",108,0) F S DGX=$O(@DGPFARR@(DGX)) Q:'DGX D "RTN","DGPFUT2",109,0) . S DGCAT=$S($P(@DGPFARR@(DGX,"FLAG"),U)[26.11:2,1:1) "RTN","DGPFUT2",110,0) . S DGINDX(DGCAT,$P(@DGPFARR@(DGX,"FLAG"),U,2))=DGX "RTN","DGPFUT2",111,0) ; "RTN","DGPFUT2",112,0) ;build sorted data array - "RTN","DGPFUT2",113,0) S (DGCAT,DGX)=0 "RTN","DGPFUT2",114,0) F S DGCAT=$O(DGINDX(DGCAT)) Q:'DGCAT D "RTN","DGPFUT2",115,0) . S DGNAME="" "RTN","DGPFUT2",116,0) . F S DGNAME=$O(DGINDX(DGCAT,DGNAME)) Q:DGNAME="" D "RTN","DGPFUT2",117,0) . . S DGX=DGX+1 "RTN","DGPFUT2",118,0) . . M @DGSORT@(DGX)=@DGPFARR@(DGINDX(DGCAT,DGNAME)) "RTN","DGPFUT2",119,0) ; "RTN","DGPFUT2",120,0) ;remove input array and replace with sorted array, kill sort array "RTN","DGPFUT2",121,0) K @DGPFARR "RTN","DGPFUT2",122,0) M @DGPFARR=@DGSORT "RTN","DGPFUT2",123,0) K @DGSORT "RTN","DGPFUT2",124,0) ; "RTN","DGPFUT2",125,0) Q 1 "RTN","DGPFUT2",126,0) ; "RTN","DGPFUT2",127,0) ACTDT ; update PRF Software Activation Date field in (#26.18) "RTN","DGPFUT2",128,0) ; This utility should only be run at the Alpha and Beta test sites "RTN","DGPFUT2",129,0) ; of the Patient Record Flags Project, Patch DG*5.3*425. "RTN","DGPFUT2",130,0) ; If necessary, this entry point will change the date that the "RTN","DGPFUT2",131,0) ; Patient Record Flags (PRF) System became active. "RTN","DGPFUT2",132,0) ; The (#1) PRF SOFTWARE ACTIVATION DATE field of the (#26.18) PRF "RTN","DGPFUT2",133,0) ; PARAMETERS file, will be changed to: SEP 25, 2003 "RTN","DGPFUT2",134,0) ; "RTN","DGPFUT2",135,0) ; Input: none "RTN","DGPFUT2",136,0) ; "RTN","DGPFUT2",137,0) ; Output: User message on successful or failure of file update "RTN","DGPFUT2",138,0) ; "RTN","DGPFUT2",139,0) N DGACTDT ; Nationally Released Software Activation Date value "RTN","DGPFUT2",140,0) N DGIENS ; IEN - internal entry # OF (#26.18) FILE "RTN","DGPFUT2",141,0) N DGFLD ; PRF Software Activation Date field # "RTN","DGPFUT2",142,0) N DGFDA ; FDA data array for filer "RTN","DGPFUT2",143,0) N DGERR ; error message array returned from filer "RTN","DGPFUT2",144,0) N DGERRMSG ; error message for display "RTN","DGPFUT2",145,0) N DGPARM ; current internal/external values of field "RTN","DGPFUT2",146,0) ; "RTN","DGPFUT2",147,0) S DGACTDT="SEP 25, 2003" "RTN","DGPFUT2",148,0) S DGIENS="1," "RTN","DGPFUT2",149,0) S DGFLD=1 "RTN","DGPFUT2",150,0) ; "RTN","DGPFUT2",151,0) ; display user message "RTN","DGPFUT2",152,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",153,0) ; "RTN","DGPFUT2",154,0) ; checks for necessary programmer variables "RTN","DGPFUT2",155,0) I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D "RTN","DGPFUT2",156,0) . S DGERRMSG="Your programming variables are not set up properly." "RTN","DGPFUT2",157,0) ; "RTN","DGPFUT2",158,0) ; check if activation is not less than the current date "RTN","DGPFUT2",159,0) I '$D(DGERRMSG),DT<3030925 D "RTN","DGPFUT2",160,0) . S DGERRMSG="This file/field update can't be run before the date of SEP 25, 2003 is reached." "RTN","DGPFUT2",161,0) ; "RTN","DGPFUT2",162,0) ; get current activation date from PRF PARAMETERS (#26.18) file "RTN","DGPFUT2",163,0) I '$D(DGERRMSG) D "RTN","DGPFUT2",164,0) . D GETS^DIQ(26.18,"1,",1,"IE","DGPARM","DGERR") "RTN","DGPFUT2",165,0) . ; "RTN","DGPFUT2",166,0) . ; check for errors and inform the user "RTN","DGPFUT2",167,0) . I $D(DGERR) D Q "RTN","DGPFUT2",168,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",169,0) . ; "RTN","DGPFUT2",170,0) . ; check to make sure field is not set already "RTN","DGPFUT2",171,0) . I $G(DGPARM(26.18,"1,",1,"I"))=3030925 D "RTN","DGPFUT2",172,0) . . S DGERRMSG="The date value is already set to SEP 25, 2003." "RTN","DGPFUT2",173,0) ; "RTN","DGPFUT2",174,0) ; now start the (#26.18) filing process "RTN","DGPFUT2",175,0) I '$D(DGERRMSG) D "RTN","DGPFUT2",176,0) . ; "RTN","DGPFUT2",177,0) . ; DELETE activation date before filing since field is uneditable "RTN","DGPFUT2",178,0) . S DGFDA(26.18,DGIENS,1)="@" "RTN","DGPFUT2",179,0) . D FILE^DIE("","DGFDA","DGERR") "RTN","DGPFUT2",180,0) . ; "RTN","DGPFUT2",181,0) . ; check for errors and inform the user "RTN","DGPFUT2",182,0) . I $D(DGERR) D Q "RTN","DGPFUT2",183,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",184,0) . ; "RTN","DGPFUT2",185,0) . ; setup and file the new activation date value (external) "RTN","DGPFUT2",186,0) . S DGFDA(26.18,DGIENS,1)=DGACTDT "RTN","DGPFUT2",187,0) . D FILE^DIE("SE","DGFDA","DGERR") "RTN","DGPFUT2",188,0) . ; "RTN","DGPFUT2",189,0) . ; check for success or errors and inform the user of update status "RTN","DGPFUT2",190,0) . I $D(DGERR) D Q "RTN","DGPFUT2",191,0) . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1)) "RTN","DGPFUT2",192,0) ; "RTN","DGPFUT2",193,0) ; display successful/failure file update - updated field and value "RTN","DGPFUT2",194,0) W !!,$C(7) "RTN","DGPFUT2",195,0) I $D(DGERRMSG) D "RTN","DGPFUT2",196,0) . W "Field could not be updated...",DGERRMSG "RTN","DGPFUT2",197,0) E D "RTN","DGPFUT2",198,0) . W "Field was successfully changed from ",$G(DGPARM(26.18,"1,",1,"E"))," to ",$G(DGFDA(26.18,DGIENS,DGFLD)),"." "RTN","DGPFUT2",199,0) ; "RTN","DGPFUT2",200,0) Q "RTN","DGPFUT2",201,0) ; "RTN","DGPFUT2",202,0) BLDTFL(DGDFN,DGTFL) ;build array of Treating Facilities "RTN","DGPFUT2",203,0) ; This function builds an array of INSTITUTION (#4) file pointers "RTN","DGPFUT2",204,0) ; that are non-local medical treating facilities for a given patient. "RTN","DGPFUT2",205,0) ; "RTN","DGPFUT2",206,0) ; Input: "RTN","DGPFUT2",207,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFUT2",208,0) ; "RTN","DGPFUT2",209,0) ; Output: "RTN","DGPFUT2",210,0) ; Function value - 1 on results returned; 0 on failure "RTN","DGPFUT2",211,0) ; DGTFL - array of treating facility INSTITUTION (#4) file pointers "RTN","DGPFUT2",212,0) ; Format: DGTFL(pointer)=date last treated "RTN","DGPFUT2",213,0) ; "RTN","DGPFUT2",214,0) N DGLOC ;pointer to local facility in INSTITUTION (#4) file "RTN","DGPFUT2",215,0) N DGDLT ;date last treated "RTN","DGPFUT2",216,0) N DGFAC ;TFL API results array "RTN","DGPFUT2",217,0) N DGI ;generic counter "RTN","DGPFUT2",218,0) N DGINST ;pointer to INSTITUTION (#4) file "RTN","DGPFUT2",219,0) ; "RTN","DGPFUT2",220,0) Q:$G(DGDFN)'>0 0 ;validate input parameter "RTN","DGPFUT2",221,0) ; "RTN","DGPFUT2",222,0) D TFL^VAFCTFU1(.DGFAC,DGDFN) "RTN","DGPFUT2",223,0) S DGLOC=$P($$SITE^VASITE(),U) "RTN","DGPFUT2",224,0) S DGI=0 "RTN","DGPFUT2",225,0) F S DGI=$O(DGFAC(DGI)) Q:'DGI D "RTN","DGPFUT2",226,0) . S DGINST=$$IEN^XUAF4($P(DGFAC(DGI),U)) "RTN","DGPFUT2",227,0) . Q:DGINST'>0 "RTN","DGPFUT2",228,0) . Q:DGINST=DGLOC ;filter local facility "RTN","DGPFUT2",229,0) . Q:'$$TF^XUAF4(DGINST) ;facility must be active treating facility "RTN","DGPFUT2",230,0) . S DGDLT=+$P(DGFAC(DGI),U,3) "RTN","DGPFUT2",231,0) . S DGTFL(DGINST)=DGDLT "RTN","DGPFUT2",232,0) ; "RTN","DGPFUT2",233,0) Q $S(+$O(DGTFL(0)):1,1:0) "UP",26.17,26.1707,-1) 26.17^ERR "UP",26.17,26.1707,0) 26.1707 "VER") 8.0^22.0 "^DD",2,2,991.01,0) INTEGRATION CONTROL NUMBER^NJ12,0X^^MPI;1^K:+X'=X!(X>999999999999)!(X<0)!(X?.E1"."1N.N)!('$D(RGRSICN)) X "^DD",2,2,991.01,1,0) ^.1^^-1 "^DD",2,2,991.01,1,1,0) 2^AICN "^DD",2,2,991.01,1,1,1) S ^DPT("AICN",$E(X,1,30),DA)="" "^DD",2,2,991.01,1,1,2) K ^DPT("AICN",$E(X,1,30),DA) "^DD",2,2,991.01,1,1,"%D",0) ^^2^2^2960807^ "^DD",2,2,991.01,1,1,"%D",1,0) This is a non-lookup cross-reference for the Integration Control "^DD",2,2,991.01,1,1,"%D",2,0) Number Field. "^DD",2,2,991.01,1,1,"DT") 2960807 "^DD",2,2,991.01,1,2,0) 2^AHICN^MUMPS "^DD",2,2,991.01,1,2,1) Q "^DD",2,2,991.01,1,2,2) I $T(ICN^VAFCHIS)'="" D ICN^VAFCHIS(X,DA) "^DD",2,2,991.01,1,2,"%D",0) ^^1^1^2980114^^^^ "^DD",2,2,991.01,1,2,"%D",1,0) Used to create ICN History, ICN lookup capability. "^DD",2,2,991.01,1,2,"DT") 2980114 "^DD",2,2,991.01,1,3,0) 2^AR^MUMPS "^DD",2,2,991.01,1,3,1) I $T(KILL^VAFCMIS)'="" D KILL^VAFCMIS(DA) "^DD",2,2,991.01,1,3,2) Q "^DD",2,2,991.01,1,3,"%D",0) ^^2^2^2980114^^^ "^DD",2,2,991.01,1,3,"%D",1,0) Cross Reference is used to delete the 'AMPIMIS' cross reference denoting "^DD",2,2,991.01,1,3,"%D",2,0) missing ICN. "^DD",2,2,991.01,1,3,"DT") 2980114 "^DD",2,2,991.01,1,4,0) 2^AENR99101^MUMPS "^DD",2,2,991.01,1,4,1) D EVENT^IVMPLOG(DA) "^DD",2,2,991.01,1,4,2) D EVENT^IVMPLOG(DA) "^DD",2,2,991.01,1,4,3) DO NOT DELETE "^DD",2,2,991.01,1,4,"%D",0) ^^2^2^2971007^^^ "^DD",2,2,991.01,1,4,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,991.01,1,4,"%D",2,0) enrollment. "^DD",2,2,991.01,1,4,"DT") 2971007 "^DD",2,2,991.01,3) This field can only be edited by CIRN ! "^DD",2,2,991.01,21,0) ^.001^1^1^3050603^^^^ "^DD",2,2,991.01,21,1,0) Machine to machine identifier for a patient. "^DD",2,2,991.01,"AUDIT") n "^DD",2,2,991.01,"DT") 3050426 "^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") 3050622 "^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") 3050622 "^DD",26.17,26.17,.07,0) ERROR CODES^26.1707^^ERR;0 "^DD",26.17,26.17,.07,21,0) ^^4^4^3050329^ "^DD",26.17,26.17,.07,21,1,0) When the receiving site of a PRF Unsolicited Update (ORU~R01) HL7 message "^DD",26.17,26.17,.07,21,2,0) encounters one or more errors while processing the message, one or more "^DD",26.17,26.17,.07,21,3,0) error codes are returned in the Acknowledgment (ACK~R01) HL7 message. "^DD",26.17,26.17,.07,21,4,0) This multiple field contains the returned error codes. "^DD",26.17,26.1707,0) ERROR CODES SUB-FIELD^^.01^1 "^DD",26.17,26.1707,0,"DT") 3050329 "^DD",26.17,26.1707,0,"IX","B",26.1707,.01) "^DD",26.17,26.1707,0,"NM","ERROR CODES") "^DD",26.17,26.1707,0,"UP") 26.17 "^DD",26.17,26.1707,.01,0) ERROR CODE^MF^^0;1^K:$L(X)>30!($L(X)<2) X "^DD",26.17,26.1707,.01,1,0) ^.1 "^DD",26.17,26.1707,.01,1,1,0) 26.1707^B "^DD",26.17,26.1707,.01,1,1,1) S ^DGPF(26.17,DA(1),"ERR","B",$E(X,1,30),DA)="" "^DD",26.17,26.1707,.01,1,1,2) K ^DGPF(26.17,DA(1),"ERR","B",$E(X,1,30),DA) "^DD",26.17,26.1707,.01,3) Answer must be 2-30 characters in length. "^DD",26.17,26.1707,.01,21,0) ^^2^2^3050329^ "^DD",26.17,26.1707,.01,21,1,0) This field contains a single error code value returned by the receiving "^DD",26.17,26.1707,.01,21,2,0) site of a PRF Unsolicited Update (ORU~R01) HL7 message. "^DD",26.17,26.1707,.01,"DT") 3050329 "^DD",26.19,26.19,0) FIELD^^.07^7 "^DD",26.19,26.19,0,"DDA") N "^DD",26.19,26.19,0,"DT") 3050401 "^DD",26.19,26.19,0,"IX","B",26.19,.01) "^DD",26.19,26.19,0,"NM","PRF HL7 QUERY LOG") "^DD",26.19,26.19,.01,0) MESSAGE CONTROL ID^RF^^0;1^K:$L(X)>20!($L(X)<1)!'(X'?1P.E) X "^DD",26.19,26.19,.01,1,0) ^.1 "^DD",26.19,26.19,.01,1,1,0) 26.19^B "^DD",26.19,26.19,.01,1,1,1) S ^DGPF(26.19,"B",$E(X,1,30),DA)="" "^DD",26.19,26.19,.01,1,1,2) K ^DGPF(26.19,"B",$E(X,1,30),DA) "^DD",26.19,26.19,.01,3) Answer must be 1-20 characters in length. "^DD",26.19,26.19,.01,21,0) ^^1^1^3050314^ "^DD",26.19,26.19,.01,21,1,0) Unique ID generated by the VistA HL7 package. "^DD",26.19,26.19,.01,"DT") 3050314 "^DD",26.19,26.19,.02,0) EVENT^RP26.21'^DGPF(26.21,^0;2^Q "^DD",26.19,26.19,.02,3) Enter the event that triggered the check for existing PRF assignments. "^DD",26.19,26.19,.02,21,0) ^^2^2^3050401^ "^DD",26.19,26.19,.02,21,1,0) This field contains the event that triggered the query for existing PRF "^DD",26.19,26.19,.02,21,2,0) assignments. "^DD",26.19,26.19,.02,"DT") 3050425 "^DD",26.19,26.19,.03,0) TRANSMISSION DATE/TIME^RD^^0;3^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.19,26.19,.03,3) Enter the date/time that the query is transmitted. "^DD",26.19,26.19,.03,21,0) ^^2^2^3050314^ "^DD",26.19,26.19,.03,21,1,0) This field contains the date and time that the HL7 query message was "^DD",26.19,26.19,.03,21,2,0) transmitted. "^DD",26.19,26.19,.03,"DT") 3050425 "^DD",26.19,26.19,.04,0) STATUS^RS^T:TRANSMITTED;AN:ACCEPTED W/NO RESULTS;A:ACCEPTED W/RESULTS;RJ:REJECTED;RT:RETRANSMITTED;^0;4^Q "^DD",26.19,26.19,.04,3) Enter the current query transmission status. "^DD",26.19,26.19,.04,21,0) ^.001^1^1^3050329^^ "^DD",26.19,26.19,.04,21,1,0) This field contains the current transmission status of the PRF query. "^DD",26.19,26.19,.04,"DT") 3050329 "^DD",26.19,26.19,.05,0) SITE TRANSMITTED TO^RP4'^DIC(4,^0;5^Q "^DD",26.19,26.19,.05,3) Enter the destination site for the PRF query. "^DD",26.19,26.19,.05,21,0) ^^2^2^3050314^ "^DD",26.19,26.19,.05,21,1,0) This field contains the site that is being queried for existing PRF "^DD",26.19,26.19,.05,21,2,0) assignments. "^DD",26.19,26.19,.05,"DT") 3050314 "^DD",26.19,26.19,.06,0) ACK RECEIVED DATE/TIME^D^^0;6^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.19,26.19,.06,3) Enter the date/time that the acknowledgment to the query was received. "^DD",26.19,26.19,.06,21,0) ^^2^2^3050314^ "^DD",26.19,26.19,.06,21,1,0) This field contains the date and time that the query acknowledgment was "^DD",26.19,26.19,.06,21,2,0) received by site originating the query. "^DD",26.19,26.19,.06,"DT") 3050314 "^DD",26.19,26.19,.07,0) ERROR CODES^26.1907^^ERR;0 "^DD",26.19,26.19,.07,21,0) ^^4^4^3050329^ "^DD",26.19,26.19,.07,21,1,0) When the receiving site of a PRF Query (QRY~R02) HL7 message encounters "^DD",26.19,26.19,.07,21,2,0) one or more errors while processing the message, one or more error codes "^DD",26.19,26.19,.07,21,3,0) are returned in the Response to Query (ORF~R04) HL7 message. This "^DD",26.19,26.19,.07,21,4,0) multiple field contains the returned error codes. "^DD",26.19,26.1907,0) ERROR CODES SUB-FIELD^^.01^1 "^DD",26.19,26.1907,0,"DT") 3050329 "^DD",26.19,26.1907,0,"IX","B",26.1907,.01) "^DD",26.19,26.1907,0,"NM","ERROR CODES") "^DD",26.19,26.1907,0,"UP") 26.19 "^DD",26.19,26.1907,.01,0) ERROR CODE^MF^^0;1^K:$L(X)>30!($L(X)<2) X "^DD",26.19,26.1907,.01,1,0) ^.1 "^DD",26.19,26.1907,.01,1,1,0) 26.1907^B "^DD",26.19,26.1907,.01,1,1,1) S ^DGPF(26.19,DA(1),"ERR","B",$E(X,1,30),DA)="" "^DD",26.19,26.1907,.01,1,1,2) K ^DGPF(26.19,DA(1),"ERR","B",$E(X,1,30),DA) "^DD",26.19,26.1907,.01,3) Answer must be 2-30 characters in length. "^DD",26.19,26.1907,.01,21,0) ^.001^2^2^3050329^^ "^DD",26.19,26.1907,.01,21,1,0) This field contains a sinlge error code value returned by the receiving "^DD",26.19,26.1907,.01,21,2,0) site of a PRF Query (QRY~R02) HL7 message. "^DD",26.19,26.1907,.01,"DT") 3050329 "^DD",26.21,26.21,0) FIELD^^.03^3 "^DD",26.21,26.21,0,"DDA") N "^DD",26.21,26.21,0,"DT") 3050608 "^DD",26.21,26.21,0,"IX","B",26.21,.01) "^DD",26.21,26.21,0,"NM","PRF HL7 EVENT") "^DD",26.21,26.21,0,"PT",26.19,.02) "^DD",26.21,26.21,.01,0) PATIENT^RP2'^DPT(^0;1^Q "^DD",26.21,26.21,.01,1,0) ^.1 "^DD",26.21,26.21,.01,1,1,0) 26.21^B "^DD",26.21,26.21,.01,1,1,1) S ^DGPF(26.21,"B",$E(X,1,30),DA)="" "^DD",26.21,26.21,.01,1,1,2) K ^DGPF(26.21,"B",$E(X,1,30),DA) "^DD",26.21,26.21,.01,3) Enter the patient that requires a PRF query. "^DD",26.21,26.21,.01,21,0) ^.001^2^2^3050401^^^^ "^DD",26.21,26.21,.01,21,1,0) This field contains the patient associated with a Patient Record Flags "^DD",26.21,26.21,.01,21,2,0) query trigger. "^DD",26.21,26.21,.01,"DT") 3050401 "^DD",26.21,26.21,.02,0) INITIAL TIMESTAMP^RD^^0;2^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",26.21,26.21,.02,3) Enter the date and time of the event trigger. "^DD",26.21,26.21,.02,21,0) ^.001^1^1^3050609^^^ "^DD",26.21,26.21,.02,21,1,0) This field contains the date and time when the PRF event trigger fired. "^DD",26.21,26.21,.02,"DT") 3050609 "^DD",26.21,26.21,.03,0) CURRENT STATUS^RS^C:COMPLETE;I:INCOMPLETE;E:ERROR;^0;3^Q "^DD",26.21,26.21,.03,3) Enter C for COMPLETE, I for INCOMPLETE, or E for ERROR. "^DD",26.21,26.21,.03,21,0) ^.001^8^8^3050629^^^^ "^DD",26.21,26.21,.03,21,1,0) This field contains the current status of the Patient Record Flags HL7 "^DD",26.21,26.21,.03,21,2,0) query process. An INCOMPLETE status indicates that the HL7 query has "^DD",26.21,26.21,.03,21,3,0) either not been transmitted or that the query was NAK'ed by all receiving "^DD",26.21,26.21,.03,21,4,0) sites. A COMPLETE status indicates that the HL7 query has run successfully "^DD",26.21,26.21,.03,21,5,0) to at least one of the patient's treating facilities or that the local "^DD",26.21,26.21,.03,21,6,0) facility is the patient's only treating facility. An ERROR status "^DD",26.21,26.21,.03,21,7,0) indicates that the maximum number of HL7 query attempts has been reached "^DD",26.21,26.21,.03,21,8,0) without a successful result. "^DD",26.21,26.21,.03,"DT") 3050629 "^DD",40.8,40.8,.07,0) INSTITUTION FILE POINTER^R*P4'X^DIC(4,^0;7^D ^DIC S X=+Y Q:$P(^DG(40.8,DA,0),U,7)=+Y K:Y<0 X I $D(X),$D(^DG(40.8,"AD",X)) W !,"Enter a unique pointer." K X "^DD",40.8,40.8,.07,1,0) ^.1 "^DD",40.8,40.8,.07,1,1,0) 40.8^ADV^MUMPS "^DD",40.8,40.8,.07,1,1,1) S ^DG(40.8,"ADV",DA)=X "^DD",40.8,40.8,.07,1,1,2) K ^DG(40.8,"ADV",DA) "^DD",40.8,40.8,.07,1,2,0) 40.8^AD "^DD",40.8,40.8,.07,1,2,1) S ^DG(40.8,"AD",$E(X,1,30),DA)="" "^DD",40.8,40.8,.07,1,2,2) K ^DG(40.8,"AD",$E(X,1,30),DA) "^DD",40.8,40.8,.07,3) Enter the institution in file #4 to which this corresponds. "^DD",40.8,40.8,.07,4) W !,"Each entry in the Medical Center Division file should point to a unique entry in the Institution file." "^DD",40.8,40.8,.07,12) ONLY SITES WITH APPROPRIATE STATION NUMBER "^DD",40.8,40.8,.07,12.1) S DIC("S")="I +$$GET1^DIQ(4,+Y,99)" "^DD",40.8,40.8,.07,21,0) ^.001^3^3^3030624^^^^ "^DD",40.8,40.8,.07,21,1,0) Enter the entry in the institution file that corresponds to this division. "^DD",40.8,40.8,.07,21,2,0) It is IMPERATIVE that you respond to this prompt properly as this affects "^DD",40.8,40.8,.07,21,3,0) transmission of data to Austin as well as many other statistical reports. "^DD",40.8,40.8,.07,"DT") 3050328 "^DD",40.8,40.8,26.01,0) PRF ASSIGNMENT OWNERSHIP^*S^1:ENABLED;0:DISABLED;^PRF;1^Q "^DD",40.8,40.8,26.01,3) Enter 1 to enable this division as a patient record flag assignment owner; enter 0 to disable this division as a patient record flag assignment owner. "^DD",40.8,40.8,26.01,12) Cannot disable this medical center division if active assignments are associated with the division. "^DD",40.8,40.8,26.01,12.1) S DIC("S")="I $$SCRNDIV^DGPFDD(DA,+Y)" "^DD",40.8,40.8,26.01,21,0) ^.001^4^4^3050623^^^^ "^DD",40.8,40.8,26.01,21,1,0) This field contains the indicator of whether or not this medical center "^DD",40.8,40.8,26.01,21,2,0) division has been designated as a patient record flag assignment owner. "^DD",40.8,40.8,26.01,21,3,0) Data in this field should not be added or edited except through the use "^DD",40.8,40.8,26.01,21,4,0) of the Patient Record Flags software that is part of Registration. "^DD",40.8,40.8,26.01,"DT") 3050622 "^DD",40.8,40.8,26.02,0) PRF OWNERSHIP EDITED^D^^PRF;2^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",40.8,40.8,26.02,3) Enter the date and time the PRF Assignment Ownership indicator is edited. "^DD",40.8,40.8,26.02,21,0) ^.001^6^6^3050628^^^^ "^DD",40.8,40.8,26.02,21,1,0) This field is used as part of the audit trail for the enabling/disabling "^DD",40.8,40.8,26.02,21,2,0) of medical center divisions as patient record flag assignment owners. This "^DD",40.8,40.8,26.02,21,3,0) field will contain the date/time that the PRF ASSIGNMENT OWNERSHIP "^DD",40.8,40.8,26.02,21,4,0) indicator was edited. "^DD",40.8,40.8,26.02,21,5,0) Data in this field should not be added or edited except through the use "^DD",40.8,40.8,26.02,21,6,0) of the Patient Record Flags software that is part of Registration. "^DD",40.8,40.8,26.02,"DT") 3050628 "^DD",40.8,40.8,26.03,0) PRF OWNERSHIP EDITED BY^P200'^VA(200,^PRF;3^Q "^DD",40.8,40.8,26.03,3) Enter the user who is editing the PRF Assignment Ownership indicator. "^DD",40.8,40.8,26.03,21,0) ^.001^6^6^3050628^^^^ "^DD",40.8,40.8,26.03,21,1,0) This field is used as part of the audit trail for the enabling/disabling "^DD",40.8,40.8,26.03,21,2,0) of medical center divisions as patient record flag assignment owners. This "^DD",40.8,40.8,26.03,21,3,0) field will contain the user responsible for editing the PRF ASSIGNMENT "^DD",40.8,40.8,26.03,21,4,0) OWNERSHIP indicator. "^DD",40.8,40.8,26.03,21,5,0) Data in this field should not be added or edited except through the use "^DD",40.8,40.8,26.03,21,6,0) of the Patient Record Flags software that is part of Registration. "^DD",40.8,40.8,26.03,"DT") 3050628 "^DIC",26.19,26.19,0) PRF HL7 QUERY LOG^26.19 "^DIC",26.19,26.19,0,"GL") ^DGPF(26.19, "^DIC",26.19,26.19,"%",0) ^1.005^^ "^DIC",26.19,26.19,"%D",0) ^^8^8^3050328^ "^DIC",26.19,26.19,"%D",1,0) This file contains a list of all Query (QRY~R02) HL7 transmissions that "^DIC",26.19,26.19,"%D",2,0) have been generated at the site by the Patient Record Flags software "^DIC",26.19,26.19,"%D",3,0) module. Entries in this file are created/edited automatically by the "^DIC",26.19,26.19,"%D",4,0) Patient Record Flags HL7 interface. "^DIC",26.19,26.19,"%D",5,0) "^DIC",26.19,26.19,"%D",6,0) Records in this file should not be added or edited except through the use "^DIC",26.19,26.19,"%D",7,0) of the Patient Record Flag software that is part of Registration. Doing so "^DIC",26.19,26.19,"%D",8,0) would likely cause Patient Record Flag database corruption. "^DIC",26.19,"B","PRF HL7 QUERY LOG",26.19) "^DIC",26.21,26.21,0) PRF HL7 EVENT^26.21 "^DIC",26.21,26.21,0,"GL") ^DGPF(26.21, "^DIC",26.21,26.21,"%D",0) ^1.001^2^2^3050615^^^ "^DIC",26.21,26.21,"%D",1,0) This file tracks patients that need to have one or more of their treating "^DIC",26.21,26.21,"%D",2,0) facilities checked for existing Patient Record Flag assignments. "^DIC",26.21,"B","PRF HL7 EVENT",26.21) **END** **END**