KIDS Distribution saved on Jun 30, 2004@14:29:14 Combat Vet **KIDS**:COMBAT VET PHASE II PIMS 1.0^PX*1.0*130^SD*5.3*325^DG*5.3*565^EC*2.0*54^ **INSTALL NAME** COMBAT VET PHASE II PIMS 1.0 "BLD",3693,0) COMBAT VET PHASE II PIMS 1.0^^1^3040630^y "BLD",3693,1,0) ^^3^3^3040527^^ "BLD",3693,1,1,0) Changes to Scheduling (SD*5.3*325), PCE (PX*1*130), ACRP (SD*5.3*325), "BLD",3693,1,2,0) Event Capture (EC*3*54), PTF (DG*5.3*565), and the ZEL segment "BLD",3693,1,3,0) (DG*5.3*565) in support of Combat Veteran Phase II. "BLD",3693,10,0) ^9.63^4^4 "BLD",3693,10,1,0) PX*1.0*130^1 "BLD",3693,10,2,0) SD*5.3*325^1 "BLD",3693,10,3,0) DG*5.3*565^1 "BLD",3693,10,4,0) EC*2.0*54^1 "BLD",3693,10,"B","DG*5.3*565",3) "BLD",3693,10,"B","EC*2.0*54",4) "BLD",3693,10,"B","PX*1.0*130",1) "BLD",3693,10,"B","SD*5.3*325",2) "MBREQ") 0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") 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 "VER") 8.0^22.0 **INSTALL NAME** PX*1.0*130 "BLD",3655,0) PX*1.0*130^PCE PATIENT CARE ENCOUNTER^0^3040630^y "BLD",3655,1,0) ^^2^2^3031119^^ "BLD",3655,1,1,0) Please see the National Patch Module for details "BLD",3655,1,2,0) of the enhancements included in this patch. "BLD",3655,4,0) ^9.64PA^9000010.07^2 "BLD",3655,4,9000010,0) 9000010 "BLD",3655,4,9000010,2,0) ^9.641^9000010^1 "BLD",3655,4,9000010,2,9000010,0) VISIT (File-top level) "BLD",3655,4,9000010,2,9000010,1,0) ^9.6411^80007^1 "BLD",3655,4,9000010,2,9000010,1,80007,0) COMBAT VETERAN "BLD",3655,4,9000010,222) y^n^p^^^^n^^n "BLD",3655,4,9000010,224) "BLD",3655,4,9000010.07,0) 9000010.07 "BLD",3655,4,9000010.07,2,0) ^9.641^9000010.07^1 "BLD",3655,4,9000010.07,2,9000010.07,0) V POV (File-top level) "BLD",3655,4,9000010.07,2,9000010.07,1,0) ^9.6411^80007^3 "BLD",3655,4,9000010.07,2,9000010.07,1,80005,0) MILITARY SEXUAL TRAUMA "BLD",3655,4,9000010.07,2,9000010.07,1,80006,0) HEAD AND/OR NECK CANCER "BLD",3655,4,9000010.07,2,9000010.07,1,80007,0) COMBAT VETERAN "BLD",3655,4,9000010.07,222) y^n^p^^^^n^^n "BLD",3655,4,9000010.07,224) "BLD",3655,4,"APDD",9000010,9000010) "BLD",3655,4,"APDD",9000010,9000010,80007) "BLD",3655,4,"APDD",9000010.07,9000010.07) "BLD",3655,4,"APDD",9000010.07,9000010.07,80005) "BLD",3655,4,"APDD",9000010.07,9000010.07,80006) "BLD",3655,4,"APDD",9000010.07,9000010.07,80007) "BLD",3655,4,"B",9000010,9000010) "BLD",3655,4,"B",9000010.07,9000010.07) "BLD",3655,"KRN",0) ^9.67PA^8989.52^19 "BLD",3655,"KRN",.4,0) .4 "BLD",3655,"KRN",.4,"NM",0) ^9.68A^^ "BLD",3655,"KRN",.401,0) .401 "BLD",3655,"KRN",.401,"NM",0) ^9.68A^^ "BLD",3655,"KRN",.402,0) .402 "BLD",3655,"KRN",.402,"NM",0) ^9.68A^^ "BLD",3655,"KRN",.403,0) .403 "BLD",3655,"KRN",.403,"NM",0) ^9.68A^^ "BLD",3655,"KRN",.5,0) .5 "BLD",3655,"KRN",.5,"NM",0) ^9.68A^^ "BLD",3655,"KRN",.84,0) .84 "BLD",3655,"KRN",.84,"NM",0) ^9.68A^1^1 "BLD",3655,"KRN",.84,"NM",1,0) 8390001.003^^0 "BLD",3655,"KRN",.84,"NM","B",8390001.003,1) "BLD",3655,"KRN",3.6,0) 3.6 "BLD",3655,"KRN",3.6,"NM",0) ^9.68A^^ "BLD",3655,"KRN",3.8,0) 3.8 "BLD",3655,"KRN",3.8,"NM",0) ^9.68A^^ "BLD",3655,"KRN",9.2,0) 9.2 "BLD",3655,"KRN",9.2,"NM",0) ^9.68A^^ "BLD",3655,"KRN",9.8,0) 9.8 "BLD",3655,"KRN",9.8,"NM",0) ^9.68A^37^28 "BLD",3655,"KRN",9.8,"NM",1,0) PXAI^^0^B38962189 "BLD",3655,"KRN",9.8,"NM",3,0) PXAICPTV^^0^B15682833 "BLD",3655,"KRN",9.8,"NM",6,0) PXAIPOV^^0^B19585929 "BLD",3655,"KRN",9.8,"NM",8,0) PXAIVST^^0^B14872845 "BLD",3655,"KRN",9.8,"NM",9,0) PXBAPI1^^0^B46973117 "BLD",3655,"KRN",9.8,"NM",10,0) PXCAPOV^^0^B28854143 "BLD",3655,"KRN",9.8,"NM",12,0) PXUTLSCC^^0^B35383382 "BLD",3655,"KRN",9.8,"NM",13,0) VSITDEF^^0^B39387096 "BLD",3655,"KRN",9.8,"NM",14,0) VSITFLD^^0^B7817318 "BLD",3655,"KRN",9.8,"NM",15,0) VSITHLP^^0^B18175891 "BLD",3655,"KRN",9.8,"NM",16,0) PXAIVSTV^^0^B54821718 "BLD",3655,"KRN",9.8,"NM",17,0) PXBAPI21^^0^B11006769 "BLD",3655,"KRN",9.8,"NM",19,0) PXBPL^^0^B19046893 "BLD",3655,"KRN",9.8,"NM",20,0) PXCADXP2^^0^B21580833 "BLD",3655,"KRN",9.8,"NM",21,0) PXCAPL^^0^B29826550 "BLD",3655,"KRN",9.8,"NM",22,0) PXCAPL1^^0^B5845414 "BLD",3655,"KRN",9.8,"NM",23,0) PXCAPL2^^0^B8168398 "BLD",3655,"KRN",9.8,"NM",25,0) PXCEAPPM^^0^B6287887 "BLD",3655,"KRN",9.8,"NM",26,0) PXCEE800^^0^B1938209 "BLD",3655,"KRN",9.8,"NM",27,0) PXCESIT^^0^B9552263 "BLD",3655,"KRN",9.8,"NM",28,0) PXCEVST^^0^B6194268 "BLD",3655,"KRN",9.8,"NM",29,0) PXKFVST^^0^B9939551 "BLD",3655,"KRN",9.8,"NM",30,0) PXKVST^^0^B18960095 "BLD",3655,"KRN",9.8,"NM",31,0) PXCAVST^^0^B35591988 "BLD",3655,"KRN",9.8,"NM",32,0) PXCAVST1^^0^B16250901 "BLD",3655,"KRN",9.8,"NM",35,0) PXKMAIN^^0^B41593205 "BLD",3655,"KRN",9.8,"NM",36,0) PXAPIDEL^^0^B29773548 "BLD",3655,"KRN",9.8,"NM",37,0) PXKFPOV^^0^B3741840 "BLD",3655,"KRN",9.8,"NM","B","PXAI",1) "BLD",3655,"KRN",9.8,"NM","B","PXAICPTV",3) "BLD",3655,"KRN",9.8,"NM","B","PXAIPOV",6) "BLD",3655,"KRN",9.8,"NM","B","PXAIVST",8) "BLD",3655,"KRN",9.8,"NM","B","PXAIVSTV",16) "BLD",3655,"KRN",9.8,"NM","B","PXAPIDEL",36) "BLD",3655,"KRN",9.8,"NM","B","PXBAPI1",9) "BLD",3655,"KRN",9.8,"NM","B","PXBAPI21",17) "BLD",3655,"KRN",9.8,"NM","B","PXBPL",19) "BLD",3655,"KRN",9.8,"NM","B","PXCADXP2",20) "BLD",3655,"KRN",9.8,"NM","B","PXCAPL",21) "BLD",3655,"KRN",9.8,"NM","B","PXCAPL1",22) "BLD",3655,"KRN",9.8,"NM","B","PXCAPL2",23) "BLD",3655,"KRN",9.8,"NM","B","PXCAPOV",10) "BLD",3655,"KRN",9.8,"NM","B","PXCAVST",31) "BLD",3655,"KRN",9.8,"NM","B","PXCAVST1",32) "BLD",3655,"KRN",9.8,"NM","B","PXCEAPPM",25) "BLD",3655,"KRN",9.8,"NM","B","PXCEE800",26) "BLD",3655,"KRN",9.8,"NM","B","PXCESIT",27) "BLD",3655,"KRN",9.8,"NM","B","PXCEVST",28) "BLD",3655,"KRN",9.8,"NM","B","PXKFPOV",37) "BLD",3655,"KRN",9.8,"NM","B","PXKFVST",29) "BLD",3655,"KRN",9.8,"NM","B","PXKMAIN",35) "BLD",3655,"KRN",9.8,"NM","B","PXKVST",30) "BLD",3655,"KRN",9.8,"NM","B","PXUTLSCC",12) "BLD",3655,"KRN",9.8,"NM","B","VSITDEF",13) "BLD",3655,"KRN",9.8,"NM","B","VSITFLD",14) "BLD",3655,"KRN",9.8,"NM","B","VSITHLP",15) "BLD",3655,"KRN",19,0) 19 "BLD",3655,"KRN",19,"NM",0) ^9.68A^^ "BLD",3655,"KRN",19.1,0) 19.1 "BLD",3655,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3655,"KRN",101,0) 101 "BLD",3655,"KRN",101,"NM",0) ^9.68A^^ "BLD",3655,"KRN",409.61,0) 409.61 "BLD",3655,"KRN",409.61,"NM",0) ^9.68A^^ "BLD",3655,"KRN",771,0) 771 "BLD",3655,"KRN",771,"NM",0) ^9.68A^^ "BLD",3655,"KRN",870,0) 870 "BLD",3655,"KRN",870,"NM",0) ^9.68A^^ "BLD",3655,"KRN",8989.51,0) 8989.51 "BLD",3655,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",3655,"KRN",8989.52,0) 8989.52 "BLD",3655,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",3655,"KRN",8994,0) 8994 "BLD",3655,"KRN",8994,"NM",0) ^9.68A^^ "BLD",3655,"KRN","B",.4,.4) "BLD",3655,"KRN","B",.401,.401) "BLD",3655,"KRN","B",.402,.402) "BLD",3655,"KRN","B",.403,.403) "BLD",3655,"KRN","B",.5,.5) "BLD",3655,"KRN","B",.84,.84) "BLD",3655,"KRN","B",3.6,3.6) "BLD",3655,"KRN","B",3.8,3.8) "BLD",3655,"KRN","B",9.2,9.2) "BLD",3655,"KRN","B",9.8,9.8) "BLD",3655,"KRN","B",19,19) "BLD",3655,"KRN","B",19.1,19.1) "BLD",3655,"KRN","B",101,101) "BLD",3655,"KRN","B",409.61,409.61) "BLD",3655,"KRN","B",771,771) "BLD",3655,"KRN","B",870,870) "BLD",3655,"KRN","B",8989.51,8989.51) "BLD",3655,"KRN","B",8989.52,8989.52) "BLD",3655,"KRN","B",8994,8994) "BLD",3655,"QUES",0) ^9.62^^ "BLD",3655,"REQB",0) ^9.611^7^6 "BLD",3655,"REQB",2,0) PX*1.0*96^2 "BLD",3655,"REQB",3,0) PX*1.0*112^2 "BLD",3655,"REQB",4,0) PX*1.0*115^2 "BLD",3655,"REQB",5,0) PX*1.0*121^2 "BLD",3655,"REQB",6,0) PX*1.0*122^2 "BLD",3655,"REQB",7,0) PX*1.0*117^2 "BLD",3655,"REQB","B","PX*1.0*112",3) "BLD",3655,"REQB","B","PX*1.0*115",4) "BLD",3655,"REQB","B","PX*1.0*117",7) "BLD",3655,"REQB","B","PX*1.0*121",5) "BLD",3655,"REQB","B","PX*1.0*122",6) "BLD",3655,"REQB","B","PX*1.0*96",2) "FIA",9000010) VISIT "FIA",9000010,0) ^AUPNVSIT( "FIA",9000010,0,0) 9000010sID "FIA",9000010,0,1) y^n^p^^^^n^^n "FIA",9000010,0,10) "FIA",9000010,0,11) "FIA",9000010,0,"RLRO") "FIA",9000010,0,"VR") 1.0^PX "FIA",9000010,9000010) 1 "FIA",9000010,9000010,80007) "FIA",9000010.07) V POV "FIA",9000010.07,0) ^AUPNVPOV( "FIA",9000010.07,0,0) 9000010.07IP "FIA",9000010.07,0,1) y^n^p^^^^n^^n "FIA",9000010.07,0,10) "FIA",9000010.07,0,11) "FIA",9000010.07,0,"RLRO") "FIA",9000010.07,0,"VR") 1.0^PX "FIA",9000010.07,9000010.07) 1 "FIA",9000010.07,9000010.07,80005) "FIA",9000010.07,9000010.07,80006) "FIA",9000010.07,9000010.07,80007) "KRN",.84,8390001.003,-1) 0^1 "KRN",.84,8390001.003,0) 8390001.003^1^y^PCE PATIENT CARE ENCOUNTER "KRN",.84,8390001.003,1,0) ^.842^2^2^3040317^^^^ "KRN",.84,8390001.003,1,1,0) Warning message for service connectedness "KRN",.84,8390001.003,1,2,0) "KRN",.84,8390001.003,2,0) ^^23^23^3040317^ "KRN",.84,8390001.003,2,1,0) * * * * * * WARNING * * * * * * "KRN",.84,8390001.003,2,2,0) "KRN",.84,8390001.003,2,3,0) Problems are: "KRN",.84,8390001.003,2,4,0) "KRN",.84,8390001.003,2,5,0) Service connected ..... |1W| |6W| "KRN",.84,8390001.003,2,6,0) Agent Orange .......... |2W| |7W| "KRN",.84,8390001.003,2,7,0) Ionizing Radiation .... |3W| |8W| "KRN",.84,8390001.003,2,8,0) Persian Gulf .......... |4W| |9W| "KRN",.84,8390001.003,2,9,0) Military Sexual Trauma. |5W| |10W| "KRN",.84,8390001.003,2,10,0) Head/Neck Cancer ...... |16W| |17W| "KRN",.84,8390001.003,2,11,0) Combat Veteran ........ |19W| |20W| "KRN",.84,8390001.003,2,12,0) "KRN",.84,8390001.003,2,13,0) Corrected to: "KRN",.84,8390001.003,2,14,0) "KRN",.84,8390001.003,2,15,0) Service connected ..... |11W| "KRN",.84,8390001.003,2,16,0) Agent Orange .......... |12W| "KRN",.84,8390001.003,2,17,0) Ionizing Radiation .... |13W| "KRN",.84,8390001.003,2,18,0) Persian Gulf .......... |14W| "KRN",.84,8390001.003,2,19,0) Military Sexual Trauma. |15W| "KRN",.84,8390001.003,2,20,0) Head/Neck Cancer ...... |18W| "KRN",.84,8390001.003,2,21,0) Combat Veteran ........ |21W| "KRN",.84,8390001.003,2,22,0) "KRN",.84,8390001.003,2,23,0) Changes have been made according to the Patient and the clinic. "KRN",.84,8390001.003,3,0) ^.845^21^21 "KRN",.84,8390001.003,3,1,0) 1W^SC as received "KRN",.84,8390001.003,3,2,0) 2W^AO a received "KRN",.84,8390001.003,3,3,0) 3W^IR as received "KRN",.84,8390001.003,3,4,0) 4W^EC as received "KRN",.84,8390001.003,3,5,0) 5W^MST as received "KRN",.84,8390001.003,3,6,0) 6W^Error message for SC "KRN",.84,8390001.003,3,7,0) 7W^Error message for AO "KRN",.84,8390001.003,3,8,0) 8W^Error message for IR "KRN",.84,8390001.003,3,9,0) 9W^Error message for EC "KRN",.84,8390001.003,3,10,0) 10W^Error message for MST "KRN",.84,8390001.003,3,11,0) 11W^Correction for SC "KRN",.84,8390001.003,3,12,0) 12W^Correction for AO "KRN",.84,8390001.003,3,13,0) 13W^Correction for IR "KRN",.84,8390001.003,3,14,0) 14W^Correction for EC "KRN",.84,8390001.003,3,15,0) 15W^Correction for MST "KRN",.84,8390001.003,3,16,0) 16W^HNC as received "KRN",.84,8390001.003,3,17,0) 17W^Error message for HNC "KRN",.84,8390001.003,3,18,0) 18W^Correction for HNC "KRN",.84,8390001.003,3,19,0) 19W^CV as received "KRN",.84,8390001.003,3,20,0) 20W^Error message for CV "KRN",.84,8390001.003,3,21,0) 21W^Correction for CV "MBREQ") 1 "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 "PKG",507,-1) 1^1 "PKG",507,0) PCE PATIENT CARE ENCOUNTER^PX^Patient Care Encounter "PKG",507,20,0) ^9.402P^^ "PKG",507,22,0) ^9.49I^1^1 "PKG",507,22,1,0) 1.0^2960812^2960912^10958 "PKG",507,22,1,"PAH",1,0) 130^3040630^100100 "PKG",507,22,1,"PAH",1,1,0) ^^2^2^3040630 "PKG",507,22,1,"PAH",1,1,1,0) Please see the National Patch Module for details "PKG",507,22,1,"PAH",1,1,2,0) of the enhancements included in this patch. "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") 28 "RTN","PXAI") 0^1^B38962189 "RTN","PXAI",1,0) PXAI ;ISL/JVS,ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ; 6/20/03 11:15am "RTN","PXAI",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112,130**;Aug 12, 1996 "RTN","PXAI",3,0) Q "RTN","PXAI",4,0) ; "RTN","PXAI",5,0) ;+ 1 2 3 4 5 6 7 8 9 "RTN","PXAI",6,0) DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB) ;+API to pass data for add/edit/delete to PCE. "RTN","PXAI",7,0) ;+ PXADATA (required) "RTN","PXAI",8,0) ;+ PXAPKG (required) "RTN","PXAI",9,0) ;+ PXASOURC (required) "RTN","PXAI",10,0) ;+ PXAVISIT (optional) is pointer to a visit for which the data is to "RTN","PXAI",11,0) ;+ be related. If the visit is not know then there must be "RTN","PXAI",12,0) ;+ the ENCOUNTER nodes needed to lookup/create the visit. "RTN","PXAI",13,0) ;+ PXAUSER (optional) this is a pointer to the user adding the data. "RTN","PXAI",14,0) ;+ PXANOT (optional) set to 1 if errors are to be displayed to the screen should only be set while writing and debugging the initial code. "RTN","PXAI",15,0) ;+ ERRRET (optional) passed by reference. If present will return PXKERROR "RTN","PXAI",16,0) ;+ array elements to the caller. "RTN","PXAI",17,0) ;+ PXAPREDT (optional) Set to 1 if you want to edit the Primary Provder "RTN","PXAI",18,0) ;+ only use if for the moment that editing is being done. (dangeous) "RTN","PXAI",19,0) ;+ .PXAPROB (optional) A dotted variable name. When errors and "RTN","PXAI",20,0) ;+ warnings occur, They will be passed back in the form "RTN","PXAI",21,0) ;+ of an array with the general description of the problem. "RTN","PXAI",22,0) ;+ IF ERROR1 - (GENERAL ERRORS) "RTN","PXAI",23,0) ;+ PXAPROB($J,SUBSCRIPT,"ERROR1",PASSED IN 'FILE',PASSED IN FIELD, "RTN","PXAI",24,0) ;+ SUBSCRIPT FROM PXADATA) "RTN","PXAI",25,0) ;+ PXAPROB(23432234,2,"ERROR1","PROVIDER","NAME",7)="BECAUSE..." "RTN","PXAI",26,0) ;+ IF WARNING2 - (GENERAL WARNINGS) "RTN","PXAI",27,0) ;+ PXAPROB($J,SUBSCRIPT,"WARNING2",PASSED IN 'FILE',PASSED IN FIELD, "RTN","PXAI",28,0) ;+ SUBSCRIPT FROM PXADATA) "RTN","PXAI",29,0) ;+ PXAPROB(23432234,3,"WARNING2","PROCEDURE","QTY",3)="BECAUSE..." "RTN","PXAI",30,0) ;+ IF WARNING3 - (WARNINGS FOR SERVICE CONNECTION) "RTN","PXAI",31,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"AO")=REASON "RTN","PXAI",32,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"EC")=REASON "RTN","PXAI",33,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"IR")=REASON "RTN","PXAI",34,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SC")=REASON "RTN","PXAI",35,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"MST")=REASON "RTN","PXAI",36,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"HNC")=REASON "RTN","PXAI",37,0) ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"CV")=REASON "RTN","PXAI",38,0) ;+ IF ERROR4 - (PROBLEM LIST ERRORS) "RTN","PXAI",39,0) ;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON "RTN","PXAI",40,0) ;+ "RTN","PXAI",41,0) ;+ "RTN","PXAI",42,0) ;+ "RTN","PXAI",43,0) ;+ Returns: "RTN","PXAI",44,0) ;+ 1 if no errors and process completely "RTN","PXAI",45,0) ;+ -1 if errors occurred but processed completely as possible "RTN","PXAI",46,0) ;+ -2 if could not get a visit "RTN","PXAI",47,0) ;+ -3 if called incorrectly "RTN","PXAI",48,0) ; "RTN","PXAI",49,0) NEW ;--NEW VARIABLES "RTN","PXAI",50,0) N NOVSIT,PXAK,DFN,PXAERRF,PXADEC,PXELAP,PXASUB "RTN","PXAI",51,0) N PATIENT,VALQUIET,PRIMFND "RTN","PXAI",52,0) K PXAERROR,PXKERROR,PXAERR,PRVDR "RTN","PXAI",53,0) S PXASUB=0,VALQUIET=1 "RTN","PXAI",54,0) ; needs to look up if not passed. "RTN","PXAI",55,0) I '$G(PXAVISIT),'$D(@PXADATA@("ENCOUNTER")) Q -3 "RTN","PXAI",56,0) I $G(PXAUSER)<1 S PXAUSER=DUZ "RTN","PXAI",57,0) ; "RTN","PXAI",58,0) K ^TMP("PXK",$J),^TMP("DIERR",$J),^TMP("PXAIADDPRV",$J) "RTN","PXAI",59,0) SOR ;--SOURCE "RTN","PXAI",60,0) I PXAPKG=+PXAPKG S PXAPKG=PXAPKG "RTN","PXAI",61,0) E S PXAPKG=$$PKG2IEN^VSIT(PXAPKG) "RTN","PXAI",62,0) I PXASOURC=+PXASOURC S PXASOURC=PXASOURC "RTN","PXAI",63,0) E S PXASOURC=$$SOURCE^PXAPIUTL(PXASOURC) "RTN","PXAI",64,0) ; "RTN","PXAI",65,0) D TMPSOURC^PXAPIUTL(PXASOURC) ;-SAVES & CREATES ^TMP("PXK",$J,"SOR") "RTN","PXAI",66,0) VST ;--VISIT "RTN","PXAI",67,0) ;--KILL VISIT "RTN","PXAI",68,0) I $G(PXAVISIT) D VPTR^PXAIVSTV I $G(PXAERRF) D ERR Q -2 "RTN","PXAI",69,0) D VST^PXAIVST "RTN","PXAI",70,0) I $G(PXAVISIT)<0 Q -2 "RTN","PXAI",71,0) I $G(PXAERRF) D ERR K PXAERR Q -2 "RTN","PXAI",72,0) PRV ;--PROVIDER "RTN","PXAI",73,0) S PATIENT=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",5) "RTN","PXAI",74,0) S (PXAK,PRIMFND)=0 "RTN","PXAI",75,0) F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:(PRIMFND)!(PXAK="") D "RTN","PXAI",76,0) .I $D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D "RTN","PXAI",77,0) ..S PRIMFND=$G(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) "RTN","PXAI",78,0) I 'PRIMFND D ;Check for each provider's status as Primary or Secondary "RTN","PXAI",79,0) .S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D "RTN","PXAI",80,0) ..I '$D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D PROVDRST "RTN","PXAI",81,0) S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D "RTN","PXAI",82,0) . D PRV^PXAIPRV I $G(PXAERRF) D ERR "RTN","PXAI",83,0) K PRI ;--FLAG FOR PRIMARY PROVIDER "RTN","PXAI",84,0) K PXAERR "RTN","PXAI",85,0) CPT ;--PROCEDURE "RTN","PXAI",86,0) S PXAK=0 F S PXAK=$O(@PXADATA@("PROCEDURE",PXAK)) Q:PXAK="" D "RTN","PXAI",87,0) . D CPT^PXAICPT I $G(PXAERRF) D ERR "RTN","PXAI",88,0) K PXAERR "RTN","PXAI",89,0) ; "RTN","PXAI",90,0) POV ;--DIAGNOSIS "RTN","PXAI",91,0) S (PXAK,PRIMFND)=0 "RTN","PXAI",92,0) F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:(PXAK="") D Q:PRIMFND "RTN","PXAI",93,0) .I +$G(@PXADATA@("DX/PL",PXAK,"PRIMARY"))=1 D "RTN","PXAI",94,0) ..S PRIMFND=$G(@PXADATA@("DX/PL",PXAK,"DIAGNOSIS")) "RTN","PXAI",95,0) I $D(@PXADATA@("DX/PL")) D POVPRM(PXAVISIT,PRIMFND,.PXADATA) D "RTN","PXAI",96,0) .S PXAK=0 F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:PXAK="" D "RTN","PXAI",97,0) ..D POV^PXAIPOV I $G(PXAERRF) D ERR "RTN","PXAI",98,0) K PXAERR "RTN","PXAI",99,0) ; "RTN","PXAI",100,0) EDU ;--PATIENT EDUCATION "RTN","PXAI",101,0) S PXAK=0 F S PXAK=$O(@PXADATA@("PATIENT ED",PXAK)) Q:PXAK="" D "RTN","PXAI",102,0) . D EDU^PXAIPED I $G(PXAERRF) D ERR "RTN","PXAI",103,0) K PXAERR "RTN","PXAI",104,0) ; "RTN","PXAI",105,0) EXAM ;--EXAMINATION "RTN","PXAI",106,0) S PXAK=0 F S PXAK=$O(@PXADATA@("EXAM",PXAK)) Q:PXAK="" D "RTN","PXAI",107,0) . D EXAM^PXAIXAM I $G(PXAERRF) D ERR "RTN","PXAI",108,0) K PXAERR "RTN","PXAI",109,0) ; "RTN","PXAI",110,0) HF ;--HEALTH FACTOR "RTN","PXAI",111,0) S PXAK=0 F S PXAK=$O(@PXADATA@("HEALTH FACTOR",PXAK)) Q:PXAK="" D "RTN","PXAI",112,0) . D HF^PXAIHF I $G(PXAERRF) D ERR "RTN","PXAI",113,0) K PXAERR "RTN","PXAI",114,0) ; "RTN","PXAI",115,0) IMM ;--IMMUNIZATION "RTN","PXAI",116,0) S PXAK=0 F S PXAK=$O(@PXADATA@("IMMUNIZATION",PXAK)) Q:PXAK="" D "RTN","PXAI",117,0) . D IMM^PXAIIMM I $G(PXAERRF) D ERR "RTN","PXAI",118,0) K PXAERR "RTN","PXAI",119,0) ; "RTN","PXAI",120,0) SKIN ;--SKIN TEST "RTN","PXAI",121,0) S PXAK=0 F S PXAK=$O(@PXADATA@("SKIN TEST",PXAK)) Q:PXAK="" D "RTN","PXAI",122,0) . D SKIN^PXAISK I $G(PXAERRF) D ERR "RTN","PXAI",123,0) K PXAERR "RTN","PXAI",124,0) ; "RTN","PXAI",125,0) ; "RTN","PXAI",126,0) D OTHER^PXAIPRV "RTN","PXAI",127,0) ; "RTN","PXAI",128,0) ; "RTN","PXAI",129,0) I $D(^TMP("PXK",$J)) D "RTN","PXAI",130,0) . D EN1^PXKMAIN "RTN","PXAI",131,0) . M ERRRET=PXKERROR "RTN","PXAI",132,0) . D PRIM^PXAIPRV K PRVDR "RTN","PXAI",133,0) . D EVENT^PXKMAIN "RTN","PXAI",134,0) K ^TMP("PXK",$J),PXAERR,PXKERROR "RTN","PXAI",135,0) Q $S($G(PXAERRF):-1,1:1) "RTN","PXAI",136,0) ; "RTN","PXAI",137,0) ; "RTN","PXAI",138,0) EXIT ;--EXIT AND CLEAN UP "RTN","PXAI",139,0) D EVENT^PXKMAIN "RTN","PXAI",140,0) K ^TMP("PXK",$J),PRVDR "RTN","PXAI",141,0) K PXAERR "RTN","PXAI",142,0) Q "RTN","PXAI",143,0) ;-----------------SUBROUTINES----------------------- "RTN","PXAI",144,0) ERR ; "RTN","PXAI",145,0) ; "RTN","PXAI",146,0) ; "RTN","PXAI",147,0) I '$D(PXADI("DIALOG")) Q "RTN","PXAI",148,0) N NODE,SCREEN "RTN","PXAI",149,0) S PXAERR(1)=$G(PXADATA),PXAERR(2)=$G(PXAPKG),PXAERR(3)=$G(PXASOURC) "RTN","PXAI",150,0) S PXAERR(4)=$G(PXAVISIT),PXAERR(5)=$G(PXAUSER)_" "_$P($G(^VA(200,PXAUSER,0)),"^",1) "RTN","PXAI",151,0) I $G(PXANOT)=1 D EXTERNAL "RTN","PXAI",152,0) E D INTERNAL "RTN","PXAI",153,0) D ARRAY^PXAICPTV "RTN","PXAI",154,0) K PXADI("DIALOG") "RTN","PXAI",155,0) Q "RTN","PXAI",156,0) ; "RTN","PXAI",157,0) EXTERNAL ;---SEND ERRORS TO SCREEN "RTN","PXAI",158,0) W !,"-----------------------------------------------------------------" "RTN","PXAI",159,0) D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,"","SCREEN","F") "RTN","PXAI",160,0) D MSG^DIALOG("ESW","",50,10,"SCREEN") "RTN","PXAI",161,0) ; "RTN","PXAI",162,0) Q "RTN","PXAI",163,0) INTERNAL ;---SET ERRORS TO GLOBAL ARRAY "RTN","PXAI",164,0) S NODE=PXADATA "RTN","PXAI",165,0) D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,.PXAERR,NODE,"F") "RTN","PXAI",166,0) S NODE=$NA(@PXADATA@("DIERR",$J)) D MSG^DIALOG("ESW","",50,10,NODE) "RTN","PXAI",167,0) Q "RTN","PXAI",168,0) ; "RTN","PXAI",169,0) PROVDRST ; Check provider status (Primary or Secondary) "RTN","PXAI",170,0) N PRVIEN,DETS,DIC,DR,DA,DIQ,PRI,PRVPRIM "RTN","PXAI",171,0) I $G(PXAK)="" QUIT "RTN","PXAI",172,0) S PRVIEN=0 "RTN","PXAI",173,0) F S PRVIEN=$O(^AUPNVPRV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D "RTN","PXAI",174,0) .S DETS=$G(^AUPNVPRV(PRVIEN,0)) "RTN","PXAI",175,0) .I $P(DETS,U)=$G(@PXADATA@("PROVIDER",PXAK,"NAME")) D "RTN","PXAI",176,0) ..S DIC=9000010.06,DR=.04,DA=PRVIEN "RTN","PXAI",177,0) ..S DIQ="PRVPRIM(",DIQ(0)="EI" D EN^DIQ1 "RTN","PXAI",178,0) ..S PRI=$E($G(PRVPRIM(9000010.06,DA,DR,"E")),1,1) "RTN","PXAI",179,0) ..S @PXADATA@("PROVIDER",PXAK,"PRIMARY")=$S(PRI="P":1,1:0) "RTN","PXAI",180,0) Q "RTN","PXAI",181,0) POVPRM(VISIT,PRIMFND,POVARR) ; "RTN","PXAI",182,0) N PRVIEN,DETS,STOP,LPXAK,ORDX,NDX,ORDXP "RTN","PXAI",183,0) S PRVIEN=0 "RTN","PXAI",184,0) ;create array of existing DX; ORDX - pointer to ^ICD9( "RTN","PXAI",185,0) F S PRVIEN=$O(^AUPNVPOV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D "RTN","PXAI",186,0) .S DETS=$G(^AUPNVPOV(PRVIEN,0)),ORDX=$P(DETS,U) "RTN","PXAI",187,0) .S ORDX(ORDX)=PRVIEN I $P(DETS,U,12)="P" S ORDXP(ORDX)="" "RTN","PXAI",188,0) ; create array of passed DX; NDX - pointer to ^ICD9( "RTN","PXAI",189,0) S PXAK=0 F S PXAK=$O(@POVARR@("DX/PL",PXAK)) Q:PXAK="" D "RTN","PXAI",190,0) .S NDX=$G(@POVARR@("DX/PL",PXAK,"DIAGNOSIS")) S NDX(NDX)=PXAK "RTN","PXAI",191,0) ; force entry of originally primary diagnosis with "S" flag "RTN","PXAI",192,0) I PRIMFND S ORDX="" D "RTN","PXAI",193,0) .F S ORDX=$O(ORDXP(ORDX)) Q:ORDX="" I PRIMFND'=ORDX D "RTN","PXAI",194,0) ..I $D(NDX(ORDX)) S @POVARR@("DX/PL",NDX(ORDX),"PRIMARY")=0 "RTN","PXAI",195,0) ..E D "RTN","PXAI",196,0) ...S LPXAK=$O(@POVARR@("DX/PL",""),-1) "RTN","PXAI",197,0) ...S @POVARR@("DX/PL",LPXAK+1,"DIAGNOSIS")=ORDX "RTN","PXAI",198,0) ...S @POVARR@("DX/PL",LPXAK+1,"PRIMARY")=0 "RTN","PXAI",199,0) Q "RTN","PXAI",200,0) ; "RTN","PXAICPTV") 0^3^B15682833 "RTN","PXAICPTV",1,0) PXAICPTV ;ISL/JVS,ISA/KWP - VALADATE PROCEDURES(CPT) ;11/14/96 12:46 "RTN","PXAICPTV",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,73,74,111,121,130**;Aug 12, 1996 "RTN","PXAICPTV",3,0) ; "RTN","PXAICPTV",4,0) VAL ;--VALIDATE ENOUGH DATA "RTN","PXAICPTV",5,0) ;----Missing a pointer to PROCEDURE(CPT) name "RTN","PXAICPTV",6,0) I $G(PXAA("PROCEDURE"))']"" D Q:$G(STOP) "RTN","PXAICPTV",7,0) .S STOP=1 ;--USED TO STOP DO LOOP "RTN","PXAICPTV",8,0) .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR "RTN","PXAICPTV",9,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAICPTV",10,0) .S PXAERR(9)="PROCEDURE" "RTN","PXAICPTV",11,0) .S PXAERR(11)=$G(PXAA("PROCEDURE")) "RTN","PXAICPTV",12,0) .S PXAERR(12)="You are missing a pointer to the PROCEDURE CPT FILE#81 that represents the procedure's name" "RTN","PXAICPTV",13,0) ; "RTN","PXAICPTV",14,0) ;----NOT a pointer to PROCEDURE CPT FILE#81 "RTN","PXAICPTV",15,0) I '$D(^ICPT($G(PXAA("PROCEDURE")),0)) D Q:$G(STOP) "RTN","PXAICPTV",16,0) .S STOP=1 "RTN","PXAICPTV",17,0) .S PXAERRF=1 "RTN","PXAICPTV",18,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAICPTV",19,0) .S PXAERR(9)="PROCEDURE" "RTN","PXAICPTV",20,0) .S PXAERR(11)=$G(PXAA("PROCEDURE")) "RTN","PXAICPTV",21,0) .S PXAERR(12)=PXAERR(11)_" is NOT a pointer value to the CPT FILE #81" "RTN","PXAICPTV",22,0) ; "RTN","PXAICPTV",23,0) ;----Not a valid CPT "RTN","PXAICPTV",24,0) I '$P($$CPT^ICPTCOD(PXAA("PROCEDURE"),+^AUPNVSIT(PXAVISIT,0)),"^",7) D Q:$G(STOP) "RTN","PXAICPTV",25,0) .S STOP=1 "RTN","PXAICPTV",26,0) .S PXAERRF=1 "RTN","PXAICPTV",27,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAICPTV",28,0) .S PXAERR(9)="PROCEDURE" "RTN","PXAICPTV",29,0) .S PXAERR(11)=$G(PXAA("PROCEDURE")) "RTN","PXAICPTV",30,0) .S PXAERR(12)=PXAERR(11)_" is NOT a valid CPT code" "RTN","PXAICPTV",31,0) ; "RTN","PXAICPTV",32,0) ;----Not a valid modifier "RTN","PXAICPTV",33,0) N SUB,MODIEN "RTN","PXAICPTV",34,0) S SUB="" "RTN","PXAICPTV",35,0) F S SUB=$O(PXAA("MODIFIERS",SUB)) Q:SUB=""!($G(STOP)) D "RTN","PXAICPTV",36,0) .;S MODIEN=$$MODP^ICPTMOD(PXAA("PROCEDURE"),SUB,"E","",0) "RTN","PXAICPTV",37,0) .S MODIEN=$$MODP^ICPTMOD(PXAA("PROCEDURE"),SUB,"E",+^AUPNVSIT(PXAVISIT,0),0) "RTN","PXAICPTV",38,0) .I $P(MODIEN,"^")>0 Q "RTN","PXAICPTV",39,0) .S STOP=1 "RTN","PXAICPTV",40,0) .S PXAERRF=1 "RTN","PXAICPTV",41,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAICPTV",42,0) .S PXAERR(9)="MODIFIERS"_","_SUB "RTN","PXAICPTV",43,0) .S PXAERR(11)="" "RTN","PXAICPTV",44,0) .S PXAERR(12)=SUB_" is NOT a valid modifier for procedure "_$G(PXAA("PROCEDURE")) "RTN","PXAICPTV",45,0) ;----"Missing the number of times the procedure was performed. "RTN","PXAICPTV",46,0) I $G(PXAA("QTY"))<1 D "RTN","PXAICPTV",47,0) .S STOP=0 "RTN","PXAICPTV",48,0) .S PXAERRF=1 "RTN","PXAICPTV",49,0) .S PXADI("DIALOG")=8390001.002 "RTN","PXAICPTV",50,0) .S PXAERR(9)="QTY" "RTN","PXAICPTV",51,0) .S PXAERR(11)=$G(PXAA("QTY")) "RTN","PXAICPTV",52,0) .S PXAERR(12)="If this node is empty we will assume it should be '1'. If it is a less than '1' we will delete any reference to it in the data base." "RTN","PXAICPTV",53,0) ; "RTN","PXAICPTV",54,0) ; "RTN","PXAICPTV",55,0) Q "RTN","PXAICPTV",56,0) VAL04 ;---PROVIDER NARRATIVE "RTN","PXAICPTV",57,0) S STOP=1 "RTN","PXAICPTV",58,0) S PXAERRF=1 "RTN","PXAICPTV",59,0) S PXADI("DIALOG")=8390001.001 "RTN","PXAICPTV",60,0) S PXAERR(9)="NARRATIVE" "RTN","PXAICPTV",61,0) S PXAERR(11)=$G(PXAA("NARRATIVE")) "RTN","PXAICPTV",62,0) S PXAERR(12)="We are unable to retrive a narrative from the PROVIDER NARRATIVE file #9999999.27" "RTN","PXAICPTV",63,0) Q "RTN","PXAICPTV",64,0) VAL45 ;---PROVIDER NARRATIVE CATEGORY "RTN","PXAICPTV",65,0) S STOP=0 "RTN","PXAICPTV",66,0) S PXAERRF=1 "RTN","PXAICPTV",67,0) S PXADI("DIALOG")=8390001.002 "RTN","PXAICPTV",68,0) S PXAERR(9)="CATEGORY" "RTN","PXAICPTV",69,0) S PXAERR(11)=$G(PXAA("CATEGORY")) "RTN","PXAICPTV",70,0) S PXAERR(12)="We are unable to retrieve a narrative from the PROVIDER NARRATIVE file #9999999.27" "RTN","PXAICPTV",71,0) Q "RTN","PXAICPTV",72,0) ;---------------------SUBROUTINE------------------------------ "RTN","PXAICPTV",73,0) ARRAY ;--SET ERRORS AND WARNINGS INTO AN ARRAY TO RETURN TO CALLER "RTN","PXAICPTV",74,0) I PXADI("DIALOG")=8390001.001 D "RTN","PXAICPTV",75,0) .S PXASUB=PXASUB+1 "RTN","PXAICPTV",76,0) .S PXAPROB($J,PXASUB,"ERROR1",PXAERR(7),PXAERR(9),PXAK)=$G(PXAERR(12)) "RTN","PXAICPTV",77,0) I PXADI("DIALOG")=8390001.002 D "RTN","PXAICPTV",78,0) .S PXASUB=PXASUB+1 "RTN","PXAICPTV",79,0) .S PXAPROB($J,PXASUB,"WARNING2",PXAERR(7),PXAERR(9),PXAK)=$G(PXAERR(12)) "RTN","PXAICPTV",80,0) I PXADI("DIALOG")=8390001.003 D "RTN","PXAICPTV",81,0) .S PXASUB=PXASUB+1 "RTN","PXAICPTV",82,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"SC")=$G(PXAERR("6W")) "RTN","PXAICPTV",83,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"AO")=$G(PXAERR("7W")) "RTN","PXAICPTV",84,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"IR")=$G(PXAERR("8W")) "RTN","PXAICPTV",85,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"EC")=$G(PXAERR("9W")) "RTN","PXAICPTV",86,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"MST")=$G(PXAERR("10W")) "RTN","PXAICPTV",87,0) .;PX*1*111 - Add HNC "RTN","PXAICPTV",88,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"HNC")=$G(PXAERR("17W")) "RTN","PXAICPTV",89,0) .S PXAPROB($J,PXASUB,"WARNING3","ENCOUNTER",1,"CV")=$G(PXAERR("18W")) "RTN","PXAICPTV",90,0) I PXADI("DIALOG")=8390001.004 D "RTN","PXAICPTV",91,0) .S PXASUB=PXASUB+1 "RTN","PXAICPTV",92,0) .S PXAPROB($J,PXASUB,"ERROR4","PX/DL",PXAK)=$G(PXAERR("PL1")) "RTN","PXAICPTV",93,0) Q "RTN","PXAIPOV") 0^6^B19585929 "RTN","PXAIPOV",1,0) PXAIPOV ;ISL/JVS,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ; 6/25/03 2:05pm "RTN","PXAIPOV",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112,130**;Aug 12, 1996 "RTN","PXAIPOV",3,0) ; "RTN","PXAIPOV",4,0) Q "RTN","PXAIPOV",5,0) POV ;--CREATE DIAGNOSIS "RTN","PXAIPOV",6,0) ; "RTN","PXAIPOV",7,0) SET ;--SET AND NEW VARIABLES "RTN","PXAIPOV",8,0) N AFTER0,AFTER12,AFTER800,AFTER801,AFTER811,AFTER802,AFTER812 "RTN","PXAIPOV",9,0) N BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR811,BEFOR802,BEFOR812 "RTN","PXAIPOV",10,0) N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP,VAR,AFTER8A "RTN","PXAIPOV",11,0) N FPRI,J,LNARR,GMPSAVED,NOPLLIST,PXDIGNS,VAR,PRI "RTN","PXAIPOV",12,0) N POVI,PRVDR,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXKDONE "RTN","PXAIPOV",13,0) ; "RTN","PXAIPOV",14,0) K PXAERR "RTN","PXAIPOV",15,0) S PXAERR(8)=PXAK "RTN","PXAIPOV",16,0) S PXAERR(7)="DX/PL" "RTN","PXAIPOV",17,0) ; "RTN","PXAIPOV",18,0) S SUB="" F S SUB=$O(@PXADATA@("DX/PL",PXAK,SUB)) Q:SUB="" D "RTN","PXAIPOV",19,0) .S PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB) "RTN","PXAIPOV",20,0) ; "RTN","PXAIPOV",21,0) ;--VALIDATE ENOUGH DATA "RTN","PXAIPOV",22,0) D VAL^PXAIPOVV Q:$G(STOP) "RTN","PXAIPOV",23,0) ; "RTN","PXAIPOV",24,0) SETVARA ;--SET VISIT VARIABLES "RTN","PXAIPOV",25,0) S $P(AFTER0,"^",1)=$G(PXAA("DIAGNOSIS")) "RTN","PXAIPOV",26,0) I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@" "RTN","PXAIPOV",27,0) S $P(AFTER0,"^",2)=$G(PATIENT),PXAA("PATIENT")=$G(PATIENT) "RTN","PXAIPOV",28,0) S $P(AFTER0,"^",3)=$G(PXAVISIT) "RTN","PXAIPOV",29,0) S $P(AFTER0,"^",4)=$G(PXAA("NARRATIVE")) D "RTN","PXAIPOV",30,0) .I $G(PXAA("NARRATIVE"))']""!($L($G(PXAA("NARRATIVE")))>245) D "RTN","PXAIPOV",31,0) ..S PXAA("NARRATIVE")=$$EXTTEXT^PXUTL1($G(PXAA("DIAGNOSIS")),1,80,10,3) ;--TEXT OF NARRATIVE "RTN","PXAIPOV",32,0) .S $P(AFTER0,"^",4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.07) "RTN","PXAIPOV",33,0) S $P(AFTER0,"^",12)=$S($G(PXAA("PRIMARY"))=1:"P",1:"S") "RTN","PXAIPOV",34,0) ;--ADDED FOR PATCH 28 "RTN","PXAIPOV",35,0) S $P(AFTER0,"^",15)=$G(PXAA("LEXICON TERM")) "RTN","PXAIPOV",36,0) S $P(AFTER0,"^",16)=$G(PXAA("PL IEN")) "RTN","PXAIPOV",37,0) ;--END OF NEW PATCH 28 "RTN","PXAIPOV",38,0) S $P(AFTER12,"^",1)=$G(PXAA("EVENT D/T")) "RTN","PXAIPOV",39,0) S $P(AFTER12,"^",4)=$G(PXAA("ENC PROVIDER")) "RTN","PXAIPOV",40,0) ;PX*1*108 "RTN","PXAIPOV",41,0) I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D "RTN","PXAIPOV",42,0) .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))="" "RTN","PXAIPOV",43,0) ; "RTN","PXAIPOV",44,0) I $G(PXAA("CATEGORY"))]"" S $P(AFTER802,"^",1)=+$$PROVNARR^PXAPI($G(PXAA("CATEGORY")),9000010.07) "RTN","PXAIPOV",45,0) S $P(AFTER811,"^",1)=$G(PXAA("COMMENT")) "RTN","PXAIPOV",46,0) ; "RTN","PXAIPOV",47,0) ; "RTN","PXAIPOV",48,0) ; "RTN","PXAIPOV",49,0) ; "RTN","PXAIPOV",50,0) S $P(AFTER800,"^",1)=$G(PXAA("PL SC")) "RTN","PXAIPOV",51,0) S $P(AFTER800,"^",2)=$G(PXAA("PL AO")) "RTN","PXAIPOV",52,0) S $P(AFTER800,"^",3)=$G(PXAA("PL IR")) "RTN","PXAIPOV",53,0) S $P(AFTER800,"^",4)=$G(PXAA("PL EC")) "RTN","PXAIPOV",54,0) S $P(AFTER800,U,5)=$G(PXAA("PL MST")) "RTN","PXAIPOV",55,0) S $P(AFTER800,U,6)=$G(PXAA("PL HNC")) "RTN","PXAIPOV",56,0) S $P(AFTER800,U,7)=$G(PXAA("PL CV")) "RTN","PXAIPOV",57,0) ; "RTN","PXAIPOV",58,0) ; "RTN","PXAIPOV",59,0) ; "RTN","PXAIPOV",60,0) D SCC^PXUTLSCC(PATIENT,$P($G(^AUPNVSIT(PXAVISIT,0)),"^",1),$P($G(^AUPNVSIT(PXAVISIT,0)),"^",22),$G(PXAVISIT),AFTER800,.AFTER800) "RTN","PXAIPOV",61,0) ; "RTN","PXAIPOV",62,0) S $P(AFTER812,"^",3)=$G(PXASOURC) "RTN","PXAIPOV",63,0) S $P(AFTER812,"^",2)=$G(PXAPKG) "RTN","PXAIPOV",64,0) ; "RTN","PXAIPOV",65,0) D PL^PXAIPL "RTN","PXAIPOV",66,0) ; "RTN","PXAIPOV",67,0) ; "RTN","PXAIPOV",68,0) SETPXKA ;--SET PXK ARRAY AFTER "RTN","PXAIPOV",69,0) S ^TMP("PXK",$J,"POV",PXAK,0,"AFTER")=$G(AFTER0) "RTN","PXAIPOV",70,0) S ^TMP("PXK",$J,"POV",PXAK,12,"AFTER")=$G(AFTER12) "RTN","PXAIPOV",71,0) S ^TMP("PXK",$J,"POV",PXAK,800,"AFTER")=$G(AFTER800) "RTN","PXAIPOV",72,0) S ^TMP("PXK",$J,"POV",PXAK,802,"AFTER")=$G(AFTER802) "RTN","PXAIPOV",73,0) S ^TMP("PXK",$J,"POV",PXAK,811,"AFTER")=$G(AFTER811) "RTN","PXAIPOV",74,0) S ^TMP("PXK",$J,"POV",PXAK,812,"AFTER")=$G(AFTER812) "RTN","PXAIPOV",75,0) ; "RTN","PXAIPOV",76,0) SETVARB ;--SET VARIABLES BEFORE "RTN","PXAIPOV",77,0) ; "RTN","PXAIPOV",78,0) ;--GET IEN FOR 'PXK NODE' "RTN","PXAIPOV",79,0) D POV^PXBGPOV(PXAVISIT) "RTN","PXAIPOV",80,0) I $D(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")))) D "RTN","PXAIPOV",81,0) .S (^TMP("PXK",$J,"POV",PXAK,"IEN"),IENB)=$O(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")),0)) "RTN","PXAIPOV",82,0) K ^TMP("PXBGPOVMATCH",$J) "RTN","PXAIPOV",83,0) ; "RTN","PXAIPOV",84,0) BEFOR ; "RTN","PXAIPOV",85,0) I $G(IENB) D "RTN","PXAIPOV",86,0) .F PIECE=0,12,800,802,811 S ^TMP("PXK",$J,"POV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPOV(IENB,PIECE)) "RTN","PXAIPOV",87,0) .K ^TMP("PXK",$J,"POV",PXAK,812) "RTN","PXAIPOV",88,0) E D "RTN","PXAIPOV",89,0) .S (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)="" "RTN","PXAIPOV",90,0) .; "RTN","PXAIPOV",91,0) SETPXKB .;--SET PXK ARRAY BEFORE "RTN","PXAIPOV",92,0) .S ^TMP("PXK",$J,"POV",PXAK,0,"BEFORE")=$G(BEFOR0) "RTN","PXAIPOV",93,0) .S ^TMP("PXK",$J,"POV",PXAK,12,"BEFORE")=$G(BEFOR12) "RTN","PXAIPOV",94,0) .S ^TMP("PXK",$J,"POV",PXAK,800,"BEFORE")=$G(BEFOR800) "RTN","PXAIPOV",95,0) .S ^TMP("PXK",$J,"POV",PXAK,802,"BEFORE")=$G(BEFOR802) "RTN","PXAIPOV",96,0) .S ^TMP("PXK",$J,"POV",PXAK,811,"BEFORE")=$G(BEFOR811) "RTN","PXAIPOV",97,0) .S ^TMP("PXK",$J,"POV",PXAK,812,"BEFORE")=$G(BEFOR812) "RTN","PXAIPOV",98,0) .S ^TMP("PXK",$J,"POV",PXAK,"IEN")="" "RTN","PXAIPOV",99,0) ; "RTN","PXAIPOV",100,0) MISC ;--MISCELLANEOUS NODE "RTN","PXAIPOV",101,0) ; "RTN","PXAIPOV",102,0) Q "RTN","PXAIPOV",103,0) PRIM ;--SET A PROVIDER AS PRIMARY "RTN","PXAIPOV",104,0) N PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI ;108 "RTN","PXAIPOV",105,0) D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI) ;108 "RTN","PXAIPOV",106,0) I $D(PRVDR) Q "RTN","PXAIPOV",107,0) I '$D(PXBSKY) Q "RTN","PXAIPOV",108,0) ; "RTN","PXAIPOV",109,0) S $P(AFTER0,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1) "RTN","PXAIPOV",110,0) S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5) "RTN","PXAIPOV",111,0) S $P(AFTER0,"^",3)=PXAVISIT "RTN","PXAIPOV",112,0) S $P(AFTER0,"^",4)="P" "RTN","PXAIPOV",113,0) S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0 "RTN","PXAIPOV",114,0) S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0)) "RTN","PXAIPOV",115,0) S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0)) "RTN","PXAIPOV",116,0) D EN1^PXKMAIN "RTN","PXAIPOV",117,0) K PXRDR "RTN","PXAIPOV",118,0) K ^TMP("PXBGPOVMATCH",$J) "RTN","PXAIPOV",119,0) Q "RTN","PXAIVST") 0^8^B14872845 "RTN","PXAIVST",1,0) PXAIVST ;ISL/JVS,KWP,ESW - GET A VISIT FROM ENCOUNTER NODE ; 11/20/02 4:38pm "RTN","PXAIVST",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,9,15,74,111,96,130**;Aug 12, 1996 "RTN","PXAIVST",3,0) ; "RTN","PXAIVST",4,0) ; "RTN","PXAIVST",5,0) Q "RTN","PXAIVST",6,0) VST ;--CREAT A VISIT "RTN","PXAIVST",7,0) ; "RTN","PXAIVST",8,0) SET ;--SET AND NEW VARIABLES "RTN","PXAIVST",9,0) N AFTER0,AFTER21,AFTER800,AFTER150,BEFOR0,BEFOR21,BEFOR800,BEFOR150 "RTN","PXAIVST",10,0) N AFTER811,BEFOR811,BEFOR812 "RTN","PXAIVST",11,0) N PXAA,PXAB,SUB,PIECE,STOP "RTN","PXAIVST",12,0) N AFTER8A,AFTER812 "RTN","PXAIVST",13,0) ; "RTN","PXAIVST",14,0) S SUB="" F S SUB=$O(@PXADATA@("ENCOUNTER",1,SUB)) Q:SUB="" D "RTN","PXAIVST",15,0) .S PXAA(SUB)=@PXADATA@("ENCOUNTER",1,SUB) "RTN","PXAIVST",16,0) ; "RTN","PXAIVST",17,0) S (AFTER812,BEFOR812)="" "RTN","PXAIVST",18,0) ; "RTN","PXAIVST",19,0) S PXAK=1 "RTN","PXAIVST",20,0) S PXAERR(8)=1 "RTN","PXAIVST",21,0) S PXAERR(7)="ENCOUNTER" "RTN","PXAIVST",22,0) ; "RTN","PXAIVST",23,0) VAL ;--VALIDATE ENOUGH DATA "RTN","PXAIVST",24,0) I $D(@PXADATA@("ENCOUNTER")) D VAL^PXAIVSTV Q:$G(STOP) "RTN","PXAIVST",25,0) I $G(PXAVISIT) S (PATIENT,PXAA("PATIENT"))=$P(^AUPNVSIT(PXAVISIT,0),"^",5) S PXAA("ENC D/T")=$P(^AUPNVSIT(PXAVISIT,0),"^",1) "RTN","PXAIVST",26,0) ; "RTN","PXAIVST",27,0) SETVARA ;--SET VISIT VARIABLES "RTN","PXAIVST",28,0) S $P(AFTER0,"^",1)=$G(PXAA("ENC D/T")) "RTN","PXAIVST",29,0) ;PX*1*96 - Set TYPE (Piece #3) according to following; "RTN","PXAIVST",30,0) ; 1. If OUTSIDE LOCATION then TYPE is "O" "RTN","PXAIVST",31,0) ; 2. If no OUTSIDE LOCATION but INSTITUTION then TYPE is "V" "RTN","PXAIVST",32,0) ; 3. Else set to value of DUZ("AG") "RTN","PXAIVST",33,0) ;Set TYPE "RTN","PXAIVST",34,0) I $L($G(PXAA("OUTSIDE LOCATION"))) S $P(AFTER0,U,3)="O" "RTN","PXAIVST",35,0) E I $L($G(PXAA("INSTITUTION"))) S $P(AFTER0,U,3)="V" "RTN","PXAIVST",36,0) E S $P(AFTER0,U,3)=$G(DUZ("AG")) "RTN","PXAIVST",37,0) S $P(AFTER0,"^",5)=$G(PXAA("PATIENT")) "RTN","PXAIVST",38,0) S $P(AFTER0,"^",6)=$G(PXAA("INSTITUTION")) "RTN","PXAIVST",39,0) S $P(AFTER0,"^",7)=$G(PXAA("SERVICE CATEGORY")) "RTN","PXAIVST",40,0) S $P(AFTER0,"^",8)="" ;$G(PXAA("DSS ID")) "RTN","PXAIVST",41,0) S $P(AFTER0,"^",12)=$G(PXAA("PARENT")) "RTN","PXAIVST",42,0) S $P(AFTER0,"^",18)=$G(PXAA("CHECKOUT D/T")) "RTN","PXAIVST",43,0) S $P(AFTER0,"^",21)=$G(PXAA("ELIGIBILITY")) "RTN","PXAIVST",44,0) S $P(PXELAP,"^",1)=$G(PXAA("ELIGIBILITY")) "RTN","PXAIVST",45,0) S $P(PXELAP,"^",3)=$G(PXAA("APPT")) "RTN","PXAIVST",46,0) S $P(AFTER0,"^",22)=$G(PXAA("HOS LOC")) "RTN","PXAIVST",47,0) S $P(AFTER800,"^",1)=$G(PXAA("SC")) "RTN","PXAIVST",48,0) S $P(AFTER800,"^",2)=$G(PXAA("AO")) "RTN","PXAIVST",49,0) S $P(AFTER800,"^",3)=$G(PXAA("IR")) "RTN","PXAIVST",50,0) S $P(AFTER800,"^",4)=$G(PXAA("EC")) "RTN","PXAIVST",51,0) S $P(AFTER800,"^",5)=$G(PXAA("MST")) "RTN","PXAIVST",52,0) ;PX*1*111 - Add HNC "RTN","PXAIVST",53,0) S $P(AFTER800,"^",6)=$G(PXAA("HNC")) "RTN","PXAIVST",54,0) S $P(AFTER800,"^",7)=$G(PXAA("CV")) "RTN","PXAIVST",55,0) ;--VALIDATE SERVICE CONNECTEDNESS "RTN","PXAIVST",56,0) ; "RTN","PXAIVST",57,0) S AFTER8A=AFTER800 D VALSCC^PXAIVSTV "RTN","PXAIVST",58,0) S AFTER800=AFTER8A "RTN","PXAIVST",59,0) ; "RTN","PXAIVST",60,0) S $P(AFTER21,"^",1)=$G(PXAA("OUTSIDE LOCATION")) ;PX/96 "RTN","PXAIVST",61,0) S $P(AFTER150,"^",3)=$G(PXAA("ENCOUNTER TYPE")) "RTN","PXAIVST",62,0) S $P(AFTER811,"^",1)=$G(PXAA("COMMENT")) "RTN","PXAIVST",63,0) S $P(AFTER812,"^",3)=$G(PXASOURC) "RTN","PXAIVST",64,0) SETPXKA ;--SET PXK ARRAY AFTER "RTN","PXAIVST",65,0) S ^TMP("PXK",$J,"VST",1,0,"AFTER")=AFTER0 "RTN","PXAIVST",66,0) S ^TMP("PXK",$J,"VST",1,21,"AFTER")=AFTER21 "RTN","PXAIVST",67,0) S ^TMP("PXK",$J,"VST",1,150,"AFTER")=AFTER150 "RTN","PXAIVST",68,0) S ^TMP("PXK",$J,"VST",1,800,"AFTER")=AFTER800 "RTN","PXAIVST",69,0) S ^TMP("PXK",$J,"VST",1,811,"AFTER")=AFTER811 "RTN","PXAIVST",70,0) S ^TMP("PXK",$J,"VST",1,812,"AFTER")=AFTER812 "RTN","PXAIVST",71,0) SETVARB ;--SET VARIABLES BEFORE "RTN","PXAIVST",72,0) I $G(PXAVISIT) D "RTN","PXAIVST",73,0) .F PIECE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PIECE,"BEFORE")=$G(^AUPNVSIT(PXAVISIT,PIECE)) "RTN","PXAIVST",74,0) .I '$D(@PXADATA@("ENCOUNTER")) D "RTN","PXAIVST",75,0) ..F PIECE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PIECE,"AFTER")=$G(^AUPNVSIT(PXAVISIT,PIECE)) "RTN","PXAIVST",76,0) E D "RTN","PXAIVST",77,0) .S (BEFOR0,BEFOR21,BEFOR150,BEFOR800,BEFOR811)="" "RTN","PXAIVST",78,0) .; "RTN","PXAIVST",79,0) SETPXKB .;--SET PXK ARRAY BEFORE "RTN","PXAIVST",80,0) .S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=BEFOR0 "RTN","PXAIVST",81,0) .S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=BEFOR21 "RTN","PXAIVST",82,0) .S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=BEFOR150 "RTN","PXAIVST",83,0) .S ^TMP("PXK",$J,"VST",1,800,"BEFORE")=BEFOR800 "RTN","PXAIVST",84,0) .S ^TMP("PXK",$J,"VST",1,811,"BEFORE")=BEFOR811 "RTN","PXAIVST",85,0) .S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=BEFOR812 "RTN","PXAIVST",86,0) MISC ;--MISCELLANEOUS NODE "RTN","PXAIVST",87,0) S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXAVISIT) "RTN","PXAIVST",88,0) ; "RTN","PXAIVST",89,0) CALL ;--CALL "RTN","PXAIVST",90,0) S PXALOOK=$$LOOKVSIT^PXUTLVST($P(AFTER0,U,5),$P(AFTER0,U),$P(AFTER0,U,22),$P(AFTER0,"^",8),$P(AFTER0,U,6)) I $G(PXALOOK)>0 S PXAVISIT=PXALOOK ;PX/96 - included INSTITUTION - $P(AFTER0,U,6) "RTN","PXAIVST",91,0) D EN1^PXKMAIN "RTN","PXAIVST",92,0) I '$G(PXAVISIT) S PXAVISIT=$G(^TMP("PXK",$J,"VST",1,"IEN")) "RTN","PXAIVST",93,0) Q "RTN","PXAIVSTV") 0^16^B54821718 "RTN","PXAIVSTV",1,0) PXAIVSTV ;ISL/JVS,ISA/KWP - VALIDATE THE VISIT DATA ;04/28/99 "RTN","PXAIVSTV",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,15,19,74,111,116,130**;Aug 12, 1996 "RTN","PXAIVSTV",3,0) ; "RTN","PXAIVSTV",4,0) ; "RTN","PXAIVSTV",5,0) Q "RTN","PXAIVSTV",6,0) VALSCC ;--VALIDATE SERVICE CONNECTIVENESS "RTN","PXAIVSTV",7,0) N ERR,ERR1 "RTN","PXAIVSTV",8,0) D SCC^PXUTLSCC($G(PXAA("PATIENT")),$G(PXAA("ENC D/T")),$G(PXAA("HOS LOC")),$G(PXAVISIT),$G(AFTER800),.AFTER8A,.ERR) "RTN","PXAIVSTV",9,0) ;PX*1*111 - Add HNC "RTN","PXAIVSTV",10,0) I $P(ERR,"^",1)=0,$P(ERR,"^",2)=0,$P(ERR,"^",3)=0,$P(ERR,"^",4)=0,$P(ERR,"^",5)=0,$P(ERR,"^",6)=0,$P(ERR,"^",7)=0 Q "RTN","PXAIVSTV",11,0) S PXADI("DIALOG")=8390001.003 "RTN","PXAIVSTV",12,0) S PXAERRF=1 "RTN","PXAIVSTV",13,0) S PXAERR("1W")=$S($P(AFTER800,"^",1)']"":"NULL",1:$P(AFTER800,"^",1)) "RTN","PXAIVSTV",14,0) S PXAERR("2W")=$S($P(AFTER800,"^",2)']"":"NULL",1:$P(AFTER800,"^",2)) "RTN","PXAIVSTV",15,0) S PXAERR("3W")=$S($P(AFTER800,"^",3)']"":"NULL",1:$P(AFTER800,"^",3)) "RTN","PXAIVSTV",16,0) S PXAERR("4W")=$S($P(AFTER800,"^",4)']"":"NULL",1:$P(AFTER800,"^",4)) "RTN","PXAIVSTV",17,0) S PXAERR("5W")=$S($P(AFTER800,"^",5)']"":"NULL",1:$P(AFTER800,"^",5)) "RTN","PXAIVSTV",18,0) ;PX*1*111 - Add HNC "RTN","PXAIVSTV",19,0) S PXAERR("16W")=$S($P(AFTER800,"^",6)']"":"NULL",1:$P(AFTER800,"^",6)) "RTN","PXAIVSTV",20,0) S PXAERR("19W")=$S($P(AFTER800,"^",7)']"":"NULL",1:$P(AFTER800,"^",7)) "RTN","PXAIVSTV",21,0) S ERR1=$P(ERR,"^",1),PXAERR("6W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",22,0) S ERR1=$P(ERR,"^",2),PXAERR("7W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",23,0) S ERR1=$P(ERR,"^",3),PXAERR("8W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",24,0) S ERR1=$P(ERR,"^",4),PXAERR("9W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",25,0) S ERR1=$P(ERR,"^",5),PXAERR("10W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",26,0) ;PX*1*111 - Add HNC "RTN","PXAIVSTV",27,0) S ERR1=$P(ERR,"^",6),PXAERR("17W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",28,0) S ERR1=$P(ERR,"^",7),PXAERR("20W")=$S(ERR1=1:"Should be a YES or NO!, not NULL",ERR1=0:"No error",ERR1=-1:"Not a valid value",ERR1=-2:"Value must be NULL",ERR1=-3:"Must be NULL because Service Connected is yes",1:"") "RTN","PXAIVSTV",29,0) S PXAERR("11W")=$S($P(AFTER8A,"^",1)']"":"NULL",1:$P(AFTER8A,"^",1)) "RTN","PXAIVSTV",30,0) S PXAERR("12W")=$S($P(AFTER8A,"^",2)']"":"NULL",1:$P(AFTER8A,"^",2)) "RTN","PXAIVSTV",31,0) S PXAERR("13W")=$S($P(AFTER8A,"^",3)']"":"NULL",1:$P(AFTER8A,"^",3)) "RTN","PXAIVSTV",32,0) S PXAERR("14W")=$S($P(AFTER8A,"^",4)']"":"NULL",1:$P(AFTER8A,"^",4)) "RTN","PXAIVSTV",33,0) S PXAERR("15W")=$S($P(AFTER8A,"^",5)']"":"NULL",1:$P(AFTER8A,"^",5)) "RTN","PXAIVSTV",34,0) ;PX*1*111 - Add HNC "RTN","PXAIVSTV",35,0) S PXAERR("18W")=$S($P(AFTER8A,"^",6)']"":"NULL",1:$P(AFTER8A,"^",6)) "RTN","PXAIVSTV",36,0) S PXAERR("21W")=$S($P(AFTER8A,"^",7)']"":"NULL",1:$P(AFTER8A,"^",7)) "RTN","PXAIVSTV",37,0) D ERR^PXAI K PXAERRF "RTN","PXAIVSTV",38,0) Q "RTN","PXAIVSTV",39,0) ; "RTN","PXAIVSTV",40,0) VAL ;--VALIDATE ENOUGH DATA "RTN","PXAIVSTV",41,0) ; "RTN","PXAIVSTV",42,0) ;---Is the visit sent TO US valid? "RTN","PXAIVSTV",43,0) I $G(PXAVISIT) D Q:$D(STOP) "RTN","PXAIVSTV",44,0) .I '$D(^AUPNVSIT(PXAVISIT,0)) D Q:$G(STOP) "RTN","PXAIVSTV",45,0) ..S STOP=1 "RTN","PXAIVSTV",46,0) ..S PXAERRF=1 "RTN","PXAIVSTV",47,0) ..S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",48,0) ..S PXAERR(11)=$G(PXAVISIT) "RTN","PXAIVSTV",49,0) ..S PXAERR(12)="The value that was sent to us is not a valid visit in the VISIT file # 9000010. The Patients name will be derived from the visit file and could cause the data to be given to the wrong patient if not correct." "RTN","PXAIVSTV",50,0) ..S PXAERR(13)="If the correct VISIT isn't known, set the 'ENCOUNTER' array and we will look it up or create a correct one. Setting both at the same time will only add confusion as to what data is correct." "RTN","PXAIVSTV",51,0) Q:$G(PXAVISIT) "RTN","PXAIVSTV",52,0) ; "RTN","PXAIVSTV",53,0) ;----Missing a date and time of visit "RTN","PXAIVSTV",54,0) I $G(PXAA("ENC D/T"))']"" D Q:$G(STOP) "RTN","PXAIVSTV",55,0) .S STOP=1 ;--USED TO STOP DO LOOP "RTN","PXAIVSTV",56,0) .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR "RTN","PXAIVSTV",57,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",58,0) .S PXAERR(9)="ENC D/T" "RTN","PXAIVSTV",59,0) .S PXAERR(11)=$G(PXAA("ENC D/T")) "RTN","PXAIVSTV",60,0) .S PXAERR(12)="You are missing the date and time of the visit in FileManager internal format." "RTN","PXAIVSTV",61,0) ; "RTN","PXAIVSTV",62,0) ;----Missing Time and not Historical Visit "RTN","PXAIVSTV",63,0) I $L($G(PXAA("ENC D/T")),".")=1,$G(PXAA("SERVICE CATEGORY"))'="E" D "RTN","PXAIVSTV",64,0) .S STOP=1 ;--USED TO STOP DO LOOP "RTN","PXAIVSTV",65,0) .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR "RTN","PXAIVSTV",66,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",67,0) .S PXAERR(9)="ENC D/T" "RTN","PXAIVSTV",68,0) .S PXAERR(11)=$G(PXAA("ENC D/T")) "RTN","PXAIVSTV",69,0) .S PXAERR(12)="You are missing the TIME of the visit in FileManager internal format. Unless this is an HISTORICAL encounter, you must have the time." "RTN","PXAIVSTV",70,0) ; "RTN","PXAIVSTV",71,0) ; "RTN","PXAIVSTV",72,0) ; "RTN","PXAIVSTV",73,0) ;----MISSING a pointer to PATIENT/IHS FILE # 9000001 "RTN","PXAIVSTV",74,0) I $G(PXAA("PATIENT"))']"" D Q:$G(STOP) "RTN","PXAIVSTV",75,0) .S STOP=1 "RTN","PXAIVSTV",76,0) .S PXAERRF=1 "RTN","PXAIVSTV",77,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",78,0) .S PXAERR(9)="PATIENT" "RTN","PXAIVSTV",79,0) .S PXAERR(11)=$G(PXAA("PATIENT")) "RTN","PXAIVSTV",80,0) .S PXAERR(12)="Missing a pointer to the PATIENT/IHS file #9000001" "RTN","PXAIVSTV",81,0) ; "RTN","PXAIVSTV",82,0) ; "RTN","PXAIVSTV",83,0) ;----Not a pointer to the PATIENT/IHS file #9000001 "RTN","PXAIVSTV",84,0) I '$D(^AUPNPAT($G(PXAA("PATIENT")),0)) D Q:$G(STOP) "RTN","PXAIVSTV",85,0) .S STOP=1 "RTN","PXAIVSTV",86,0) .S PXAERRF=1 "RTN","PXAIVSTV",87,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",88,0) .S PXAERR(9)="PATIENT" "RTN","PXAIVSTV",89,0) .S PXAERR(11)=$G(PXAA("PATIENT")) "RTN","PXAIVSTV",90,0) .S PXAERR(12)="This value is not a pointer to file PATIENT/IHS file # 9000001" "RTN","PXAIVSTV",91,0) ; "RTN","PXAIVSTV",92,0) ;---Missing required information "RTN","PXAIVSTV",93,0) I $G(PXAA("OUTSIDE LOC"))']"",$G(PXAA("HOS LOC"))']"",$G(PXAA("SERVICE CATEGORY"))'="E" D Q:$G(STOP) "RTN","PXAIVSTV",94,0) .S STOP=1 "RTN","PXAIVSTV",95,0) .S PXAERRF=1 "RTN","PXAIVSTV",96,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",97,0) .S PXAERR(9)="HOS LOC or OUTSIDE LOC" "RTN","PXAIVSTV",98,0) .S PXAERR(11)="BOTH ENTRIES ARE NULL AND SERVICE CATEGORY IS NOT ""E""" "RTN","PXAIVSTV",99,0) .S PXAERR(12)="The HOSPITAL LOCATION (pointer to the HOSPITAL LOCATION file #44 ) needs to be sent in order to create a visit." "RTN","PXAIVSTV",100,0) ; "RTN","PXAIVSTV",101,0) ;---not a pointer to hospital location file "RTN","PXAIVSTV",102,0) I $D(PXAA("HOS LOC")) D Q:$G(STOP) "RTN","PXAIVSTV",103,0) .I '$D(^SC($G(PXAA("HOS LOC")),0)) D Q:$G(STOP) "RTN","PXAIVSTV",104,0) ..S STOP=1 "RTN","PXAIVSTV",105,0) ..S PXAERRF=1 "RTN","PXAIVSTV",106,0) ..S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",107,0) ..S PXAERR(9)="HOS LOC" "RTN","PXAIVSTV",108,0) ..S PXAERR(11)=$G(PXAA("HOS LOC")) "RTN","PXAIVSTV",109,0) ..S PXAERR(12)="This HOSPITAL LOCATION is not a pointer to the HOSPITAL LOCATION file #44" "RTN","PXAIVSTV",110,0) ;---hospital location is the dispositioning location "RTN","PXAIVSTV",111,0) ;Allow a dispositioning location to be used "RTN","PXAIVSTV",112,0) ;I $D(PXAA("HOS LOC")) D Q:$G(STOP) ;PX*1.0*116 "RTN","PXAIVSTV",113,0) ;.I $D(^PX(815,1,"DHL","B",$G(PXAA("HOS LOC")))) D Q:$G(STOP) "RTN","PXAIVSTV",114,0) ;..S STOP=1 "RTN","PXAIVSTV",115,0) ;..S PXAERRF=1 "RTN","PXAIVSTV",116,0) ;..S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",117,0) ;..S PXAERR(9)="HOS LOC" "RTN","PXAIVSTV",118,0) ;..S PXAERR(11)=$G(PXAA("HOS LOC")) "RTN","PXAIVSTV",119,0) ;..S PXAERR(12)="This HOSPITAL LOCATION is a dispositioning location and cannot be used. Refer to entries in file#815 PCE PARAMETERS" "RTN","PXAIVSTV",120,0) ;--Not a service category "RTN","PXAIVSTV",121,0) I '$D(PXAA("SERVICE CATEGORY")) D Q:$G(STOP) "RTN","PXAIVSTV",122,0) .S STOP=1 "RTN","PXAIVSTV",123,0) .S PXAERRF=1 "RTN","PXAIVSTV",124,0) .S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",125,0) .S PXAERR(9)="SERVICE CATEGORY" "RTN","PXAIVSTV",126,0) .S PXAERR(11)=$G(PXAA("SERVICE CATEGORY")) "RTN","PXAIVSTV",127,0) .S PXAERR(12)="SERVICE CATEGORY is a required field" "RTN","PXAIVSTV",128,0) Q "RTN","PXAIVSTV",129,0) ; "RTN","PXAIVSTV",130,0) VPTR ;---Is the visit sent TO US valid? "RTN","PXAIVSTV",131,0) I $G(PXAVISIT) D Q:$D(STOP) "RTN","PXAIVSTV",132,0) .I '$D(^AUPNVSIT(PXAVISIT,0)) D Q:$G(STOP) "RTN","PXAIVSTV",133,0) ..S STOP=1 "RTN","PXAIVSTV",134,0) ..S PXAK=1 "RTN","PXAIVSTV",135,0) ..S PXAERRF=1 "RTN","PXAIVSTV",136,0) ..S PXADI("DIALOG")=8390001.001 "RTN","PXAIVSTV",137,0) ..S PXAERR(7)="ENCOUNTER" "RTN","PXAIVSTV",138,0) ..S PXAERR(9)="GENERAL NATURE" "RTN","PXAIVSTV",139,0) ..S PXAERR(11)=$G(PXAVISIT) "RTN","PXAIVSTV",140,0) ..S PXAERR(12)="The value that was sent to us is not a valid visit in the VISIT file # 9000010. The Patients name will be derived from the visit file and could cause the data to be given to the wrong patient if not correct." "RTN","PXAIVSTV",141,0) ..S PXAERR(13)="If the correct VISIT isn't known, set the 'ENCOUNTER' array and we will look it up or create a correct one. Setting both at the same time will only add confusion as to what data is correct." "RTN","PXAIVSTV",142,0) Q:$G(PXAVISIT) "RTN","PXAIVSTV",143,0) Q "RTN","PXAPIDEL") 0^36^B29773548 "RTN","PXAPIDEL",1,0) PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;11/4/96 "RTN","PXAPIDEL",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130**;Aug 12, 1996 "RTN","PXAPIDEL",3,0) Q "RTN","PXAPIDEL",4,0) ; "RTN","PXAPIDEL",5,0) DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER) ;Deletes the requesed data related to the visit. "RTN","PXAPIDEL",6,0) ; PXAWHICH is a ^ delimited string with the last two or three letters "RTN","PXAPIDEL",7,0) ; of the v-files to delete entries from and VISIT for the "RTN","PXAPIDEL",8,0) ; administative data on the visit and STOP for the stop codes. "RTN","PXAPIDEL",9,0) ; (e.g. for immunization the v-file is AUPNVIMM so IMM is "RTN","PXAPIDEL",10,0) ; passed.) Or "ALL" to delete all of the data form the "RTN","PXAPIDEL",11,0) ; V-Files, the Stop Code and Visit. "RTN","PXAPIDEL",12,0) ; PXAVISIT is pointer to a visit for which the related data is be "RTN","PXAPIDEL",13,0) ; deleted. "RTN","PXAPIDEL",14,0) ; PACKAGE (optional) if passed will only delete items created by "RTN","PXAPIDEL",15,0) ; this package "RTN","PXAPIDEL",16,0) ; SOURCE (optional) if passed will only delete items created by "RTN","PXAPIDEL",17,0) ; this source "RTN","PXAPIDEL",18,0) ; PXAASK (optional) if passed and not 0 or "" then will ask the user "RTN","PXAPIDEL",19,0) ; if they are sure that they want to delete "RTN","PXAPIDEL",20,0) ; (suggest 1 if want to ask). "RTN","PXAPIDEL",21,0) ; PXAECHO (optional) if passed and not 0 or "" then will display to "RTN","PXAPIDEL",22,0) ; the user what is being deleted (suggest 1 if want to echo). "RTN","PXAPIDEL",23,0) ; PXAUSER (optional) this is the duz of a user if you only want to "RTN","PXAPIDEL",24,0) ; delete entries that this user created. If it is not passed "RTN","PXAPIDEL",25,0) ; or is 0 or "" then it will not matter who created the "RTN","PXAPIDEL",26,0) ; entries being deleted. "RTN","PXAPIDEL",27,0) ; "RTN","PXAPIDEL",28,0) ; Returns: "RTN","PXAPIDEL",29,0) ; 1 if no errors and process completely "RTN","PXAPIDEL",30,0) ; 0 if errors occurred "RTN","PXAPIDEL",31,0) ; or try to delete something that was now allowed to delete "RTN","PXAPIDEL",32,0) ; but deletion processed completely as possible "RTN","PXAPIDEL",33,0) ; -1 if user said not to delete or user up arrows out "RTN","PXAPIDEL",34,0) ; or errors out. In any case nothing was delete. "RTN","PXAPIDEL",35,0) ; -2 if could not get a visit "RTN","PXAPIDEL",36,0) ; -3 if called incorrectly "RTN","PXAPIDEL",37,0) ; -4 if dependent entry count is still greater than zer0 "RTN","PXAPIDEL",38,0) ; "RTN","PXAPIDEL",39,0) ;Good visit? "RTN","PXAPIDEL",40,0) Q:'$G(PXAVISIT) -2 "RTN","PXAPIDEL",41,0) Q:'($D(^AUPNVSIT(PXAVISIT,0))#2) -2 "RTN","PXAPIDEL",42,0) ; "RTN","PXAPIDEL",43,0) ;Get package pointer "RTN","PXAPIDEL",44,0) S PACKAGE=$G(PACKAGE) "RTN","PXAPIDEL",45,0) I PACKAGE="" S PXAPKG=0 "RTN","PXAPIDEL",46,0) E I PACKAGE=+PACKAGE S PXAPKG=PACKAGE "RTN","PXAPIDEL",47,0) E S PXAPKG=$$PKG2IEN^VSIT(PACKAGE) I PXAPKG=-1 W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM." Q -3 "RTN","PXAPIDEL",48,0) I PXAPKG>0,'($D(^DIC(9.4,PXAPKG,0))#2) W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM." Q -3 "RTN","PXAPIDEL",49,0) ; "RTN","PXAPIDEL",50,0) ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO "RTN","PXAPIDEL",51,0) S SOURCE=$G(SOURCE) "RTN","PXAPIDEL",52,0) I SOURCE="" S PXASOURC=0 "RTN","PXAPIDEL",53,0) E I SOURCE=+SOURCE S PXASOURC=SOURCE "RTN","PXAPIDEL",54,0) E S PXASOURC=$$SOURCE^PXAPIUTL(SOURCE) "RTN","PXAPIDEL",55,0) I +PXASOURC=-1 W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""SOURCE"", contact IRM." Q -3 "RTN","PXAPIDEL",56,0) ; "RTN","PXAPIDEL",57,0) K ^TMP("PXK",$J) "RTN","PXAPIDEL",58,0) N PXACOUNT,PXAINDX,PXAVFILE,PXAFILE,PXARET,PXAWFLAG "RTN","PXAPIDEL",59,0) N PXALEN,PXAIEN,PXAPIECE,PXAMYSOR "RTN","PXAPIDEL",60,0) S PXARET=1 "RTN","PXAPIDEL",61,0) I PXAWHICH="ALL" S PXAWHICH="VISIT^STOP^CPT^IMM^PED^POV^PRV^SK^TRT^HF^XAM" "RTN","PXAPIDEL",62,0) S PXALEN=$L(PXAWHICH,"^") "RTN","PXAPIDEL",63,0) Q:PXALEN<1 -3 "RTN","PXAPIDEL",64,0) E F PXACOUNT=1:1:PXALEN S PXAVFILE=$P(PXAWHICH,"^",PXACOUNT) D Q:PXARET<0 "RTN","PXAPIDEL",65,0) . I "~VISIT~STOP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~"'[("~"_PXAVFILE_"~") S PXARET=-3 "RTN","PXAPIDEL",66,0) Q:PXARET<0 PXARET "RTN","PXAPIDEL",67,0) I PXAASK D Q:PXARET<0 PXARET "RTN","PXAPIDEL",68,0) . N DIR,X,Y "RTN","PXAPIDEL",69,0) . ;ask the user if they want to delete "RTN","PXAPIDEL",70,0) . S DIR(0)="Y" "RTN","PXAPIDEL",71,0) . S DIR("A")="Are you sure you want to delete the encounter information" "RTN","PXAPIDEL",72,0) . S DIR("B")="NO" "RTN","PXAPIDEL",73,0) . D ^DIR "RTN","PXAPIDEL",74,0) . I Y'=1 S PXARET=-1 Q "RTN","PXAPIDEL",75,0) S PXAMYSOR=$$SOURCE^PXAPIUTL("PCE DELETE V-FILES API") "RTN","PXAPIDEL",76,0) ;Do Stop Codes first "RTN","PXAPIDEL",77,0) S PXAWFLAG=PXAECHO&'$D(ZTQUEUED) "RTN","PXAPIDEL",78,0) I "^"_PXAWHICH_"^"["^STOP^" D "RTN","PXAPIDEL",79,0) . S PXAIEN=0 "RTN","PXAPIDEL",80,0) . F PXACOUNT=0:1 S PXAIEN=$O(^AUPNVSIT("AD",PXAVISIT,PXAIEN)) Q:'PXAIEN D "RTN","PXAPIDEL",81,0) .. I PXAUSER>0,PXAUSER'=$P(^AUPNVSIT(PXAIEN,0),"^",23) Q "RTN","PXAPIDEL",82,0) .. I PXAWFLAG S PXAWFLAG=0 W !," ...deleting Stop Codes" "RTN","PXAPIDEL",83,0) .. I $$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN) "RTN","PXAPIDEL",84,0) ;Set up the visit "RTN","PXAPIDEL",85,0) S ^TMP("PXK",$J,"PKG")=PXAPKG "RTN","PXAPIDEL",86,0) S ^TMP("PXK",$J,"SOR")=PXAMYSOR "RTN","PXAPIDEL",87,0) S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT "RTN","PXAPIDEL",88,0) F PXAPIECE=0,21,150,800,811 D "RTN","PXAPIDEL",89,0) . S (^TMP("PXK",$J,"VST",1,PXAPIECE,"BEFORE"),^TMP("PXK",$J,"VST",1,PXAPIECE,"AFTER"))=$G(^AUPNVSIT(PXAVISIT,PXAPIECE)) "RTN","PXAPIDEL",90,0) ; "RTN","PXAPIDEL",91,0) F PXACOUNT=1:1:PXALEN S PXAVFILE=$P(PXAWHICH,"^",PXACOUNT) D "RTN","PXAPIDEL",92,0) . I PXAVFILE="VISIT" D "RTN","PXAPIDEL",93,0) .. ;set fields to @ "RTN","PXAPIDEL",94,0) .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",18)="@" "RTN","PXAPIDEL",95,0) .. F INDEX=1:1:7 S:$P(^TMP("PXK",$J,"VST",1,800,"AFTER"),"^",INDEX)]"" $P(^TMP("PXK",$J,"VST",1,800,"AFTER"),"^",INDEX)="@" "RTN","PXAPIDEL",96,0) . E I PXAVFILE="STOP" ;skip already done "RTN","PXAPIDEL",97,0) . E D ;the v-files "RTN","PXAPIDEL",98,0) .. S PXAWFLAG=PXAECHO&'$D(ZTQUEUED) "RTN","PXAPIDEL",99,0) .. S PXAFILE=$P($T(FORMAT^@("PXCE"_$S(PXAVFILE="IMM":"VIMM",1:PXAVFILE))),"~",5) "RTN","PXAPIDEL",100,0) .. S PXAIEN=0 "RTN","PXAPIDEL",101,0) .. F PXAINDX=1:1 S PXAIEN=$O(@(PXAFILE_"(""AD"",PXAVISIT,PXAIEN)")) Q:'PXAIEN D "RTN","PXAPIDEL",102,0) ... I $P($G(@(PXAFILE_"(PXAIEN,812)")),"^",1) S PXARET=0 Q "RTN","PXAPIDEL",103,0) ... I PXAUSER>0,PXAUSER'=$P($P($P($G(@(PXAFILE_"(PXAIEN,801)")),"^",2),";",1)," ",2) Q "RTN","PXAPIDEL",104,0) ... I PXAPKG>0,PXAPKG'=$P($G(@(PXAFILE_"(PXAIEN,812)")),"^",2) Q "RTN","PXAPIDEL",105,0) ... I PXASOURC>0,PXASOURC'=$P($G(@(PXAFILE_"(PXAIEN,812)")),"^",3) Q "RTN","PXAPIDEL",106,0) ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,0,"BEFORE")=@(PXAFILE_"(PXAIEN,0)") "RTN","PXAPIDEL",107,0) ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,0,"AFTER")="@" "RTN","PXAPIDEL",108,0) ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,"IEN")=PXAIEN "RTN","PXAPIDEL",109,0) ... I PXAWFLAG D "RTN","PXAPIDEL",110,0) .... S PXAWFLAG=0 "RTN","PXAPIDEL",111,0) .... W !," ...deleting " "RTN","PXAPIDEL",112,0) .... W $S("CPT"=PXAVFILE:"Procedure","IMM"=PXAVFILE:"Immunizations","PED"=PXAVFILE:"Patient Education",1:"") "RTN","PXAPIDEL",113,0) .... W $S("POV"=PXAVFILE:"Diagnoses","PRV"=PXAVFILE:"Providers","SK"=PXAVFILE:"Skin Test","TRT"=PXAVFILE:"Treatments","HF"=PXAVFILE:"Health Factors","XAM"=PXAVFILE:"Exams",1:"") "RTN","PXAPIDEL",114,0) ;now process all the data except the stop codes which have already been done "RTN","PXAPIDEL",115,0) N PXKERROR "RTN","PXAPIDEL",116,0) I $D(^TMP("PXK",$J)) D "RTN","PXAPIDEL",117,0) . I PXAECHO,'$D(ZTQUEUED) D WAIT^DICD "RTN","PXAPIDEL",118,0) . D EN1^PXKMAIN "RTN","PXAPIDEL",119,0) . D EVENT^PXKMAIN "RTN","PXAPIDEL",120,0) . K ^TMP("PXK",$J) "RTN","PXAPIDEL",121,0) N PXAKILL "RTN","PXAPIDEL",122,0) I "^"_PXAWHICH_"^"["^VISIT^" D "RTN","PXAPIDEL",123,0) . S PXAKILL=$$KILL^VSITKIL(PXAVISIT) "RTN","PXAPIDEL",124,0) Q $S(PXARET=0!$D(PXKERROR):0,$G(PXAKILL):-4,1:1) "RTN","PXAPIDEL",125,0) ; "RTN","PXBAPI1") 0^9^B46973117 "RTN","PXBAPI1",1,0) PXBAPI1 ;ISL/JVS,dee - PCE's API - interview questions ;10/15/96 "RTN","PXBAPI1",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,23,56,104,111,113,122,116,130**;Aug 12, 1996 "RTN","PXBAPI1",3,0) ;; "RTN","PXBAPI1",4,0) Q "RTN","PXBAPI1",5,0) ; "RTN","PXBAPI1",6,0) PROCESS(PXBEXIT) ; "RTN","PXBAPI1",7,0) I WHAT="INTV" D "RTN","PXBAPI1",8,0) . ;-- Interview is all of the questions "RTN","PXBAPI1",9,0) . D ADQ(.PXBEXIT) I PXBEXIT<1 Q "RTN","PXBAPI1",10,0) 1 . D PRV(.PXBEXIT) I PXBEXIT<1 Q "RTN","PXBAPI1",11,0) 3 . D POV(.PXBEXIT) I PXBEXIT<1 Q "RTN","PXBAPI1",12,0) 2 . D CPT(.PXBEXIT) I PXBEXIT<1 Q "RTN","PXBAPI1",13,0) . I $P($G(^AUPNVSIT($G(PXBVST),150)),"^",3)="O" S PXBEXIT=0 Q "RTN","PXBAPI1",14,0) . I '$$DISPOSIT^PXUTL1($G(PXBPAT),$P($G(^AUPNVSIT(PXBVST,0)),"^",1),$G(PXBVST)) D STP(.PXBEXIT) I PXBEXIT<1 Q "RTN","PXBAPI1",15,0) E I WHAT="ADDEDIT" D "RTN","PXBAPI1",16,0) . D ADDEDIT "RTN","PXBAPI1",17,0) E I WHAT="ADQ" D "RTN","PXBAPI1",18,0) . ;-- Adminstrative questions "RTN","PXBAPI1",19,0) . D ADQ(.PXBEXIT) "RTN","PXBAPI1",20,0) E I WHAT="CODT" D "RTN","PXBAPI1",21,0) . ;-- Check out Date/Time "RTN","PXBAPI1",22,0) . D CODT(.PXBEXIT) "RTN","PXBAPI1",23,0) . Q:PXBEXIT<1 "RTN","PXBAPI1",24,0) . D VISIT(.PXBEXIT) "RTN","PXBAPI1",25,0) . I PXBVST'>0 S PXBEXIT=-2 Q "RTN","PXBAPI1",26,0) E I WHAT="SCC" D "RTN","PXBAPI1",27,0) . ;-- Service connected conditions "RTN","PXBAPI1",28,0) . D SCC(.PXBEXIT) "RTN","PXBAPI1",29,0) . Q:PXBEXIT<1 "RTN","PXBAPI1",30,0) . D VISIT(.PXBEXIT) "RTN","PXBAPI1",31,0) . I PXBVST'>0 S PXBEXIT=-2 Q "RTN","PXBAPI1",32,0) E I WHAT="PRV" D "RTN","PXBAPI1",33,0) . ;-- Providers "RTN","PXBAPI1",34,0) . D PRV(.PXBEXIT) "RTN","PXBAPI1",35,0) E I WHAT="CPT" D "RTN","PXBAPI1",36,0) . ;-- Providers and CPT codes "RTN","PXBAPI1",37,0) . D CPT(.PXBEXIT) "RTN","PXBAPI1",38,0) E I WHAT="POV" D "RTN","PXBAPI1",39,0) . ;-- Diagnoses "RTN","PXBAPI1",40,0) . D POV(.PXBEXIT) "RTN","PXBAPI1",41,0) E I WHAT="STP" D "RTN","PXBAPI1",42,0) . ;-- Stop Codes "RTN","PXBAPI1",43,0) . D STP(.PXBEXIT) "RTN","PXBAPI1",44,0) E S PXBEXIT=-3 W !,"Procedure ""INTV^PXAPI"" was called incorrectly, contact IRM." "RTN","PXBAPI1",45,0) Q "RTN","PXBAPI1",46,0) ; "RTN","PXBAPI1",47,0) ADDEDIT ; "RTN","PXBAPI1",48,0) N ANS "RTN","PXBAPI1",49,0) ADDEDIT1 ; "RTN","PXBAPI1",50,0) D ADQ(.PXBEXIT) "RTN","PXBAPI1",51,0) G:PXBEXIT<1 ADDEDIT2 "RTN","PXBAPI1",52,0) D PRV(.PXBEXIT) "RTN","PXBAPI1",53,0) G:PXBEXIT<1 ADDEDIT2 "RTN","PXBAPI1",54,0) D POV(.PXBEXIT) "RTN","PXBAPI1",55,0) G:PXBEXIT<1 ADDEDIT2 "RTN","PXBAPI1",56,0) ; "RTN","PXBAPI1",57,0) ;Call to CPT is not determined by a credit stop code any more "RTN","PXBAPI1",58,0) ; "RTN","PXBAPI1",59,0) D CPT(.PXBEXIT) "RTN","PXBAPI1",60,0) G:PXBEXIT<1 ADDEDIT2 "RTN","PXBAPI1",61,0) ADDEDIT2 ; "RTN","PXBAPI1",62,0) I PXBVST>0,'$D(^AUPNVCPT("AD",PXBVST)),'$D(^AUPNVSIT("AD",PXBVST)) D I ANS'=1 S PXBEXIT=1 G ADDEDIT1 "RTN","PXBAPI1",63,0) . N DIR,X,Y "RTN","PXBAPI1",64,0) . W !! "RTN","PXBAPI1",65,0) . S DIR(0)="Y" "RTN","PXBAPI1",66,0) . S DIR("A",1)="Must have a STOP CODE or a PROCEDURE to complete this action." "RTN","PXBAPI1",67,0) . S DIR("A")="Do you want to delete this encounter" "RTN","PXBAPI1",68,0) . S DIR("B")="NO" "RTN","PXBAPI1",69,0) . D ^DIR "RTN","PXBAPI1",70,0) . S ANS=Y "RTN","PXBAPI1",71,0) . Q:ANS'=1 "RTN","PXBAPI1",72,0) . I $$DELVFILE^PXAPIDEL("ALL",PXBVST,"","","","","")=1 S PXBEXIT=-1 "RTN","PXBAPI1",73,0) I PXBVST>0,'$D(^AUPNVSIT(PXBVST,0)) S PXBVST="" "RTN","PXBAPI1",74,0) Q "RTN","PXBAPI1",75,0) ; "RTN","PXBAPI1",76,0) ADQ(PXBEXIT) ;Ask the Administration questions "RTN","PXBAPI1",77,0) I PXBVST'>0 D "RTN","PXBAPI1",78,0) . ;This is only done for new visits "RTN","PXBAPI1",79,0) . I PXBPAT'>0 S PXBPAT=$$ASKPAT I PXBPAT'>0 S PXBEXIT=-1 Q "RTN","PXBAPI1",80,0) . S DFN=PXBPAT "RTN","PXBAPI1",81,0) . I PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q "RTN","PXBAPI1",82,0) . S PXBVSTDT=$S(PXBAPPT>0:PXBAPPT,1:$$ASKDT) I PXBVSTDT'>0 S PXBEXIT=-1 Q "RTN","PXBAPI1",83,0) . I PXBAPPT'>0&PXBHLOC'=+$G(^DPT(PXBPAT,"S",PXBVSTDT,0)) D "RTN","PXBAPI1",84,0) .. ;This is only done if there is no appointment. "RTN","PXBAPI1",85,0) .. S PXELAP=$$ELAP^SDPCE(PXBPAT,PXBHLOC) "RTN","PXBAPI1",86,0) I PXBEXIT'<1,PXBHLOC'>0 S PXBHLOC=$$ASKHL I PXBHLOC'>0 S PXBEXIT=-1 Q "RTN","PXBAPI1",87,0) I PXBEXIT'<1 D CODT(.PXBEXIT) "RTN","PXBAPI1",88,0) I PXBEXIT'<1 D SCC(.PXBEXIT) "RTN","PXBAPI1",89,0) I PXBEXIT'<1 D "RTN","PXBAPI1",90,0) . D VISIT(.PXBEXIT) "RTN","PXBAPI1",91,0) . I PXBVST'>0 S PXBEXIT=-2 Q "RTN","PXBAPI1",92,0) Q "RTN","PXBAPI1",93,0) ; "RTN","PXBAPI1",94,0) ASKPAT() ;Ask user for a patient "RTN","PXBAPI1",95,0) ;DIC on file 9000001 "RTN","PXBAPI1",96,0) N DIR,DIC,Y,X,DA "RTN","PXBAPI1",97,0) S DIR(0)="P^9000001:AEMQ" "RTN","PXBAPI1",98,0) S DIR("A")="Patient Name" "RTN","PXBAPI1",99,0) D ^DIR "RTN","PXBAPI1",100,0) Q $S(+Y>0:+Y,1:-1) "RTN","PXBAPI1",101,0) ; "RTN","PXBAPI1",102,0) ASKHL() ;Ask user for a Hospital Location "RTN","PXBAPI1",103,0) ASKHL2 ;DIC on file 44 "RTN","PXBAPI1",104,0) N DIR,DIC,Y,X,DA "RTN","PXBAPI1",105,0) S DIR(0)="PA^44:AEMQ" "RTN","PXBAPI1",106,0) S DIR("A")="Clinic: " "RTN","PXBAPI1",107,0) ; not occasion of service and not dispositioning "RTN","PXBAPI1",108,0) ;I PXALHLOC S DIR("S")="I '+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))" "RTN","PXBAPI1",109,0) ; not occasion of service only ;PX*1.0*116 "RTN","PXBAPI1",110,0) I PXALHLOC S DIR("S")="I '+$G(^(""OOS""))" ;PX*1.0*116 "RTN","PXBAPI1",111,0) ; only clinic that are not occasion of service and not dispositioning "RTN","PXBAPI1",112,0) ;E S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))&'$O(^PX(815,1,""DHL"",""B"",Y,0))" "RTN","PXBAPI1",113,0) E S DIR("S")="I $P(^(0),U,3)=""C""&'+$G(^(""OOS""))" ;PX*1.0*116 "RTN","PXBAPI1",114,0) D ^DIR "RTN","PXBAPI1",115,0) ;enable to select a disposition clinic ;PX*1.0*116 "RTN","PXBAPI1",116,0) ;I $D(^PX(815,1,"DHL","B",+Y)) D HELPDISP^PXCEVSIT W !,$C(7) G ASKHL2 "RTN","PXBAPI1",117,0) Q $S(+Y>0:+Y,1:-1) "RTN","PXBAPI1",118,0) ; "RTN","PXBAPI1",119,0) ASKDT() ;Ask user for the encounter Date/Time "RTN","PXBAPI1",120,0) N DIR,Y,X,DA "RTN","PXBAPI1",121,0) S DIR(0)="D^"_$S(PXLIMDT>2960000:PXLIMDT,1:"")_":"_(DT+.24)_":AEPRSX" "RTN","PXBAPI1",122,0) S DIR("A")="Encounter Date and Time" "RTN","PXBAPI1",123,0) S DIR("?")="Enter the Date and Time of this encounter" "RTN","PXBAPI1",124,0) D ^DIR "RTN","PXBAPI1",125,0) Q $S(+Y>0:+Y,1:-1) "RTN","PXBAPI1",126,0) ; "RTN","PXBAPI1",127,0) CODT(PXBEXIT) ;Ask the user the Check out Date/Time "RTN","PXBAPI1",128,0) N PXCHKOUT "RTN","PXBAPI1",129,0) D CHIKOUT^PXBAPI2("",PXBPAT,PXBHLOC,PXBVSTDT) "RTN","PXBAPI1",130,0) S PXBCODT=PXCHKOUT "RTN","PXBAPI1",131,0) S:PXCHKOUT=-1 PXBCODT="" "RTN","PXBAPI1",132,0) ;; PX*1*113 - Change for EAS*1*3 Appointment processing removed "RTN","PXBAPI1",133,0) ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T D Q:PXBEXIT<1 "RTN","PXBAPI1",134,0) ;. S:$G(EASACT)'="W" EASACT="C" "RTN","PXBAPI1",135,0) ;. I $$MT^EASMTCHK(PXBPAT,"",EASACT,PXBVSTDT) D S PXBEXIT=-1 "RTN","PXBAPI1",136,0) ;. . D PAUSE^VALM1 "RTN","PXBAPI1",137,0) I WHAT'["ADDEDIT",PXCHKOUT=-1 S PXBEXIT=-1 "RTN","PXBAPI1",138,0) I $G(PXBVST),$$DISPOSIT^PXUTL1(DFN,$P($G(^AUPNVSIT(PXBVST,0)),"^",1),PXBVST) S PXBEXIT=1 "RTN","PXBAPI1",139,0) Q "RTN","PXBAPI1",140,0) ; "RTN","PXBAPI1",141,0) SCC(PXBEXIT) ;Ask the user the Service connected conditions "RTN","PXBAPI1",142,0) N PXBDATA,PXBCLASS,PXBOUTEN "RTN","PXBAPI1",143,0) S PXBOUTEN="" "RTN","PXBAPI1",144,0) ;I $$APPOINT^PXUTL1(PXBPAT,PXBVSTDT,PXBHLOC) D "RTN","PXBAPI1",145,0) ;. S PXBOUTEN=$P($G(^DPT(+PXBPAT,"S",+PXBVSTDT,0)),"^",20) "RTN","PXBAPI1",146,0) ;E I $$DISPOSIT^PXUTL1(PXBPAT,PXBVSTDT,PXBVST) D "RTN","PXBAPI1",147,0) ;. S PXBOUTEN=+$P($G(^DPT(+PXBPAT,"DIS",9999999-PXBVSTDT,0)),"^",18) "RTN","PXBAPI1",148,0) ;I 'PXBOUTEN,$G(PXBVST)>0 S PXBOUTEN=$O(^SCE("AVSIT",PXBVST,0)) "RTN","PXBAPI1",149,0) ;D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC) "RTN","PXBAPI1",150,0) D CLASS^PXBAPI21(PXBOUTEN,PXBPAT,PXBVSTDT,PXBHLOC,PXBVST) "RTN","PXBAPI1",151,0) ;PX*1*111 - Add HNC "RTN","PXBAPI1",152,0) F PXBCLASS=1:1:7 I $G(PXBDATA("ERR",PXBCLASS))=4 S PXBEXIT=-1 Q ; changed 6/17/98 for MST enhancement "RTN","PXBAPI1",153,0) Q:PXBEXIT<1 "RTN","PXBAPI1",154,0) S PXB800(1)=$P($G(PXBDATA(3)),"^",2) "RTN","PXBAPI1",155,0) S PXB800(2)=$P($G(PXBDATA(1)),"^",2) "RTN","PXBAPI1",156,0) S PXB800(3)=$P($G(PXBDATA(2)),"^",2) "RTN","PXBAPI1",157,0) S PXB800(4)=$P($G(PXBDATA(4)),"^",2) "RTN","PXBAPI1",158,0) S PXB800(5)=$P($G(PXBDATA(5)),"^",2) ;added 6/17/98 for MST enhancement "RTN","PXBAPI1",159,0) ;PX*1*111 - Add HNC "RTN","PXBAPI1",160,0) S PXB800(6)=$P($G(PXBDATA(6)),"^",2) "RTN","PXBAPI1",161,0) S PXB800(7)=$P($G(PXBDATA(7)),"^",2) "RTN","PXBAPI1",162,0) Q "RTN","PXBAPI1",163,0) ; "RTN","PXBAPI1",164,0) VISIT(PXBEXIT) ;Creat or edit the Visit "RTN","PXBAPI1",165,0) ;Set up ^TMP("PXK",$J and call PXK "RTN","PXBAPI1",166,0) I PXBVST>0 L +^AUPNVSIT(PXBVST):10 E W !!,$C(7),"Cannot edit at this time, try again later." D WAIT^PXCEHELP S PXBEXIT=-2 Q "RTN","PXBAPI1",167,0) K ^TMP("PXK",$J) "RTN","PXBAPI1",168,0) N PXBNODE,PXBAFTER,PXKERROR "RTN","PXBAPI1",169,0) F PXBNODE=0,21,150,800,811,812 D "RTN","PXBAPI1",170,0) . S PXBAFTER(PXBNODE)=$S(PXBVST>0:$G(^AUPNVSIT(PXBVST,PXBNODE)),1:"") "RTN","PXBAPI1",171,0) . S ^TMP("PXK",$J,"VST",1,PXBNODE,"BEFORE")=PXBAFTER(PXBNODE) "RTN","PXBAPI1",172,0) I PXBVST'>0 D "RTN","PXBAPI1",173,0) . S $P(PXBAFTER(0),"^",1)=PXBVSTDT "RTN","PXBAPI1",174,0) . S $P(PXBAFTER(0),"^",5)=PXBPAT "RTN","PXBAPI1",175,0) . S $P(PXBAFTER(0),"^",8)=$P(^SC(PXBHLOC,0),"^",7) "RTN","PXBAPI1",176,0) . S:PXBAPPT>0 $P(PXBAFTER(0),"^",16)="A" "RTN","PXBAPI1",177,0) . S $P(PXBAFTER(150),"^",3)="P" "RTN","PXBAPI1",178,0) . S $P(PXBAFTER(812),"^",2)=PXBPKG "RTN","PXBAPI1",179,0) . S $P(PXBAFTER(812),"^",3)=PXBSOURC "RTN","PXBAPI1",180,0) S $P(PXBAFTER(0),"^",18)=$G(PXBCODT) "RTN","PXBAPI1",181,0) S:$P(PXBAFTER(0),"^",22)="" $P(PXBAFTER(0),"^",22)=PXBHLOC "RTN","PXBAPI1",182,0) S $P(PXBAFTER(800),"^",1)=$G(PXB800(1)) "RTN","PXBAPI1",183,0) S $P(PXBAFTER(800),"^",2)=$G(PXB800(2)) "RTN","PXBAPI1",184,0) S $P(PXBAFTER(800),"^",3)=$G(PXB800(3)) "RTN","PXBAPI1",185,0) S $P(PXBAFTER(800),"^",4)=$G(PXB800(4)) "RTN","PXBAPI1",186,0) S $P(PXBAFTER(800),"^",5)=$G(PXB800(5)) ;added 6/17/98 for MST emhancement "RTN","PXBAPI1",187,0) ;PX*1*111 - Add HNC "RTN","PXBAPI1",188,0) S $P(PXBAFTER(800),"^",6)=$G(PXB800(6)) "RTN","PXBAPI1",189,0) S $P(PXBAFTER(800),"^",7)=$G(PXB800(7)) "RTN","PXBAPI1",190,0) I $D(PXELAP)#2 D "RTN","PXBAPI1",191,0) . S $P(PXBAFTER(0),"^",21)=+PXELAP "RTN","PXBAPI1",192,0) F PXBNODE=0,21,150,800,811,812 D "RTN","PXBAPI1",193,0) . S ^TMP("PXK",$J,"VST",1,PXBNODE,"AFTER")=PXBAFTER(PXBNODE) "RTN","PXBAPI1",194,0) S ^TMP("PXK",$J,"VST",1,"IEN")=$S(PXBVST>0:PXBVST,1:"") "RTN","PXBAPI1",195,0) S ^TMP("PXK",$J,"SOR")=PXBSOURC "RTN","PXBAPI1",196,0) D EN1^PXKMAIN "RTN","PXBAPI1",197,0) I PXBVST>0 L -^AUPNVSIT(PXBVST):5 "RTN","PXBAPI1",198,0) S PXBVST=$G(^TMP("PXK",$J,"VST",1,"IEN")) "RTN","PXBAPI1",199,0) Q "RTN","PXBAPI1",200,0) ; "RTN","PXBAPI1",201,0) CPT(PXBEXIT) ;Ask the user Providers and CTPs "RTN","PXBAPI1",202,0) D CPT^PXBMCPT(PXBVST) K PRVDR "RTN","PXBAPI1",203,0) Q "RTN","PXBAPI1",204,0) ; "RTN","PXBAPI1",205,0) POV(PXBEXIT) ;Ask the user Diagnoses "RTN","PXBAPI1",206,0) D POV^PXBMPOV(PXBVST) K PRVDR "RTN","PXBAPI1",207,0) Q "RTN","PXBAPI1",208,0) ; "RTN","PXBAPI1",209,0) PRV(PXBEXIT) ;Ask the user Providers "RTN","PXBAPI1",210,0) D PRV^PXBMPRV(PXBVST,"PRV") K PRVDR "RTN","PXBAPI1",211,0) Q "RTN","PXBAPI1",212,0) ; "RTN","PXBAPI1",213,0) STP(PXBEXIT) ;Ask the user Stop Codes "RTN","PXBAPI1",214,0) I $L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXBVST,0))) Q "RTN","PXBAPI1",215,0) D STP^PXBMSTP(PXBVST) K PRVDR "RTN","PXBAPI1",216,0) Q "RTN","PXBAPI1",217,0) ; "RTN","PXBAPI21") 0^17^B11006769 "RTN","PXBAPI21",1,0) PXBAPI21 ;ISL/DCM - API for Classification check out ;7/25/96 15:04 "RTN","PXBAPI21",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**130**;Aug 12, 1996 "RTN","PXBAPI21",3,0) CLASS(ENCOWNTR,DFN,APTDT,LOC,VISIT) ;Edit classification fields "RTN","PXBAPI21",4,0) ; Input - ENCOWNTR - ien of ^SCE(ien (409.68 Outpatient Encounter file) "RTN","PXBAPI21",5,0) ; ENCOWNTR optional if DFN,LOC,APTDT params used "RTN","PXBAPI21",6,0) ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR) "RTN","PXBAPI21",7,0) ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR) "RTN","PXBAPI21",8,0) ; APTDT - Appointment Date/time (only used if no ENCOWNTR) "RTN","PXBAPI21",9,0) ; VISIT - optional if no ENCOWNTR look for main encounter that "RTN","PXBAPI21",10,0) ; points to this visit "RTN","PXBAPI21",11,0) ; Output - PXBDATA(Classification type)=OutPT Class ien^Value "RTN","PXBAPI21",12,0) ; PXBDATA("ERR",Class type)=1 Bad ptr to 409.41 "RTN","PXBAPI21",13,0) ; =2 DATA entry not applicable "RTN","PXBAPI21",14,0) ; =3 DATA entry uneditable "RTN","PXBAPI21",15,0) ; =4 User ^ out of prompt "RTN","PXBAPI21",16,0) ; Classification type 1 - Agent Orange "RTN","PXBAPI21",17,0) ; 2 - Ionizing Radiation "RTN","PXBAPI21",18,0) ; 3 - Service Connected "RTN","PXBAPI21",19,0) ; 4 - Environmental Contaminants "RTN","PXBAPI21",20,0) ; 5 - Military Sexual Trauma "RTN","PXBAPI21",21,0) ; 6 - Head and/or Neck Cancer "RTN","PXBAPI21",22,0) ; 7 - Combat Veteran "RTN","PXBAPI21",23,0) ; "RTN","PXBAPI21",24,0) ; Ext References: ^SCE(DA,0) INP^SDAM2 "RTN","PXBAPI21",25,0) ; REQ^SDM1A CLINIC^SDAMU "RTN","PXBAPI21",26,0) ; EXOE^SDCOU2 CLOE^SDCO21 "RTN","PXBAPI21",27,0) ; SEQ^SDCO21 CL^SDCO21 "RTN","PXBAPI21",28,0) ; In ^PXBAPI22 "RTN","PXBAPI21",29,0) ; ^DG(43,1,"SCLR") piece 24 "RTN","PXBAPI21",30,0) ; ^SD(409.41,DA,0) ^SD(409.41,DA,2) "RTN","PXBAPI21",31,0) ; VAL^SDCODD SC^SDCO23 "RTN","PXBAPI21",32,0) I $G(ENCOWNTR)'>0,$G(VISIT)>0 D "RTN","PXBAPI21",33,0) . S ENCOWNTR=$O(^SCE("AVSIT",VISIT,0)) "RTN","PXBAPI21",34,0) . I ENCOWNTR,$P(^SCE(ENCOWNTR,0),"^",6) S ENCOWNTR=$P(^SCE(ENCOWNTR,0),"^",6) "RTN","PXBAPI21",35,0) N IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT "RTN","PXBAPI21",36,0) I $G(ENCOWNTR) Q:'$D(^SCE(+ENCOWNTR,0)) N APTDT,DFN,LOC S END=0,X0=^(0) D ENCHK(ENCOWNTR,X0) Q:END G ON "RTN","PXBAPI21",37,0) Q:'$G(DFN)!'$G(LOC)!'$G(APTDT) "RTN","PXBAPI21",38,0) S X=$G(^DPT(DFN,"S",APTDT,0)) "RTN","PXBAPI21",39,0) I +X,+X=LOC,$P(X,"^",20),$D(^SCE($P(X,"^",20),0)) S ENCOWNTR=$P(X,"^",20),END=0,X0=^(0) D ENCHK(ENCOWNTR,X0) Q:END G ON "RTN","PXBAPI21",40,0) ON D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT) "RTN","PXBAPI21",41,0) I '$D(SDCLOEY) Q "RTN","PXBAPI21",42,0) I $D(SDCLOEY) D ASK($G(ENCOWNTR),.SDCLOEY,.SQUIT) Q:$D(SQUIT) "RTN","PXBAPI21",43,0) Q "RTN","PXBAPI21",44,0) ASKCL(ENCOWNTR,SDCLOEY,DFN,APTDT) ;Ask classifications on check out "RTN","PXBAPI21",45,0) I $G(ENCOWNTR) D CLOE^SDCO21(ENCOWNTR,.SDCLOEY) Q "RTN","PXBAPI21",46,0) D CL^SDCO21(DFN,APTDT,"",.SDCLOEY) "RTN","PXBAPI21",47,0) Q "RTN","PXBAPI21",48,0) ASK(ENCOWNTR,SDCLOEY,SQUIT) ;Ask classifications "RTN","PXBAPI21",49,0) N I,IOINHI,IOINORM,TYPI,TYPSEQ,CTS,X "RTN","PXBAPI21",50,0) S X="IOINHI;IOINORM" D ENDR^%ZISS "RTN","PXBAPI21",51,0) I '$D(SDCLOEY) Q "RTN","PXBAPI21",52,0) W !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]" "RTN","PXBAPI21",53,0) W ! S TYPSEQ=$$SEQ^SDCO21 ;Get classification type sequence (3,1,2,4) "RTN","PXBAPI21",54,0) F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI!($D(SQUIT)) D "RTN","PXBAPI21",55,0) .I $D(SDCLOEY(TYPI)) D "RTN","PXBAPI21",56,0) ..D ONE^PXBAPI22(TYPI,SDCLOEY(TYPI),ENCOWNTR,.SQUIT) "RTN","PXBAPI21",57,0) ..I TYPI=3 F I=1,2,4 S:$D(SDCLOEY(I))&($P($G(PXBDATA(3)),"^",2)=1) $P(SDCLOEY(I),"^",3)=1 S:$P($G(PXBDATA(3)),"^",2)=0&('$D(SDCLOEY(I))) SDCLOEY(I)="" "RTN","PXBAPI21",58,0) Q "RTN","PXBAPI21",59,0) ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks "RTN","PXBAPI21",60,0) S APTDT=+X0,DFN=$P(X0,"^",2),LOC=$P(X0,"^",4),ORG=$P(X0,"^",8),DA=$P(X0,"^",9) "RTN","PXBAPI21",61,0) I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter "RTN","PXBAPI21",62,0) I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic "RTN","PXBAPI21",63,0) I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk "RTN","PXBAPI21",64,0) I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classifications "RTN","PXBAPI21",65,0) Q "RTN","PXBAPI21",66,0) TEST ;Test call to CLASS "RTN","PXBAPI21",67,0) N PXIFN S PXIFN=63 "RTN","PXBAPI21",68,0) F S PXIFN=$O(^SCE(PXIFN)) Q:PXIFN<1 S DFN=$P(^(PXIFN,0),"^",2) K PXBDATA W !!,PXIFN_" "_$P(^DPT(DFN,0),"^") D S %=1 W !,"Continue " D YN^DICN Q:%'=1 "RTN","PXBAPI21",69,0) . D CLASS(PXIFN) "RTN","PXBAPI21",70,0) . ;W ! ZW PXBDATA "RTN","PXBAPI21",71,0) Q "RTN","PXBPL") 0^19^B19046893 "RTN","PXBPL",1,0) PXBPL ;ISL/JVS - ADD DIAGNOSIS TO PROBLEM LIST ; 3/27/02 4:48pm "RTN","PXBPL",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,94,115,130**;Aug 12, 1996 "RTN","PXBPL",3,0) ; "RTN","PXBPL",4,0) ; "RTN","PXBPL",5,0) ; "RTN","PXBPL",6,0) W !,"THIS IS NOT AN ENTRY POINT" Q "RTN","PXBPL",7,0) SET ;--SETUP AND NEW VARIABLES "RTN","PXBPL",8,0) N OK,PXBPL,FLAG,DATA,ICDCODE "RTN","PXBPL",9,0) D WIN17^PXBCC(PXBCNT) "RTN","PXBPL",10,0) I '$G(NOPLLIST) Q "RTN","PXBPL",11,0) PRMPT ;--Ask if you want to put entries in PL "RTN","PXBPL",12,0) S DIR(0)="Y,A,O" "RTN","PXBPL",13,0) S DIR("B")="NO" "RTN","PXBPL",14,0) I PXBCNT'>1 S DIR("A")="Would you like to add this Diagnosis to the Problem List? " "RTN","PXBPL",15,0) I PXBCNT>1 S DIR("A")="Would you like to add any Diagnoses to the Problem List? " "RTN","PXBPL",16,0) D ^DIR K DIR "RTN","PXBPL",17,0) I Y=0!(Y="^")!(Y="") Q "RTN","PXBPL",18,0) SELECT ;--Select entries for PL "RTN","PXBPL",19,0) W ! "RTN","PXBPL",20,0) I PXBCNT'>1 S OK=1 "RTN","PXBPL",21,0) I PXBCNT>1 W !,"Select 1 or several Diagnoses (eg 1,3,4,7,3-6,2-5): " R OK:DTIME "RTN","PXBPL",22,0) I OK?1.N1"E".NAP S OK=" "_OK "RTN","PXBPL",23,0) I OK?24.N S OK=$E(OK,1,24) "RTN","PXBPL",24,0) ; "RTN","PXBPL",25,0) ; "RTN","PXBPL",26,0) I OK["-" D "RTN","PXBPL",27,0) .N PIECE,PXBI,PXBJ,PXBK "RTN","PXBPL",28,0) .S PIECE="" F PXBI=1:1:$L(OK,",") S PIECE=$P(OK,",",PXBI) I PIECE["-" D "RTN","PXBPL",29,0) ..S PXBJ=0 F PXBJ=$P(PIECE,"-",1):1:$P(PIECE,"-",2) S PXBK=","_PXBJ,OK=OK_PXBK "RTN","PXBPL",30,0) ; "RTN","PXBPL",31,0) ; "RTN","PXBPL",32,0) ; "RTN","PXBPL",33,0) S PXBLEN=0 "RTN","PXBPL",34,0) I OK["?" W !,"Enter the ITEM numbers of the entries you whish to add to the PROBLEM LIST." G SELECT "RTN","PXBPL",35,0) ;----SPACE BAR--------- "RTN","PXBPL",36,0) I OK'=" ",OK'["^",OK'="" S ^DISV(DUZ,"PXBPL-2")=OK "RTN","PXBPL",37,0) I OK=" ",$D(^DISV(DUZ,"PXBPL-2")) S OK=^DISV(DUZ,"PXBPL-2") W OK "RTN","PXBPL",38,0) ;----------------------- "RTN","PXBPL",39,0) S PXBLEN=$L(OK,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(OK,",",PXI) D "RTN","PXBPL",40,0) .Q:PXBPIECE="" "RTN","PXBPL",41,0) .I $D(PXBSAM(PXBPIECE)) D "RTN","PXBPL",42,0) ..S FLAG=1 "RTN","PXBPL",43,0) ..D REVPOV^PXBCC(PXBPIECE) "RTN","PXBPL",44,0) I '$G(FLAG) S DIR(0)="Y^AO",DIR("B")="NO",DIR("A")="INVALID entry. Would you like to try again" D ^DIR K DIR I Y=1 K Y G SELECT "RTN","PXBPL",45,0) PRV ;--Ask for provider "RTN","PXBPL",46,0) I '$G(FLAG) Q "RTN","PXBPL",47,0) S FROM="PL" D PRV^PXBGPRV(PXBVST) "RTN","PXBPL",48,0) R K ERROR S FROM="PL" D PRV^PXBPPRV G:$G(ERROR) R W IOEDEOP "RTN","PXBPL",49,0) I DATA["^P" D LOC^PXBCC(3,0),EN0^PXBDPRV,LOC^PXBCC(15,0) G PRV "RTN","PXBPL",50,0) D POV^PXBGPOV(PXBVST) "RTN","PXBPL",51,0) LOOP ;--Loop through diagnosis "RTN","PXBPL",52,0) S PXBLEN=$L(OK,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(OK,",",PXI) D "RTN","PXBPL",53,0) .I PXBPIECE="" Q "RTN","PXBPL",54,0) .I $D(PXBSAM(PXBPIECE)) D "RTN","PXBPL",55,0) ..S PXBPL("PATIENT")=PATIENT "RTN","PXBPL",56,0) ..S PXBPL("NARRATIVE")=$P($G(PXBSAM(PXBPIECE)),"^",3) "RTN","PXBPL",57,0) ..S PXBPL("PROVIDER")=$P(REQI,"^",1) "RTN","PXBPL",58,0) ..S PXBPL("DIAGNOSIS")=+^AUPNVPOV($O(PXBSKY(PXBPIECE,0)),0) "RTN","PXBPL",59,0) ..S PXBPL("LOCATION")=$P(^AUPNVSIT(PXBVST,0),"^",22) "RTN","PXBPL",60,0) ..;PRH - PX*1*115 - Set up Service Conditions "RTN","PXBPL",61,0) ..N PXSCSTR,PXII,PXTYP "RTN","PXBPL",62,0) ..S PXSCSTR="SC^AO^IR^EC^MST^HNC^CV" "RTN","PXBPL",63,0) ..F PXII=1:1:7 D "RTN","PXBPL",64,0) ...S PXTYP=$P(PXSCSTR,"^",PXII) "RTN","PXBPL",65,0) ...S PXBPL(PXTYP)=$P($G(^AUPNVSIT(PXBVST,800)),"^",PXII) "RTN","PXBPL",66,0) ..S ICDCODE="",ICDCODE=$P($G(PXBSAM(PXBPIECE)),"^",1) "RTN","PXBPL",67,0) ..I ICDCODE'="" D ; Get Lexicon entry for ICD Code "RTN","PXBPL",68,0) ...KILL LEXS D EN^LEXCODE(ICDCODE) "RTN","PXBPL",69,0) ...I $G(LEXS("ICD",0))>0 S PXBPL("LEXICON")=$P($G(LEXS("ICD",1)),"^",1) "RTN","PXBPL",70,0) ..D CREATE^GMPLUTL(.PXBPL,.PXBRES) "RTN","PXBPL",71,0) ..D PR "RTN","PXBPL",72,0) K NOPLLIST "RTN","PXBPL",73,0) Q "RTN","PXBPL",74,0) SEND ;--Entry point to send data to problem list "RTN","PXBPL",75,0) N PXBPL,OK,ICDCODE "RTN","PXBPL",76,0) I '$D(IORVON) D TERM^PXBCC "RTN","PXBPL",77,0) S PXBPL("PATIENT")=PATIENT "RTN","PXBPL",78,0) S PXBPL("NARRATIVE")=PXBSAM($O(PXBKY($P($P(REQE,"^",5)," ",1),0)),"LNARR") "RTN","PXBPL",79,0) S PXBPL("PROVIDER")=$P(REQI,"^",1) "RTN","PXBPL",80,0) S PXBPL("DIAGNOSIS")=$P(REQI,"^",5) "RTN","PXBPL",81,0) S PXBPL("LOCATION")=$P(^AUPNVSIT(PXBVST,0),"^",22) "RTN","PXBPL",82,0) ;PRH - PX*1*115 - Set up Service Conditions "RTN","PXBPL",83,0) N PXSCSTR,PXII,PXTYP "RTN","PXBPL",84,0) S PXSCSTR="SC^AO^IR^EC^MST^HNC^CV" "RTN","PXBPL",85,0) F PXII=1:1:6 D "RTN","PXBPL",86,0) . S PXTYP=$P(PXSCSTR,"^",PXII) "RTN","PXBPL",87,0) . S PXBPL(PXTYP)=$P($G(^AUPNVSIT(PXBVST,800)),"^",PXII) "RTN","PXBPL",88,0) S ICDCODE="",ICDCODE=$P($G(PXBSAM($O(PXBKY($P($P(REQE,"^",5)," ",1),0)))),"^",1) "RTN","PXBPL",89,0) I ICDCODE'="" D ; Get Lexicon entry for ICD Code "RTN","PXBPL",90,0) .KILL LEXS D EN^LEXCODE(ICDCODE) "RTN","PXBPL",91,0) .I $G(LEXS("ICD",0))>0 S PXBPL("LEXICON")=$P($G(LEXS("ICD",1)),"^",1) "RTN","PXBPL",92,0) D CREATE^GMPLUTL(.PXBPL,.PXBRES) "RTN","PXBPL",93,0) PR ; "RTN","PXBPL",94,0) I PXBRES<0 D Q ;'Q'uit added for PX*1*115 "RTN","PXBPL",95,0) .W !,IORVON,"--WARNING-Problem NOT Created because: ",PXBRES(0),IORVOFF "RTN","PXBPL",96,0) .D HELP1^PXBUTL1("CON") R OK:DTIME "RTN","PXBPL",97,0) ; "RTN","PXBPL",98,0) ;PX*1*115 - Add Problem File Pointer to V POV file "RTN","PXBPL",99,0) I PXBRES>0 D "RTN","PXBPL",100,0) . N DA,DIE,DR,PXBPLARR,PXBPLERR,PXBPLPOV "RTN","PXBPL",101,0) . S DA=$O(PXBSKY(PXBPIECE,0)) "RTN","PXBPL",102,0) . S PXBPLPOV=9000010.07 "RTN","PXBPL",103,0) . K PXBPLARR,PXBPLERR "RTN","PXBPL",104,0) . D GETS^DIQ(PXBPLPOV,(DA_","),.16,"I","PXBPLARR","PXBPLERR") "RTN","PXBPL",105,0) . Q:$D(PXBPLERR) "RTN","PXBPL",106,0) . I $L($G(PXBPLARR(PXBPLPOV,(DA_","),.16,"I"))) Q "RTN","PXBPL",107,0) . ; "RTN","PXBPL",108,0) . S DIE="^AUPNVPOV(",DR=".16////"_PXBRES "RTN","PXBPL",109,0) . D ^DIE "RTN","PXBPL",110,0) ; "RTN","PXBPL",111,0) Q "RTN","PXCADXP2") 0^20^B21580833 "RTN","PXCADXP2",1,0) PXCADXP2 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ; 9/12/01 12:16pm "RTN","PXCADXP2",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**115,130**;Aug 12, 1996 "RTN","PXCADXP2",3,0) Q "RTN","PXCADXP2",4,0) ; "RTN","PXCADXP2",5,0) PART2 ; "RTN","PXCADXP2",6,0) ;Problem Active "RTN","PXCADXP2",7,0) S PXCAITEM=$P(PXCADXPL,U,6) "RTN","PXCADXP2",8,0) I '(PXCAITEM="A"!(PXCAITEM="I")!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,6)="Problem Active flag bad^"_PXCAITEM "RTN","PXCADXP2",9,0) ; "RTN","PXCADXP2",10,0) ;Problem Onset Date "RTN","PXCADXP2",11,0) S PXCAITEM=$P(PXCADXPL,U,7) "RTN","PXCADXP2",12,0) I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM "RTN","PXCADXP2",13,0) ; "RTN","PXCADXP2",14,0) ;Problem Resolved Date "RTN","PXCADXP2",15,0) S PXCAITEM=$P(PXCADXPL,U,8) "RTN","PXCADXP2",16,0) I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,8)="Problem Resolved Date is bad^"_PXCAITEM "RTN","PXCADXP2",17,0) ; "RTN","PXCADXP2",18,0) ;SC Condition "RTN","PXCADXP2",19,0) S PXCAITEM=$P(PXCADXPL,U,9) "RTN","PXCADXP2",20,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,9)="SC flag bad^"_PXCAITEM "RTN","PXCADXP2",21,0) ; "RTN","PXCADXP2",22,0) ;AO Condition "RTN","PXCADXP2",23,0) S PXCAITEM=$P(PXCADXPL,U,10) "RTN","PXCADXP2",24,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,10)="AO flag bad^"_PXCAITEM "RTN","PXCADXP2",25,0) ; "RTN","PXCADXP2",26,0) ;IR Condition "RTN","PXCADXP2",27,0) S PXCAITEM=$P(PXCADXPL,U,11) "RTN","PXCADXP2",28,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,11)="IR flag bad^"_PXCAITEM "RTN","PXCADXP2",29,0) ; "RTN","PXCADXP2",30,0) ;EC Condition "RTN","PXCADXP2",31,0) S PXCAITEM=$P(PXCADXPL,U,12) "RTN","PXCADXP2",32,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,12)="EC flag bad^"_PXCAITEM "RTN","PXCADXP2",33,0) ; "RTN","PXCADXP2",34,0) ;PX*1*115 - MST Condition "RTN","PXCADXP2",35,0) S PXCAITEM=$P(PXCADXPL,U,15) "RTN","PXCADXP2",36,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,15)="MST flag bad^"_PXCAITEM "RTN","PXCADXP2",37,0) ; "RTN","PXCADXP2",38,0) ;PX*1*115 - HNC Condition "RTN","PXCADXP2",39,0) S PXCAITEM=$P(PXCADXPL,U,16) "RTN","PXCADXP2",40,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,16)="HNC flag bad^"_PXCAITEM "RTN","PXCADXP2",41,0) ; "RTN","PXCADXP2",42,0) S PXCAITEM=$P(PXCADXPL,U,17) "RTN","PXCADXP2",43,0) I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,17)="CV flag bad^"_PXCAITEM "RTN","PXCADXP2",44,0) ; "RTN","PXCADXP2",45,0) ;Narrative: Required for DX and for new Problem "RTN","PXCADXP2",46,0) S PXCAITEM=$P(PXCADXPL,"^",13),PXCAITM2=$L(PXCAITEM) "RTN","PXCADXP2",47,0) I PXCAITEM]"" D "RTN","PXCADXP2",48,0) . I PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,13)="Provider's Narrative must be 2-80 Characters^"_PXCAITEM "RTN","PXCADXP2",49,0) . E D "RTN","PXCADXP2",50,0) .. S PXCAITM3=+$$PROVNARR^PXAPI(PXCAITEM,9000010.07,$G(PXCACLEX)) "RTN","PXCADXP2",51,0) .. I PXCAITM3'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,13)="Could not get pointer to Provider's NARRATIVE^"_PXCAITEM "RTN","PXCADXP2",52,0) .. E S $P(PXCADXPL,"^",13)=PXCAITM3 "RTN","PXCADXP2",53,0) E D "RTN","PXCADXP2",54,0) .I PXCADIAG S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,13)="Provider's Narrative is required for DIAGNOSIS " "RTN","PXCADXP2",55,0) .I PXCAPROB,($P(PXCADXPL,"^",4)="") S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,13)=$P($G(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,13)),"^",1)_"Provider's Narrative is required for a new PROBLEM" "RTN","PXCADXP2",56,0) ; "RTN","PXCADXP2",57,0) ;Narrative Category "RTN","PXCADXP2",58,0) S PXCAITEM=$P(PXCADXPL,"^",14),PXCAITM2=$L(PXCAITEM) "RTN","PXCADXP2",59,0) I PXCAITEM]"" D "RTN","PXCADXP2",60,0) . I PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,14)="Provider's NARRATIVE Category must be 2-80 Characters^"_PXCAITEM "RTN","PXCADXP2",61,0) . E D "RTN","PXCADXP2",62,0) .. S PXCAITM3=+$$PROVNARR^PXAPI(PXCAITEM,9000010.07) "RTN","PXCADXP2",63,0) .. I PXCAITM3'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,14)="Could not get pointer to Provider's NARRATIVE Category^"_PXCAITEM "RTN","PXCADXP2",64,0) .. E S $P(PXCADXPL,"^",14)=PXCAITM3 "RTN","PXCADXP2",65,0) ; "RTN","PXCADXP2",66,0) Q "RTN","PXCADXP2",67,0) ; "RTN","PXCAPL") 0^21^B29826550 "RTN","PXCAPL",1,0) PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97 "RTN","PXCAPL",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130**;Aug 12, 1996 "RTN","PXCAPL",3,0) Q "RTN","PXCAPL",4,0) ; PXCAPROB Copy of a Problem node of the PXCA array "RTN","PXCAPL",5,0) ; PXCAPRV Pointer to the provider (200) "RTN","PXCAPL",6,0) ; PXCAINDX Count of the number of problems for one provider "RTN","PXCAPL",7,0) ; PXCAPL The parameter array passed to Problem List "RTN","PXCAPL",8,0) ; PXCARES The result back from Problem List "RTN","PXCAPL",9,0) ; PXCANUMB Count of the total number of problems "RTN","PXCAPL",10,0) ; "RTN","PXCAPL",11,0) ; "RTN","PXCAPL",12,0) PROBLEM(PXCA,PXCABULD,PXCAERRS) ; "RTN","PXCAPL",13,0) Q:'$D(PXCA("PROBLEM")) "RTN","PXCAPL",14,0) I '$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") S PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed" Q "RTN","PXCAPL",15,0) N PXCAPROB,PXCAPRV,PXCAINDX "RTN","PXCAPL",16,0) N PXCAITEM,PXCAITM2 "RTN","PXCAPL",17,0) S PXCAPRV="" "RTN","PXCAPL",18,0) F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV']"" D "RTN","PXCAPL",19,0) . I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV "RTN","PXCAPL",20,0) . E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV) "RTN","PXCAPL",21,0) . S PXCAINDX=0 "RTN","PXCAPL",22,0) . F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D "RTN","PXCAPL",23,0) .. S PXCAPROB=$G(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) "RTN","PXCAPL",24,0) .. I PXCAPROB="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing" Q "RTN","PXCAPL",25,0) .. S PXCAITEM=$P(PXCAPROB,U,1),PXCAITM2=$L(PXCAITEM) "RTN","PXCAPL",26,0) .. I PXCAITEM]"",PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM "RTN","PXCAPL",27,0) .. S PXCAITEM=$P(PXCAPROB,U,2) "RTN","PXCAPL",28,0) .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM "RTN","PXCAPL",29,0) .. S PXCAITEM=$P(PXCAPROB,U,3) "RTN","PXCAPL",30,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM "RTN","PXCAPL",31,0) .. E I PXCAITEM="" S $P(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1 "RTN","PXCAPL",32,0) .. S PXCAITEM=$P(PXCAPROB,U,4) "RTN","PXCAPL",33,0) .. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM "RTN","PXCAPL",34,0) .. S PXCAITEM=$P(PXCAPROB,U,5) "RTN","PXCAPL",35,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM "RTN","PXCAPL",36,0) .. S PXCAITEM=$P(PXCAPROB,U,6) "RTN","PXCAPL",37,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM "RTN","PXCAPL",38,0) .. S PXCAITEM=$P(PXCAPROB,U,7) "RTN","PXCAPL",39,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM "RTN","PXCAPL",40,0) .. S PXCAITEM=$P(PXCAPROB,U,8) "RTN","PXCAPL",41,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM "RTN","PXCAPL",42,0) .. ;PX*1*115 - ADD MST & HNC "RTN","PXCAPL",43,0) .. S PXCAITEM=$P(PXCAPROB,U,13) "RTN","PXCAPL",44,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM "RTN","PXCAPL",45,0) .. S PXCAITEM=$P(PXCAPROB,U,14) "RTN","PXCAPL",46,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM "RTN","PXCAPL",47,0) .. S PXCAITEM=$P(PXCAPROB,U,15) "RTN","PXCAPL",48,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM "RTN","PXCAPL",49,0) .. S PXCAITEM=$P(PXCAPROB,U,9) "RTN","PXCAPL",50,0) .. I PXCAITEM>0 D "RTN","PXCAPL",51,0) ... N DIC,DR,DA,DIQ,PXCADIQ1 "RTN","PXCAPL",52,0) ... S DIC=80 "RTN","PXCAPL",53,0) ... S DR=".01;102" "RTN","PXCAPL",54,0) ... S DA=PXCAITEM "RTN","PXCAPL",55,0) ... S DIQ="PXCADIQ1(" "RTN","PXCAPL",56,0) ... S DIQ(0)="I" "RTN","PXCAPL",57,0) ... D EN^DIQ1 "RTN","PXCAPL",58,0) ... I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM "RTN","PXCAPL",59,0) ... E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code is INACTIVE^"_PXCAITEM "RTN","PXCAPL",60,0) .. S PXCAITEM=$P(PXCAPROB,U,10) "RTN","PXCAPL",61,0) .. I PXCAITEM]"" D "RTN","PXCAPL",62,0) ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM "RTN","PXCAPL",63,0) ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM "RTN","PXCAPL",64,0) .. E S PXCAITEM=$P(PXCAPROB,U,1) I PXCAITEM']"" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM "RTN","PXCAPL",65,0) .. S PXCAITEM=$P(PXCAPROB,U,11),PXCAITM2=$L(PXCAITEM) "RTN","PXCAPL",66,0) .. I PXCAITM2>60 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM "RTN","PXCAPL",67,0) .. ; "RTN","PXCAPL",68,0) .. ;Clinical Lexicon Term "RTN","PXCAPL",69,0) .. S PXCAITEM=$P(PXCAPROB,"^",12) "RTN","PXCAPL",70,0) .. I PXCAITEM]"" D "RTN","PXCAPL",71,0) ... I $D(^LEX(757.01)) D "RTN","PXCAPL",72,0) .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility term is not in file 757.01^"_PXCAITEM "RTN","PXCAPL",73,0) .... E S PXCACLEX=PXCAITEM "RTN","PXCAPL",74,0) ... E I $D(^GMP(757.01)) D "RTN","PXCAPL",75,0) .... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM "RTN","PXCAPL",76,0) .... E S PXCACLEX=PXCAITEM "RTN","PXCAPL",77,0) ... E S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM "RTN","PXCAPL",78,0) ; "RTN","PXCAPL",79,0) Q "RTN","PXCAPL",80,0) ; "RTN","PXCAPL1") 0^22^B5845414 "RTN","PXCAPL1",1,0) PXCAPL1 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into a call to update Problem List ;7/19/96 "RTN","PXCAPL1",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130**;Aug 12, 1996 "RTN","PXCAPL1",3,0) Q "RTN","PXCAPL1",4,0) ; PXCAPROB Copy of a Problem node of the PXCA array "RTN","PXCAPL1",5,0) ; PXCAPRV Pointer to the provider (200) "RTN","PXCAPL1",6,0) ; PXCAINDX Count of the number of problems for one provider "RTN","PXCAPL1",7,0) ; PXCAPL The parameter array passed to Problem List "RTN","PXCAPL1",8,0) ; PXCARES The result back from Problem List "RTN","PXCAPL1",9,0) ; PXCANUMB Count of the total number of problems "RTN","PXCAPL1",10,0) ; "RTN","PXCAPL1",11,0) PROBLIST ;Problem List "RTN","PXCAPL1",12,0) Q:'$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") "RTN","PXCAPL1",13,0) N PXCAPRV,PXCAINDX,PXCANUMB "RTN","PXCAPL1",14,0) S PXCANUMB=0 "RTN","PXCAPL1",15,0) S PXCAPRV="" "RTN","PXCAPL1",16,0) F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D "RTN","PXCAPL1",17,0) . S PXCAINDX=0 "RTN","PXCAPL1",18,0) . F S PXCAINDX=$O(PXCA("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D "RTN","PXCAPL1",19,0) .. S PXCANUMB=PXCANUMB+1 "RTN","PXCAPL1",20,0) .. Q:$D(PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX)) "RTN","PXCAPL1",21,0) .. N PXCAPROB,PXCAPL,PXCARES "RTN","PXCAPL1",22,0) .. S PXCAPROB=PXCA("PROBLEM",PXCAPRV,PXCAINDX) "RTN","PXCAPL1",23,0) .. S PXCAPL("PROBLEM")=$P(PXCAPROB,"^",10) "RTN","PXCAPL1",24,0) .. S PXCAPL("NARRATIVE")=$P(PXCAPROB,"^",1) "RTN","PXCAPL1",25,0) .. S PXCAPL("PATIENT")=PXCAPAT "RTN","PXCAPL1",26,0) .. S PXCAPL("STATUS")=$S($P(PXCAPROB,"^",3)="1":"A",$P(PXCAPROB,"^",3)="0":"I",1:"A") "RTN","PXCAPL1",27,0) .. S PXCAPL("PROVIDER")=PXCAPRV "RTN","PXCAPL1",28,0) .. S PXCAPL("LOCATION")=PXCAHLOC "RTN","PXCAPL1",29,0) .. S PXCAPL("SC")=$P(PXCAPROB,"^",5) "RTN","PXCAPL1",30,0) .. S PXCAPL("AO")=$P(PXCAPROB,"^",6) "RTN","PXCAPL1",31,0) .. S PXCAPL("IR")=$P(PXCAPROB,"^",7) "RTN","PXCAPL1",32,0) .. S PXCAPL("EC")=$P(PXCAPROB,"^",8) "RTN","PXCAPL1",33,0) .. ;PX*1*115 Add MST & HNC "RTN","PXCAPL1",34,0) .. S PXCAPL("MST")=$P(PXCAPROB,"^",13) "RTN","PXCAPL1",35,0) .. S PXCAPL("HNC")=$P(PXCAPROB,"^",14) "RTN","PXCAPL1",36,0) .. S PXCAPL("CV")=$P(PXCAPROB,"^",15) "RTN","PXCAPL1",37,0) .. S PXCAPL("DIAGNOSIS")=$P(PXCAPROB,"^",9) "RTN","PXCAPL1",38,0) .. S PXCAPL("RESOLVED")=$P(PXCAPROB,"^",4) "RTN","PXCAPL1",39,0) .. S PXCAPL("ONSET")=$P(PXCAPROB,"^",2) "RTN","PXCAPL1",40,0) .. S PXCAPL("COMMENT")=$P(PXCAPROB,"^",11) "RTN","PXCAPL1",41,0) .. S PXCAPL("LEXICON")=$P(PXCAPROB,"^",12) "RTN","PXCAPL1",42,0) .. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES) "RTN","PXCAPL1",43,0) .. I $G(PXCARES)'>0 D "RTN","PXCAPL1",44,0) ... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX "RTN","PXCAPL1",45,0) ... S PXCA("WARNING","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0)) "RTN","PXCAPL1",46,0) Q "RTN","PXCAPL1",47,0) ; "RTN","PXCAPL2") 0^23^B8168398 "RTN","PXCAPL2",1,0) PXCAPL2 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface for "DIAGNOSIS/PROBLEM" into a call to update Problem List ;7/19/96 "RTN","PXCAPL2",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**33,115,130**;Aug 12, 1996 "RTN","PXCAPL2",3,0) Q "RTN","PXCAPL2",4,0) ; PXCADXPL Copy of a Problem node of the PXCA array "RTN","PXCAPL2",5,0) ; PXCAPRV Pointer to the provider (200) "RTN","PXCAPL2",6,0) ; PXCAINDX Count of the number of problems for one provider "RTN","PXCAPL2",7,0) ; PXCAPL The parameter array passed to Problem List "RTN","PXCAPL2",8,0) ; PXCARES The result back from Problem List "RTN","PXCAPL2",9,0) ; PXCANUMB Count of the total number of problems "RTN","PXCAPL2",10,0) ; "RTN","PXCAPL2",11,0) PROBLIST ;Problem List "RTN","PXCAPL2",12,0) Q:'$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") "RTN","PXCAPL2",13,0) N PXCAPRV,PXCAINDX,PXCANUMB "RTN","PXCAPL2",14,0) S PXCANUMB=0 "RTN","PXCAPL2",15,0) S PXCAPRV="" "RTN","PXCAPL2",16,0) F S PXCAPRV=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV)) Q:PXCAPRV'>0 D "RTN","PXCAPL2",17,0) . S PXCAINDX=0 "RTN","PXCAPL2",18,0) . F S PXCAINDX=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D "RTN","PXCAPL2",19,0) .. S PXCANUMB=PXCANUMB+1 "RTN","PXCAPL2",20,0) .. ;Quit if there is an error in this node "RTN","PXCAPL2",21,0) .. Q:$D(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) "RTN","PXCAPL2",22,0) .. N PXCADXPL,PXCAPL,PXCARES "RTN","PXCAPL2",23,0) .. S PXCADXPL=PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX) "RTN","PXCAPL2",24,0) .. S PXCAPL("COMMENT")=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1) "RTN","PXCAPL2",25,0) .. ;Quit if this is not a problem "RTN","PXCAPL2",26,0) .. Q:"^^^"[$P(PXCADXPL,"^",5,8)&(PXCAPL("COMMENT")="") "RTN","PXCAPL2",27,0) .. S PXCAPL("PATIENT")=PXCAPAT "RTN","PXCAPL2",28,0) .. S PXCAPL("PROVIDER")=PXCAPRV "RTN","PXCAPL2",29,0) .. S PXCAPL("LOCATION")=PXCAHLOC "RTN","PXCAPL2",30,0) .. S PXCAPL("DIAGNOSIS")=$P(PXCADXPL,"^",1) "RTN","PXCAPL2",31,0) .. S PXCAPL("LEXICON")=$P(PXCADXPL,"^",3) "RTN","PXCAPL2",32,0) .. S PXCAPL("PROBLEM")=$P(PXCADXPL,"^",4) "RTN","PXCAPL2",33,0) .. S PXCAPL("STATUS")=$P(PXCADXPL,"^",6) "RTN","PXCAPL2",34,0) .. S PXCAPL("ONSET")=$P(PXCADXPL,"^",7) "RTN","PXCAPL2",35,0) .. S PXCAPL("RESOLVED")=$P(PXCADXPL,"^",8) "RTN","PXCAPL2",36,0) .. S PXCAPL("SC")=$P(PXCADXPL,"^",9) "RTN","PXCAPL2",37,0) .. S PXCAPL("AO")=$P(PXCADXPL,"^",10) "RTN","PXCAPL2",38,0) .. S PXCAPL("IR")=$P(PXCADXPL,"^",11) "RTN","PXCAPL2",39,0) .. S PXCAPL("EC")=$P(PXCADXPL,"^",12) "RTN","PXCAPL2",40,0) .. ;Add MST & HNC "RTN","PXCAPL2",41,0) .. S PXCAPL("MST")=$P(PXCADXPL,"^",15) "RTN","PXCAPL2",42,0) .. S PXCAPL("HNC")=$P(PXCADXPL,"^",16) "RTN","PXCAPL2",43,0) .. S PXCAPL("CV")=$P(PXCADXPL,"^",17) "RTN","PXCAPL2",44,0) .. S PXCAPL("NARRATIVE")=$P(PXCADXPL,"^",13) "RTN","PXCAPL2",45,0) .. S:'PXCAPL("PROBLEM") PXCAPL("RECORDED")=$P($P(PXCA("ENCOUNTER"),"^"),".") ;Only if new problem "RTN","PXCAPL2",46,0) .. D UPDATE^GMPLUTL(.PXCAPL,.PXCARES) "RTN","PXCAPL2",47,0) .. I $G(PXCARES)'>0 D "RTN","PXCAPL2",48,0) ... I PXCARES(0)'="Duplicate problem" S PXKERROR("PL",PXCANUMB,0,0)="Problem Not Stored = "_$G(PXCARES(0))_" For Provider = "_PXCAPRV_" and index = "_PXCAINDX "RTN","PXCAPL2",49,0) ... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM Not Stored^"_$G(PXCARES(0)) "RTN","PXCAPL2",50,0) .. E I $D(^TMP("PXK",$J,"POV",PXCADNUM(PXCAPRV,PXCAINDX),0,"AFTER"))#2 S $P(^("AFTER"),"^",16)=PXCARES "RTN","PXCAPL2",51,0) Q "RTN","PXCAPL2",52,0) ; "RTN","PXCAPOV") 0^10^B28854143 "RTN","PXCAPOV",1,0) PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97 "RTN","PXCAPOV",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33,121,130**;Aug 12, 1996 "RTN","PXCAPOV",3,0) Q "RTN","PXCAPOV",4,0) ; Variables "RTN","PXCAPOV",5,0) ; PXCADIAG Copy of a Diagnosis node of the PXCA array "RTN","PXCAPOV",6,0) ; PXCAPRV Pointer to the provider (200) "RTN","PXCAPOV",7,0) ; PXCANUMB Count of the number if POVs "RTN","PXCAPOV",8,0) ; PXCAINDX Count of the number of Diagnoses for one provider "RTN","PXCAPOV",9,0) ; "RTN","PXCAPOV",10,0) DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV "RTN","PXCAPOV",11,0) N PXCADIAG,PXCAPRV,PXCANUMB,PXCAINDX "RTN","PXCAPOV",12,0) S PXCAPRV="" "RTN","PXCAPOV",13,0) S PXCANUMB=0 "RTN","PXCAPOV",14,0) F S PXCAPRV=$O(PXCA("DIAGNOSIS",PXCAPRV)) Q:PXCAPRV']"" D "RTN","PXCAPOV",15,0) . I PXCAPRV>0 D "RTN","PXCAPOV",16,0) .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV "RTN","PXCAPOV",17,0) .. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV) "RTN","PXCAPOV",18,0) . S PXCAINDX=0 "RTN","PXCAPOV",19,0) . F S PXCAINDX=$O(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D "RTN","PXCAPOV",20,0) .. S PXCADIAG=$G(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX)) "RTN","PXCAPOV",21,0) .. S PXCANUMB=PXCANUMB+1 "RTN","PXCAPOV",22,0) .. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q "RTN","PXCAPOV",23,0) .. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX "RTN","PXCAPOV",24,0) .. ; "RTN","PXCAPOV",25,0) .. S PXCAITEM=$P(PXCADIAG,"^",1) "RTN","PXCAPOV",26,0) .. D "RTN","PXCAPOV",27,0) ... ;N DIC,DR,DA,DIQ,PXCADIQ1 "RTN","PXCAPOV",28,0) ... ;S DIC=80 "RTN","PXCAPOV",29,0) ... ;S DR=".01;102" "RTN","PXCAPOV",30,0) ... ;S DA=$S(PXCAITEM'="":PXCAITEM,1:-1) "RTN","PXCAPOV",31,0) ... ;S DIQ="PXCADIQ1(" "RTN","PXCAPOV",32,0) ... ;S DIQ(0)="I" "RTN","PXCAPOV",33,0) ... ;D EN^DIQ1 "RTN","PXCAPOV",34,0) ... ;I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM "RTN","PXCAPOV",35,0) ... ;E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM "RTN","PXCAPOV",36,0) ... N ICDSTR,ICDCN,ICDID "RTN","PXCAPOV",37,0) ... S ICDSTR=$$ICDDX^ICDCODE($S(PXCAITEM'="":PXCAITEM,1:-1),+PXCADT) "RTN","PXCAPOV",38,0) ... S ICDCN=$P(ICDSTR,"^",2) "RTN","PXCAPOV",39,0) ... S ICDID=$P(ICDSTR,"^",12) "RTN","PXCAPOV",40,0) ... I +ICDSTR=-1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM "RTN","PXCAPOV",41,0) ... E I '$P(ICDSTR,"^",10) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM "RTN","PXCAPOV",42,0) ...; "RTN","PXCAPOV",43,0) .. S PXCAITEM=$P(PXCADIAG,"^",2) "RTN","PXCAPOV",44,0) .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM "RTN","PXCAPOV",45,0) .. E I PXCAITEM="P" D "RTN","PXCAPOV",46,0) ... I 'PXCAPDX S PXCAPDX=$P(PXCADIAG,"^",1) "RTN","PXCAPOV",47,0) ... E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM "RTN","PXCAPOV",48,0) ... E D "RTN","PXCAPOV",49,0) .... S PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM "RTN","PXCAPOV",50,0) .... S $P(PXCADIAG,"^",2)="S" "RTN","PXCAPOV",51,0) .. S PXCAITEM=$P(PXCADIAG,"^",3) "RTN","PXCAPOV",52,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM "RTN","PXCAPOV",53,0) .. S PXCAITEM=$P(PXCADIAG,"^",4) "RTN","PXCAPOV",54,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM "RTN","PXCAPOV",55,0) .. S PXCAITEM=$P(PXCADIAG,"^",5) "RTN","PXCAPOV",56,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM "RTN","PXCAPOV",57,0) .. S PXCAITEM=$P(PXCADIAG,"^",6) "RTN","PXCAPOV",58,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM "RTN","PXCAPOV",59,0) .. S PXCAITEM=$P(PXCADIAG,"^",11) "RTN","PXCAPOV",60,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM "RTN","PXCAPOV",61,0) .. S PXCAITEM=$P(PXCADIAG,"^",12) "RTN","PXCAPOV",62,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HCN flag bad^"_PXCAITEM "RTN","PXCAPOV",63,0) .. S PXCAITEM=$P(PXCADIAG,"^",13) "RTN","PXCAPOV",64,0) .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM "RTN","PXCAPOV",65,0) .. S PXCAITEM=$P(PXCADIAG,"^",7) "RTN","PXCAPOV",66,0) .. I PXCAITEM]"" D "RTN","PXCAPOV",67,0) ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM "RTN","PXCAPOV",68,0) ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM "RTN","PXCAPOV",69,0) .. ; "RTN","PXCAPOV",70,0) .. ;Clinical Lexicon Term "RTN","PXCAPOV",71,0) .. S PXCAITEM=$P(PXCADIAG,"^",10) "RTN","PXCAPOV",72,0) .. I PXCAITEM]"" D "RTN","PXCAPOV",73,0) ... I $D(^LEX(757.01)) D "RTN","PXCAPOV",74,0) .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility term is not in file 757.01^"_PXCAITEM "RTN","PXCAPOV",75,0) .... E S PXCACLEX=PXCAITEM "RTN","PXCAPOV",76,0) ... E I $D(^GMP(757.01)) D "RTN","PXCAPOV",77,0) .... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM "RTN","PXCAPOV",78,0) .... E S PXCACLEX=PXCAITEM "RTN","PXCAPOV",79,0) ... E S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM "RTN","PXCAPOV",80,0) .. ; "RTN","PXCAPOV",81,0) .. D PART1^PXCAPOV1 "RTN","PXCAPOV",82,0) .. ; "RTN","PXCAPOV",83,0) .. I PXCABULD&'$D(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS D POV^PXCADX(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS) "RTN","PXCAPOV",84,0) Q "RTN","PXCAPOV",85,0) ; "RTN","PXCAVST") 0^31^B35591988 "RTN","PXCAVST",1,0) PXCAVST ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface for the Visit and Providers ;11/19/96 "RTN","PXCAVST",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,33,74,111,116,130**;Aug 12, 1996 "RTN","PXCAVST",3,0) Q "RTN","PXCAVST",4,0) ; "RTN","PXCAVST",5,0) ENCOUNT(PXCA,PXCABULD,PXCAERRS,PXCAEVAL) ; "RTN","PXCAVST",6,0) I '($D(PXCA("ENCOUNTER"))#2) S PXCA("ERROR","ENCOUNTER",0,0,0)="ENCOUNTER node of the local data array is missing" Q "RTN","PXCAVST",7,0) N PXCAENC "RTN","PXCAVST",8,0) N PXCAITEM,PXCAITM2,PXCAOUT,PXCAERR "RTN","PXCAVST",9,0) S PXCAENC=$G(PXCA("ENCOUNTER")) "RTN","PXCAVST",10,0) I PXCAENC="" S PXCA("ERROR","ENCOUNTER",0,0,0)="ENCOUNTER data missing" Q "RTN","PXCAVST",11,0) I '($D(^DPT(PXCAPAT,0))#2) S PXCA("ERROR","ENCOUNTER",0,0,2)="Patient missing or invalid in file 2^"_PXCAPAT "RTN","PXCAVST",12,0) I '($D(^AUPNPAT(PXCAPAT,0))#2) S PXCA("ERROR","ENCOUNTER",0,0,2)="Patient missing or invalid in file 9000001^"_PXCAPAT "RTN","PXCAVST",13,0) S PXCAITEM=+$P(PXCAENC,"^",1) "RTN","PXCAVST",14,0) I 'PXCAITEM S PXCA("ERROR","ENCOUNTER",0,0,1)="Encounter Data/Time Missing^"_PXCAITEM "RTN","PXCAVST",15,0) E I $D(^DPT(PXCAPAT,"S",PXCAITEM,0)),$D(^SC(+PXCAHLOC,0)),^DPT(PXCAPAT,"S",PXCAITEM,0),PXCAHLOC D "RTN","PXCAVST",16,0) . ;Have an appointment at this time "RTN","PXCAVST",17,0) . N VASD,VAERR "RTN","PXCAVST",18,0) . S VASD("W")=345678 "RTN","PXCAVST",19,0) . S VASD("F")=PXCAITEM-.0000001 "RTN","PXCAVST",20,0) . S VASD("T")=PXCAITEM+.0000001 "RTN","PXCAVST",21,0) . S VASD("C",PXCAHLOC)="" "RTN","PXCAVST",22,0) . D SDA^VADPT "RTN","PXCAVST",23,0) . I $D(^UTILITY("VASD",$J)) S PXCA("ERROR","ENCOUNTER",0,0,1)="Appointment is No Show or Canceled^"_PXCAITEM "RTN","PXCAVST",24,0) I '$D(^DPT(PXCAPAT,"S",PXCAITEM,0))!(+$G(^DPT(PXCAPAT,"S",PXCAITEM,0))'=PXCAHLOC),'(+$P(PXCAENC,"^",5)),'$D(PXCA("PROCEDURE")),'$D(^AUPNVCPT("AD",+PXCAVSIT)) D "RTN","PXCAVST",25,0) . S PXCA("ERROR","ENCOUNTER",0,0,1)="Encounters that do not have an appointment must have a procedure^" "RTN","PXCAVST",26,0) E I PXCAITEM>(DT+.7) S PXCA("ERROR","ENCOUNTER",0,0,1)="Encounter Date/Time is later that today^"_PXCAITEM "RTN","PXCAVST",27,0) I '$D(^SC(PXCAHLOC,0)) S PXCA("ERROR","ENCOUNTER",0,0,3)="HOSPITAL LOCATION Missing is not in file 44^"_PXCAHLOC "RTN","PXCAVST",28,0) ;Allow a disposition clinic to be used as HOSPITAL LOCATION ;PX*1.0*116 "RTN","PXCAVST",29,0) ;I $D(^PX(815,1,"DHL","B",PXCAHLOC)) S PXCA("ERROR","ENCOUNTER",0,0,3)="HOSPITAL LOCATION Can not be a disposition clinic^"_PXCAHLOC "RTN","PXCAVST",30,0) D EVALCODE^PXCAVST2(.PXCAEVAL) "RTN","PXCAVST",31,0) D SCC^PXUTLSCC(PXCAPAT,PXCADT,PXCAHLOC,PXCAVSIT,$P(PXCAENC,"^",6,11),.PXCAOUT,.PXCAERR) "RTN","PXCAVST",32,0) S PXCAITEM=$P(PXCAERR,"^",1) "RTN","PXCAVST",33,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,6)="SC flag bad^"_$P(PXCAENC,"^",6) "RTN","PXCAVST",34,0) I PXCAITEM=-2,$P(PXCAENC,"^",6)=1 S PXCA("WARNING","ENCOUNTER",0,0,6)="SC flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",6) "RTN","PXCAVST",35,0) I PXCAITEM=1,$P($G(^PX(815,1,"DI")),"^",1) S PXCA("WARNING","ENCOUNTER",0,0,6)="SC flag is missing^"_$P(PXCAENC,"^",6) "RTN","PXCAVST",36,0) S PXCAITEM=$P(PXCAERR,"^",2) "RTN","PXCAVST",37,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,7)="AO flag bad^"_$P(PXCAENC,"^",7) "RTN","PXCAVST",38,0) I PXCAITEM=-2,$P(PXCAENC,"^",7)=1 S PXCA("WARNING","ENCOUNTER",0,0,7)="AO flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",7) "RTN","PXCAVST",39,0) I PXCAITEM=-3,$P(PXCAENC,"^",7)=1 S PXCA("WARNING","ENCOUNTER",0,0,7)="AO flag must be N/A not YES because SC flag is true^"_$P(PXCAENC,"^",7) "RTN","PXCAVST",40,0) I PXCAITEM=1,$P($G(^PX(815,1,"DI")),"^",1) S PXCA("WARNING","ENCOUNTER",0,0,7)="AO flag is missing^"_$P(PXCAENC,"^",7) "RTN","PXCAVST",41,0) S PXCAITEM=$P(PXCAERR,"^",3) "RTN","PXCAVST",42,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,8)="IR flag bad^"_$P(PXCAENC,"^",8) "RTN","PXCAVST",43,0) I PXCAITEM=-2,$P(PXCAENC,"^",8)=1 S PXCA("WARNING","ENCOUNTER",0,0,8)="IR flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",8) "RTN","PXCAVST",44,0) I PXCAITEM=-3,$P(PXCAENC,"^",8)=1 S PXCA("WARNING","ENCOUNTER",0,0,8)="IR flag must be N/A not YES because SC flag is true^"_$P(PXCAENC,"^",8) "RTN","PXCAVST",45,0) I PXCAITEM=1,$P($G(^PX(815,1,"DI")),"^",1) S PXCA("WARNING","ENCOUNTER",0,0,8)="IR flag is missing^"_$P(PXCAENC,"^",8) "RTN","PXCAVST",46,0) S PXCAITEM=$P(PXCAERR,"^",4) "RTN","PXCAVST",47,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,9)="EC flag bad^"_$P(PXCAENC,"^",9) "RTN","PXCAVST",48,0) I PXCAITEM=-2,$P(PXCAENC,"^",9)=1 S PXCA("WARNING","ENCOUNTER",0,0,9)="EC flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",9) "RTN","PXCAVST",49,0) I PXCAITEM=-3,$P(PXCAENC,"^",9)=1 S PXCA("WARNING","ENCOUNTER",0,0,9)="EC flag must be N/A not YES because SC flag is true^"_$P(PXCAENC,"^",9) "RTN","PXCAVST",50,0) I PXCAITEM=1,$P($G(^PX(815,1,"DI")),"^",1) S PXCA("WARNING","ENCOUNTER",0,0,9)="EC flag is missing^"_$P(PXCAENC,"^",9) "RTN","PXCAVST",51,0) S PXCAITEM=$P(PXCAERR,"^",5) "RTN","PXCAVST",52,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,10)="MST flag bad^"_$P(PXCAENC,"^",10) "RTN","PXCAVST",53,0) I PXCAITEM=-2,$P(PXCAENC,"^",10)=1 S PXCA("WARNING","ENCOUNTER",0,0,10)="MST flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",10) "RTN","PXCAVST",54,0) S PXCAITEM=$P(PXCAERR,"^",17) "RTN","PXCAVST",55,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,17)="HNC flag bad^"_$P(PXCAENC,"^",17) "RTN","PXCAVST",56,0) I PXCAITEM=-2,$P(PXCAENC,"^",11)=1 S PXCA("WARNING","ENCOUNTER",0,0,17)="HNC flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",17) "RTN","PXCAVST",57,0) S PXCAITEM=$P(PXCAERR,"^",18) "RTN","PXCAVST",58,0) I PXCAITEM=-1 S PXCA("ERROR","ENCOUNTER",0,0,18)="CV flag bad^"_$P(PXCAENC,"^",18) "RTN","PXCAVST",59,0) I PXCAITEM=-2,$P(PXCAENC,"^",11)=1 S PXCA("WARNING","ENCOUNTER",0,0,18)="CV flag must be N/A not YES for this patient^"_$P(PXCAENC,"^",18) "RTN","PXCAVST",60,0) S $P(PXCAENC,"^",6,11)=PXCAOUT "RTN","PXCAVST",61,0) S PXCAITEM=+$P(PXCAENC,"^",13) "RTN","PXCAVST",62,0) I PXCAITEM D "RTN","PXCAVST",63,0) . N PXCADILF,DIERR "RTN","PXCAVST",64,0) . S PXCAITM2=$$EXTERNAL^DILFD(9000010,.21,"",PXCAITEM,"PXCADILF") "RTN","PXCAVST",65,0) . I $D(DIERR) S PXCA("ERROR","ENCOUNTER",0,0,13)="Eligibility code not in File 8^"_PXCAITEM "RTN","PXCAVST",66,0) . E I PXCAITEM=$P($G(PXCAPAT("ELIG")),"^",1) "RTN","PXCAVST",67,0) . E I $D(PXCAPAT("ELIG",PXCAITEM))=1 "RTN","PXCAVST",68,0) . E S PXCA("ERROR","ENCOUNTER",0,0,13)="Eligibility code is not one of this patient's Eligibilities^"_PXCAITEM "RTN","PXCAVST",69,0) S PXCAITEM=+$P(PXCAENC,"^",14) "RTN","PXCAVST",70,0) I PXCAITEM=0 "RTN","PXCAVST",71,0) E I PXCAITEM>(DT+.7) S PXCA("ERROR","ENCOUNTER",0,0,14)="Check-out Date and Time is later that today^"_PXCAITEM "RTN","PXCAVST",72,0) E I PXCAITEM#1=0 S PXCA("ERROR","ENCOUNTER",0,0,14)="Time is required for Check-out Date and Time^"_PXCAITEM "RTN","PXCAVST",73,0) I PXCACSTP'="" D "RTN","PXCAVST",74,0) . I '$D(^DIC(40.7,+PXCACSTP,0)) S PXCA("ERROR","ENCOUNTER",0,0,17)="Optional CREDIT STOP not in File 40.7^"_PXCACSTP "RTN","PXCAVST",75,0) . E I $P(^DIC(40.7,+PXCACSTP,0),"^",3),PXCADT'<$P(^(0),"^",3) S PXCA("ERROR","ENCOUNTER",0,0,17)="Optional CREDIT STOP is inactive in file 40.7^"_PXCACSTP "RTN","PXCAVST",76,0) ; "RTN","PXCAVST",77,0) I PXCABULD&'$D(PXCA("ERROR","ENCOUNTER"))!PXCAERRS D VST^PXCAVST1(PXCAENC) "RTN","PXCAVST",78,0) ; "RTN","PXCAVST",79,0) D PROVIDER^PXCAVST2 "RTN","PXCAVST",80,0) ; "RTN","PXCAVST",81,0) Q "RTN","PXCAVST",82,0) ; "RTN","PXCAVST1") 0^32^B16250901 "RTN","PXCAVST1",1,0) PXCAVST1 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for the Visit and Providers ;8/1/96 "RTN","PXCAVST1",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,74,111,121,130**;Aug 12, 1996 "RTN","PXCAVST1",3,0) Q "RTN","PXCAVST1",4,0) ; "RTN","PXCAVST1",5,0) VST(PXCAENC) ;Visit "RTN","PXCAVST1",6,0) N PXCAFTER "RTN","PXCAVST1",7,0) NODE0 ; "RTN","PXCAVST1",8,0) 1 S PXCAFTER=$P(PXCAENC,"^",1)_"^^^^" "RTN","PXCAVST1",9,0) 5 S PXCAFTER=PXCAFTER_PXCAPAT_"^^^" "RTN","PXCAVST1",10,0) 8 S PXCAFTER=PXCAFTER_PXCACSTP_"^^^^^^^^^" "RTN","PXCAVST1",11,0) 17 ;Store the Evaluation and Management Code in V-CPT and NOT in the Visit "RTN","PXCAVST1",12,0) D EVALCODE($P(PXCAENC,"^",5),$P(PXCAENC,"^",4)) "RTN","PXCAVST1",13,0) S PXCAFTER=PXCAFTER_"^" "RTN","PXCAVST1",14,0) 18 S PXCAFTER=PXCAFTER_$P(PXCAENC,"^",14)_"^^^" "RTN","PXCAVST1",15,0) 21 I $P(PXCAENC,"^",13)]"" S PXCAFTER=PXCAFTER_$P(PXCAENC,"^",13)_"^" "RTN","PXCAVST1",16,0) E D "RTN","PXCAVST1",17,0) . N PXCAELIG "RTN","PXCAVST1",18,0) . S PXCAELIG=$$ELIGIBIL^PXCEVSIT(PXCAPAT,PXCAHLOC,+PXCAENC) "RTN","PXCAVST1",19,0) . S PXCAELIG=$S(PXCAELIG>0:PXCAELIG,1:"") "RTN","PXCAVST1",20,0) . S PXCAFTER=PXCAFTER_PXCAELIG_"^" "RTN","PXCAVST1",21,0) 22 S PXCAFTER=PXCAFTER_PXCAHLOC "RTN","PXCAVST1",22,0) S ^TMP(PXCAGLB,$J,"VST",1,0,"AFTER")=PXCAFTER "RTN","PXCAVST1",23,0) ; "RTN","PXCAVST1",24,0) NODE150 I $P($G(^SC(+PXCAHLOC,0)),"^",7)=PXCACSTP D "RTN","PXCAVST1",25,0) . S ^TMP(PXCAGLB,$J,"VST",1,150,"AFTER")="^^P" "RTN","PXCAVST1",26,0) ; "RTN","PXCAVST1",27,0) NODE800 ; "RTN","PXCAVST1",28,0) S ^TMP(PXCAGLB,$J,"VST",1,800,"AFTER")=$P(PXCAENC,"^",6,10)_"^"_$P(PXCAENC,"^",17,18) "RTN","PXCAVST1",29,0) ; "RTN","PXCAVST1",30,0) I PXCAVSIT'>0 D "RTN","PXCAVST1",31,0) . S ^TMP(PXCAGLB,$J,"VST",1,"IEN")="" "RTN","PXCAVST1",32,0) . S ^TMP(PXCAGLB,$J,"VST",1,0,"BEFORE")="" "RTN","PXCAVST1",33,0) . S ^TMP(PXCAGLB,$J,"VST",1,150,"BEFORE")="" "RTN","PXCAVST1",34,0) . S ^TMP(PXCAGLB,$J,"VST",1,800,"BEFORE")="" "RTN","PXCAVST1",35,0) . S ^TMP(PXCAGLB,$J,"VST",1,812,"BEFORE")="" "RTN","PXCAVST1",36,0) . S ^TMP(PXCAGLB,$J,"VST",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR "RTN","PXCAVST1",37,0) E D "RTN","PXCAVST1",38,0) . S ^TMP(PXCAGLB,$J,"VST",1,"IEN")=PXCAVSIT "RTN","PXCAVST1",39,0) . S ^TMP(PXCAGLB,$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,0)) "RTN","PXCAVST1",40,0) . S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",3)=$P(^AUPNVSIT(PXCAVSIT,0),"^",3) "RTN","PXCAVST1",41,0) . S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",7)=$P(^AUPNVSIT(PXCAVSIT,0),"^",7) "RTN","PXCAVST1",42,0) . S ^TMP(PXCAGLB,$J,"VST",1,150,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,150)) "RTN","PXCAVST1",43,0) . S ^TMP(PXCAGLB,$J,"VST",1,800,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,800)) "RTN","PXCAVST1",44,0) . S ^TMP(PXCAGLB,$J,"VST",1,21,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,21)) "RTN","PXCAVST1",45,0) . S ^TMP(PXCAGLB,$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,21)) "RTN","PXCAVST1",46,0) . S ^TMP(PXCAGLB,$J,"VST",1,811,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,811)) "RTN","PXCAVST1",47,0) . S ^TMP(PXCAGLB,$J,"VST",1,811,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,811)) "RTN","PXCAVST1",48,0) . S ^TMP(PXCAGLB,$J,"VST",1,812,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,812)) "RTN","PXCAVST1",49,0) . S ^TMP(PXCAGLB,$J,"VST",1,812,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,812)) "RTN","PXCAVST1",50,0) Q "RTN","PXCAVST1",51,0) ; "RTN","PXCAVST1",52,0) EVALCODE(CODE,PROV) ;Store the Evaluation and Management Code in a CPT node. "RTN","PXCAVST1",53,0) ;Evaluation and Management Code always has a sequence number of 1 "RTN","PXCAVST1",54,0) ; and there is only one of them. "RTN","PXCAVST1",55,0) Q:'CODE "RTN","PXCAVST1",56,0) N PXCAFTER,PXCAITEM,PXCAPNAR,PXCACNAR,PXCACNT,PXCAMOD,PXCASTR "RTN","PXCAVST1",57,0) N DIC,DR,DA,DIQ,PXCADIQ1 "RTN","PXCAVST1",58,0) S DIC=357.69 "RTN","PXCAVST1",59,0) S DR=".015;.02;.03" "RTN","PXCAVST1",60,0) S DA=+CODE "RTN","PXCAVST1",61,0) S DIQ="PXCADIQ1(" "RTN","PXCAVST1",62,0) S DIQ(0)="E" "RTN","PXCAVST1",63,0) D EN^DIQ1 "RTN","PXCAVST1",64,0) S PXCAITEM=$S($G(PXCADIQ1(357.69,DA,.03,"E"))]"":PXCADIQ1(357.69,DA,.03,"E"),$G(PXCADIQ1(357.69,DA,.015,"E"))]"":PXCADIQ1(357.69,DA,.015,"E"),1:"UNKNOWN") "RTN","PXCAVST1",65,0) S PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,9000010.18) "RTN","PXCAVST1",66,0) I PXCAPNAR'>0 S PXCAPNAR="" "RTN","PXCAVST1",67,0) S ^TMP(PXCAGLB,$J,"CPT",1,0,"BEFORE")="" "RTN","PXCAVST1",68,0) S PXCAFTER=CODE_"^"_PXCAPAT_"^"_PXCAVSIT_"^" "RTN","PXCAVST1",69,0) S PXCAFTER=PXCAFTER_PXCAPNAR "RTN","PXCAVST1",70,0) S PXCAFTER=PXCAFTER_"^^^^^^^^^^^^1" "RTN","PXCAVST1",71,0) S ^TMP(PXCAGLB,$J,"CPT",1,0,"AFTER")=PXCAFTER "RTN","PXCAVST1",72,0) ; File modifiers in ^TMP global "RTN","PXCAVST1",73,0) S ^TMP(PXCAGLB,$J,"CPT",1,1,1,"BEFORE")="" "RTN","PXCAVST1",74,0) S (PXCACNT,PXCAMOD)="" "RTN","PXCAVST1",75,0) F PXCACNT=1:1 S PXCAMOD=$O(PXCA("ENCOUNTER","MODIFIER",PXCAMOD)) Q:PXCAMOD="" D "RTN","PXCAVST1",76,0) . S PXCASTR=$$MODP^ICPTMOD(CODE,PXCAMOD,"E",PXCADT) "RTN","PXCAVST1",77,0) . Q:+PXCASTR<1 "RTN","PXCAVST1",78,0) . S ^TMP(PXCAGLB,$J,"CPT",1,1,PXCACNT,"AFTER")=+PXCASTR "RTN","PXCAVST1",79,0) S ^TMP(PXCAGLB,$J,"CPT",1,12,"BEFORE")="" "RTN","PXCAVST1",80,0) I PROV S ^TMP(PXCAGLB,$J,"CPT",1,12,"AFTER")="^^^"_PROV "RTN","PXCAVST1",81,0) E S ^TMP(PXCAGLB,$J,"CPT",1,12,"AFTER")="" "RTN","PXCAVST1",82,0) S ^TMP(PXCAGLB,$J,"CPT",1,802,"BEFORE")="" "RTN","PXCAVST1",83,0) S ^TMP(PXCAGLB,$J,"CPT",1,812,"BEFORE")="" "RTN","PXCAVST1",84,0) S ^TMP(PXCAGLB,$J,"CPT",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR "RTN","PXCAVST1",85,0) S PXCACNAR="" "RTN","PXCAVST1",86,0) I $G(PXCADIQ1(357.69,DA,.02,"E"))]"" D "RTN","PXCAVST1",87,0) . S PXCACNAR=+$$PROVNARR^PXAPI(PXCADIQ1(357.69,DA,.02,"E"),9000010.18) "RTN","PXCAVST1",88,0) . I PXCACNAR'>0 S PXCACNAR="" "RTN","PXCAVST1",89,0) S ^TMP(PXCAGLB,$J,"CPT",1,802,"AFTER")=PXCACNAR "RTN","PXCAVST1",90,0) S ^TMP(PXCAGLB,$J,"CPT",1,"IEN")="" "RTN","PXCAVST1",91,0) Q "RTN","PXCAVST1",92,0) ; "RTN","PXCEAPPM") 0^25^B6287887 "RTN","PXCEAPPM",1,0) PXCEAPPM ;ISL/dee,ISA/KWP - Used to add a new visit from the appointment display and display a visit ;04/28/99 "RTN","PXCEAPPM",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,74,111,130**;Aug 12, 1996 "RTN","PXCEAPPM",3,0) ;+The classifications are displayed with this routine when adding "RTN","PXCEAPPM",4,0) ;+an encounter from the appointment list "RTN","PXCEAPPM",5,0) Q "RTN","PXCEAPPM",6,0) ; "RTN","PXCEAPPM",7,0) ;Line with the line label "FORMAT" "RTN","PXCEAPPM",8,0) ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name "RTN","PXCEAPPM",9,0) ; 1 2 3 4 5 "RTN","PXCEAPPM",10,0) ; "RTN","PXCEAPPM",11,0) ;Following lines: "RTN","PXCEAPPM",12,0) ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~ "RTN","PXCEAPPM",13,0) ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10 "RTN","PXCEAPPM",14,0) ;The Display & Edit routines are for special cases. "RTN","PXCEAPPM",15,0) ; "RTN","PXCEAPPM",16,0) FORMAT ;;Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT "RTN","PXCEAPPM",17,0) ;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~B "RTN","PXCEAPPM",18,0) ;;0~18~.18~Check Out ~Check Out Date and Time: ~~ECODT^PXCEVSIT~~~D "RTN","PXCEAPPM",19,0) ;;800~1~80001~Service Connected: ~Service Connected: ~~GET800^PXCEE800~~~D "RTN","PXCEAPPM",20,0) ;;800~2~80002~Agent Orange Exposure: ~Agent Orange Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",21,0) ;;800~3~80003~Ionizing Radiation Exposure: ~Ionizing Radiation Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",22,0) ;;800~4~80004~Persian Gulf Exposure: ~Persian Gulf Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",23,0) ;;800~5~80005~Military Sexual Trauma: ~Military Sexual Trauma: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",24,0) ;;800~6~80006~Head and/or Neck Cancer: ~Head and/or Neck Cancer: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",25,0) ;;800~7~80007~Combat Veteran: ~Combat Veteran: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEAPPM",26,0) ;; "RTN","PXCEAPPM",27,0) ; "RTN","PXCEAPPM",28,0) ;******************************** "RTN","PXCEAPPM",29,0) ;Special cases for display of visit are in PXCEVSIT. "RTN","PXCEAPPM",30,0) ; "RTN","PXCEAPPM",31,0) ;******************************** "RTN","PXCEAPPM",32,0) ;Special cases for edit of visit are in PXCEVSIT. "RTN","PXCEAPPM",33,0) ; "RTN","PXCEAPPM",34,0) ;******************************** "RTN","PXCEAPPM",35,0) ;Display text for the .01 field which is a Date and Time. "RTN","PXCEAPPM",36,0) ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.) "RTN","PXCEAPPM",37,0) DISPLY01(PXCEVSIT) ; "RTN","PXCEAPPM",38,0) Q $$DISPLY01^PXCESIT(PXCEVSIT) "RTN","PXCEAPPM",39,0) ; "RTN","PXCEE800") 0^26^B1938209 "RTN","PXCEE800",1,0) PXCEE800 ;ISL/dee,ISA/KWP - Used in editing the 800 node, Service Connected conditions ;04/28/99 "RTN","PXCEE800",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,111,130**;Aug 12, 1996 "RTN","PXCEE800",3,0) ;; ; "RTN","PXCEE800",4,0) Q "RTN","PXCEE800",5,0) ; "RTN","PXCEE800",6,0) GET800 ;Used by all the Service Connected Conditions "RTN","PXCEE800",7,0) ;Do not ask if not primary visit. "RTN","PXCEE800",8,0) Q:$P(PXCEAFTR(0),"^",22)'>0 "RTN","PXCEE800",9,0) Q:$P(PXCEAFTR(0),"^",8)'=$P(^SC($P(PXCEAFTR(0),"^",22),0),"^",7) "RTN","PXCEE800",10,0) N PXCEINDX,PXOUT "RTN","PXCEE800",11,0) N PXBDATA "RTN","PXCEE800",12,0) D CLASS^PXBAPI21("",PXCEPAT,+PXCEAFTR(0),$P(PXCEAFTR(0),"^",22),PXCEFIEN) "RTN","PXCEE800",13,0) ;PX*1*111 - Add HNC "RTN","PXCEE800",14,0) F PXCEINDX=1:1:7 I $G(PXBDATA("ERR",PXCEINDX))=4 S PXOUT=PXBDATA("ERR",PXCEINDX) "RTN","PXCEE800",15,0) I $D(PXOUT) S (PXCEEND,PXCEQUIT)=1 Q ;for visit and required fields "RTN","PXCEE800",16,0) S $P(PXCEAFTR(800),"^",1)=$P($G(PXBDATA(3)),"^",2) "RTN","PXCEE800",17,0) S $P(PXCEAFTR(800),"^",2)=$P($G(PXBDATA(1)),"^",2) "RTN","PXCEE800",18,0) S $P(PXCEAFTR(800),"^",3)=$P($G(PXBDATA(2)),"^",2) "RTN","PXCEE800",19,0) S $P(PXCEAFTR(800),"^",4)=$P($G(PXBDATA(4)),"^",2) "RTN","PXCEE800",20,0) S $P(PXCEAFTR(800),"^",5)=$P($G(PXBDATA(5)),"^",2) "RTN","PXCEE800",21,0) ;PX*1*111 - Add HNC "RTN","PXCEE800",22,0) S $P(PXCEAFTR(800),"^",6)=$P($G(PXBDATA(6)),"^",2) "RTN","PXCEE800",23,0) S $P(PXCEAFTR(800),"^",7)=$P($G(PXBDATA(7)),"^",2) "RTN","PXCEE800",24,0) Q "RTN","PXCEE800",25,0) ; "RTN","PXCESIT") 0^27^B9552263 "RTN","PXCESIT",1,0) PXCESIT ;ISL/dee,ISA/KWP - Used to edit a new visit and display (use most) a visit ;04/28/99 "RTN","PXCESIT",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,74,111,130**;Aug 12, 1996 "RTN","PXCESIT",3,0) ;+ The classifications show in the Display Detail Protocol "RTN","PXCESIT",4,0) Q "RTN","PXCESIT",5,0) ; "RTN","PXCESIT",6,0) ;Line with the line label "FORMAT" "RTN","PXCESIT",7,0) ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name "RTN","PXCESIT",8,0) ; 1 2 3 4 5 "RTN","PXCESIT",9,0) ; "RTN","PXCESIT",10,0) ;Following lines: "RTN","PXCESIT",11,0) ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~ "RTN","PXCESIT",12,0) ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10 "RTN","PXCESIT",13,0) ;The Display & Edit routines are for special cases. "RTN","PXCESIT",14,0) ; "RTN","PXCESIT",15,0) FORMAT ;;Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT "RTN","PXCESIT",16,0) ;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~B "RTN","PXCESIT",17,0) ;;0~5~.05~Patient Name: ~Patient Name: ~~EPAT^PXCEVSIT~~~D "RTN","PXCESIT",18,0) ;;0~22~.22~Hospital Location: ~Hospital Location: ~~EHOSPLOC^PXCEVSIT~^D HELPHLOC^PXCEVSIT~~D "RTN","PXCESIT",19,0) ;;0~8~.08~Clinic Stop: ~Clinic Stop: ~$$DISPLY08^PXCECSTP~EWORKLOD^PXCEVSIT(0)~~~D "RTN","PXCESIT",20,0) ;;0~18~.18~Check Out ~Check Out Date and Time: ~~ECODT^PXCEVSIT~~~D "RTN","PXCESIT",21,0) ;;800~1~80001~Service Connected: ~Service Connected: ~~GET800^PXCEE800~~~D "RTN","PXCESIT",22,0) ;;800~7~80007~Combat Veteran: ~Combat Veteran: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",23,0) ;;800~2~80002~Agent Orange Exposure: ~Agent Orange Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",24,0) ;;800~3~80003~Ionizing Radiation Exposure: ~Ionizing Radiation Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",25,0) ;;800~4~80004~Persian Gulf Exposure: ~Persian Gulf Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",26,0) ;;800~5~80005~Military Sexual Trauma: ~Military Sexual Trauma: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",27,0) ;;800~6~80006~Head and/or Neck Cancer: ~Head and/or Neck Cancer: ~~SKIP^PXCEVSIT~~~D "RTN","PXCESIT",28,0) ;; "RTN","PXCESIT",29,0) ; "RTN","PXCESIT",30,0) ;******************************** "RTN","PXCESIT",31,0) ;Special cases for display of visit are in PXCEVSIT. "RTN","PXCESIT",32,0) ; "RTN","PXCESIT",33,0) ;******************************** "RTN","PXCESIT",34,0) ;Special cases for edit of visit are in PXCEVSIT. "RTN","PXCESIT",35,0) ; "RTN","PXCESIT",36,0) ;******************************** "RTN","PXCESIT",37,0) ;Display text for the .01 field which is a Date and Time. "RTN","PXCESIT",38,0) ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.) "RTN","PXCESIT",39,0) DISPLY01(PXCEVSIT) ; "RTN","PXCESIT",40,0) N DIERR,PXCEDILF,PXCEINT,PXCEEXT "RTN","PXCESIT",41,0) N TEXT "RTN","PXCESIT",42,0) S PXCEINT=$P(PXCEVSIT,"^",1) "RTN","PXCESIT",43,0) S PXCEEXT=$$EXTERNAL^DILFD(9000010,.01,"",PXCEINT,"PXCEDILF") "RTN","PXCESIT",44,0) S TEXT=$S('$D(DIERR):PXCEEXT,1:PXCEINT) "RTN","PXCESIT",45,0) S PXCEINT=$P(PXCEVSIT,"^",22) "RTN","PXCESIT",46,0) S PXCEEXT=$$EXTERNAL^DILFD(9000010,.22,"",PXCEINT,"PXCEDILF") "RTN","PXCESIT",47,0) S TEXT=TEXT_" "_$S('$D(DIERR):PXCEEXT,1:PXCEINT) "RTN","PXCESIT",48,0) S PXCEINT=$P(PXCEVSIT,"^",8) "RTN","PXCESIT",49,0) S PXCEEXT=$$EXTERNAL^DILFD(9000010,.08,"",PXCEINT,"PXCEDILF") "RTN","PXCESIT",50,0) S TEXT=TEXT_" "_$S('$D(DIERR):PXCEEXT,1:PXCEINT) "RTN","PXCESIT",51,0) Q TEXT "RTN","PXCESIT",52,0) ; "RTN","PXCEVST") 0^28^B6194268 "RTN","PXCEVST",1,0) PXCEVST ;ISL/dee,ISA/KWP - Used to edit a visit and display a visit ;04/8/99 "RTN","PXCEVST",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,74,111,130**;Aug 12, 1996 "RTN","PXCEVST",3,0) ;; ; "RTN","PXCEVST",4,0) Q "RTN","PXCEVST",5,0) ; "RTN","PXCEVST",6,0) ;Line with the line label "FORMAT" "RTN","PXCEVST",7,0) ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name "RTN","PXCEVST",8,0) ; 1 2 3 4 5 "RTN","PXCEVST",9,0) ; "RTN","PXCEVST",10,0) ;Following lines: "RTN","PXCEVST",11,0) ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~ "RTN","PXCEVST",12,0) ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10 "RTN","PXCEVST",13,0) ;The Display & Edit routines are for special cases. "RTN","PXCEVST",14,0) ; "RTN","PXCEVST",15,0) FORMAT ;;Encounter~9000010~0,21,150,800,811,812~~^AUPNVSIT "RTN","PXCEVST",16,0) ;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~B "RTN","PXCEVST",17,0) ;;0~18~.18~Check Out ~Check Out Date and Time: ~~ECODT^PXCEVSIT~~~D "RTN","PXCEVST",18,0) ;;800~1~80001~Service Connected: ~Service Connected: ~~GET800^PXCEE800~~~D "RTN","PXCEVST",19,0) ;;800~2~80002~Agent Orange Exposure: ~Agent Orange Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",20,0) ;;800~3~80003~Ionizing Radiation Exposure: ~Ionizing Radiation Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",21,0) ;;800~4~80004~Persian Gulf Exposure: ~Persian Gulf Exposure: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",22,0) ;;800~5~80005~Military Sexual Trauma: ~Military Sexual Trauma: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",23,0) ;;800~6~80006~Head and/or Neck Cancer: ~Head and/or Neck Cancer: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",24,0) ;;800~7~80007~Combat Veteran: ~Combat Veteran: ~~SKIP^PXCEVSIT~~~D "RTN","PXCEVST",25,0) ;; "RTN","PXCEVST",26,0) ; "RTN","PXCEVST",27,0) ;******************************** "RTN","PXCEVST",28,0) ;Special cases for display of visit are in PXCEVSIT. "RTN","PXCEVST",29,0) ; "RTN","PXCEVST",30,0) ;******************************** "RTN","PXCEVST",31,0) ;Special cases for edit of visit are in PXCEVSIT. "RTN","PXCEVST",32,0) ; "RTN","PXCEVST",33,0) ;******************************** "RTN","PXCEVST",34,0) ;Display text for the .01 field which is a Date and Time. "RTN","PXCEVST",35,0) ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.) "RTN","PXCEVST",36,0) DISPLY01(PXCEVSIT) ; "RTN","PXCEVST",37,0) Q $$DISPLY01^PXCESIT(PXCEVSIT) "RTN","PXCEVST",38,0) ; "RTN","PXKFPOV") 0^37^B3741840 "RTN","PXKFPOV",1,0) PXKFPOV ;ISL/JVS - Fields for V PURPOSE OF VISIT (POV) file ;5/21/96 13:17 "RTN","PXKFPOV",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,130**;Aug 12, 1996 "RTN","PXKFPOV",3,0) ; "RTN","PXKFPOV",4,0) ; Adding or Editing of data in a particular field can be controlled "RTN","PXKFPOV",5,0) ;by adding a ~ as a delimiter and the letters A and/or E to the "RTN","PXKFPOV",6,0) ;end of the line of text which represents what could be added "RTN","PXKFPOV",7,0) ;to the DR string in a DIE call. "RTN","PXKFPOV",8,0) ; 1. If none or all three(~AE) of these characters are added then "RTN","PXKFPOV",9,0) ; the data in this field can be either added or edited. "RTN","PXKFPOV",10,0) ; 2. If only the ~ is added then the data in this field can be "RTN","PXKFPOV",11,0) ; neither added or edited. "RTN","PXKFPOV",12,0) ; 3. IF only the ~A is added then the data can only be added to "RTN","PXKFPOV",13,0) ; the file for this field but not edited. "RTN","PXKFPOV",14,0) ; 4. If only the ~E is added the the data can only be edited in "RTN","PXKFPOV",15,0) ; this file for this field. (not a likely possibility) "RTN","PXKFPOV",16,0) ; "RTN","PXKFPOV",17,0) ; The word "OPTION" in front of the line of text below tells the "RTN","PXKFPOV",18,0) ;software to determine,based on the data, the appropriateness "RTN","PXKFPOV",19,0) ;of using either a "///" or "////" stuff in a DIE call. "RTN","PXKFPOV",20,0) ; "RTN","PXKFPOV",21,0) ; The information on line tag 0 $P(,," * ",1) are the piece numbers "RTN","PXKFPOV",22,0) ;of the fields on the zero node that are required by the data "RTN","PXKFPOV",23,0) ;dictionary and are checked for to determine if enough data is present "RTN","PXKFPOV",24,0) ;to proceed without any errors. $P(,," * ",2) are the nodes and "RTN","PXKFPOV",25,0) ;piece numbers of the fields used to determine duplicates in the "RTN","PXKFPOV",26,0) ;file (node+piece (eg. 12+4)). $P(,," * ",3) is a flag use to "RTN","PXKFPOV",27,0) ;determine if duplicates are allowed in this visit file. "RTN","PXKFPOV",28,0) ;If it is set to 0 then no duplicate checks will occur. If it is "RTN","PXKFPOV",29,0) ;set to 1 then the file will be checked for duplicates based on "RTN","PXKFPOV",30,0) ;the information in $P 2. "RTN","PXKFPOV",31,0) ; "RTN","PXKFPOV",32,0) ; The following is the file's global name. Each global must have a "RTN","PXKFPOV",33,0) ;unique name and can not have any subscripts as part of the global root. "RTN","PXKFPOV",34,0) GLOBAL ;;^AUPNVPOV "RTN","PXKFPOV",35,0) ; "RTN","PXKFPOV",36,0) EN1 ; "RTN","PXKFPOV",37,0) S PXKER="" "RTN","PXKFPOV",38,0) S PXKER=$P($T(@PXKNOD+PXKPCE),";;",2) Q "RTN","PXKFPOV",39,0) EN2 ; "RTN","PXKFPOV",40,0) S PXKFD="" "RTN","PXKFPOV",41,0) S PXKFD=$P($T(@PXKNOD+PXKPCE),";;",2) D "RTN","PXKFPOV",42,0) .I PXKFD="" S PXKPCE=PXKPCE+1 D EN2 "RTN","PXKFPOV",43,0) Q "RTN","PXKFPOV",44,0) ADD ;Add an entry to the file "RTN","PXKFPOV",45,0) Q "RTN","PXKFPOV",46,0) 0 ;;1,2,3,4 * 0+1,0+3,0+4 * 1 "RTN","PXKFPOV",47,0) ;;.01////^S X=$G( "RTN","PXKFPOV",48,0) ;;.02////^S X=$G( "RTN","PXKFPOV",49,0) ;;.03////^S X=$G( "RTN","PXKFPOV",50,0) ;;OPTION * .04////^S X=$G( * .04///^S X=$G( "RTN","PXKFPOV",51,0) ;;.05///^S X=$G( "RTN","PXKFPOV",52,0) ;;.06///^S X=$G( "RTN","PXKFPOV",53,0) ;;.07///^S X=$G( "RTN","PXKFPOV",54,0) ;;.08///^S X=$G( "RTN","PXKFPOV",55,0) ;;.09////^S X=$G( "RTN","PXKFPOV",56,0) ;; "RTN","PXKFPOV",57,0) ;;.11///^S X=$G( "RTN","PXKFPOV",58,0) ;;.12///^S X=$G( "RTN","PXKFPOV",59,0) ;;.13///^S X=$G( "RTN","PXKFPOV",60,0) ;;.14////^S X=$G( "RTN","PXKFPOV",61,0) ;;.15////^S X=$G( "RTN","PXKFPOV",62,0) ;;.16////^S X=$G( "RTN","PXKFPOV",63,0) 12 ;; "RTN","PXKFPOV",64,0) ;;1201////^S X=$G( "RTN","PXKFPOV",65,0) ;;1202////^S X=$G( "RTN","PXKFPOV",66,0) ;; "RTN","PXKFPOV",67,0) ;;1204////^S X=$G( "RTN","PXKFPOV",68,0) ;; "RTN","PXKFPOV",69,0) ;; "RTN","PXKFPOV",70,0) 800 ;; "RTN","PXKFPOV",71,0) ;;80001///^S X=$G( "RTN","PXKFPOV",72,0) ;;80002///^S X=$G( "RTN","PXKFPOV",73,0) ;;80003///^S X=$G( "RTN","PXKFPOV",74,0) ;;80004///^S X=$G( "RTN","PXKFPOV",75,0) ;;80005///^S X=$G( "RTN","PXKFPOV",76,0) ;;80006///^S X=$G( "RTN","PXKFPOV",77,0) ;;80007///^S X=$G( "RTN","PXKFPOV",78,0) 801 ;; "RTN","PXKFPOV",79,0) ;;80101///^S X=1; "RTN","PXKFPOV",80,0) ;;80102///^S X=$G(PXKAUDIT); "RTN","PXKFPOV",81,0) 802 ;; "RTN","PXKFPOV",82,0) ;;OPTION * 80201////^S X=$G( * 80201///^S X=$G( "RTN","PXKFPOV",83,0) 811 ;; "RTN","PXKFPOV",84,0) ;;81101///^S X=$G( "RTN","PXKFPOV",85,0) 812 ;; "RTN","PXKFPOV",86,0) ;;81201///^S X=$G( "RTN","PXKFPOV",87,0) ;;81202////^S X=$G( "RTN","PXKFPOV",88,0) ;;81203////^S X=$G( "RTN","PXKFPOV",89,0) SPEC ; "RTN","PXKFPOV",90,0) Q "RTN","PXKFVST") 0^29^B9939551 "RTN","PXKFVST",1,0) PXKFVST ;ISL/JVS - Fields for VISIT file ;7/29/96 "RTN","PXKFVST",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,56,111,130**;Aug 12, 1996 "RTN","PXKFVST",3,0) ; "RTN","PXKFVST",4,0) ; Adding or Editing of data in a particular field can be controlled "RTN","PXKFVST",5,0) ;by adding a ~ as a delimiter and the letters A and/or E to the "RTN","PXKFVST",6,0) ;end of the line of text which represents what could be added "RTN","PXKFVST",7,0) ;to the DR string in a DIE call. "RTN","PXKFVST",8,0) ; 1. If none or all three(~AE) of these characters are added then "RTN","PXKFVST",9,0) ; the data in this field can be either added or edited. "RTN","PXKFVST",10,0) ; 2. If only the ~ is added then the data in this field can be "RTN","PXKFVST",11,0) ; neither added or edited. "RTN","PXKFVST",12,0) ; 3. IF only the ~A is added then the data can only be added to "RTN","PXKFVST",13,0) ; the file for this field but not edited. "RTN","PXKFVST",14,0) ; 4. If only the ~E is added the the data can only be edited in "RTN","PXKFVST",15,0) ; this file for this field. (not a likely possibility) "RTN","PXKFVST",16,0) ; "RTN","PXKFVST",17,0) ; The word "OPTION" in front of the line of text below tells the "RTN","PXKFVST",18,0) ;software to determine,based on the data, the appropriateness "RTN","PXKFVST",19,0) ;of using either a "///" or "////" stuff in a DIE call. "RTN","PXKFVST",20,0) ; "RTN","PXKFVST",21,0) ; The information on line tag 0 $P(,," * ",1) are the piece numbers "RTN","PXKFVST",22,0) ;of the fields on the zero node that are required by the data "RTN","PXKFVST",23,0) ;dictionary and are checked for to determine if enough data is present "RTN","PXKFVST",24,0) ;to proceed without any errors. $P(,," * ",2) are the nodes and "RTN","PXKFVST",25,0) ;piece numbers of the fields used to determine duplicates in the "RTN","PXKFVST",26,0) ;file (node+piece (eg. 12+4)). $P(,," * ",3) is a flag use to "RTN","PXKFVST",27,0) ;determine if duplicates are allowed in this visit file. "RTN","PXKFVST",28,0) ;If it is set to 0 then no duplicate checks will occur. If it is "RTN","PXKFVST",29,0) ;set to 1 then the file will be checked for duplicates based on "RTN","PXKFVST",30,0) ;the information in $P 2. "RTN","PXKFVST",31,0) ; "RTN","PXKFVST",32,0) ; The following is the file's global name. Each global must have a "RTN","PXKFVST",33,0) ;unique name and can not have any subscripts as part of the global root. "RTN","PXKFVST",34,0) GLOBAL ;;^AUPNVSIT "RTN","PXKFVST",35,0) ; "RTN","PXKFVST",36,0) EN1 ; "RTN","PXKFVST",37,0) S PXKER="" "RTN","PXKFVST",38,0) S PXKER=$P($T(@PXKNOD+PXKPCE),";;",2) Q "RTN","PXKFVST",39,0) EN2 ; "RTN","PXKFVST",40,0) S PXKFD="" "RTN","PXKFVST",41,0) S PXKFD=$P($T(@PXKNOD+PXKPCE),";;",2) D "RTN","PXKFVST",42,0) .I PXKFD="" S PXKPCE=PXKPCE+1 D EN2 "RTN","PXKFVST",43,0) Q "RTN","PXKFVST",44,0) ADD ;Add an entry to the file "RTN","PXKFVST",45,0) Q "RTN","PXKFVST",46,0) 0 ;;1,3,5,7,8,22 * * 0 "RTN","PXKFVST",47,0) ;;.01///^S X=$G(~ "RTN","PXKFVST",48,0) ;;.02///^S X=$G(~ "RTN","PXKFVST",49,0) ;;.03///^S X=$G(~ "RTN","PXKFVST",50,0) ;; "RTN","PXKFVST",51,0) ;;.05////^S X=$G(~ "RTN","PXKFVST",52,0) ;;.06////^S X=$G(~ "RTN","PXKFVST",53,0) ;;.07///^S X=$G(~ "RTN","PXKFVST",54,0) ;;.08////^S X=$G(~ "RTN","PXKFVST",55,0) ;;.09///^S X=$G(~ "RTN","PXKFVST",56,0) ;; "RTN","PXKFVST",57,0) ;;.11///^S X=$G(~ "RTN","PXKFVST",58,0) ;;.12////^S X=$G(~ "RTN","PXKFVST",59,0) ;;.13///^S X=$G(~ "RTN","PXKFVST",60,0) ;; "RTN","PXKFVST",61,0) ;; "RTN","PXKFVST",62,0) ;; "RTN","PXKFVST",63,0) ;; "RTN","PXKFVST",64,0) ;;.18///^S X=$G(~ "RTN","PXKFVST",65,0) ;; "RTN","PXKFVST",66,0) ;; "RTN","PXKFVST",67,0) ;;.21////^S X=$G(~ "RTN","PXKFVST",68,0) ;;.22////^S X=$G(~ "RTN","PXKFVST",69,0) ;;.23////^S X=$G(~ "RTN","PXKFVST",70,0) ;;.24////^S X=$G(~ "RTN","PXKFVST",71,0) 21 ;; "RTN","PXKFVST",72,0) ;;2101///^S X=$G(~ "RTN","PXKFVST",73,0) 800 ;; "RTN","PXKFVST",74,0) ;;80001///^S X=$G(~ "RTN","PXKFVST",75,0) ;;80002///^S X=$G(~ "RTN","PXKFVST",76,0) ;;80003///^S X=$G(~ "RTN","PXKFVST",77,0) ;;80004///^S X=$G(~ "RTN","PXKFVST",78,0) ;;80005///^S X=$G(~ ;added 6/17/98 for MST enhancement "RTN","PXKFVST",79,0) ;;80006///^S X=$G(~ ;PX*1*111 - added for HNC enhancement "RTN","PXKFVST",80,0) ;;80007///^S X=$G(~ ;PX*1*130 "RTN","PXKFVST",81,0) 812 ;; "RTN","PXKFVST",82,0) ;;81201///^S X=$G( "RTN","PXKFVST",83,0) ;;81202////^S X=$G( "RTN","PXKFVST",84,0) ;;81203////^S X=$G( "RTN","PXKFVST",85,0) ; "RTN","PXKFVST",86,0) UPD ;Up date visit file using visit tracking "RTN","PXKFVST",87,0) ;--new VSIT to make sure that none are left around after call "RTN","PXKFVST",88,0) N PXTMPVST "RTN","PXKFVST",89,0) S PXTMPVST=VSIT("IEN") "RTN","PXKFVST",90,0) N VSIT "RTN","PXKFVST",91,0) S VSIT("IEN")=PXTMPVST "RTN","PXKFVST",92,0) I $G(PXKAV(0,8))]"" D "RTN","PXKFVST",93,0) .I PXKAV(0,8)="@" S VSIT("DSS")="@" "RTN","PXKFVST",94,0) .E D "RTN","PXKFVST",95,0) ..K ^UTILITY("DIQ1",$J) "RTN","PXKFVST",96,0) ..S DIC=40.7,DA=+$G(PXKAV(0,8)),DIQ(0)="I",DR=1 D EN^DIQ1 "RTN","PXKFVST",97,0) ..S VSIT("DSS")=$G(^UTILITY("DIQ1",$J,40.7,DA,1,"I")) "RTN","PXKFVST",98,0) K ^UTILITY("DIQ1",$J),DIQ,DR,DA,DIC "RTN","PXKFVST",99,0) I $G(PXKAV(0,6))]"" S VSIT("INS")=$G(PXKAV(0,6)) "RTN","PXKFVST",100,0) I $G(PXKAV(0,18))]"" S VSIT("COD")=$G(PXKAV(0,18)) "RTN","PXKFVST",101,0) ;--cannot edit "ELG" "RTN","PXKFVST",102,0) I $G(PXKAV(0,22))]"" S VSIT("LOC")=$G(PXKAV(0,22)) "RTN","PXKFVST",103,0) ;Classification questions "RTN","PXKFVST",104,0) N PXP,PXV,PXN "RTN","PXKFVST",105,0) ;AO, IR, and EC not applicable if SC answered YES (1) "RTN","PXKFVST",106,0) I $G(PXKAV(800,1))=1 F PXP=2:1:4 S PXKAV(800,PXP)="@" "RTN","PXKFVST",107,0) F PXP=1:1:7 D "RTN","PXKFVST",108,0) .S PXV=$G(PXKAV(800,PXP)) "RTN","PXKFVST",109,0) .S PXN=$P("SC^AO^IR^EC^MST^HNC^CV","^",PXP) "RTN","PXKFVST",110,0) .I PXV'="" S VSIT(PXN)=PXV "RTN","PXKFVST",111,0) D UPD^VSIT "RTN","PXKFVST",112,0) K VSIT("DSS"),VSIT("COD"),VSIT("SC"),VSIT("AO"),VSIT("IR"),VSIT("EC") "RTN","PXKFVST",113,0) K VSIT("LOC"),VSIT("INS"),VSIT("ELG"),VSIT("MDT") "RTN","PXKFVST",114,0) ;PX*1*111 - added for HNC enhancement "RTN","PXKFVST",115,0) K VSIT("MST"),VSIT("HNC"),VSIT("CV") "RTN","PXKFVST",116,0) Q "RTN","PXKFVST",117,0) SPEC ; "RTN","PXKFVST",118,0) Q "RTN","PXKMAIN") 0^35^B41593205 "RTN","PXKMAIN",1,0) PXKMAIN ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;9/11/98 "RTN","PXKMAIN",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117,130**;Aug 12, 1996 "RTN","PXKMAIN",3,0) ;+This routine is responsible for: "RTN","PXKMAIN",4,0) ;+ "RTN","PXKMAIN",5,0) ;+LOCAL VARIABLE LIST: "RTN","PXKMAIN",6,0) ;+ PXP59LOC = LOCK name (introduced in patch PX*1.0*59). "RTN","PXKMAIN",7,0) ;+ PXFG = Stop flag with duplicate of delete "RTN","PXKMAIN",8,0) ;+ PXKAFT = After node "RTN","PXKMAIN",9,0) ;+ PXKBEF = Before node "RTN","PXKMAIN",10,0) ;+ PXKAV = Pieces from the after node "RTN","PXKMAIN",11,0) ;+ PXKBV = Pieces from the before node "RTN","PXKMAIN",12,0) ;+ PXKERROR = Set when there is an error "RTN","PXKMAIN",13,0) ;+ PXKFGAD = ADD flag "RTN","PXKMAIN",14,0) ;+ PXKFGED = EDIT flag "RTN","PXKMAIN",15,0) ;+ PXKFGDE = DELETE flag "RTN","PXKMAIN",16,0) ;+ PXKSEQ = Sequence number in PXK tmp global "RTN","PXKMAIN",17,0) ;+ PXKCAT = Category of entry (CPT,MSR,VST...) "RTN","PXKMAIN",18,0) ;+ PXKREF = Root of temp global "RTN","PXKMAIN",19,0) ;+ PXKPIEN = IEN of v file or the visit file "RTN","PXKMAIN",20,0) ;+ PXKREF = The original reference we are ordering off of "RTN","PXKMAIN",21,0) ;+ PXKRT = name of the node in the v file "RTN","PXKMAIN",22,0) ;+ PXKRTN = routine name for the "f"ile routine "RTN","PXKMAIN",23,0) ;+ PXKSOR = the data source for this entry "RTN","PXKMAIN",24,0) ;+ PXKSUB = the subscript the data is located on the the v file "RTN","PXKMAIN",25,0) ;+ PXKVST = the visit IEN "RTN","PXKMAIN",26,0) ;+ PXKDUZ = the DUZ of the user "RTN","PXKMAIN",27,0) ;+ *PXKHLR* = A variable set by calling routine so that duplicate "RTN","PXKMAIN",28,0) ;+ PXKERROR messages aren't produced. "RTN","PXKMAIN",29,0) ; "RTN","PXKMAIN",30,0) W !,"This is not an entry point" Q "RTN","PXKMAIN",31,0) EN1 ;+Main entry point to read ^TMP("PXK", Global "RTN","PXKMAIN",32,0) ;+ Partial ^TMP Global Structure when called: "RTN","PXKMAIN",33,0) ;+ ^TMP("PXK",$J,"SOR") = Source ien "RTN","PXKMAIN",34,0) ;+ "RTN","PXKMAIN",35,0) ;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file "RTN","PXKMAIN",36,0) ;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes. "RTN","PXKMAIN",37,0) ;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = "" "RTN","PXKMAIN",38,0) ;+ "RTN","PXKMAIN",39,0) ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = "" "RTN","PXKMAIN",40,0) ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary "RTN","PXKMAIN",41,0) ;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = "" "RTN","PXKMAIN",42,0) ;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = "" "RTN","PXKMAIN",43,0) ;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien "RTN","PXKMAIN",44,0) ;+ "RTN","PXKMAIN",45,0) N PXP59LOC "RTN","PXKMAIN",46,0) D LOCK "RTN","PXKMAIN",47,0) K PXKERROR "RTN","PXKMAIN",48,0) I '$G(PXKDUZ) D "RTN","PXKMAIN",49,0) . I $G(DUZ) S PXKDUZ=DUZ "RTN","PXKMAIN",50,0) . E S PXKDUZ=.5 "RTN","PXKMAIN",51,0) D VST "RTN","PXKMAIN",52,0) I $D(PXP59LOC) D UNLOCK "RTN","PXKMAIN",53,0) Q "RTN","PXKMAIN",54,0) VST ;--Check for visit node and get one created or quit. "RTN","PXKMAIN",55,0) I '$G(^TMP("PXK",$J,"VST",1,"IEN")) D "RTN","PXKMAIN",56,0) .D VSIT^PXKVST "RTN","PXKMAIN",57,0) I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-1 S PXKERROR("VISIT")="Visit Tracking could not get a visit." Q "RTN","PXKMAIN",58,0) I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-2 S PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits." Q "RTN","PXKMAIN",59,0) I +$G(^TMP("PXK",$J,"VST",1,"IEN"))<1 S PXKERROR("VISIT")="Did not get a visit^"_$G(^TMP("PXK",$J,"VST",1,"IEN")) Q "RTN","PXKMAIN",60,0) ; "RTN","PXKMAIN",61,0) NEW ;--New variables and set main variables "RTN","PXKMAIN",62,0) N PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT "RTN","PXKMAIN",63,0) N PXKCAT,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE "RTN","PXKMAIN",64,0) N PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT "RTN","PXKMAIN",65,0) N PXKPTR,PXDFG,PX,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKP "RTN","PXKMAIN",66,0) N PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX "RTN","PXKMAIN",67,0) PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2 "RTN","PXKMAIN",68,0) D PRVTYPE^PXKMAIN2 "RTN","PXKMAIN",69,0) ; "RTN","PXKMAIN",70,0) SET ;--SET VARIABLES NECESSARY "RTN","PXKMAIN",71,0) ;'DA' should not be defined at this point "RTN","PXKMAIN",72,0) N DA ;PX*1.0*117 "RTN","PXKMAIN",73,0) ; "RTN","PXKMAIN",74,0) S PXFG=0,TMPPX="^",PXKLAYGO="",PXDFG=0 "RTN","PXKMAIN",75,0) SOURCE S PXKSOR=$G(^TMP("PXK",$J,"SOR")) D Q:$D(PXKERROR("SOURCE")) "RTN","PXKMAIN",76,0) .S PXKCO("SOR")=PXKSOR "RTN","PXKMAIN",77,0) .I $D(PXKSOR)']"" S PXKERROR("SOURCE")="" Q "RTN","PXKMAIN",78,0) VISIT S (PXKVST,VSIT("IEN"))=$G(^TMP("PXK",$J,"VST",1,"IEN")) "RTN","PXKMAIN",79,0) ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables "RTN","PXKMAIN",80,0) S PXKREF="^TMP(""PXK"",$J)" "RTN","PXKMAIN",81,0) CATEG S PXKCAT="" F S (PXKCAT,PXKVCAT)=$O(@PXKREF@(PXKCAT)) Q:PXKCAT="" D "RTN","PXKMAIN",82,0) .I PXKCAT="VST" S PXKVCAT="SIT" "RTN","PXKMAIN",83,0) .S PXKRTN="PXKF"_PXKCAT "RTN","PXKMAIN",84,0) .S X=PXKRTN X ^%ZOSF("TEST") Q:'$T "RTN","PXKMAIN",85,0) SEQUE .S PXKSEQ=0 F S PXKSEQ=$O(@PXKREF@(PXKCAT,PXKSEQ)) K PXKAV,PXKBV S PXFG=0 Q:'PXKSEQ D "RTN","PXKMAIN",86,0) ..S PXKPIEN=$G(@PXKREF@(PXKCAT,PXKSEQ,"IEN")),(PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0 "RTN","PXKMAIN",87,0) SUBSCR ..S PXKSUB="" F S PXKSUB=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB)) Q:PXKSUB["IEN" Q:PXFG=1 Q:PXDFG=1 D "RTN","PXKMAIN",88,0) AFTER ...S PXKAFT(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER")) "RTN","PXKMAIN",89,0) BEFORE ...S PXKBEF(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE")) "RTN","PXKMAIN",90,0) ...I PXKCAT="CPT",PXKSUB=1 D SUBSCR^PXKMOD "RTN","PXKMAIN",91,0) ...D LOOP^PXKMAIN1 D ERROR^PXKMAIN1 S PXDFG=0 I $G(PXKAV(0,1))["@"!('$D(PXKAV(0,1))) S PXKAFT(PXKSUB)="" K PXKAV(0) S PXDFG=1 "RTN","PXKMAIN",92,0) ..Q:PXFG=1 "RTN","PXKMAIN",93,0) ..I $D(PXKAV),'$D(PXKBV) S PXKSORR=PXKSOR_"-A "_PXKDUZ,PXKFGAD=1 I PXKCAT["VST" S PXKFGAD=0 "RTN","PXKMAIN",94,0) ..I '$D(PXKAV),$D(PXKBV) S PXKFGDE=1,PXKFVDLM="" D "RTN","PXKMAIN",95,0) ...S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" I $D(@PXKRT) D DELETE^PXKMAIN1,EN1^PXKMASC S PXFG=1 K PXKRT Q "RTN","PXKMAIN",96,0) ..I 'PXKFGAD,'PXKFGDE D "RTN","PXKMAIN",97,0) ...I PXKCAT="VST" D CQDEL "RTN","PXKMAIN",98,0) ...D CLEAN^PXKMAIN1 "RTN","PXKMAIN",99,0) ...I $D(PXKAV) S PXKSORR=PXKSOR_"-E "_PXKDUZ,PXKFGED=1 I PXKCAT="VST",'$D(PXKBV),$D(PXKVST) S PXKFGED=0 "RTN","PXKMAIN",100,0) ..I 'PXKFGAD,'PXKFGDE,'PXKFGED,PXKCAT["VST" D EN1^PXKMASC "RTN","PXKMAIN",101,0) ..I PXKFGAD=1 D Q:PXFG "RTN","PXKMAIN",102,0) ...D ERROR^PXKMAIN1 "RTN","PXKMAIN",103,0) ...I $D(PXKERROR(PXKCAT,PXKSEQ)) S PXFG=1 "RTN","PXKMAIN",104,0) ...D:'PXFG DUP^PXKMAIN1 "RTN","PXKMAIN",105,0) ...I PXFG=1 D Q "RTN","PXKMAIN",106,0) ....Q:PXKCAT'="CPT" "RTN","PXKMAIN",107,0) ....I $G(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]"" D REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN")) "RTN","PXKMAIN",108,0) ...D:'PXKPIEN FILE^PXKMAIN1 "RTN","PXKMAIN",109,0) ...S:'$G(DA) DA=PXKPIEN "RTN","PXKMAIN",110,0) ...D AUD2^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC "RTN","PXKMAIN",111,0) ..I PXKFGED=1,PXKCAT'="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D AUD12^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC "RTN","PXKMAIN",112,0) ..I PXKFGED=1,PXKCAT="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D DRDIE^PXKMAIN1,EN1^PXKMASC "RTN","PXKMAIN",113,0) ..D SPEC^PXKMAIN2 "RTN","PXKMAIN",114,0) ..K PXKAFT,PXKBEF "RTN","PXKMAIN",115,0) I $D(^TMP("PXKSAVE",$J)) D RECALL^PXKMAIN2 "RTN","PXKMAIN",116,0) D EXIT "RTN","PXKMAIN",117,0) Q "RTN","PXKMAIN",118,0) EXIT ;--EXIT "RTN","PXKMAIN",119,0) I $D(PXKFVDLM) D MODIFIED^VSIT(PXKVST) "RTN","PXKMAIN",120,0) K PXKPXD,TMPPX "RTN","PXKMAIN",121,0) K DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN") Q "RTN","PXKMAIN",122,0) EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT "RTN","PXKMAIN",123,0) ;Setting the variable PXKNOEVT=1 will stop the event from being "RTN","PXKMAIN",124,0) ;fired off whenever any data is sent into PCE "RTN","PXKMAIN",125,0) ; "RTN","PXKMAIN",126,0) I $G(PXKNOEVT) K ^TMP("PXKCO",$J) Q "RTN","PXKMAIN",127,0) N PXP59LOC "RTN","PXKMAIN",128,0) D LOCK "RTN","PXKMAIN",129,0) D EVENT^PXKMASC "RTN","PXKMAIN",130,0) I $D(PXP59LOC) D UNLOCK "RTN","PXKMAIN",131,0) Q "RTN","PXKMAIN",132,0) LOCK ; Lock (results in PXP59LOC)--Patch PX*1.0*59. "RTN","PXKMAIN",133,0) N PX0,PXWHO,PXWHERE,PXWHEN,PXEXIT,PXVISIT "RTN","PXKMAIN",134,0) S PXEXIT=1,(PXWHO,PXWHERE,PXWHEN)="" "RTN","PXKMAIN",135,0) ;First case: new visit data being saved. "RTN","PXKMAIN",136,0) I 11[$D(^TMP("PXK",$J,"VST",1,0,"AFTER")) D "RTN","PXKMAIN",137,0) . S PX0=^TMP("PXK",$J,"VST",1,0,"AFTER") "RTN","PXKMAIN",138,0) . D L2 "RTN","PXKMAIN",139,0) ;Second case: use existing visit data. "RTN","PXKMAIN",140,0) I 11[$D(^TMP("PXK",$J,"VST",1,"IEN")) D "RTN","PXKMAIN",141,0) . S PXVISIT=+^TMP("PXK",$J,"VST",1,"IEN") "RTN","PXKMAIN",142,0) . Q:'PXVISIT "RTN","PXKMAIN",143,0) . Q:$D(^AUPNVSIT(PXVISIT,0))[0 "RTN","PXKMAIN",144,0) . S PX0=^AUPNVSIT(PXVISIT,0) "RTN","PXKMAIN",145,0) . D L2 "RTN","PXKMAIN",146,0) ;Third case: Uses "PXKCO" instead of "PXK". "RTN","PXKMAIN",147,0) I PXEXIT,$D(^TMP("PXKCO",$J)) D "RTN","PXKMAIN",148,0) . S PXVISIT=$O(^TMP("PXKCO",$J,0)) "RTN","PXKMAIN",149,0) . Q:'PXVISIT "RTN","PXKMAIN",150,0) . S PX0=$G(^TMP("PXKCO",$J,PXVISIT,"VST",PXVISIT,0,"AFTER")) "RTN","PXKMAIN",151,0) . Q:PX0="" "RTN","PXKMAIN",152,0) . D L2 "RTN","PXKMAIN",153,0) ;Fourth case: Uses "PXKENC" instead of "PXK". "RTN","PXKMAIN",154,0) I PXEXIT,$D(^TMP("PXKENC",$J)) D "RTN","PXKMAIN",155,0) . S PXVISIT=$O(^TMP("PXKENC",$J,0)) "RTN","PXKMAIN",156,0) . Q:'PXVISIT "RTN","PXKMAIN",157,0) . S PX0=$G(^TMP("PXKENC",$J,PXVISIT,"VST",PXVISIT,0)) ; Look at ^TMP("PXKENC",$J "RTN","PXKMAIN",158,0) . Q:PX0="" "RTN","PXKMAIN",159,0) . D L2 "RTN","PXKMAIN",160,0) I PXEXIT Q ; Unable to obtain non-null subscripts. "RTN","PXKMAIN",161,0) S PXP59LOC=$NA(^PXLOCK(PXWHO,PXWHERE,PXWHEN)) "RTN","PXKMAIN",162,0) L +@PXP59LOC:300 "RTN","PXKMAIN",163,0) E K PXP59LOC ; Lock was unsuccessful. "RTN","PXKMAIN",164,0) Q "RTN","PXKMAIN",165,0) L2 ; Get values from visit 0 node (PX0). "RTN","PXKMAIN",166,0) I 'PXWHO S PXWHO=$P(PX0,U,5) "RTN","PXKMAIN",167,0) I 'PXWHEN S PXWHEN=$P(PX0,U,1) "RTN","PXKMAIN",168,0) I 'PXWHERE S PXWHERE=+$P(PX0,U,22) "RTN","PXKMAIN",169,0) I PXWHO,PXWHEN S PXEXIT=0 "RTN","PXKMAIN",170,0) Q "RTN","PXKMAIN",171,0) UNLOCK ; Unlock (use info in PXP59LOC)--Patch PX*1.0*59. "RTN","PXKMAIN",172,0) L -@PXP59LOC "RTN","PXKMAIN",173,0) Q "RTN","PXKMAIN",174,0) ; "RTN","PXKMAIN",175,0) CQDEL ;Classification question deletion check "RTN","PXKMAIN",176,0) I PXKCAT'="VST" Q "RTN","PXKMAIN",177,0) S PXJ="" F S PXJ=$O(PXKBV(800,PXJ)) Q:'PXJ I PXKBV(800,PXJ)'="" I '$D(PXKAV(800,PXJ)) S PXKAV(800,PXJ)="@" "RTN","PXKMAIN",178,0) K PXJ Q "RTN","PXKVST") 0^30^B18960095 "RTN","PXKVST",1,0) PXKVST ;ISL/ARS - SET UP VISIT FIELDS BEFORE CALLING OFF TO VSIT ;8/1/96 "RTN","PXKVST",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**56,111,130**;Aug 12, 1996 "RTN","PXKVST",3,0) VSIT ;ENTRY POINT "RTN","PXKVST",4,0) ;COMMON SECTION "RTN","PXKVST",5,0) N PXKAFTR,PXKAFT8,PXKAFT15,PXKAFT21,PXKAF811,PXKAF812,PXVSTIEN "RTN","PXKVST",6,0) N VSIT,VSITPKG "RTN","PXKVST",7,0) S PXKAFTR=$S($G(^TMP("PXK",$J,"VST",1,0,"AFTER"))]"":^TMP("PXK",$J,"VST",1,0,"AFTER"),1:"") "RTN","PXKVST",8,0) Q:PXKAFTR="" "RTN","PXKVST",9,0) S PXKAFT21=$S($G(^TMP("PXK",$J,"VST",1,21,"AFTER"))]"":^TMP("PXK",$J,"VST",1,21,"AFTER"),1:"") "RTN","PXKVST",10,0) S PXKAFT15=$S($G(^TMP("PXK",$J,"VST",1,150,"AFTER"))]"":^TMP("PXK",$J,"VST",1,150,"AFTER"),1:"") "RTN","PXKVST",11,0) S PXKAFT8=$S($G(^TMP("PXK",$J,"VST",1,800,"AFTER"))]"":^TMP("PXK",$J,"VST",1,800,"AFTER"),1:"") "RTN","PXKVST",12,0) S PXKAF811=$S($G(^TMP("PXK",$J,"VST",1,811,"AFTER"))]"":^TMP("PXK",$J,"VST",1,811,"AFTER"),1:"") "RTN","PXKVST",13,0) S PXKAF812=$S($G(^TMP("PXK",$J,"VST",1,812,"AFTER"))]"":^TMP("PXK",$J,"VST",1,812,"AFTER"),1:"") "RTN","PXKVST",14,0) S VSIT("IEN")=$S(^TMP("PXK",$J,"VST",1,"IEN")]"":^TMP("PXK",$J,"VST",1,"IEN"),1:"") "RTN","PXKVST",15,0) I VSIT("IEN")="" S PXKAFTR=$TR(PXKAFTR,"@"),PXKAFT8=$TR(PXKAFT8,"@") "RTN","PXKVST",16,0) S VSIT("VDT")=$S($P(PXKAFTR,"^",1)]"":$P(PXKAFTR,"^",1),1:"NOW") "RTN","PXKVST",17,0) S VSIT("TYP")=$P(PXKAFTR,"^",3) "RTN","PXKVST",18,0) S VSIT("INS")=$P(PXKAFTR,"^",6) "RTN","PXKVST",19,0) S VSIT("OUT")=$P(PXKAFT21,"^") "RTN","PXKVST",20,0) S VSIT("PAT")=$P(PXKAFTR,"^",5) "RTN","PXKVST",21,0) S VSIT("SVC")=$P(PXKAFTR,"^",7) "RTN","PXKVST",22,0) S VSIT("DSS")=$P(PXKAFTR,"^",8) "RTN","PXKVST",23,0) S VSIT("LNK")=$P(PXKAFTR,"^",12) "RTN","PXKVST",24,0) S VSIT("WIA")=$P(PXKAFTR,"^",16) "RTN","PXKVST",25,0) S VSIT("LOS")=$P(PXKAFTR,"^",17) "RTN","PXKVST",26,0) S VSIT("COD")=$P(PXKAFTR,"^",18) "RTN","PXKVST",27,0) S:$P(PXKAFTR,"^",21)]"" VSIT("ELG")=$P(PXKAFTR,"^",21) "RTN","PXKVST",28,0) S VSIT("LOC")=$P(PXKAFTR,"^",22) "RTN","PXKVST",29,0) S:$P(PXKAFT8,"^",1)]"" VSIT("SC")=$P(PXKAFT8,"^",1) "RTN","PXKVST",30,0) S:$P(PXKAFT8,"^",2)]"" VSIT("AO")=$P(PXKAFT8,"^",2) "RTN","PXKVST",31,0) S:$P(PXKAFT8,"^",3)]"" VSIT("IR")=$P(PXKAFT8,"^",3) "RTN","PXKVST",32,0) S:$P(PXKAFT8,"^",4)]"" VSIT("EC")=$P(PXKAFT8,"^",4) "RTN","PXKVST",33,0) S:$P(PXKAFT8,"^",5)]"" VSIT("MST")=$P(PXKAFT8,"^",5) ;added 6/17/98 for MST enhancement "RTN","PXKVST",34,0) ;PX*1*111 - added for HNC enhancement "RTN","PXKVST",35,0) S:$P(PXKAFT8,"^",6)]"" VSIT("HNC")=$P(PXKAFT8,"^",6) "RTN","PXKVST",36,0) S:$P(PXKAFT8,"^",7)]"" VSIT("CV")=$P(PXKAFT8,"^",7) "RTN","PXKVST",37,0) S:$P(PXKAFT15,"^",1)]"" VSIT("SVP")=$P(PXKAFT15,"^",1) "RTN","PXKVST",38,0) S:$P(PXKAFT15,"^",2)]"" VSIT("IO")=$P(PXKAFT15,"^",2) "RTN","PXKVST",39,0) S:$P(PXKAFT15,"^",3)]"" VSIT("PRI")=$P(PXKAFT15,"^",3) "RTN","PXKVST",40,0) S:$P(PXKAF812,"^",2)]"" VSIT("PKG")=$P(PXKAF812,"^",2) "RTN","PXKVST",41,0) S:$P(PXKAF812,"^",3)]"" VSIT("SOR")=$P(PXKAF812,"^",3) "RTN","PXKVST",42,0) S:PXKAF811]"" VSIT("COM")=PXKAF811 "RTN","PXKVST",43,0) I $G(VSIT("PRI"))="",VSIT("SVC")="E"!($P($G(^SC(+VSIT("LOC"),0)),"^",7)=VSIT("DSS")) S VSIT("PRI")="P" "RTN","PXKVST",44,0) S VSITPKG="PX" "RTN","PXKVST",45,0) I '$D(VSIT(0)) D "RTN","PXKVST",46,0) .S VSIT(0)=$S(VSIT("SVC")="E":"D0NM",1:"D0NEM") "RTN","PXKVST",47,0) ; "RTN","PXKVST",48,0) ;CALL FOR VSIT "RTN","PXKVST",49,0) D ^VSIT "RTN","PXKVST",50,0) I '$D(VSIT("IEN"))#2 Q "RTN","PXKVST",51,0) S PXVSTIEN=$P(VSIT("IEN"),"^",1) "RTN","PXKVST",52,0) S ^TMP("PXK",$J,"VST",1,"IEN")=PXVSTIEN "RTN","PXKVST",53,0) I PXVSTIEN<1 Q "RTN","PXKVST",54,0) D VIEN(PXVSTIEN) "RTN","PXKVST",55,0) I $P(VSIT("IEN"),"^",3)'=1 D "RTN","PXKVST",56,0) .S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=^AUPNVSIT(PXVSTIEN,0) "RTN","PXKVST",57,0) .S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,21)) "RTN","PXKVST",58,0) .S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,150)) "RTN","PXKVST",59,0) .S ^TMP("PXK",$J,"VST",1,800,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,800)) "RTN","PXKVST",60,0) .S ^TMP("PXK",$J,"VST",1,811,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,811)) "RTN","PXKVST",61,0) .S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,812)) "RTN","PXKVST",62,0) .S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",3)=$P(^AUPNVSIT(PXVSTIEN,0),"^",3) "RTN","PXKVST",63,0) .S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",7)=$P(^AUPNVSIT(PXVSTIEN,0),"^",7) "RTN","PXKVST",64,0) I $P(VSIT("IEN"),"^",3)=1 D "RTN","PXKVST",65,0) .S ^TMP("PXK",$J,"VST",1,0,"AFTER")=^AUPNVSIT(PXVSTIEN,0) "RTN","PXKVST",66,0) .S ^TMP("PXK",$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,21)) "RTN","PXKVST",67,0) .S ^TMP("PXK",$J,"VST",1,150,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,150)) "RTN","PXKVST",68,0) .S ^TMP("PXK",$J,"VST",1,800,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,800)) "RTN","PXKVST",69,0) .S ^TMP("PXK",$J,"VST",1,811,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,811)) "RTN","PXKVST",70,0) .S ^TMP("PXK",$J,"VST",1,812,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,812)) "RTN","PXKVST",71,0) .S ^TMP("PXK",$J,"VST",1,0,"BEFORE")="" "RTN","PXKVST",72,0) .S ^TMP("PXK",$J,"VST",1,21,"BEFORE")="" "RTN","PXKVST",73,0) .S ^TMP("PXK",$J,"VST",1,150,"BEFORE")="" "RTN","PXKVST",74,0) .S ^TMP("PXK",$J,"VST",1,800,"BEFORE")="" "RTN","PXKVST",75,0) .S ^TMP("PXK",$J,"VST",1,811,"BEFORE")="" "RTN","PXKVST",76,0) .S ^TMP("PXK",$J,"VST",1,812,"BEFORE")="" "RTN","PXKVST",77,0) .I $D(PXELAP)#2 D "RTN","PXKVST",78,0) ..S ^TMP("PXKCO",$J,PXVSTIEN,"VST",PXVSTIEN,"ELAP","BEFORE")="" "RTN","PXKVST",79,0) ..S ^TMP("PXKCO",$J,PXVSTIEN,"VST",PXVSTIEN,"ELAP","AFTER")=PXELAP "RTN","PXKVST",80,0) K VSIT "RTN","PXKVST",81,0) Q "RTN","PXKVST",82,0) ; "RTN","PXKVST",83,0) VIEN(VIEN) ;Put the Visit IEN in the AFTERs for all of the V-Files "RTN","PXKVST",84,0) N PXCAINX1,PXCAINX2 "RTN","PXKVST",85,0) S PXCAINX1="" "RTN","PXKVST",86,0) F S PXCAINX1=$O(^TMP("PXK",$J,PXCAINX1)) Q:PXCAINX1']"" D:"^VST^SOR^"'[PXCAINX1 "RTN","PXKVST",87,0) . S PXCAINX2="" "RTN","PXKVST",88,0) . F S PXCAINX2=$O(^TMP("PXK",$J,PXCAINX1,PXCAINX2)) Q:PXCAINX2']"" D "RTN","PXKVST",89,0) .. I $D(^TMP("PXK",$J,PXCAINX1,PXCAINX2,0,"AFTER"))=1 S $P(^TMP("PXK",$J,PXCAINX1,PXCAINX2,0,"AFTER"),"^",3)=VIEN "RTN","PXKVST",90,0) Q "RTN","PXKVST",91,0) ; "RTN","PXUTLSCC") 0^12^B35383382 "RTN","PXUTLSCC",1,0) PXUTLSCC ;ISL/dee,ISA/KWP - Validates and corrects the Service Connected Conditions ;7/23/96 "RTN","PXUTLSCC",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111,130**;Aug 12, 1996 "RTN","PXUTLSCC",3,0) Q "RTN","PXUTLSCC",4,0) ; "RTN","PXUTLSCC",5,0) SCC(PXUPAT,PXUDT,PXUHLOC,PXUTLVST,PXUIN,PXUOUT,PXUERR) ; "RTN","PXUTLSCC",6,0) ;+Input Parameters: "RTN","PXUTLSCC",7,0) ;+ PXUPAT IEN of patient "RTN","PXUTLSCC",8,0) ;+ PXUDT date and time of the encounter "RTN","PXUTLSCC",9,0) ;+ PXUHLOC Hospital Location of the enocunter "RTN","PXUTLSCC",10,0) ;+ PXUTLVST (optional) pointer to the visit that is being used "RTN","PXUTLSCC",11,0) ;+ PXUIN service connected^agent orange^ionizing radiation "RTN","PXUTLSCC",12,0) ;+ ^enviromental contaminants^military sexual trauma "RTN","PXUTLSCC",13,0) ;+ ^head and/or neck cancer "RTN","PXUTLSCC",14,0) ;+ where 1 ::= yes, 0 ::= no, null ::= n/a "RTN","PXUTLSCC",15,0) ;+ "RTN","PXUTLSCC",16,0) ;+Output Parameters: "RTN","PXUTLSCC",17,0) ;+ PXUOUT this is PXUIN corrected so that the invalid answers "RTN","PXUTLSCC",18,0) ;+ are changed to null "RTN","PXUTLSCC",19,0) ;+ PXUERR this is a six piece value one for each condition as follows: "RTN","PXUTLSCC",20,0) ;+ 1 ::= should be yes or no, but it is null "RTN","PXUTLSCC",21,0) ;+ 0 ::= no error "RTN","PXUTLSCC",22,0) ;+ -1 ::= not valued value "RTN","PXUTLSCC",23,0) ;+ -2 ::= value must be null "RTN","PXUTLSCC",24,0) ;+ -3 ::= must be null because SC is yes "RTN","PXUTLSCC",25,0) ; "RTN","PXUTLSCC",26,0) N PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC "RTN","PXUTLSCC",27,0) D SCCOND(PXUPAT,PXUDT,PXUHLOC,$G(PXUTLVST),.PXUPSCC) ;Set up array of the patients SCC "RTN","PXUTLSCC",28,0) S PXUOUT=PXUIN "RTN","PXUTLSCC",29,0) S PXUERR="0^0^0^0^0^0^0" "RTN","PXUTLSCC",30,0) S PXUSC=$P(PXUIN,"^",1) "RTN","PXUTLSCC",31,0) I '(PXUSC=1!(PXUSC=0)!(PXUSC="")) S $P(PXUERR,"^",1)=-1 S $P(PXUOUT,"^",1)="" "RTN","PXUTLSCC",32,0) E I PXUSC="" D ;it is ok "RTN","PXUTLSCC",33,0) . I $P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=1,$P(PXUOUT,"^",1)=$P(PXUPSCC("SC"),"^",2) ;should have had a value "RTN","PXUTLSCC",34,0) E I PXUSC]"" D "RTN","PXUTLSCC",35,0) . I '$P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=-2 S $P(PXUOUT,"^",1)="" ;it must be null "RTN","PXUTLSCC",36,0) . E ;it is ok "RTN","PXUTLSCC",37,0) S PXUSC=$P(PXUOUT,"^",1) "RTN","PXUTLSCC",38,0) S PXUAO=$P(PXUIN,"^",2) "RTN","PXUTLSCC",39,0) I '(PXUAO=1!(PXUAO=0)!(PXUAO="")) S $P(PXUERR,"^",2)=-1 S $P(PXUOUT,"^",2)="" "RTN","PXUTLSCC",40,0) E I PXUAO="" D ;it is ok "RTN","PXUTLSCC",41,0) . I $P(PXUPSCC("AO"),"^",1),'PXUSC S $P(PXUERR,"^",2)=1,$P(PXUOUT,"^",2)=$P(PXUPSCC("AO"),"^",2) ;should have had a value "RTN","PXUTLSCC",42,0) E I PXUAO]"" D "RTN","PXUTLSCC",43,0) . I '$P(PXUPSCC("AO"),"^",1) S $P(PXUERR,"^",2)=-2 S $P(PXUOUT,"^",2)="" ;it must be null "RTN","PXUTLSCC",44,0) . E I PXUSC,PXUAO]"" S $P(PXUERR,"^",2)=-3 S $P(PXUOUT,"^",2)="" ;it is SC so it must be null "RTN","PXUTLSCC",45,0) . ;E ;it is ok "RTN","PXUTLSCC",46,0) S PXUIR=$P(PXUIN,"^",3) "RTN","PXUTLSCC",47,0) I '(PXUIR=1!(PXUIR=0)!(PXUIR="")) S $P(PXUERR,"^",3)=-1 S $P(PXUOUT,"^",3)="" "RTN","PXUTLSCC",48,0) E I PXUIR="" D ;it is ok "RTN","PXUTLSCC",49,0) . I $P(PXUPSCC("IR"),"^",1),'PXUSC S $P(PXUERR,"^",3)=1,$P(PXUOUT,"^",3)=$P(PXUPSCC("IR"),"^",2) ;should have had a value "RTN","PXUTLSCC",50,0) E I PXUIR]"" D "RTN","PXUTLSCC",51,0) . I '$P(PXUPSCC("IR"),"^",1) S $P(PXUERR,"^",3)=-2 S $P(PXUOUT,"^",3)="" ;it must be null "RTN","PXUTLSCC",52,0) . E I PXUSC,PXUIR]"" S $P(PXUERR,"^",3)=-3 S $P(PXUOUT,"^",3)="" ;it is SC so it must be null "RTN","PXUTLSCC",53,0) . ;E ;it is ok "RTN","PXUTLSCC",54,0) S PXUEC=$P(PXUIN,"^",4) "RTN","PXUTLSCC",55,0) I '(PXUEC=1!(PXUEC=0)!(PXUEC="")) S $P(PXUERR,"^",4)=-1 S $P(PXUOUT,"^",4)="" "RTN","PXUTLSCC",56,0) E I PXUEC="" D ;it is ok "RTN","PXUTLSCC",57,0) . I $P(PXUPSCC("EC"),"^",1),'PXUSC S $P(PXUERR,"^",4)=1,$P(PXUOUT,"^",4)=$P(PXUPSCC("EC"),"^",2) ;should have had a value "RTN","PXUTLSCC",58,0) E I PXUEC]"" D "RTN","PXUTLSCC",59,0) . I '$P(PXUPSCC("EC"),"^",1) S $P(PXUERR,"^",4)=-2 S $P(PXUOUT,"^",4)="" ;it must be null "RTN","PXUTLSCC",60,0) . E I PXUSC,PXUEC]"" S $P(PXUERR,"^",4)=-3 S $P(PXUOUT,"^",4)="" ;it is SC so it must be null "RTN","PXUTLSCC",61,0) . ;E ;it is ok "RTN","PXUTLSCC",62,0) S PXUMST=$P(PXUIN,"^",5) ;MST not dependent on SC question "RTN","PXUTLSCC",63,0) I '(PXUMST=1!(PXUMST=0)!(PXUMST="")) S $P(PXUERR,"^",5)=-1 S $P(PXUOUT,"^",5)="" ;not valid data "RTN","PXUTLSCC",64,0) E I PXUMST="" D ;it is ok "RTN","PXUTLSCC",65,0) . I $P(PXUPSCC("MST"),"^",1) S $P(PXUERR,"^",5)=1,$P(PXUOUT,"^",5)=$P(PXUPSCC("MST"),"^",2) ;should have had a value "RTN","PXUTLSCC",66,0) E I PXUMST]"" D "RTN","PXUTLSCC",67,0) .I '$P(PXUPSCC("MST"),"^",1) S $P(PXUERR,"^",5)=-2 S $P(PXUOUT,"^",5)="" ;it must be null, not MST status "RTN","PXUTLSCC",68,0) ;PX*1*111 - Add Head & Neck "RTN","PXUTLSCC",69,0) S PXUHNC=$P(PXUIN,"^",6) ;HNC not dependent on SC question "RTN","PXUTLSCC",70,0) I '(PXUHNC=1!(PXUHNC=0)!(PXUHNC="")) S $P(PXUERR,"^",6)=-1 S $P(PXUOUT,"^",6)="" ;not valid data "RTN","PXUTLSCC",71,0) E I PXUHNC="" D ;it is ok "RTN","PXUTLSCC",72,0) . I $P(PXUPSCC("HNC"),"^",1) S $P(PXUERR,"^",6)=1,$P(PXUOUT,"^",6)=$P(PXUPSCC("HNC"),"^",2) ;should have had a value "RTN","PXUTLSCC",73,0) E I PXUHNC]"" D "RTN","PXUTLSCC",74,0) .I '$P(PXUPSCC("HNC"),"^",1) S $P(PXUERR,"^",6)=-2 S $P(PXUOUT,"^",6)="" ;it must be null, not HNC status "RTN","PXUTLSCC",75,0) S PXUCV=$P(PXUIN,"^",7) ;CV not dependent on SC question "RTN","PXUTLSCC",76,0) I '(PXUCV=1!(PXUCV=0)!(PXUCV="")) S $P(PXUERR,"^",7)=-1 S $P(PXUOUT,"^",7)="" ;not valid data "RTN","PXUTLSCC",77,0) E I PXUCV="" D ;it is ok "RTN","PXUTLSCC",78,0) . I $P(PXUPSCC("CV"),"^",1) S $P(PXUERR,"^",7)=1,$P(PXUOUT,"^",7)=$P(PXUPSCC("CV"),"^",2) ;should have had a value "RTN","PXUTLSCC",79,0) E I PXUCV]"" D "RTN","PXUTLSCC",80,0) .I '$P(PXUPSCC("CV"),"^",1) S $P(PXUERR,"^",7)=-2 S $P(PXUOUT,"^",7)="" ;it must be null, not HNC status "RTN","PXUTLSCC",81,0) Q "RTN","PXUTLSCC",82,0) ; "RTN","PXUTLSCC",83,0) ; "RTN","PXUTLSCC",84,0) SCCOND(DFN,APPDT,HLOC,VISIT,PXUDATA) ;Set up array of the patients "RTN","PXUTLSCC",85,0) ; Service Connected Conditions "RTN","PXUTLSCC",86,0) ; "RTN","PXUTLSCC",87,0) ;Input Parameters: "RTN","PXUTLSCC",88,0) ; DFN IEN of patient "RTN","PXUTLSCC",89,0) ; APPDT date and time of the encounter "RTN","PXUTLSCC",90,0) ; HLOC Hospital Location of the enocunter "RTN","PXUTLSCC",91,0) ; VISIT (optional) The visit that is being used "RTN","PXUTLSCC",92,0) ; "RTN","PXUTLSCC",93,0) ;Output Parameters: "RTN","PXUTLSCC",94,0) ; PXUDATA this is an array subscriped by "SC","AO","IR","EC","MST","HNC" "RTN","PXUTLSCC",95,0) ; that contains to piece each "RTN","PXUTLSCC",96,0) ; first: 1 if the condition can be answered "RTN","PXUTLSCC",97,0) ; 0 if it should be null "RTN","PXUTLSCC",98,0) ; second: the answer that Scheduling has if it has one "RTN","PXUTLSCC",99,0) ; 1 ::= yes, 0 ::= no "RTN","PXUTLSCC",100,0) ; "RTN","PXUTLSCC",101,0) N CLASSIF,XX,OUTENC,CL,END,X0,MNE "RTN","PXUTLSCC",102,0) S OUTENC="" "RTN","PXUTLSCC",103,0) I VISIT>0 D "RTN","PXUTLSCC",104,0) .S OUTENC=$O(^SCE("AVSIT",VISIT,0)) "RTN","PXUTLSCC",105,0) .I OUTENC>0,$P(^SCE(OUTENC,0),U,6) S OUTENC=$P(^SCE(OUTENC,0),U,6) "RTN","PXUTLSCC",106,0) I 'VISIT D "RTN","PXUTLSCC",107,0) .; Call if they have an appointment for this hospital location "RTN","PXUTLSCC",108,0) .; and there is an Outpatient Encounter IEN; "RTN","PXUTLSCC",109,0) .; returns the answer that scheduling has if any "RTN","PXUTLSCC",110,0) .I $G(^DPT(DFN,"S",APPDT,0))]"" S XX=$G(^(0)) I +XX=HLOC D "RTN","PXUTLSCC",111,0) ..S OUTENC=$P(XX,U,20) "RTN","PXUTLSCC",112,0) .Q:OUTENC "RTN","PXUTLSCC",113,0) .; "RTN","PXUTLSCC",114,0) .; Find an Outpatient encouter matching DFN APPDT,HLOC if any. "RTN","PXUTLSCC",115,0) .S OUTENC=$$EXAE^SDOE(DFN,APPDT,APPDT) D VEROUT "RTN","PXUTLSCC",116,0) ; "RTN","PXUTLSCC",117,0) ;Do Outpatient Encounter checks "RTN","PXUTLSCC",118,0) I OUTENC D "RTN","PXUTLSCC",119,0) .I '$D(^SCE(OUTENC,0)) S OUTENC="" Q "RTN","PXUTLSCC",120,0) .S X0=^SCE(OUTENC,0),END=0 D ENCHK(OUTENC,X0) "RTN","PXUTLSCC",121,0) .I END S OUTENC="" "RTN","PXUTLSCC",122,0) I OUTENC>0 D CLOE^SDCO21(OUTENC,.CLASSIF) "RTN","PXUTLSCC",123,0) ; "RTN","PXUTLSCC",124,0) I '$G(OUTENC) D CL^SDCO21(DFN,APPDT,"",.CLASSIF) "RTN","PXUTLSCC",125,0) S XX=0 "RTN","PXUTLSCC",126,0) F S XX=$O(^SD(409.41,XX)) Q:XX'>0 D "RTN","PXUTLSCC",127,0) .S MNE=$P($G(^SD(409.41,XX,0)),U,7) I $D(MNE) D "RTN","PXUTLSCC",128,0) ..S PXUDATA(MNE)=$D(CLASSIF(XX))_U_$P($G(CLASSIF(XX)),U,2) "RTN","PXUTLSCC",129,0) Q "RTN","PXUTLSCC",130,0) ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks "RTN","PXUTLSCC",131,0) N LOC,ORG,DFN "RTN","PXUTLSCC",132,0) S DFN=$P(X0,U,2),LOC=$P(X0,U,4),ORG=$P(X0,U,8) "RTN","PXUTLSCC",133,0) I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter "RTN","PXUTLSCC",134,0) I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic "RTN","PXUTLSCC",135,0) I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk "RTN","PXUTLSCC",136,0) I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classification "RTN","PXUTLSCC",137,0) Q "RTN","PXUTLSCC",138,0) VEROUT ;verify a clinic "RTN","PXUTLSCC",139,0) Q:'OUTENC "RTN","PXUTLSCC",140,0) S CL=$$GETOE^SDOE(OUTENC) I $P(CL,U,4)'=HLOC S OUTENC="" "RTN","PXUTLSCC",141,0) Q "RTN","PXUTLSCC",142,0) ; "RTN","VSITDEF") 0^13^B39387096 "RTN","VSITDEF",1,0) VSITDEF ;ISL/dee - Defaulting Logic for the Visit ;4/17/97 "RTN","VSITDEF",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,130**;Aug 12, 1996 "RTN","VSITDEF",3,0) ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect "RTN","VSITDEF",4,0) ; the incorporation of the module into PCE. For historical reference, "RTN","VSITDEF",5,0) ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT "RTN","VSITDEF",6,0) ; patches. "RTN","VSITDEF",7,0) ; "RTN","VSITDEF",8,0) ;;2.0;VISIT TRACKING;**1,2**;Aug 12, 1996 "RTN","VSITDEF",9,0) ; "RTN","VSITDEF",10,0) Q ; - not an entry point "RTN","VSITDEF",11,0) ; "RTN","VSITDEF",12,0) REQUIRED() ;Check the required variables "RTN","VSITDEF",13,0) ;and Default all fields that are need for lookup matching "RTN","VSITDEF",14,0) ; Returns: 0 if no errors and "RTN","VSITDEF",15,0) ; 1 if there are errors that prevent processing "RTN","VSITDEF",16,0) ; (stored in QUIT) "RTN","VSITDEF",17,0) N QUIT,SITE "RTN","VSITDEF",18,0) S QUIT=0 "RTN","VSITDEF",19,0) S SITE=+$$SITE^VASITE($P($G(VSIT("VDT")),"^")) "RTN","VSITDEF",20,0) ; - VDT "RTN","VSITDEF",21,0) S VSIT("VDT")=$$ERRCHK^VSITCK("VDT",VSIT("VDT"),$S(VSIT("SVC")="E":"TS",1:"")) "RTN","VSITDEF",22,0) I $L(VSIT("VDT"),"^")>1 D ERR^VSITPUT($P(VSIT("VDT"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",23,0) ; - PAT "RTN","VSITDEF",24,0) S VSIT("PAT")=$$ERRCHK^VSITCK("PAT",VSIT("PAT")) "RTN","VSITDEF",25,0) I $L(VSIT("PAT"),"^")>1 D ERR^VSITPUT($P(VSIT("PAT"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",26,0) I VSIT("INS")="",VSIT("OUT")="",VSIT("SVC")'="E" D "RTN","VSITDEF",27,0) . S VSIT("INS")=$$INS4LOC^VSITCK1(+VSIT("LOC")) "RTN","VSITDEF",28,0) . I VSIT("INS")']"",SITE>0 S VSIT("INS")=SITE "RTN","VSITDEF",29,0) . S VSIT("INS")=$$ERRCHK^VSITCK("INS",VSIT("INS")) "RTN","VSITDEF",30,0) I $L(VSIT("INS"),"^")>1 D ERR^VSITPUT($P(VSIT("INS"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",31,0) ; - LOC "RTN","VSITDEF",32,0) I (VSIT("INS")=SITE&(VSIT("SVC")'="E"))!(VSIT("LOC")]"") D "RTN","VSITDEF",33,0) . S VSIT("LOC")=$$ERRCHK^VSITCK("LOC",VSIT("LOC")) "RTN","VSITDEF",34,0) I $L(VSIT("LOC"),"^")>1 D ERR^VSITPUT($P(VSIT("LOC"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",35,0) ; - TYP "RTN","VSITDEF",36,0) I VSIT("TYP")']"",VSIT("INS")]"" S VSIT("TYP")="V" "RTN","VSITDEF",37,0) I VSIT("TYP")']"",VSIT("SVC")="E" S VSIT("TYP")="O" "RTN","VSITDEF",38,0) S:VSIT("TYP")']"" VSIT("TYP")=$G(DUZ("AG")) "RTN","VSITDEF",39,0) S:VSIT("TYP")']"" VSIT("TYP")=$P($G(^DIC(150.9,1,0)),"^",3) "RTN","VSITDEF",40,0) S VSIT("TYP")=$$ERRCHK^VSITCK("TYP",VSIT("TYP")) "RTN","VSITDEF",41,0) I $L(VSIT("TYP"),"^")>1 D ERR^VSITPUT($P(VSIT("TYP"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",42,0) ; - DSS "RTN","VSITDEF",43,0) I VSIT("DSS")="",VSIT("LOC")]"" D "RTN","VSITDEF",44,0) . S VSIT("DSS")=$$DSS4LOC^VSITCK1(+VSIT("LOC")) "RTN","VSITDEF",45,0) I VSIT("DSS")]"" D "RTN","VSITDEF",46,0) . S VSIT("DSS")=$$ERRCHK^VSITCK("DSS",VSIT("DSS")) "RTN","VSITDEF",47,0) I $L(VSIT("DSS"),"^")>1 D ERR^VSITPUT($P(VSIT("DSS"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",48,0) ; - IO "RTN","VSITDEF",49,0) S VSIT("IO")=$S(VSITIPM>0:1,1:0) "RTN","VSITDEF",50,0) ; - SVC "RTN","VSITDEF",51,0) I VSIT("SVC")'="E" D "RTN","VSITDEF",52,0) . I +VSIT("DSS") D "RTN","VSITDEF",53,0) .. ;Default svc based on the dss id "RTN","VSITDEF",54,0) .. I $P(^DIC(40.7,+VSIT("DSS"),0),"^",1)["TELE" S VSIT("SVC")="T" ;any TELEphone "RTN","VSITDEF",55,0) .. E I $O(^VSIT(150.1,"B",+$P(^DIC(40.7,+VSIT("DSS"),0),"^",2),0)) S VSIT("SVC")="X" "RTN","VSITDEF",56,0) .. E I VSIT("SVC")="",VSIT("DSS")=$P($G(^SC(+VSIT("LOC"),0)),"^",7) S VSIT("SVC")="A" "RTN","VSITDEF",57,0) . I VSIT("SVC")="" S VSIT("SVC")="X" "RTN","VSITDEF",58,0) I VSIT("IO") D "RTN","VSITDEF",59,0) . I VSIT("SVC")="A" S VSIT("SVC")="I" "RTN","VSITDEF",60,0) . E I VSIT("SVC")="X" S VSIT("SVC")="D" "RTN","VSITDEF",61,0) E D "RTN","VSITDEF",62,0) . I VSIT("SVC")="I" S VSIT("SVC")="A" "RTN","VSITDEF",63,0) . E I VSIT("SVC")="D" S VSIT("SVC")="X" "RTN","VSITDEF",64,0) S VSIT("SVC")=$$ERRCHK^VSITCK("SVC",VSIT("SVC")) "RTN","VSITDEF",65,0) I $L(VSIT("SVC"),"^")>1 D ERR^VSITPUT($P(VSIT("SVC"),"^",2,99)) S QUIT=1 "RTN","VSITDEF",66,0) ; "RTN","VSITDEF",67,0) Q QUIT "RTN","VSITDEF",68,0) ; "RTN","VSITDEF",69,0) DEFAULTS ;Default all of the rest of the fields that are NOT need for lookup matching "RTN","VSITDEF",70,0) ; - CDT & MDT "RTN","VSITDEF",71,0) D "RTN","VSITDEF",72,0) . N %,%H,%I,X "RTN","VSITDEF",73,0) . D NOW^%DTC "RTN","VSITDEF",74,0) . S (VSIT("CDT"),VSIT("MDT"))=% "RTN","VSITDEF",75,0) ; - LNK "RTN","VSITDEF",76,0) ; check if good "RTN","VSITDEF",77,0) D:VSIT("LNK")]"" "RTN","VSITDEF",78,0) . S VSIT("LNK")=$$GET^VSITVAR("LNK",VSIT("LNK")) "RTN","VSITDEF",79,0) . I +VSIT("LNK"),+VSIT("PAT") D "RTN","VSITDEF",80,0) . . S NOD=$G(^AUPNVSIT(+VSIT("LNK"),0)) "RTN","VSITDEF",81,0) . . S:+$P(NOD,"^",11) VSIT("LNK")="" ; delete flag "RTN","VSITDEF",82,0) . . S:+VSIT("PAT")'=$P(NOD,"^",5) VSIT("LNK")="" ; different patients "RTN","VSITDEF",83,0) S VSIT("LNK")=$$ERRCHK^VSITCK("LNK",VSIT("LNK")) "RTN","VSITDEF",84,0) D:$L(VSIT("LNK"),"^")>1 WRN^VSITPUT($P(VSIT("LNK"),"^",2,99)) "RTN","VSITDEF",85,0) ; - COD "RTN","VSITDEF",86,0) S VSIT("COD")=$$ERRCHK^VSITCK("COD",VSIT("COD")) "RTN","VSITDEF",87,0) D:$L(VSIT("COD"),"^")>1 WRN^VSITPUT($P(VSIT("COD"),"^",2,99)) "RTN","VSITDEF",88,0) ; - ELG "RTN","VSITDEF",89,0) I +VSIT("PAT"),$F(VSIT(0),"I")!($F(VSIT(0),"E")) D "RTN","VSITDEF",90,0) . S:VSIT(0)["I" VSIT("ELG")=$$ELG^VSITASK(VSIT("PAT")) "RTN","VSITDEF",91,0) . D:VSIT("ELG")="" "RTN","VSITDEF",92,0) . . S:VSIT("LNK")>0 VSIT("ELG")=$P($G(^AUPNVSIT(VSIT("LNK"),0)),"^",21) ;Eligibility Code form Parent Visit "RTN","VSITDEF",93,0) . . S:VSIT("ELG")="" VSIT("ELG")=$P($G(^DPT(+VSIT("PAT"),.36)),"^") ;Primary Eligibility Code "RTN","VSITDEF",94,0) . . D:VSIT("ELG")="" "RTN","VSITDEF",95,0) . . . N VSITI,VSITE "RTN","VSITDEF",96,0) . . . S (VSITI,VSITE)=0 "RTN","VSITDEF",97,0) . . . ;See if any eligibilities it the Patient Eigibilities sub-file "RTN","VSITDEF",98,0) . . . F S VSITE=$O(^DPT(+VSIT("PAT"),"E",VSITE)) Q:VSITE'>0 S VSITI=VSITI+1 "RTN","VSITDEF",99,0) . . . I VSITI=1 S VSIT("ELG")=$O(^DPT(+VSIT("PAT"),"E",0)) ;If only one use it "RTN","VSITDEF",100,0) S VSIT("ELG")=$$ERRCHK^VSITCK("ELG",VSIT("ELG")) "RTN","VSITDEF",101,0) D:$L(VSIT("ELG"),"^")>1 WRN^VSITPUT($P(VSIT("ELG"),"^",2,99)) "RTN","VSITDEF",102,0) ; - USR "RTN","VSITDEF",103,0) I VSIT("USR")="",+$G(DUZ) S VSIT("USR")=+DUZ "RTN","VSITDEF",104,0) S VSIT("USR")=$$ERRCHK^VSITCK("USR",VSIT("USR")) "RTN","VSITDEF",105,0) D:$L(VSIT("USR"),"^")>1 WRN^VSITPUT($P(VSIT("USR"),"^",2,99)) "RTN","VSITDEF",106,0) ; - OPT "RTN","VSITDEF",107,0) S:VSIT("OPT")="" VSIT("OPT")=$P($G(XQY),"^") "RTN","VSITDEF",108,0) S VSIT("OPT")=$$ERRCHK^VSITCK("OPT",VSIT("OPT")) "RTN","VSITDEF",109,0) D:$L(VSIT("OPT"),"^")>1 WRN^VSITPUT($P(VSIT("OPT"),"^",2,99)) "RTN","VSITDEF",110,0) ; - PRO "RTN","VSITDEF",111,0) I VSIT("PRO")="",$P($G(XQORNOD),";",2)="ORD(101," S VSIT("PRO")=$P($G(XQORNOD),";") "RTN","VSITDEF",112,0) S VSIT("PRO")=$$ERRCHK^VSITCK("PRO",VSIT("PRO")) "RTN","VSITDEF",113,0) D:$L(VSIT("PRO"),"^")>1 WRN^VSITPUT($P(VSIT("PRO"),"^",2,99)) "RTN","VSITDEF",114,0) ; - OUT "RTN","VSITDEF",115,0) S VSIT("OUT")=$$ERRCHK^VSITCK("OUT",VSIT("OUT")) "RTN","VSITDEF",116,0) D:$L(VSIT("OUT"),"^")>1 WRN^VSITPUT($P(VSIT("OUT"),"^",2,99)) "RTN","VSITDEF",117,0) ; - VID "RTN","VSITDEF",118,0) S VSIT("VID")=$$GETVID^VSITVID "RTN","VSITDEF",119,0) ; - PRI "RTN","VSITDEF",120,0) I VSIT("PRI")="P",$O(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+VSIT("DSS"),0)),"^",2),0)) S VSIT("PRI")="O" "RTN","VSITDEF",121,0) S VSIT("PRI")=$$ERRCHK^VSITCK("PRI",VSIT("PRI")) "RTN","VSITDEF",122,0) D:$L(VSIT("PRI"),"^")>1 WRN^VSITPUT($P(VSIT("PRI"),"^",2,99)) "RTN","VSITDEF",123,0) ; - SC "RTN","VSITDEF",124,0) S VSIT("SC")=$$ERRCHK^VSITCK("SC",VSIT("SC")) "RTN","VSITDEF",125,0) D:$L(VSIT("SC"),"^")>1 WRN^VSITPUT($P(VSIT("SC"),"^",2,99)) "RTN","VSITDEF",126,0) ; - AO "RTN","VSITDEF",127,0) S VSIT("AO")=$$ERRCHK^VSITCK("AO",VSIT("AO")) "RTN","VSITDEF",128,0) D:$L(VSIT("AO"),"^")>1 WRN^VSITPUT($P(VSIT("AO"),"^",2,99)) "RTN","VSITDEF",129,0) ; - IR "RTN","VSITDEF",130,0) S VSIT("IR")=$$ERRCHK^VSITCK("IR",VSIT("IR")) "RTN","VSITDEF",131,0) D:$L(VSIT("IR"),"^")>1 WRN^VSITPUT($P(VSIT("IR"),"^",2,99)) "RTN","VSITDEF",132,0) ; - EC "RTN","VSITDEF",133,0) S VSIT("EC")=$$ERRCHK^VSITCK("EC",VSIT("EC")) "RTN","VSITDEF",134,0) D:$L(VSIT("EC"),"^")>1 WRN^VSITPUT($P(VSIT("EC"),"^",2,99)) "RTN","VSITDEF",135,0) ; - HNC - PX*1*111 - Head & Neck "RTN","VSITDEF",136,0) S VSIT("HNC")=$$ERRCHK^VSITCK("HNC",VSIT("HNC")) "RTN","VSITDEF",137,0) D:$L(VSIT("HNC"),"^")>1 WRN^VSITPUT($P(VSIT("HNC"),"^",2,99)) "RTN","VSITDEF",138,0) ; - CV - PX*1*130 - Combat Vet "RTN","VSITDEF",139,0) S VSIT("CV")=$$ERRCHK^VSITCK("CV",VSIT("CV")) "RTN","VSITDEF",140,0) D:$L(VSIT("CV"),"^")>1 WRN^VSITPUT($P(VSIT("CV"),"^",2,99)) "RTN","VSITDEF",141,0) ; - COM "RTN","VSITDEF",142,0) S VSIT("COM")=$$ERRCHK^VSITCK("COM",VSIT("COM")) "RTN","VSITDEF",143,0) D:$L(VSIT("COM"),"^")>1 WRN^VSITPUT($P(VSIT("COM"),"^",2,99)) "RTN","VSITDEF",144,0) ; - VER "RTN","VSITDEF",145,0) S VSIT("VER")=$$ERRCHK^VSITCK("VER",VSIT("VER")) "RTN","VSITDEF",146,0) D:$L(VSIT("VER"),"^")>1 WRN^VSITPUT($P(VSIT("VER"),"^",2,99)) "RTN","VSITDEF",147,0) ; - PKG "RTN","VSITDEF",148,0) S VSIT("PKG")=$$PKG2IEN^VSIT(VSIT("PKG")) "RTN","VSITDEF",149,0) S VSIT("PKG")=$$ERRCHK^VSITCK("PKG",VSIT("PKG")) "RTN","VSITDEF",150,0) D:$L(VSIT("PKG"),"^")>1 WRN^VSITPUT($P(VSIT("PKG"),"^",2,99)) "RTN","VSITDEF",151,0) ; - SOR "RTN","VSITDEF",152,0) ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO "RTN","VSITDEF",153,0) I VSIT("SOR")'=+VSIT("SOR") D "RTN","VSITDEF",154,0) . I $T(SOURCE^PXAPI)="" D "RTN","VSITDEF",155,0) .. S VSIT("SOR")=$$SOURCE^PXAPI(VSIT("SOR")) "RTN","VSITDEF",156,0) . E S VSIT("SOR")="" "RTN","VSITDEF",157,0) S VSIT("SOR")=$$ERRCHK^VSITCK("SOR",VSIT("SOR")) "RTN","VSITDEF",158,0) D:$L(VSIT("SOR"),"^")>1 WRN^VSITPUT($P(VSIT("SOR"),"^",2,99)) "RTN","VSITDEF",159,0) ; "RTN","VSITDEF",160,0) Q "RTN","VSITDEF",161,0) ; "RTN","VSITFLD") 0^14^B7817318 "RTN","VSITFLD",1,0) VSITFLD ;ISD/MRL,RJP - Visit Tracking file fields array setup ;6/20/96 "RTN","VSITFLD",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,81,111,130**;Aug 12, 1996 "RTN","VSITFLD",3,0) ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect "RTN","VSITFLD",4,0) ; the incorporation of the module into PCE. For historical reference, "RTN","VSITFLD",5,0) ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT "RTN","VSITFLD",6,0) ; patches. "RTN","VSITFLD",7,0) ; "RTN","VSITFLD",8,0) ;;2.0;VISIT TRACKING;**4**;Aug 12, 1996; "RTN","VSITFLD",9,0) ; "RTN","VSITFLD",10,0) Q "RTN","VSITFLD",11,0) ; "RTN","VSITFLD",12,0) FLD ; - Visit file fields; array subscript and field DD number fmt "RTN","VSITFLD",13,0) ; ;;;; "RTN","VSITFLD",14,0) ; "RTN","VSITFLD",15,0) S ^TMP("VSITDD",$J,"VDT")="VDT;.01;0;1;Invalid Encounter/Admit Date&Time [0;1]" "RTN","VSITFLD",16,0) S ^TMP("VSITDD",$J,"CDT")="CDT;.02;0;2" "RTN","VSITFLD",17,0) S ^TMP("VSITDD",$J,"TYP")="TYP;.03;0;3;Invalid Type [0:3]" "RTN","VSITFLD",18,0) S ^TMP("VSITDD",$J,"PAT")="PAT;.05;0;5;Invalid Patient [0:5]" "RTN","VSITFLD",19,0) S ^TMP("VSITDD",$J,"INS")="INS;.06;0;6;Invalid Loc of Encounter [0:6]" "RTN","VSITFLD",20,0) S ^TMP("VSITDD",$J,"SVC")="SVC;.07;0;7;Invalid Service Category [0:7]" "RTN","VSITFLD",21,0) S ^TMP("VSITDD",$J,"DSS")="DSS;.08;0;8;Invalid DSS ID [0:8]" "RTN","VSITFLD",22,0) S ^TMP("VSITDD",$J,"CTR")="CTR;.09;0;9" "RTN","VSITFLD",23,0) S ^TMP("VSITDD",$J,"DEL")="DEL;.11;0;11" "RTN","VSITFLD",24,0) S ^TMP("VSITDD",$J,"LNK")="LNK;.12;0;12" "RTN","VSITFLD",25,0) S ^TMP("VSITDD",$J,"MDT")="MDT;.13;0;13" "RTN","VSITFLD",26,0) S ^TMP("VSITDD",$J,"COD")="COD;.18;0;18" "RTN","VSITFLD",27,0) S ^TMP("VSITDD",$J,"ELG")="ELG;.21;0;21;Invalid Eligibility [0:21]" "RTN","VSITFLD",28,0) S ^TMP("VSITDD",$J,"LOC")="LOC;.22;0;22;Invalid Hospital Location [0:22] - The specified Hospital Location was not found defined in the Hospital Location file." "RTN","VSITFLD",29,0) S ^TMP("VSITDD",$J,"USR")="USR;.23;0;23;Invalid Created by User [0:23]" "RTN","VSITFLD",30,0) S ^TMP("VSITDD",$J,"OPT")="OPT;.24;0;24" "RTN","VSITFLD",31,0) S ^TMP("VSITDD",$J,"PRO")="PRO;.25;0;25" "RTN","VSITFLD",32,0) S ^TMP("VSITDD",$J,"OUT")="OUT;2101;21;1" "RTN","VSITFLD",33,0) S ^TMP("VSITDD",$J,"VID")="VID;15001;150;1" "RTN","VSITFLD",34,0) S ^TMP("VSITDD",$J,"IO")="IO;15002;150;2" "RTN","VSITFLD",35,0) S ^TMP("VSITDD",$J,"PRI")="PRI;15003;150;3" "RTN","VSITFLD",36,0) S ^TMP("VSITDD",$J,"SC")="SC;80001;800;1" "RTN","VSITFLD",37,0) S ^TMP("VSITDD",$J,"AO")="AO;80002;800;2" "RTN","VSITFLD",38,0) S ^TMP("VSITDD",$J,"IR")="IR;80003;800;3" "RTN","VSITFLD",39,0) S ^TMP("VSITDD",$J,"EC")="EC;80004;800;4" "RTN","VSITFLD",40,0) S ^TMP("VSITDD",$J,"MST")="MST;80005;800;5" ;added 6/17/98 for MST enhancement "RTN","VSITFLD",41,0) S ^TMP("VSITDD",$J,"HNC")="HNC;80006;800;6" ;PX*1*111 added for HNC enhancement "RTN","VSITFLD",42,0) S ^TMP("VSITDD",$J,"CV")="CV;80007;800;7" ;PX*1*130 added for CV enhancement "RTN","VSITFLD",43,0) S ^TMP("VSITDD",$J,"COM")="COM;81101;811;1" "RTN","VSITFLD",44,0) S ^TMP("VSITDD",$J,"VER")="VER;81201;812;1" "RTN","VSITFLD",45,0) S ^TMP("VSITDD",$J,"PKG")="PKG;81202;812;2" "RTN","VSITFLD",46,0) S ^TMP("VSITDD",$J,"SOR")="SOR;81203;812;3" "RTN","VSITFLD",47,0) Q "RTN","VSITFLD",48,0) ; "RTN","VSITHLP") 0^15^B18175891 "RTN","VSITHLP",1,0) VSITHLP ;ISD/RJP - Visit Information ;8/8/96 "RTN","VSITHLP",2,0) ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,130**;Aug 12, 1996 "RTN","VSITHLP",3,0) ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect "RTN","VSITHLP",4,0) ; the incorporation of the module into PCE. For historical reference, "RTN","VSITHLP",5,0) ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT "RTN","VSITHLP",6,0) ; patches. "RTN","VSITHLP",7,0) ; "RTN","VSITHLP",8,0) ;;2.0;VISIT TRACKING;;Aug 12, 1996; "RTN","VSITHLP",9,0) ; "RTN","VSITHLP",10,0) N TXT,DIR,DX,DY,VSITI,X "RTN","VSITHLP",11,0) I '$D(IOSL) S IOP=0 D ^%ZIS K IOP "RTN","VSITHLP",12,0) D HOME^%ZIS W @IOF "RTN","VSITHLP",13,0) F VSITI=1:1 S TXT=$T(TXT+VSITI) Q:TXT="" D "RTN","VSITHLP",14,0) . W $P(TXT,";;",2) "RTN","VSITHLP",15,0) . I $Y>(IOSL-3) D "RTN","VSITHLP",16,0) . . S DIR(0)="E" D ^DIR "RTN","VSITHLP",17,0) . . N X S $P(X," ",79)="" W $C(13),X,$C(13) "RTN","VSITHLP",18,0) . . S (DX,DY)=0 X ^%ZOSF("XY") "RTN","VSITHLP",19,0) . E W ! "RTN","VSITHLP",20,0) Q "RTN","VSITHLP",21,0) ; "RTN","VSITHLP",22,0) TXT ; "RTN","VSITHLP",23,0) ;; VSIT(0) A string of characters which defines how the visit "RTN","VSITHLP",24,0) ;; processor will function. "RTN","VSITHLP",25,0) ;; "RTN","VSITHLP",26,0) ;; F - Force adding a new entry. "RTN","VSITHLP",27,0) ;; I - Interactive mode. "RTN","VSITHLP",28,0) ;; E - Use pt's primary eligibility if now passed on "RTN","VSITHLP",29,0) ;; call w/ VSIT("ELG"). "RTN","VSITHLP",30,0) ;; N - Allow creation of a new visit. "RTN","VSITHLP",31,0) ;; D - Look back "n" number of days for a match, default "RTN","VSITHLP",32,0) ;; is one (1). e.g. VSIT(0)="D5" (v/dt to v/dt-4) "RTN","VSITHLP",33,0) ;; Use "D0" to require exact match on date & time. "RTN","VSITHLP",34,0) ;; M - Impose criteria on matching or creation of visits. "RTN","VSITHLP",35,0) ;; Uses the VSIT() array: "RTN","VSITHLP",36,0) ; [[^...]] for multiple values "RTN","VSITHLP",37,0) ;; - If trying to match with existing visit, each element "RTN","VSITHLP",38,0) ;; must match each corresponding field. "RTN","VSITHLP",39,0) ;; "RTN","VSITHLP",40,0) ;; Variable names for VISIT file fields: #9000010 gbl: ^AUPNVSIT( "RTN","VSITHLP",41,0) ;; (format) -> [^] "RTN","VSITHLP",42,0) ;; except VSIT() = N^S[^1] "RTN","VSITHLP",43,0) ;; where N = internal entry number "RTN","VSITHLP",44,0) ;; S = value of .01 filed "RTN","VSITHLP",45,0) ;; 1 = indicated new entry added "RTN","VSITHLP",46,0) ;; .001 - VSIT("IEN") ; NUMBER (internal entry number) "RTN","VSITHLP",47,0) ;; .01 - VSIT("VDT") ; VISIT/ADMIT DATE&TIME (date) "RTN","VSITHLP",48,0) ;; .02 - VSIT("CDT") ; DATE VISIT CREATED (date) "RTN","VSITHLP",49,0) ;; .03 - VSIT("TYP") ; TYPE (set) "RTN","VSITHLP",50,0) ;; .05 - VSIT("PAT") ; PATIENT (pointer to PATIENT file #9000001) "RTN","VSITHLP",51,0) ;; (IHS file DINUM'ed to PATIENT file #2) "RTN","VSITHLP",52,0) ;; .06 - VSIT("INS") ; LOC. OF ENCOUNTER (pointer to LOCATION file "RTN","VSITHLP",53,0) ;; #9999999.06) "RTN","VSITHLP",54,0) ;; (IHS file DINUM'ed to INSTITUTION file #4) "RTN","VSITHLP",55,0) ;; .07 - VSIT("SVC") ; SERVICE CATEGORY (set) "RTN","VSITHLP",56,0) ;; .08 - VSIT("DSS") ; CLINIC (pointer to CLINIC STOP file #40.7) "RTN","VSITHLP",57,0) ;; .09 - VSIT("CTR") ; DEPENDENT ENTRY COUNTER (number) "RTN","VSITHLP",58,0) ;; .11 - VSIT("DEL") ; DELETE FLAG (set) "RTN","VSITHLP",59,0) ;; .12 - VSIT("LNK") ; PARENT VISIT LINK (pointer to VISIT file) "RTN","VSITHLP",60,0) ;; .13 - VSIT("MDT") ; DATE LAST MODIFIED (date) "RTN","VSITHLP",61,0) ;; .18 - VSIT("COD") ; CHECK OUT DATE&TIME (date) "RTN","VSITHLP",62,0) ;; .21 - VSIT("ELG") ; ELIGIBILITY (pointer to ELIGIBILITY CODE "RTN","VSITHLP",63,0) ;; file #8) "RTN","VSITHLP",64,0) ;; .22 - VSIT("LOC") ; HOSPITAL LOCATION (pointer to HOSPITAL "RTN","VSITHLP",65,0) ;; LOCATION file #44) "RTN","VSITHLP",66,0) ;; .23 - VSIT("USR") ; CREATED BY USER (pointer to USER file #200) "RTN","VSITHLP",67,0) ;; .24 - VSIT("OPT") ; OPTION USED TO CREATE (pointer to OPTION "RTN","VSITHLP",68,0) ;; file #19) "RTN","VSITHLP",69,0) ;; .25 - VSIT("PRO") ; PROTOCOL (pointer to PROTOCOL file #101) "RTN","VSITHLP",70,0) ;; 2101 - VSIT("OUT") ; OUTSIDE LOCATION (free text) "RTN","VSITHLP",71,0) ;; 15001 - VSIT("VID") ; VISIT ID (free text) "RTN","VSITHLP",72,0) ;; 15002 - VSIT("IO") ; PATIENT STATUS IN/OUT (set) "RTN","VSITHLP",73,0) ;; 15003 - VSIT("PRI") ; ENCOUNTER TYPE (set) "RTN","VSITHLP",74,0) ;; 80001 - VSIT("SC") ; SERVICE CONNECTED (set) "RTN","VSITHLP",75,0) ;; 80002 - VSIT("AO") ; AGENT ORANGE EXPOSURE (set) "RTN","VSITHLP",76,0) ;; 80003 - VSIT("IR") ; IONIZING RADIATION EXPOSURE (set) "RTN","VSITHLP",77,0) ;; 80004 - VSIT("EC") ; PERSIAN GULF EXPOSURE (set) "RTN","VSITHLP",78,0) ;; 80006 - VSIT("HNC") ; HEAD AND/OR NECK CANCER (set) "RTN","VSITHLP",79,0) ;; 80007 - VSIT("CV") ; COMBAT VET (set) "RTN","VSITHLP",80,0) ;; 81101 - VSIT("COM") ; COMMENTS (free text) "RTN","VSITHLP",81,0) ;; 81202 - VSIT("PKG") ; PACKAGE (pointer to PACKAGE file #9.4) "RTN","VSITHLP",82,0) ;; 81203 - VSIT("SOR") ; DATA SOURCE (pointer to PCE DATA SOURCE "RTN","VSITHLP",83,0) ;; file #839.7) "VER") 8.0^22.0 "^DD",9000010,9000010,80007,0) COMBAT VETERAN^S^1:YES;0:NO;^800;7^Q "^DD",9000010,9000010,80007,3) If this visit is treating a problem possibly related to combat. "^DD",9000010,9000010,80007,21,0) ^^2^2^3031118^ "^DD",9000010,9000010,80007,21,1,0) This field is used to indicate that the visit represents treatment of a "^DD",9000010,9000010,80007,21,2,0) VA patient for a problem that is possibly related to combat. "^DD",9000010,9000010,80007,"DT") 3031118 "^DD",9000010.07,9000010.07,80005,0) MILITARY SEXUAL TRAUMA^S^1:YES;0:NO;^800;5^Q "^DD",9000010.07,9000010.07,80005,3) If this Diagnosis code is related to Military Sexual Trauma, enter a "YES" here "^DD",9000010.07,9000010.07,80005,21,0) ^.001^2^2^3030613^^^^ "^DD",9000010.07,9000010.07,80005,21,1,0) This field will be used to indicate if this Diagnosis code was "^DD",9000010.07,9000010.07,80005,21,2,0) related to a Military Sexual Trauma problem. "^DD",9000010.07,9000010.07,80005,"DT") 3030613 "^DD",9000010.07,9000010.07,80006,0) HEAD AND/OR NECK CANCER^S^1:YES;0:NO;^800;6^Q "^DD",9000010.07,9000010.07,80006,3) If this Diagnosis is treating a problem related to Head/Neck Cance "^DD",9000010.07,9000010.07,80006,21,0) ^.001^2^2^3030613^^^ "^DD",9000010.07,9000010.07,80006,21,1,0) This field will be used to indicate if this Diagnosis code was "^DD",9000010.07,9000010.07,80006,21,2,0) related to Head and/or Neck Cancer "^DD",9000010.07,9000010.07,80006,"DT") 3030613 "^DD",9000010.07,9000010.07,80007,0) COMBAT VETERAN^S^1:YES;0:NO;^800;7^Q "^DD",9000010.07,9000010.07,80007,3) If this visit is treating a problem possibly related to combat. "^DD",9000010.07,9000010.07,80007,21,0) ^^2^2^3031118^ "^DD",9000010.07,9000010.07,80007,21,1,0) This field is used to indicate that the visit represents treatment of a "^DD",9000010.07,9000010.07,80007,21,2,0) VA patient for a problem that is possibly related to combat. "^DD",9000010.07,9000010.07,80007,"DT") 3031118 **INSTALL NAME** SD*5.3*325 "BLD",3652,0) SD*5.3*325^SCHEDULING^0^3040630^y "BLD",3652,4,0) ^9.64PA^409.76^1 "BLD",3652,4,409.76,0) 409.76 "BLD",3652,4,409.76,222) n^n^f^^n^^y^o^n "BLD",3652,4,409.76,224) N TMP S TMP=$P(^(0),"^",1) I ",733,734,735,7330,7340,904,9040,"[TMP "BLD",3652,4,"B",409.76,409.76) "BLD",3652,"INI") PRE^SD53325 "BLD",3652,"INIT") POST^SD53325 "BLD",3652,"KRN",0) ^9.67PA^8989.52^19 "BLD",3652,"KRN",.4,0) .4 "BLD",3652,"KRN",.401,0) .401 "BLD",3652,"KRN",.402,0) .402 "BLD",3652,"KRN",.403,0) .403 "BLD",3652,"KRN",.5,0) .5 "BLD",3652,"KRN",.84,0) .84 "BLD",3652,"KRN",3.6,0) 3.6 "BLD",3652,"KRN",3.8,0) 3.8 "BLD",3652,"KRN",9.2,0) 9.2 "BLD",3652,"KRN",9.8,0) 9.8 "BLD",3652,"KRN",9.8,"NM",0) ^9.68A^11^10 "BLD",3652,"KRN",9.8,"NM",1,0) SD53325^^0^B8544785 "BLD",3652,"KRN",9.8,"NM",2,0) SDCO22^^0^B8515730 "BLD",3652,"KRN",9.8,"NM",3,0) SDPCE^^0^B41523344 "BLD",3652,"KRN",9.8,"NM",4,0) SDCO21^^0^B6378751 "BLD",3652,"KRN",9.8,"NM",6,0) SCDXUTL0^^0^B34266243 "BLD",3652,"KRN",9.8,"NM",7,0) SCDXMSG1^^0^B72945063 "BLD",3652,"KRN",9.8,"NM",8,0) SCMSVZEL^^0^B8509859 "BLD",3652,"KRN",9.8,"NM",9,0) SCMSVUT2^^0^B28593958 "BLD",3652,"KRN",9.8,"NM",10,0) SD53325A^^0^B19716057 "BLD",3652,"KRN",9.8,"NM",11,0) SDAMEP2^^0^B18686916 "BLD",3652,"KRN",9.8,"NM","B","SCDXMSG1",7) "BLD",3652,"KRN",9.8,"NM","B","SCDXUTL0",6) "BLD",3652,"KRN",9.8,"NM","B","SCMSVUT2",9) "BLD",3652,"KRN",9.8,"NM","B","SCMSVZEL",8) "BLD",3652,"KRN",9.8,"NM","B","SD53325",1) "BLD",3652,"KRN",9.8,"NM","B","SD53325A",10) "BLD",3652,"KRN",9.8,"NM","B","SDAMEP2",11) "BLD",3652,"KRN",9.8,"NM","B","SDCO21",4) "BLD",3652,"KRN",9.8,"NM","B","SDCO22",2) "BLD",3652,"KRN",9.8,"NM","B","SDPCE",3) "BLD",3652,"KRN",19,0) 19 "BLD",3652,"KRN",19.1,0) 19.1 "BLD",3652,"KRN",101,0) 101 "BLD",3652,"KRN",409.61,0) 409.61 "BLD",3652,"KRN",771,0) 771 "BLD",3652,"KRN",870,0) 870 "BLD",3652,"KRN",8989.51,0) 8989.51 "BLD",3652,"KRN",8989.52,0) 8989.52 "BLD",3652,"KRN",8994,0) 8994 "BLD",3652,"KRN","B",.4,.4) "BLD",3652,"KRN","B",.401,.401) "BLD",3652,"KRN","B",.402,.402) "BLD",3652,"KRN","B",.403,.403) "BLD",3652,"KRN","B",.5,.5) "BLD",3652,"KRN","B",.84,.84) "BLD",3652,"KRN","B",3.6,3.6) "BLD",3652,"KRN","B",3.8,3.8) "BLD",3652,"KRN","B",9.2,9.2) "BLD",3652,"KRN","B",9.8,9.8) "BLD",3652,"KRN","B",19,19) "BLD",3652,"KRN","B",19.1,19.1) "BLD",3652,"KRN","B",101,101) "BLD",3652,"KRN","B",409.61,409.61) "BLD",3652,"KRN","B",771,771) "BLD",3652,"KRN","B",870,870) "BLD",3652,"KRN","B",8989.51,8989.51) "BLD",3652,"KRN","B",8989.52,8989.52) "BLD",3652,"KRN","B",8994,8994) "BLD",3652,"QUES",0) ^9.62^^ "BLD",3652,"REQB",0) ^9.611^6^5 "BLD",3652,"REQB",1,0) SD*5.3*244^2 "BLD",3652,"REQB",2,0) SD*5.3*258^2 "BLD",3652,"REQB",4,0) SD*5.3*254^2 "BLD",3652,"REQB",5,0) SD*5.3*293^2 "BLD",3652,"REQB",6,0) DG*5.3*576^2 "BLD",3652,"REQB","B","DG*5.3*576",6) "BLD",3652,"REQB","B","SD*5.3*244",1) "BLD",3652,"REQB","B","SD*5.3*254",4) "BLD",3652,"REQB","B","SD*5.3*258",2) "BLD",3652,"REQB","B","SD*5.3*293",5) "DATA",409.76,276,0) 733^N "DATA",409.76,276,1) Combat Veteran is missing or invalid "DATA",409.76,276,2,0) ^^2^2^3040121^ "DATA",409.76,276,2,1,0) Review combat and military service data through the Load/Edit Patient Data "DATA",409.76,276,2,2,0) protocol, Screen 6. "DATA",409.76,276,"COR") S RTN=$$LEDT^SCENIA1() "DATA",409.76,277,0) 7330^V "DATA",409.76,277,1) Combat Veteran is missing or invalid "DATA",409.76,277,2,0) ^409.7621^2^2^3040121^^ "DATA",409.76,277,2,1,0) Review combat and military service data through the Load/Edit Patient Data "DATA",409.76,277,2,2,0) protocol, Screen 6. "DATA",409.76,277,"CHK") S RES=$$VA01^SCMSVUT3(DATA) "DATA",409.76,277,"COR") S RTN=$$LEDT^SCENIA1() "DATA",409.76,278,0) 734^N "DATA",409.76,278,1) Combat Veteran end date is invalid "DATA",409.76,278,2,0) ^^2^2^3040121^ "DATA",409.76,278,2,1,0) Review combat and military service data through the Load/Edit Patient Data "DATA",409.76,278,2,2,0) protocol, Screen 6. "DATA",409.76,278,"COR") S RTN=$$LEDT^SCENIA1() "DATA",409.76,279,0) 735^N "DATA",409.76,279,1) Combat Veteran end date missing "DATA",409.76,279,2,0) ^^2^2^3040121^ "DATA",409.76,279,2,1,0) Review combat and military service data through the Load/Edit Patient Data "DATA",409.76,279,2,2,0) protocol, Screen 6. "DATA",409.76,279,"COR") S RTN=$$LEDT^SCENIA1() "DATA",409.76,280,0) 7340^V "DATA",409.76,280,1) Combat Veteran end date missing or invalid "DATA",409.76,280,2,0) ^^2^2^3040121^ "DATA",409.76,280,2,1,0) Review combat and military service data through the Load/Edit Patient Data "DATA",409.76,280,2,2,0) protocol, Screen 6. "DATA",409.76,280,"CHK") S RES=$$CVEDT^SCMSVUT2(DATA) "DATA",409.76,280,"COR") S RTN=$$LEDT^SCENIA1() "DATA",409.76,281,0) 904^N "DATA",409.76,281,1) Combet Vet status inconsistent with classification type "DATA",409.76,281,2,0) ^409.7621^4^4^3040218^^ "DATA",409.76,281,2,1,0) Encounter has been marked as being related to combat but patient is not a "DATA",409.76,281,2,2,0) combat veteran (or was no longer considered a combat veteran at the time "DATA",409.76,281,2,3,0) of the encounter). Review patient information through Load/Edit Patient "DATA",409.76,281,2,4,0) Data protocol, Screen 6. "DATA",409.76,281,"CHK") "DATA",409.76,281,"COR") S RTN=$$LEDT^SCENIA1 "DATA",409.76,282,0) 9040^N "DATA",409.76,282,1) Combet Vet status inconsistent with classification type "DATA",409.76,282,2,0) ^409.7621^4^4^3040218^^^ "DATA",409.76,282,2,1,0) Encounter has been marked as being related to combat but patient is not a "DATA",409.76,282,2,2,0) combat veteran (or was no longer considered a combat veteran at the time "DATA",409.76,282,2,3,0) of the encounter). Review patient information through Load/Edit Patient "DATA",409.76,282,2,4,0) Data protocol, Screen 6. "DATA",409.76,282,"CHK") S RES=$$CLCV^SCMSVUT2(DATA,ENCPTR) "DATA",409.76,282,"COR") S RTN=$$LEDT^SCENIA1 "FIA",409.76) TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE "FIA",409.76,0) ^SD(409.76, "FIA",409.76,0,0) 409.76I "FIA",409.76,0,1) n^n^f^^n^^y^o^n "FIA",409.76,0,10) "FIA",409.76,0,11) N TMP S TMP=$P(^(0),"^",1) I ",733,734,735,7330,7340,904,9040,"[TMP "FIA",409.76,0,"RLRO") "FIA",409.76,0,"VR") 5.3^SD "FIA",409.76,409.76) 0 "FIA",409.76,409.7621) 0 "INI") PRE^SD53325 "INIT") POST^SD53325 "MBREQ") 1 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,20,0) ^9.402P^^ "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930824 "PKG",16,22,1,"PAH",1,0) 325^3040630^100100 "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") 10 "RTN","SCDXMSG1") 0^7^B72945063 "RTN","SCDXMSG1",1,0) SCDXMSG1 ;ALB/JRP - AMB CARE MESSAGE BUILDER UTILS;08-MAY-1996 ; 5/2/02 2:08pm "RTN","SCDXMSG1",2,0) ;;5.3;Scheduling;**44,55,70,77,85,66,143,142,162,172,180,239,245,254,293,325**;AUG 13, 1993 "RTN","SCDXMSG1",3,0) ; "RTN","SCDXMSG1",4,0) ;-- Line tags for building HL7 segment "RTN","SCDXMSG1",5,0) BLDEVN S VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS")) "RTN","SCDXMSG1",6,0) Q "RTN","SCDXMSG1",7,0) BLDPID S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR) "RTN","SCDXMSG1",8,0) D SETMAR^SCMSVUT0(.VAFPID,HL("Q"),HL("FS")) "RTN","SCDXMSG1",9,0) Q "RTN","SCDXMSG1",10,0) BLDZPD S VAFZPD=$$EN^VAFHLZPD(DFN,VAFSTR) "RTN","SCDXMSG1",11,0) S VAFZPD=$$SETPOW^SCMSVUT0(DFN,$G(VAFZPD),HL("Q"),HL("FS")) "RTN","SCDXMSG1",12,0) Q "RTN","SCDXMSG1",13,0) BLDPV1 D SETID^SCMSVUT0(ENCPTR,DELPTR) "RTN","SCDXMSG1",14,0) S VAFPV1=$$EN^VAFHLPV1(ENCPTR,DELPTR,VAFSTR,1,HL("Q"),HL("FS")) "RTN","SCDXMSG1",15,0) Q "RTN","SCDXMSG1",16,0) BLDDG1 K @VAFARRY "RTN","SCDXMSG1",17,0) D EN^VAFHLDG1(ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY) "RTN","SCDXMSG1",18,0) Q "RTN","SCDXMSG1",19,0) BLDPR1 K @VAFARRY "RTN","SCDXMSG1",20,0) D SETPRTY^SCMSVUT0(ENCPTR) "RTN","SCDXMSG1",21,0) D EN^VAFHLPR1(ENCPTR,VAFSTR,HL("Q"),HL("FS"),HL("ECH"),VAFARRY) "RTN","SCDXMSG1",22,0) Q "RTN","SCDXMSG1",23,0) BLDZEL N ELCOD,ELIGENC,I,VAFMSTDT "RTN","SCDXMSG1",24,0) S VAFMSTDT=ENCDT "RTN","SCDXMSG1",25,0) D EN1^VAFHLZEL(DFN,VAFSTR,1,.VAFZEL) "RTN","SCDXMSG1",26,0) S ELCOD=$P($G(^SCE(ENCPTR,0)),"^",13),ELIGENC=$P($G(^DIC(8,+ELCOD,0)),"^",9) "RTN","SCDXMSG1",27,0) S $P(VAFZEL(1),HL("FS"),3)=ELIGENC "RTN","SCDXMSG1",28,0) Q "RTN","SCDXMSG1",29,0) BLDZIR K DGREL,DGINC,DGINR,DGDEP "RTN","SCDXMSG1",30,0) D ALL^DGMTU21(DFN,"V",ENCDT,"R") "RTN","SCDXMSG1",31,0) S VAFZIR=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1,ENCPTR) "RTN","SCDXMSG1",32,0) K DGREL,DGINC,DGINR,DGDEP "RTN","SCDXMSG1",33,0) Q "RTN","SCDXMSG1",34,0) BLDZCL K @VAFARRY "RTN","SCDXMSG1",35,0) D EN^VAFHLZCL(DFN,ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY) "RTN","SCDXMSG1",36,0) Q "RTN","SCDXMSG1",37,0) BLDZSC K @VAFARRY "RTN","SCDXMSG1",38,0) D EN^VAFHLZSC(ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY) "RTN","SCDXMSG1",39,0) Q "RTN","SCDXMSG1",40,0) BLDZSP S VAFZSP=$$EN^VAFHLZSP(DFN,1,1) "RTN","SCDXMSG1",41,0) S VAFZSP=$$SETVSI^SCMSVUT0(DFN,$G(VAFZSP),HL("Q"),HL("FS")) "RTN","SCDXMSG1",42,0) Q "RTN","SCDXMSG1",43,0) BLDROL K @VAFARRY "RTN","SCDXMSG1",44,0) N SCDXPRV,SCDXPAR,SCDXROL,PTRPRV,NODE,PRVNUM,TMP "RTN","SCDXMSG1",45,0) D GETPRV^SDOE(ENCPTR,"SCDXPRV") "RTN","SCDXMSG1",46,0) S PTRPRV=0 "RTN","SCDXMSG1",47,0) F PRVNUM=1:1 S PTRPRV=+$O(SCDXPRV(PTRPRV)) Q:('PTRPRV) D "RTN","SCDXMSG1",48,0) .K SCDXPAR,SCDXROL "RTN","SCDXMSG1",49,0) .S NODE=SCDXPRV(PTRPRV) "RTN","SCDXMSG1",50,0) .S SCDXPAR("PTR200")=+NODE "RTN","SCDXMSG1",51,0) .S SCDXPAR("INSTID")=$$VID4XMIT^SCDXFU11(XMITPTR)_"-"_(+NODE)_"*"_PRVNUM "RTN","SCDXMSG1",52,0) .S SCDXPAR("ACTION")="CO" "RTN","SCDXMSG1",53,0) .S SCDXPAR("ALTROLE")=($TR($P(NODE,"^",4),"PS","10"))_$E(HL("ECH"),1)_HL("Q")_$E(HL("ECH"),1)_"VA01" "RTN","SCDXMSG1",54,0) .S SCDXPAR("CODEONLY")=0 "RTN","SCDXMSG1",55,0) .S SCDXPAR("RDATE")=ENCDT "RTN","SCDXMSG1",56,0) .D OUTPAT^VAFHLROL("SCDXPAR","SCDXROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240) "RTN","SCDXMSG1",57,0) .K SCDXROL("ERROR"),SCDXROL("WARNING") "RTN","SCDXMSG1",58,0) .M @VAFARRY@(PRVNUM)=SCDXROL "RTN","SCDXMSG1",59,0) Q "RTN","SCDXMSG1",60,0) BLDPD1 S VAFPD1=$$EN^VAFHLPD1(DFN,VAFSTR) "RTN","SCDXMSG1",61,0) Q "RTN","SCDXMSG1",62,0) BLDZEN S VAFZEN=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS")) "RTN","SCDXMSG1",63,0) Q "RTN","SCDXMSG1",64,0) ; "RTN","SCDXMSG1",65,0) ;-- Line tags for validating HL7 segments "RTN","SCDXMSG1",66,0) VLDEVN S ERROR=$$EN^SCMSVEVN(VAFEVN,HL("Q"),HL("FS"),VALERR) "RTN","SCDXMSG1",67,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",68,0) Q "RTN","SCDXMSG1",69,0) VLDPID S ERROR=$$EN^SCMSVPID(.VAFPID,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT,EVNTHL7) "RTN","SCDXMSG1",70,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",71,0) Q "RTN","SCDXMSG1",72,0) VLDZPD S ERROR=$$EN^SCMSVZPD(VAFZPD,HL("Q"),HL("FS"),VALERR,ENCDT,NODE) "RTN","SCDXMSG1",73,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",74,0) Q "RTN","SCDXMSG1",75,0) VLDPV1 S ERROR=$$EN^SCMSVPV1(VAFPV1,HL("Q"),HL("FS"),VALERR,NODE,EVNTHL7) "RTN","SCDXMSG1",76,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",77,0) Q "RTN","SCDXMSG1",78,0) VLDDG1 S ERROR=$$EN^SCMSVDG1(VAFARRY,HL("Q"),HL("FS"),ENCPTR,VALERR,ENCDT) "RTN","SCDXMSG1",79,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",80,0) Q "RTN","SCDXMSG1",81,0) VLDPR1 S ERROR=$$EN^SCMSVPR1(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT) "RTN","SCDXMSG1",82,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",83,0) Q "RTN","SCDXMSG1",84,0) VLDZEL S ERROR=$$EN^SCMSVZEL(.VAFZEL,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",85,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",86,0) Q "RTN","SCDXMSG1",87,0) VLDZIR S ERROR=$$EN^SCMSVZIR(VAFZIR,HL("Q"),HL("FS"),VALERR) "RTN","SCDXMSG1",88,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",89,0) Q "RTN","SCDXMSG1",90,0) VLDZCL S ERROR=$$EN^SCMSVZCL(VAFARRY,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",91,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",92,0) Q "RTN","SCDXMSG1",93,0) VLDZSC S ERROR=$$EN^SCMSVZSC(VAFARRY,HL("Q"),HL("FS"),VALERR,ENCPTR) "RTN","SCDXMSG1",94,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",95,0) Q "RTN","SCDXMSG1",96,0) VLDZSP S ERROR=$$EN^SCMSVZSP(VAFZSP,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",97,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",98,0) Q "RTN","SCDXMSG1",99,0) VLDROL S ERROR=$$EN^SCMSVROL(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR) "RTN","SCDXMSG1",100,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",101,0) Q "RTN","SCDXMSG1",102,0) VLDPD1 S ERROR=0 "RTN","SCDXMSG1",103,0) Q "RTN","SCDXMSG1",104,0) VLDZEN S ERROR=0 "RTN","SCDXMSG1",105,0) Q "RTN","SCDXMSG1",106,0) ; "RTN","SCDXMSG1",107,0) ;-- Line tags for copying HL7 segments into HL7 message "RTN","SCDXMSG1",108,0) CPYEVN N I "RTN","SCDXMSG1",109,0) S @XMITARRY@(CURLINE)=VAFEVN "RTN","SCDXMSG1",110,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",111,0) S I="" "RTN","SCDXMSG1",112,0) F S I=+$O(VAFEVN(I)) Q:('I) D "RTN","SCDXMSG1",113,0) .S @XMITARRY@(CURLINE,I)=VAFEVN(I) "RTN","SCDXMSG1",114,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",115,0) Q "RTN","SCDXMSG1",116,0) CPYPID N I "RTN","SCDXMSG1",117,0) S @XMITARRY@(CURLINE)=VAFPID "RTN","SCDXMSG1",118,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",119,0) S I="" "RTN","SCDXMSG1",120,0) F S I=+$O(VAFPID(I)) Q:('I) D "RTN","SCDXMSG1",121,0) .S @XMITARRY@(CURLINE,I)=VAFPID(I) "RTN","SCDXMSG1",122,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",123,0) Q "RTN","SCDXMSG1",124,0) CPYZPD N I "RTN","SCDXMSG1",125,0) S @XMITARRY@(CURLINE)=VAFZPD "RTN","SCDXMSG1",126,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",127,0) S I="" "RTN","SCDXMSG1",128,0) F S I=+$O(VAFZPD(I)) Q:('I) D "RTN","SCDXMSG1",129,0) .S @XMITARRY@(CURLINE,I)=VAFZPD(I) "RTN","SCDXMSG1",130,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",131,0) Q "RTN","SCDXMSG1",132,0) CPYPV1 N I "RTN","SCDXMSG1",133,0) S @XMITARRY@(CURLINE)=VAFPV1 "RTN","SCDXMSG1",134,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",135,0) S I="" "RTN","SCDXMSG1",136,0) F S I=+$O(VAFPV1(I)) Q:('I) D "RTN","SCDXMSG1",137,0) .S @XMITARRY@(CURLINE,I)=VAFPV1(I) "RTN","SCDXMSG1",138,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",139,0) Q "RTN","SCDXMSG1",140,0) CPYDG1 N I,J,K "RTN","SCDXMSG1",141,0) S I="" "RTN","SCDXMSG1",142,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",143,0) .S J="" "RTN","SCDXMSG1",144,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",145,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",146,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",147,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",148,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",149,0) Q "RTN","SCDXMSG1",150,0) CPYPR1 N I,J,K "RTN","SCDXMSG1",151,0) S I="" "RTN","SCDXMSG1",152,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",153,0) .S J="" "RTN","SCDXMSG1",154,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",155,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",156,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",157,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",158,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",159,0) Q "RTN","SCDXMSG1",160,0) CPYZEL N I "RTN","SCDXMSG1",161,0) S @XMITARRY@(CURLINE)=VAFZEL(1) "RTN","SCDXMSG1",162,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",163,0) S I="" "RTN","SCDXMSG1",164,0) F S I=+$O(VAFZEL(1,I)) Q:('I) D "RTN","SCDXMSG1",165,0) .S @XMITARRY@(CURLINE,I)=VAFZEL(1,I) "RTN","SCDXMSG1",166,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",167,0) Q "RTN","SCDXMSG1",168,0) CPYZIR N I "RTN","SCDXMSG1",169,0) S @XMITARRY@(CURLINE)=VAFZIR "RTN","SCDXMSG1",170,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",171,0) N I "RTN","SCDXMSG1",172,0) S I="" "RTN","SCDXMSG1",173,0) F S I=+$O(VAFZIR(I)) Q:('I) D "RTN","SCDXMSG1",174,0) .S @XMITARRY@(CURLINE,I)=VAFZIR(I) "RTN","SCDXMSG1",175,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",176,0) Q "RTN","SCDXMSG1",177,0) CPYZCL N I,J,K "RTN","SCDXMSG1",178,0) S I="" "RTN","SCDXMSG1",179,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",180,0) .S J="" "RTN","SCDXMSG1",181,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",182,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",183,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",184,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",185,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",186,0) Q "RTN","SCDXMSG1",187,0) CPYZSC N I,J,K "RTN","SCDXMSG1",188,0) S I="" "RTN","SCDXMSG1",189,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",190,0) .S J="" "RTN","SCDXMSG1",191,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",192,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",193,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",194,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",195,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",196,0) Q "RTN","SCDXMSG1",197,0) CPYZSP N I "RTN","SCDXMSG1",198,0) S @XMITARRY@(CURLINE)=VAFZSP "RTN","SCDXMSG1",199,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",200,0) S I="" "RTN","SCDXMSG1",201,0) F S I=+$O(VAFZSP(I)) Q:('I) D "RTN","SCDXMSG1",202,0) .S @XMITARRY@(CURLINE,I)=VAFZSP(I) "RTN","SCDXMSG1",203,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",204,0) Q "RTN","SCDXMSG1",205,0) CPYROL N I,J,K "RTN","SCDXMSG1",206,0) S I="" "RTN","SCDXMSG1",207,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",208,0) .S J="" "RTN","SCDXMSG1",209,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",210,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",211,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",212,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",213,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",214,0) Q "RTN","SCDXMSG1",215,0) CPYPD1 N I "RTN","SCDXMSG1",216,0) S @XMITARRY@(CURLINE)=VAFPD1 "RTN","SCDXMSG1",217,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",218,0) S I="" "RTN","SCDXMSG1",219,0) F S I=+$O(VAFPD1(I)) Q:('I) D "RTN","SCDXMSG1",220,0) .S @XMITARRY@(CURLINE,I)=VAFPD1(I) "RTN","SCDXMSG1",221,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",222,0) Q "RTN","SCDXMSG1",223,0) CPYZEN N I "RTN","SCDXMSG1",224,0) S @XMITARRY@(CURLINE)=VAFZEN "RTN","SCDXMSG1",225,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",226,0) S I="" "RTN","SCDXMSG1",227,0) F S I=+$O(VAFZEN(I)) Q:('I) D "RTN","SCDXMSG1",228,0) .S @XMITARRY@(CURLINE,I)=VAFZEN(I) "RTN","SCDXMSG1",229,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",230,0) Q "RTN","SCDXMSG1",231,0) ; "RTN","SCDXMSG1",232,0) ;-- Line tags for deleting HL7 segments "RTN","SCDXMSG1",233,0) DELEVN K VAFEVN "RTN","SCDXMSG1",234,0) Q "RTN","SCDXMSG1",235,0) DELPID K VAFPID "RTN","SCDXMSG1",236,0) Q "RTN","SCDXMSG1",237,0) DELZPD K VAFZPD "RTN","SCDXMSG1",238,0) Q "RTN","SCDXMSG1",239,0) DELPV1 K VAFPV1 "RTN","SCDXMSG1",240,0) Q "RTN","SCDXMSG1",241,0) DELDG1 K @VAFARRY "RTN","SCDXMSG1",242,0) Q "RTN","SCDXMSG1",243,0) DELPR1 K @VAFARRY "RTN","SCDXMSG1",244,0) Q "RTN","SCDXMSG1",245,0) DELZEL K VAFZEL "RTN","SCDXMSG1",246,0) Q "RTN","SCDXMSG1",247,0) DELZIR K VAFZIR "RTN","SCDXMSG1",248,0) Q "RTN","SCDXMSG1",249,0) DELZCL K @VAFARRY "RTN","SCDXMSG1",250,0) Q "RTN","SCDXMSG1",251,0) DELZSC K @VAFARRY "RTN","SCDXMSG1",252,0) Q "RTN","SCDXMSG1",253,0) DELZSP K VAFZSP "RTN","SCDXMSG1",254,0) Q "RTN","SCDXMSG1",255,0) DELROL K @VAFARRY "RTN","SCDXMSG1",256,0) Q "RTN","SCDXMSG1",257,0) DELPD1 K VAFPD1 "RTN","SCDXMSG1",258,0) Q "RTN","SCDXMSG1",259,0) DELZEN K VAFZEN "RTN","SCDXMSG1",260,0) Q "RTN","SCDXMSG1",261,0) ; "RTN","SCDXMSG1",262,0) ; "RTN","SCDXMSG1",263,0) SEGMENTS(EVNTTYPE,SEGARRY) ;Build list of HL7 segments for a given "RTN","SCDXMSG1",264,0) ; event type "RTN","SCDXMSG1",265,0) ; "RTN","SCDXMSG1",266,0) ;Input : EVNTTYPE - Event type to build list for "RTN","SCDXMSG1",267,0) ; A08 & A23 are the only types currently supported "RTN","SCDXMSG1",268,0) ; (Defaults to A08) "RTN","SCDXMSG1",269,0) ; SEGARRY - Array to place output in (full global reference) "RTN","SCDXMSG1",270,0) ; (Defaults to ^TMP("SCDX SEGMENTS",$J)) "RTN","SCDXMSG1",271,0) ;Output : None "RTN","SCDXMSG1",272,0) ; SEGARRY(Seq,Name) = Fields "RTN","SCDXMSG1",273,0) ; Seq - Sequencing number to order the segments as "RTN","SCDXMSG1",274,0) ; they should be placed in the HL7 message "RTN","SCDXMSG1",275,0) ; Name - Name of HL7 segment "RTN","SCDXMSG1",276,0) ; Fields - List of fields used by Ambulatory Care "RTN","SCDXMSG1",277,0) ; VAFSTR would be set to this value "RTN","SCDXMSG1",278,0) ; : MSH segment is not included "RTN","SCDXMSG1",279,0) ; "RTN","SCDXMSG1",280,0) ;Check input "RTN","SCDXMSG1",281,0) S EVNTTYPE=$G(EVNTTYPE) "RTN","SCDXMSG1",282,0) S:(EVNTTYPE'="A23") EVNTTYPE="A08" "RTN","SCDXMSG1",283,0) S SEGARRY=$G(SEGARRY) "RTN","SCDXMSG1",284,0) S:(SEGARRY="") SEGARRY="^TMP(""SCDX SEGMENTS"","_$J_")" "RTN","SCDXMSG1",285,0) ;Segments used by A08 & A23 "RTN","SCDXMSG1",286,0) S @SEGARRY@(1,"EVN")="1,2" "RTN","SCDXMSG1",287,0) S @SEGARRY@(2,"PID")="1,2,3,4,5,6,7,8,10N,11PC,13,14,16,17,19,22N" "RTN","SCDXMSG1",288,0) S @SEGARRY@(3,"PD1")="3,4" "RTN","SCDXMSG1",289,0) S @SEGARRY@(4,"PV1")="1,2,4,14,19,39,44,50" "RTN","SCDXMSG1",290,0) ;Building list for A23 - add ZPD segment and quit "RTN","SCDXMSG1",291,0) I (EVNTTYPE="A23") D Q "RTN","SCDXMSG1",292,0) .S @SEGARRY@(5,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21" "RTN","SCDXMSG1",293,0) S @SEGARRY@(5,"DG1")="1,2,3,4,5,15" "RTN","SCDXMSG1",294,0) S @SEGARRY@(6,"PR1")="1,3,16" "RTN","SCDXMSG1",295,0) S @SEGARRY@(7,"ROL")="1,2,3,4" "RTN","SCDXMSG1",296,0) S @SEGARRY@(8,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21" "RTN","SCDXMSG1",297,0) S @SEGARRY@(9,"ZEL")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,29,37,38" "RTN","SCDXMSG1",298,0) S @SEGARRY@(10,"ZIR")="1,2,3,4,5,6,7,8,9,10,11,12,13" "RTN","SCDXMSG1",299,0) S @SEGARRY@(11,"ZCL")="1,2,3" "RTN","SCDXMSG1",300,0) S @SEGARRY@(12,"ZSC")="1,2,3" "RTN","SCDXMSG1",301,0) S @SEGARRY@(13,"ZSP")="1,2,3,4" "RTN","SCDXMSG1",302,0) S @SEGARRY@(14,"ZEN")="1,2,3,4,5,6,7,8,9,10" "RTN","SCDXMSG1",303,0) Q "RTN","SCDXMSG1",304,0) ; "RTN","SCDXMSG1",305,0) UNWIND(XMITARRY,INSRTPNT) ;Remove all data that was put into HL7 message "RTN","SCDXMSG1",306,0) ; "RTN","SCDXMSG1",307,0) ;Input : XMITARRY - Array containing HL7 message (full global ref) "RTN","SCDXMSG1",308,0) ; (Defaults to ^TMP("HLS",$J)) "RTN","SCDXMSG1",309,0) ; INSRTPNT - Where to begin deletion from (Defaults to 1) "RTN","SCDXMSG1",310,0) ;Output : None "RTN","SCDXMSG1",311,0) ; "RTN","SCDXMSG1",312,0) ;Check input "RTN","SCDXMSG1",313,0) S XMITARRY=$G(XMITARRY) "RTN","SCDXMSG1",314,0) S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")" "RTN","SCDXMSG1",315,0) S INSRTPNT=$G(INSRTPNT) "RTN","SCDXMSG1",316,0) S:(INSRTPNT="") INSRTPNT=1 "RTN","SCDXMSG1",317,0) ;Remove insertion point from array "RTN","SCDXMSG1",318,0) K @XMITARRY@(INSRTPNT) "RTN","SCDXMSG1",319,0) ;Remove everything from insertion point to end of array "RTN","SCDXMSG1",320,0) F S INSRTPNT=$O(@XMITARRY@(INSRTPNT)) Q:(INSRTPNT="") K @XMITARRY@(INSRTPNT) "RTN","SCDXMSG1",321,0) ;Done "RTN","SCDXMSG1",322,0) Q "RTN","SCDXUTL0") 0^6^B34266243 "RTN","SCDXUTL0",1,0) SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 10/5/99 11:23am "RTN","SCDXUTL0",2,0) ;;5.3;Scheduling;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325**;Aug 13, 1993 "RTN","SCDXUTL0",3,0) ; "RTN","SCDXUTL0",4,0) ; This routine contains functions used with the Ambulatory Care "RTN","SCDXUTL0",5,0) ; Reporting Project (ACRP). "RTN","SCDXUTL0",6,0) ; "RTN","SCDXUTL0",7,0) MTI(DFN,DATE,EC,AT,SDOE) ;Calculate Means Test Indicator "RTN","SCDXUTL0",8,0) ; "RTN","SCDXUTL0",9,0) ; Input: DFN = Patient IEN "RTN","SCDXUTL0",10,0) ; Date = Encounter Date/Time "RTN","SCDXUTL0",11,0) ; EC = Eligibility (Code) of Encounter "RTN","SCDXUTL0",12,0) ; AT = Appointment Type of Encounter "RTN","SCDXUTL0",13,0) ; SDOE = Outpatient Encounter IEN "RTN","SCDXUTL0",14,0) ; "RTN","SCDXUTL0",15,0) ; Output: MTI = Means Test Indicator "RTN","SCDXUTL0",16,0) ; "RTN","SCDXUTL0",17,0) N MT,MTI,SDVD1,SDINPT,SDANS,SDANS1,SDINPT,SDMT,VET,X "RTN","SCDXUTL0",18,0) S MTI="" "RTN","SCDXUTL0",19,0) S DFN=$G(DFN),DATE=$G(DATE),EC=$G(EC),AT=$G(AT),SDOE=$G(SDOE) "RTN","SCDXUTL0",20,0) I (DFN="")!(DATE="")!(EC="")!(EC=0)!(AT="")!(SDOE="") G MTQ "RTN","SCDXUTL0",21,0) ; "RTN","SCDXUTL0",22,0) ;- VA Code (get from MAS Eligibility Code IEN) "RTN","SCDXUTL0",23,0) S X=$G(^DIC(8.1,$P($G(^DIC(8,+EC,0)),"^",9),0)) "RTN","SCDXUTL0",24,0) S EC=$P(X,"^",4),VET=$P(X,"^",5) "RTN","SCDXUTL0",25,0) ;- Non-Veteran "RTN","SCDXUTL0",26,0) I $P($G(^DPT(DFN,"VET")),"^")="N"!(VET="N") S MTI="N" G MTQ "RTN","SCDXUTL0",27,0) ;- Dom patient "RTN","SCDXUTL0",28,0) I EC=6 S MTI="X" G MTQ "RTN","SCDXUTL0",29,0) ;- Inpatient status "RTN","SCDXUTL0",30,0) S SDVD1=DATE D INPT^SDOPC1 I SDMT="X0" S MTI="X" G MTQ "RTN","SCDXUTL0",31,0) ;- Service Connected > 50 % "RTN","SCDXUTL0",32,0) I EC=1 S MTI="AS" G MTQ "RTN","SCDXUTL0",33,0) ;-- Service Connected < 50 % "RTN","SCDXUTL0",34,0) I EC=3,$$SC^DGMTR(DFN) D I MTI'="" G MTQ "RTN","SCDXUTL0",35,0) .; 'AS' if seen for SC condition "RTN","SCDXUTL0",36,0) .I $P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),U,3) S MTI="AS" "RTN","SCDXUTL0",37,0) ;-Military Disability Retiree "RTN","SCDXUTL0",38,0) S X=$P($G(^DPT(DFN,.36)),"^",2) I X,(X<3) S MTI="AS" G MTQ "RTN","SCDXUTL0",39,0) ; "RTN","SCDXUTL0",40,0) I EC=2 D I MTI'="" G MTQ "RTN","SCDXUTL0",41,0) .;- Mexican Border Period or World War I "RTN","SCDXUTL0",42,0) .I $P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=1!($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=3) S MTI="AS" Q "RTN","SCDXUTL0",43,0) .;- Prisoner of War (POW) "RTN","SCDXUTL0",44,0) .I $P($G(^DPT(DFN,.52)),"^",5)="Y" S MTI="AS" Q "RTN","SCDXUTL0",45,0) .;- Purple Heart Recipient "RTN","SCDXUTL0",46,0) .I $P($G(^DPT(DFN,.53)),"^")="Y" S MTI="AS" Q "RTN","SCDXUTL0",47,0) .;- Aid and Attendance "RTN","SCDXUTL0",48,0) .I $P($G(^DPT(DFN,.362)),"^",12)="Y" S MTI="AN" Q "RTN","SCDXUTL0",49,0) .;- Housebound "RTN","SCDXUTL0",50,0) .I $P($G(^DPT(DFN,.362)),"^",13)="Y" S MTI="AN" Q "RTN","SCDXUTL0",51,0) ;- Receiving VA Pension "RTN","SCDXUTL0",52,0) I EC=4,$P($G(^DPT(DFN,.362)),"^",14)="Y" S MTI="AN" G MTQ "RTN","SCDXUTL0",53,0) ; "RTN","SCDXUTL0",54,0) I EC=5!(EC=3) D I MTI'="" G MTQ "RTN","SCDXUTL0",55,0) .;- Eligible for Medicaid "RTN","SCDXUTL0",56,0) .I $P($G(^DPT(DFN,.38)),"^")=1 S MTI="AN" Q "RTN","SCDXUTL0",57,0) .;- Appt types with ignore billing set to 1 (except comp gen) "RTN","SCDXUTL0",58,0) .I AT'=10,$P($G(^SD(409.1,+AT,0)),"^",2) S MTI="X" Q "RTN","SCDXUTL0",59,0) .;- Treatment for AO, IR, EC, MST, HNC "RTN","SCDXUTL0",60,0) .F SDANS1=1,2,4,5,6 S SDANS=$S('$D(^SDD(409.42,"AO",+SDOE,SDANS1)):"",$P($G(^SDD(409.42,$O(^(SDANS1,0)),0)),"^",3):1,1:0) I SDANS=1 S MTI="AS" Q "RTN","SCDXUTL0",61,0) .I MTI]"" Q "RTN","SCDXUTL0",62,0) .;- Means Test Code A, C, or G (also Pending Adj = Code C or Code G) "RTN","SCDXUTL0",63,0) .S MT=$$LST^DGMTU(DFN,DATE) "RTN","SCDXUTL0",64,0) .I $P(MT,"^",4)="A" S MTI="AN" Q "RTN","SCDXUTL0",65,0) .I $P(MT,"^",4)="C" S MTI="C" Q "RTN","SCDXUTL0",66,0) .I $P(MT,"^",4)="G" S MTI="G" Q "RTN","SCDXUTL0",67,0) .I $P(MT,"^",4)="P" D Q "RTN","SCDXUTL0",68,0) . .S MTI=$$PA^DGMTUTL($P(MT,"^")),MTI=$S('$D(MTI):"U",MTI="MT":"C",MTI="GMT":"G",1:"U") "RTN","SCDXUTL0",69,0) .;- no means test status or no longer required...check current eligibility data "RTN","SCDXUTL0",70,0) .S X=+$G(^DPT(DFN,.36)),X=+$P($G(^DIC(8,X,0)),U,9) ; get MAS eligibility "RTN","SCDXUTL0",71,0) .;- Service connected > 50 % "RTN","SCDXUTL0",72,0) .I X=1 S MTI="AS" Q "RTN","SCDXUTL0",73,0) .;- Service connected < 50 % "RTN","SCDXUTL0",74,0) .I EC=3,'$$SC^DGMTR(DFN) S MTI="AS" Q "RTN","SCDXUTL0",75,0) .;- mex border or WWI or POW "RTN","SCDXUTL0",76,0) .I X=16!(X=17)!(X=18)!(X=22) S MTI="AS" Q "RTN","SCDXUTL0",77,0) .;- A&A or Pension or HB "RTN","SCDXUTL0",78,0) .I X=2!(X=4)!(X=15) S MTI="AN" Q "RTN","SCDXUTL0",79,0) ;- Means Test required and not done/completed "RTN","SCDXUTL0",80,0) S MTI="U" "RTN","SCDXUTL0",81,0) MTQ Q MTI "RTN","SCDXUTL0",82,0) ; "RTN","SCDXUTL0",83,0) ; "RTN","SCDXUTL0",84,0) PATCLASS(DFN,SDOE) ; - Return classification questions from PATIENT (#2) file "RTN","SCDXUTL0",85,0) ; (Agent Orange, Radiation Exposure, Service Connected, "RTN","SCDXUTL0",86,0) ; Environmental Contaminants, Military Sexual Trauma and "RTN","SCDXUTL0",87,0) ; Head/Neck Cancer questions) "RTN","SCDXUTL0",88,0) ; "RTN","SCDXUTL0",89,0) ; Input: DFN = Patient IEN (from file #2) "RTN","SCDXUTL0",90,0) ; SDOE = Outpatient Encounter File IEN [Optional] "RTN","SCDXUTL0",91,0) ; "RTN","SCDXUTL0",92,0) ; Output: String containing Y if classification question = YES, N if "RTN","SCDXUTL0",93,0) ; = NO, null otherwise (classifications separated by "^") "RTN","SCDXUTL0",94,0) ; "RTN","SCDXUTL0",95,0) N NODE,PATCLASS,SDTEMP,X "RTN","SCDXUTL0",96,0) S SDTEMP(1)=$$AO^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",97,0) S SDTEMP(2)=$$IR^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",98,0) S SDTEMP(3)=$$SC^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",99,0) S SDTEMP(4)=$$EC^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",100,0) S SDTEMP(5)=$$MST^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",101,0) S SDTEMP(6)=$$HNC^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",102,0) S SDTEMP(7)=$$CV^SDCO22(DFN,$G(SDOE)) "RTN","SCDXUTL0",103,0) F X=1:1:7 S $P(PATCLASS,U,X)=$S(SDTEMP(X)=1:"Y",1:"N") "RTN","SCDXUTL0",104,0) Q PATCLASS "RTN","SCDXUTL0",105,0) ; "RTN","SCDXUTL0",106,0) ; "RTN","SCDXUTL0",107,0) CLASS(SDOE,SCDXARRY) ; - Return array of classification types for encounter "RTN","SCDXUTL0",108,0) ; "RTN","SCDXUTL0",109,0) ; Input: SDOE = Outpatient Encounter IEN (from file #409.68) "RTN","SCDXUTL0",110,0) ; "RTN","SCDXUTL0",111,0) ; Output: Array (pass desired name as parameter) containing "RTN","SCDXUTL0",112,0) ; Classification Type^Value "RTN","SCDXUTL0",113,0) ; "RTN","SCDXUTL0",114,0) N CLASS,I,X "RTN","SCDXUTL0",115,0) S CLASS="",(I,X)=0 "RTN","SCDXUTL0",116,0) S SDOE=+$G(SDOE) "RTN","SCDXUTL0",117,0) F S CLASS=+$O(^SDD(409.42,"OE",SDOE,CLASS)) Q:'CLASS D "RTN","SCDXUTL0",118,0) . S I=$P($G(^SDD(409.42,CLASS,0)),"^"),X=X+1 "RTN","SCDXUTL0",119,0) . S @SCDXARRY@(I)=$P($G(^SDD(409.42,CLASS,0)),"^")_"^"_$P($G(^SDD(409.42,CLASS,0)),"^",3) "RTN","SCDXUTL0",120,0) CLASSQ S @SCDXARRY@(0)=X "RTN","SCDXUTL0",121,0) Q "RTN","SCDXUTL0",122,0) ; "RTN","SCDXUTL0",123,0) ; "RTN","SCDXUTL0",124,0) CHKCLASS(DFN,SDOE) ; - Get classification data for HL7 VAFHLZCL segment "RTN","SCDXUTL0",125,0) ; "RTN","SCDXUTL0",126,0) ; Input: DFN = Patient IEN (from file #2) "RTN","SCDXUTL0",127,0) ; SDOE = Outpatient Encounter IEN (from file #409.68) "RTN","SCDXUTL0",128,0) ; "RTN","SCDXUTL0",129,0) ; Output: String separated by "^" containing: "RTN","SCDXUTL0",130,0) ; 1 (patient class = YES and encounter class = YES) "RTN","SCDXUTL0",131,0) ; 0 (patient class = YES and encounter class = NO) "RTN","SCDXUTL0",132,0) ; HLQ ("""""") otherwise "RTN","SCDXUTL0",133,0) ; "RTN","SCDXUTL0",134,0) EN N OECLASS,OUT,PATCLASS,TYPE,ENCVAL,CLCNT,PATVAL "RTN","SCDXUTL0",135,0) S PATCLASS=$$PATCLASS(DFN,SDOE) "RTN","SCDXUTL0",136,0) D CLASS(SDOE,"OECLASS") "RTN","SCDXUTL0",137,0) S CLCNT=$L(PATCLASS,"^") "RTN","SCDXUTL0",138,0) F TYPE=1:1:CLCNT D "RTN","SCDXUTL0",139,0) .S ENCVAL=$P($G(OECLASS(TYPE)),"^",2) "RTN","SCDXUTL0",140,0) .S PATVAL=$P(PATCLASS,"^",TYPE) "RTN","SCDXUTL0",141,0) .S $P(OUT,"^",TYPE)="""""" "RTN","SCDXUTL0",142,0) .I PATVAL="Y" S $P(OUT,"^",TYPE)=ENCVAL "RTN","SCDXUTL0",143,0) ENQ Q OUT "RTN","SCDXUTL0",144,0) ; "RTN","SCDXUTL0",145,0) ; "RTN","SCDXUTL0",146,0) POV(DFN,DATE,CLINIC,APTYP) ; - Determine Purpose of Visit for encounter "RTN","SCDXUTL0",147,0) ; "RTN","SCDXUTL0",148,0) ; Input: DFN = Patient IEN "RTN","SCDXUTL0",149,0) ; DATE = Appointment Date/Time "RTN","SCDXUTL0",150,0) ; CLINIC = Clinic "RTN","SCDXUTL0",151,0) ; APTYP = Appointment Type "RTN","SCDXUTL0",152,0) ; "RTN","SCDXUTL0",153,0) ; Output: Purpose of Visit value (combination of Purpose of Visit "RTN","SCDXUTL0",154,0) ; and Appointment Type) "RTN","SCDXUTL0",155,0) ; "RTN","SCDXUTL0",156,0) N POV,SCDXPOV "RTN","SCDXUTL0",157,0) I (DFN=""!(DATE="")!(CLINIC="")!(APTYP="")) G POVQ "RTN","SCDXUTL0",158,0) I $P($G(^DPT(DFN,"S",+DATE,0)),"^")'=CLINIC G POVQ "RTN","SCDXUTL0",159,0) S POV=$P($G(^DPT(DFN,"S",+DATE,0)),"^",7),POV=$S($L(POV)=1:"0"_POV,1:POV) "RTN","SCDXUTL0",160,0) S APTYP=$S($L(APTYP)=1:"0"_APTYP,1:APTYP) "RTN","SCDXUTL0",161,0) S SCDXPOV=POV_APTYP "RTN","SCDXUTL0",162,0) POVQ Q $G(SCDXPOV) "RTN","SCDXUTL0",163,0) ; "RTN","SCDXUTL0",164,0) ; "RTN","SCDXUTL0",165,0) SCODE(SDOE,SCDXARRY) ; Return array of stop codes for encounter "RTN","SCDXUTL0",166,0) ; "RTN","SCDXUTL0",167,0) ; Input: SDOE = Outpatient Encounter IEN (from file #409.68) "RTN","SCDXUTL0",168,0) ; "RTN","SCDXUTL0",169,0) ; Output: Array (pass desired name as parameter) containing "RTN","SCDXUTL0",170,0) ; stop codes "RTN","SCDXUTL0",171,0) ; "RTN","SCDXUTL0",172,0) ; "RTN","SCDXUTL0",173,0) N CNT,I,SDOE0,SDOEC,SDOEC0 "RTN","SCDXUTL0",174,0) S CNT=1,(I,SDOEC)=0 "RTN","SCDXUTL0",175,0) S SDOE=+$G(SDOE) "RTN","SCDXUTL0",176,0) I '$D(^SCE(SDOE,0)) G SCODEQ "RTN","SCDXUTL0",177,0) I '$P($G(^SCE(SDOE,0)),"^",3) G SCODEQ "RTN","SCDXUTL0",178,0) S SDOE0=$G(^SCE(SDOE,0)) "RTN","SCDXUTL0",179,0) ; "RTN","SCDXUTL0",180,0) ;- Get stop code from parent encounter "RTN","SCDXUTL0",181,0) I $P(SDOE0,"^",3) S @SCDXARRY@(CNT)=$P(SDOE0,"^",3),I=CNT "RTN","SCDXUTL0",182,0) ; "RTN","SCDXUTL0",183,0) ;- Get stop code from child encounter (credit stop) "RTN","SCDXUTL0",184,0) F S SDOEC=+$O(^SCE("APAR",SDOE,SDOEC)) Q:('SDOEC)!(CNT=2) D "RTN","SCDXUTL0",185,0) . S SDOEC0=$G(^SCE(SDOEC,0)) "RTN","SCDXUTL0",186,0) . I $P(SDOEC0,"^",3),($P(SDOEC0,"^",8)=4) D "RTN","SCDXUTL0",187,0) .. S CNT=CNT+1,I=CNT "RTN","SCDXUTL0",188,0) .. S @SCDXARRY@(CNT)=$P(SDOEC0,"^",3) "RTN","SCDXUTL0",189,0) SCODEQ S @SCDXARRY@(0)=I "RTN","SCDXUTL0",190,0) Q "RTN","SCDXUTL0",191,0) ; "RTN","SCDXUTL0",192,0) ; "RTN","SCDXUTL0",193,0) PROC(SDOE,SCDXARRY) ; Return array of procedures for encounter "RTN","SCDXUTL0",194,0) ; "RTN","SCDXUTL0",195,0) ; "RTN","SCDXUTL0",196,0) ; Input: SDOE = Outpatient Encounter IEN (from file #409.68) "RTN","SCDXUTL0",197,0) ; "RTN","SCDXUTL0",198,0) ; Output: Array (pass desired name as parameter) containing "RTN","SCDXUTL0",199,0) ; procedures "RTN","SCDXUTL0",200,0) ; "RTN","SCDXUTL0",201,0) N CNT "RTN","SCDXUTL0",202,0) S CNT=0,SDOE=+$G(SDOE) "RTN","SCDXUTL0",203,0) I '$D(^SCE(SDOE,0)) G PROCQ "RTN","SCDXUTL0",204,0) ; "RTN","SCDXUTL0",205,0) D GETPROC(.CNT,SDOE,SCDXARRY) G PROCQ "RTN","SCDXUTL0",206,0) ; "RTN","SCDXUTL0",207,0) ;- Array of procedures "RTN","SCDXUTL0",208,0) PROCQ S @SCDXARRY@(0)=CNT "RTN","SCDXUTL0",209,0) Q "RTN","SCDXUTL0",210,0) ; "RTN","SCDXUTL0",211,0) ; "RTN","SCDXUTL0",212,0) GETPROC(CNT,ENC,SCDXARRY) ;Get procedures from Scheduling Visits file "RTN","SCDXUTL0",213,0) ; "RTN","SCDXUTL0",214,0) N CPTS,VCPT "RTN","SCDXUTL0",215,0) D GETCPT^SDOE(ENC,"CPTS") "RTN","SCDXUTL0",216,0) N CPT,QTY,I "RTN","SCDXUTL0",217,0) S VCPT=0 "RTN","SCDXUTL0",218,0) F S VCPT=$O(CPTS(VCPT)) Q:'VCPT D "RTN","SCDXUTL0",219,0) . S CPT=$G(CPTS(VCPT)) "RTN","SCDXUTL0",220,0) . S QTY=+$P(CPT,U,16) "RTN","SCDXUTL0",221,0) . F I=1:1:QTY S CNT=CNT+1,@SCDXARRY@(CNT)=+CPT "RTN","SCDXUTL0",222,0) Q "RTN","SCMSVUT2") 0^9^B28593958 "RTN","SCMSVUT2",1,0) SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99 "RTN","SCMSVUT2",2,0) ;;5.3;Scheduling;**66,180,254,293,325**;AUG 13,1993 "RTN","SCMSVUT2",3,0) ;06/28/99 ACS Added CPT modifier validation "RTN","SCMSVUT2",4,0) ; "RTN","SCMSVUT2",5,0) COUNT(VALER) ;counts the number of errored encounters found. "RTN","SCMSVUT2",6,0) ;INPUT VALER - The array containing the errors. "RTN","SCMSVUT2",7,0) ;OUTPUT the number of errors "RTN","SCMSVUT2",8,0) ; "RTN","SCMSVUT2",9,0) N VAR,CNT "RTN","SCMSVUT2",10,0) S VAR="",CNT=0 "RTN","SCMSVUT2",11,0) F S VAR=$O(@VALER@(VAR)) Q:VAR']"" S CNT=CNT+1 "RTN","SCMSVUT2",12,0) Q CNT "RTN","SCMSVUT2",13,0) ; "RTN","SCMSVUT2",14,0) FILEVERR(PTR,VALERR) ;files the errors found for an encounter "RTN","SCMSVUT2",15,0) ;INPUT PTR - The pointer to the entry in the transmission file 409.73 "RTN","SCMSVUT2",16,0) ; VALERR - The array holding the errors for the encounter. "RTN","SCMSVUT2",17,0) ;OUTPUT 0 - did not file "RTN","SCMSVUT2",18,0) ; 1 - did file "RTN","SCMSVUT2",19,0) N SEG,FILE "RTN","SCMSVUT2",20,0) I '$D(VALERR) Q 0 "RTN","SCMSVUT2",21,0) S SEG="",FILE=-1 "RTN","SCMSVUT2",22,0) F S SEG=$O(@VALERR@(SEG)) Q:SEG']"" D FILE(VALERR,SEG,PTR,.FILE) "RTN","SCMSVUT2",23,0) Q $S(FILE=1:1,1:0) "RTN","SCMSVUT2",24,0) ; "RTN","SCMSVUT2",25,0) FILE(VALERR,SEG,PTR,FILE) ; "RTN","SCMSVUT2",26,0) N NBR "RTN","SCMSVUT2",27,0) S NBR=0 "RTN","SCMSVUT2",28,0) F S NBR=$O(@VALERR@(SEG,NBR)) Q:'NBR DO "RTN","SCMSVUT2",29,0) .N CODPTR "RTN","SCMSVUT2",30,0) .S CODE=$G(@VALERR@(SEG,NBR)) "RTN","SCMSVUT2",31,0) .I CODE']"" Q "RTN","SCMSVUT2",32,0) .S CODPTR=$O(^SD(409.76,"B",CODE,"")) "RTN","SCMSVUT2",33,0) .I 'CODPTR Q "RTN","SCMSVUT2",34,0) .I $D(^SD(409.75,"AER",PTR,CODPTR)) S FILE=1 Q "RTN","SCMSVUT2",35,0) .S FILE=$$CRTERR^SCDXFU02(PTR,CODE) "RTN","SCMSVUT2",36,0) .Q "RTN","SCMSVUT2",37,0) Q "RTN","SCMSVUT2",38,0) ; "RTN","SCMSVUT2",39,0) VALWL(CLIN) ;WORKLOAD VALIDATION AT CHECK OUT "RTN","SCMSVUT2",40,0) ;INPUT CLIN - IEN OF CLINIC "RTN","SCMSVUT2",41,0) ;OUTPUT 0 - DO NOT VALIDATE WORKLOAD "RTN","SCMSVUT2",42,0) ; 1 - VALIDATE CLINIC WORKLOAD "RTN","SCMSVUT2",43,0) N A1 "RTN","SCMSVUT2",44,0) I '$D(CLIN) S CLIN=0 "RTN","SCMSVUT2",45,0) S A1=$P($G(^SC(+CLIN,0)),U,30) "RTN","SCMSVUT2",46,0) Q $S(A1=1:1,1:0) "RTN","SCMSVUT2",47,0) ; "RTN","SCMSVUT2",48,0) VALIDATE(XMITPTR) ;validates data that has a entry in the transmit file. "RTN","SCMSVUT2",49,0) ; "RTN","SCMSVUT2",50,0) ;INPUT XMITPTR - This is the point to an entry in file 409.73. "RTN","SCMSVUT2",51,0) ; "RTN","SCMSVUT2",52,0) ;OUTPUT -1 - the was a problem with the inputs "RTN","SCMSVUT2",53,0) ; 0 - no errors were found "RTN","SCMSVUT2",54,0) ; 1 - errors were found "RTN","SCMSVUT2",55,0) ; "RTN","SCMSVUT2",56,0) N VALERR,ERR,HL,HLEID,DFN "RTN","SCMSVUT2",57,0) S ANS=-1 "RTN","SCMSVUT2",58,0) S XMITPTR=+$G(XMITPTR) "RTN","SCMSVUT2",59,0) I $G(^SD(409.73,XMITPTR,0))']"" G VALQ "RTN","SCMSVUT2",60,0) D PATDFN^SCDXUTL2(XMITPTR) "RTN","SCMSVUT2",61,0) ; "RTN","SCMSVUT2",62,0) S HL7XMIT="^TMP(""HLS"","_$J_")",VALERR="^TMP(""SCDXVALID"","_$J_","_XMITPTR_")" "RTN","SCMSVUT2",63,0) ;Initialze HL7 variables "RTN","SCMSVUT2",64,0) S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0)) "RTN","SCMSVUT2",65,0) I ('HLEID) G VALQ "RTN","SCMSVUT2",66,0) D INIT^HLFNC2(HLEID,.HL) "RTN","SCMSVUT2",67,0) I ($O(HL(""))="") G VALQ "RTN","SCMSVUT2",68,0) ; "RTN","SCMSVUT2",69,0) S ERR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,1,HL7XMIT,1,VALERR) "RTN","SCMSVUT2",70,0) ; "RTN","SCMSVUT2",71,0) I ERR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0) "RTN","SCMSVUT2",72,0) S ANS=0 "RTN","SCMSVUT2",73,0) D DELAERR^SCDXFU02(XMITPTR,0) "RTN","SCMSVUT2",74,0) D DEMUPDT(DFN,VALERR,"DEMO") "RTN","SCMSVUT2",75,0) I $O(@VALERR@(0))]"" DO "RTN","SCMSVUT2",76,0) .N FILE "RTN","SCMSVUT2",77,0) .S ANS=1 "RTN","SCMSVUT2",78,0) .S FILE=$$FILEVERR(XMITPTR,VALERR) "RTN","SCMSVUT2",79,0) .Q "RTN","SCMSVUT2",80,0) ; "RTN","SCMSVUT2",81,0) K @VALERR,@HL7XMIT "RTN","SCMSVUT2",82,0) ; "RTN","SCMSVUT2",83,0) VALQ Q ANS "RTN","SCMSVUT2",84,0) ; "RTN","SCMSVUT2",85,0) DEMUPDT(DFN,VALERR,TYP) ; "RTN","SCMSVUT2",86,0) ;This entry point updates all the other encoutners for this patient "RTN","SCMSVUT2",87,0) ;that HAVE errors with a new set or demographic errors or deletes all "RTN","SCMSVUT2",88,0) ;the demographic errors if none were found. "RTN","SCMSVUT2",89,0) ;INPUT DFN - The patient's DFN "RTN","SCMSVUT2",90,0) ; VALERR - errors to log "RTN","SCMSVUT2",91,0) ; TYP - The type of errors to delete and log. "RTN","SCMSVUT2",92,0) ; Right now demographic errors are the only kind "DEMO" "RTN","SCMSVUT2",93,0) ; "RTN","SCMSVUT2",94,0) S DFN=$G(DFN),TYP=$G(TYP),VALERR=$G(VALERR) "RTN","SCMSVUT2",95,0) I DFN=""!(TYP="")!(VALERR="") Q "RTN","SCMSVUT2",96,0) N PTRS,RNG,LP,PTR "RTN","SCMSVUT2",97,0) S RNG=$P($T(@(TYP)),";;",2),PTRS="" "RTN","SCMSVUT2",98,0) D CLEAN(DFN,RNG,.PTRS) "RTN","SCMSVUT2",99,0) I '$D(@VALERR@("PID")) Q "RTN","SCMSVUT2",100,0) I PTRS']"" Q "RTN","SCMSVUT2",101,0) F LP=1:1 S PTR=$P(PTRS,U,LP) Q:PTR']"" DO "RTN","SCMSVUT2",102,0) .I '$D(^SD(409.73,PTR,0)) Q "RTN","SCMSVUT2",103,0) .N FILE "RTN","SCMSVUT2",104,0) .D FILE(VALERR,"PID",PTR,.FILE) "RTN","SCMSVUT2",105,0) .Q "RTN","SCMSVUT2",106,0) Q "RTN","SCMSVUT2",107,0) ; "RTN","SCMSVUT2",108,0) CLEAN(DFN,RNG,PTRS) ;This subroutine cleans out all errors for a pateint "RTN","SCMSVUT2",109,0) ;and returns a string of which entries in 409.73 were cleaned of errors "RTN","SCMSVUT2",110,0) ; "RTN","SCMSVUT2",111,0) N LP,COD,LP2,IEN "RTN","SCMSVUT2",112,0) F LP=1:1 S COD=$P(RNG,U,LP) Q:COD']"" I $D(^SD(409.75,"ACOD",DFN,COD)) S IEN="" F LP2=1:1 S IEN=$O(^SD(409.75,"ACOD",DFN,COD,IEN)) Q:IEN']"" DO "RTN","SCMSVUT2",113,0) .N VAR,RES "RTN","SCMSVUT2",114,0) .S VAR=$P($G(^SD(409.75,IEN,0)),U,1)_"^" "RTN","SCMSVUT2",115,0) .I $P(VAR,U,1)="" S PTR="" Q "RTN","SCMSVUT2",116,0) .S RES=$$DELERR^SCDXFU02(IEN) "RTN","SCMSVUT2",117,0) .I PTRS[VAR Q "RTN","SCMSVUT2",118,0) .S PTRS=PTRS_VAR "RTN","SCMSVUT2",119,0) .Q "RTN","SCMSVUT2",120,0) Q "RTN","SCMSVUT2",121,0) ; "RTN","SCMSVUT2",122,0) MODCODE(DATA,ENCDT) ; "RTN","SCMSVUT2",123,0) ; "RTN","SCMSVUT2",124,0) ;--------------------------------------------------------------- "RTN","SCMSVUT2",125,0) ; VALIDATE MODIFIER AND CPT+MODIFIER COMBINATION "RTN","SCMSVUT2",126,0) ; "RTN","SCMSVUT2",127,0) ; INPUT: DATA - The procedure and modifier code to be checked "RTN","SCMSVUT2",128,0) ; format: CPT~modifier "RTN","SCMSVUT2",129,0) ; ENCDT - The date of the encounter "RTN","SCMSVUT2",130,0) ; "RTN","SCMSVUT2",131,0) ;OUTPUT: 1 - valid modifier and CPT+modifier combination "RTN","SCMSVUT2",132,0) ; 0 - invalid modifier or CPT+modifier combination "RTN","SCMSVUT2",133,0) ; "RTN","SCMSVUT2",134,0) ;**NOTE** This call makes the assumption that leading zeros are "RTN","SCMSVUT2",135,0) ; intact in the input. "RTN","SCMSVUT2",136,0) ;--------------------------------------------------------------- "RTN","SCMSVUT2",137,0) ; "RTN","SCMSVUT2",138,0) ;- validate modifier only "RTN","SCMSVUT2",139,0) N DATAMOD "RTN","SCMSVUT2",140,0) S DATAMOD=$P(DATA,"~",2) "RTN","SCMSVUT2",141,0) I '$D(DATAMOD) Q 0 "RTN","SCMSVUT2",142,0) I $$MOD^ICPTMOD(DATAMOD,"E",ENCDT,1)'>0 Q 0 "RTN","SCMSVUT2",143,0) ; "RTN","SCMSVUT2",144,0) ;- validate CPT+modifier pair "RTN","SCMSVUT2",145,0) N DATAPROC "RTN","SCMSVUT2",146,0) S DATAPROC=$P(DATA,"~",1) "RTN","SCMSVUT2",147,0) I '$D(DATAPROC) Q 0 "RTN","SCMSVUT2",148,0) I $$MODP^ICPTMOD(DATAPROC,DATAMOD,"E",ENCDT,1)'>0 Q 0 "RTN","SCMSVUT2",149,0) Q 1 "RTN","SCMSVUT2",150,0) ; "RTN","SCMSVUT2",151,0) MODMETH(DATA) ; "RTN","SCMSVUT2",152,0) ; "RTN","SCMSVUT2",153,0) ;--------------------------------------------------------------- "RTN","SCMSVUT2",154,0) ; VALIDATE MODIFIER CODING METHOD "RTN","SCMSVUT2",155,0) ; "RTN","SCMSVUT2",156,0) ; INPUT: DATA - The modifier coding method to be checked "RTN","SCMSVUT2",157,0) ; "RTN","SCMSVUT2",158,0) ;OUTPUT: 1 - valid modifier coding method "RTN","SCMSVUT2",159,0) ; 0 - invalid modifier coding method "RTN","SCMSVUT2",160,0) ; "RTN","SCMSVUT2",161,0) ; Valid modifier coding methods: C and H "RTN","SCMSVUT2",162,0) ;--------------------------------------------------------------- "RTN","SCMSVUT2",163,0) ; "RTN","SCMSVUT2",164,0) I '$D(DATA) Q 0 "RTN","SCMSVUT2",165,0) S DATA=","_DATA_"," "RTN","SCMSVUT2",166,0) I ",C,H,"'[DATA Q 0 "RTN","SCMSVUT2",167,0) Q 1 "RTN","SCMSVUT2",168,0) ; "RTN","SCMSVUT2",169,0) ETHNIC(DATA) ; "RTN","SCMSVUT2",170,0) ;INPUT DATA - the ethnicity code to be validated (NNNN-C-XXX) "RTN","SCMSVUT2",171,0) ; "RTN","SCMSVUT2",172,0) N VAL,MTHD "RTN","SCMSVUT2",173,0) I '$D(DATA) Q 0 "RTN","SCMSVUT2",174,0) I DATA="" Q 1 "RTN","SCMSVUT2",175,0) S VAL=$P(DATA,"-",1,2) "RTN","SCMSVUT2",176,0) S MTHD=$P(DATA,"-",3) "RTN","SCMSVUT2",177,0) I VAL'?4N1"-"1N Q 0 "RTN","SCMSVUT2",178,0) I ",SLF,UNK,PRX,OBS,"'[MTHD Q 0 "RTN","SCMSVUT2",179,0) Q 1 "RTN","SCMSVUT2",180,0) CONFDT(DATA,SUB) ;CONFIDENTIAL ADDRESS START/STOP DATE "RTN","SCMSVUT2",181,0) N X,Y,%DT,DTOUT,STDT,ENDT "RTN","SCMSVUT2",182,0) I '$D(DATA) Q 0 "RTN","SCMSVUT2",183,0) S STDT=$P(DATA,SUB,1) "RTN","SCMSVUT2",184,0) S ENDT=$P(DATA,SUB,2) "RTN","SCMSVUT2",185,0) I STDT="" Q 0 "RTN","SCMSVUT2",186,0) S STDT=$$FMDATE^HLFNC(STDT) "RTN","SCMSVUT2",187,0) S X=STDT D ^%DT I Y=-1 Q 0 "RTN","SCMSVUT2",188,0) I ENDT="" Q 1 "RTN","SCMSVUT2",189,0) S ENDT=$$FMDATE^HLFNC(ENDT) "RTN","SCMSVUT2",190,0) S X=ENDT D ^%DT I Y=-1 Q 0 "RTN","SCMSVUT2",191,0) I $$FMDIFF^XLFDT(ENDT,STDT,1)<0 Q 0 "RTN","SCMSVUT2",192,0) Q 1 "RTN","SCMSVUT2",193,0) ; "RTN","SCMSVUT2",194,0) CONFCAT(DATA) ;CONFIDENTIAL ADDRESS CATEGORY TYPE "RTN","SCMSVUT2",195,0) I '$D(DATA) Q 0 "RTN","SCMSVUT2",196,0) I DATA="" Q 0 "RTN","SCMSVUT2",197,0) N VAL,GOOD "RTN","SCMSVUT2",198,0) S GOOD=0 "RTN","SCMSVUT2",199,0) F VAL="VACAA","VACAC","VACAE","VACAM","VACAO" I DATA=VAL S GOOD=1 Q "RTN","SCMSVUT2",200,0) Q GOOD "RTN","SCMSVUT2",201,0) ; "RTN","SCMSVUT2",202,0) CVEDT(DATA) ;Combat vet end date (ZEL.38) "RTN","SCMSVUT2",203,0) ;Input : DATA - CombatVetIndicator ^ CombatVetEndDate "RTN","SCMSVUT2",204,0) ;Output : 1 = Good / 0 = Bad "RTN","SCMSVUT2",205,0) ; "RTN","SCMSVUT2",206,0) N CVI,CVEDT "RTN","SCMSVUT2",207,0) S DATA=$G(DATA) "RTN","SCMSVUT2",208,0) S CVI=$P(DATA,"^",1) "RTN","SCMSVUT2",209,0) S CVEDT=$P(DATA,"^",2) "RTN","SCMSVUT2",210,0) I 'CVI Q $S(CVEDT="":1,1:0) "RTN","SCMSVUT2",211,0) Q CVEDT?8N "RTN","SCMSVUT2",212,0) ; "RTN","SCMSVUT2",213,0) CLCV(DATA,SDOE) ;Cross check for combat vet classification question "RTN","SCMSVUT2",214,0) ;Input : DATA - Answer to classification question "RTN","SCMSVUT2",215,0) ; SDOE - Pointer to encounter (file # 409.68) "RTN","SCMSVUT2",216,0) ;Output : 1 = Good / 0 = Bad "RTN","SCMSVUT2",217,0) ; "RTN","SCMSVUT2",218,0) S DATA=$G(DATA) "RTN","SCMSVUT2",219,0) Q:(DATA'=1) 1 "RTN","SCMSVUT2",220,0) N VET,SDDT,SDOE0 "RTN","SCMSVUT2",221,0) S SDOE=$G(SDOE) Q:'SDOE 0 "RTN","SCMSVUT2",222,0) S SDOE0=$G(^SCE(SDOE,0)) "RTN","SCMSVUT2",223,0) S SDDT=+SDOE0 Q:'SDDT 0 "RTN","SCMSVUT2",224,0) S DFN=+$P(SDOE0,"^",2) Q:'DFN 0 "RTN","SCMSVUT2",225,0) S VET=$P($$EL^SDCO22(DFN,SDOE),"^",5) "RTN","SCMSVUT2",226,0) I VET'="Y" Q 0 "RTN","SCMSVUT2",227,0) S VET=+$$CVEDT^DGCV(DFN,SDDT) "RTN","SCMSVUT2",228,0) Q $S(VET=1:1,1:0) "RTN","SCMSVUT2",229,0) ; "RTN","SCMSVUT2",230,0) DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360 "RTN","SCMSVZEL") 0^8^B8509859 "RTN","SCMSVZEL",1,0) SCMSVZEL ;ALB/ESD HL7 ZEL Segment Validation ; 8/11/99 9:24am "RTN","SCMSVZEL",2,0) ;;5.3;Scheduling;**44,66,142,184,180,222,239,325**;Aug 13, 1993 "RTN","SCMSVZEL",3,0) ; "RTN","SCMSVZEL",4,0) ; "RTN","SCMSVZEL",5,0) EN(ZELSEG,HLQ,HLFS,VALERR,DFN) ; "RTN","SCMSVZEL",6,0) ; Entry point to return the HL7 ZEL (Patient Eligibility) validation segment "RTN","SCMSVZEL",7,0) ; "RTN","SCMSVZEL",8,0) ; Input: .ZELSEG - ZEL Segment Array "RTN","SCMSVZEL",9,0) ; HLQ - HL7 null variable "RTN","SCMSVZEL",10,0) ; HLFS - HL7 field separator "RTN","SCMSVZEL",11,0) ; VALERR - The array name to put the errors in "RTN","SCMSVZEL",12,0) ; DFN - The DFN of the patient "RTN","SCMSVZEL",13,0) ; "RTN","SCMSVZEL",14,0) ; Output: 1 if ZEL passed validity check "RTN","SCMSVZEL",15,0) ; Error message if ZEL failed validity check in form of: "RTN","SCMSVZEL",16,0) ; -1^"xxx failed validity check" (xxx=element in ZEL segment) "RTN","SCMSVZEL",17,0) ; "RTN","SCMSVZEL",18,0) ; "RTN","SCMSVZEL",19,0) N I,MSG,X,CNT,DATA,SEG,ELIG,VET,LP,MSTSTAT,MSTDATE,SEGLINE,NODE,OFFSET "RTN","SCMSVZEL",20,0) N CVET "RTN","SCMSVZEL",21,0) S SEG="ZEL",CNT=1 "RTN","SCMSVZEL",22,0) S MSG="-1^Element in ZEL segment failed validity check" "RTN","SCMSVZEL",23,0) S ZELSEG(1)=$G(ZELSEG(1)) "RTN","SCMSVZEL",24,0) D VALIDATE^SCMSVUT0(SEG,ZELSEG(1),"0010",VALERR,.CNT) "RTN","SCMSVZEL",25,0) I $D(@VALERR@(SEG)) G ENQ "RTN","SCMSVZEL",26,0) ; "RTN","SCMSVZEL",27,0) ;- Convert HLQ to null "RTN","SCMSVZEL",28,0) S ZELSEG(1)=$$CONVERT^SCMSVUT0(ZELSEG(1),HLFS,HLQ) "RTN","SCMSVZEL",29,0) S I=0 "RTN","SCMSVZEL",30,0) F S I=+$O(ZELSEG(1,I)) Q:'I S ZELSEG(1,I)=$$CONVERT^SCMSVUT0(ZELSEG(1,I),HLFS,HLQ) "RTN","SCMSVZEL",31,0) ; "RTN","SCMSVZEL",32,0) S OFFSET=0,NODE=0,SEGLINE=ZELSEG(1) "RTN","SCMSVZEL",33,0) F I=1,3,9,19,20,23,24,25,30,38,39 DO "RTN","SCMSVZEL",34,0) . I $L(SEGLINE,HLFS)<(I-OFFSET) D "RTN","SCMSVZEL",35,0) . . ;Segment wrapped "RTN","SCMSVZEL",36,0) . . S OFFSET=OFFSET+$L(SEGLINE,HLFS)-1 "RTN","SCMSVZEL",37,0) . . S NODE=+$O(ZELSEG(1,NODE)) "RTN","SCMSVZEL",38,0) . . I NODE=0 S SEGLINE="",NODE=+$O(ZELSEG(1,NODE),-1) Q "RTN","SCMSVZEL",39,0) . . S SEGLINE=$G(ZELSEG(1,NODE)) "RTN","SCMSVZEL",40,0) . S DATA=$P(SEGLINE,HLFS,I-OFFSET) "RTN","SCMSVZEL",41,0) . I I=3 S ELIG=DATA "RTN","SCMSVZEL",42,0) . I I=9 S VET=DATA "RTN","SCMSVZEL",43,0) . I I=24 S MSTSTAT=DATA "RTN","SCMSVZEL",44,0) . I I=25 S MSTDATE=DATA,DATA=MSTSTAT_"^"_MSTDATE "RTN","SCMSVZEL",45,0) . I I=38 S CVET=DATA "RTN","SCMSVZEL",46,0) . I I=39 S DATA=CVET_"^"_DATA "RTN","SCMSVZEL",47,0) . D VALIDATE^SCMSVUT0(SEG,DATA,$P($T(@(I)),";",3),VALERR,.CNT) "RTN","SCMSVZEL",48,0) . Q "RTN","SCMSVZEL",49,0) ; "RTN","SCMSVZEL",50,0) S DATA=ELIG_"^"_VET "RTN","SCMSVZEL",51,0) F LP=32,91 D VALIDATE^SCMSVUT0(SEG,$S(LP=32:ELIG,LP=91:VET,1:DATA),$P($T(@(LP)),";",3),VALERR,.CNT) "RTN","SCMSVZEL",52,0) ; "RTN","SCMSVZEL",53,0) ENQ Q $S($D(@VALERR@(SEG)):MSG,1:1) "RTN","SCMSVZEL",54,0) ; "RTN","SCMSVZEL",55,0) ; "RTN","SCMSVZEL",56,0) ; "RTN","SCMSVZEL",57,0) ERR ;;Invalid or missing patient eligibility data for encounter (HL7 ZEL segment) "RTN","SCMSVZEL",58,0) ; "RTN","SCMSVZEL",59,0) ; "RTN","SCMSVZEL",60,0) ;- ZEL data elements validated "RTN","SCMSVZEL",61,0) ; "RTN","SCMSVZEL",62,0) 1 ;;0035;HL7 SEGMENT NAME "RTN","SCMSVZEL",63,0) 3 ;;7000;ELIGIBILITY CODE MISSING "RTN","SCMSVZEL",64,0) 31 ;;7020;ELIGIBILITY CODE INCONSISTENT WITH VET STATUS "RTN","SCMSVZEL",65,0) 32 ;;7030;ELIGIBILITY CODE INACTIVE "RTN","SCMSVZEL",66,0) 9 ;;7050;VETERAN? "RTN","SCMSVZEL",67,0) 91 ;;7100;VET STATUS INCONSISTENT WITH POW "RTN","SCMSVZEL",68,0) 19 ;;7120;AGENT ORANGE EXPOSURE "RTN","SCMSVZEL",69,0) 23 ;;7150;INVALID/INCONSISTENT RADIATION EXPOSURE METHOD "RTN","SCMSVZEL",70,0) 20 ;;7210;RADIATION EXPOSURE INDICATED "RTN","SCMSVZEL",71,0) 24 ;;7040;INVALID MST CLASSIFICATION "RTN","SCMSVZEL",72,0) 25 ;;7060;MST STATUS DATE INVALID OR INCONSISTENT WITH MST STATUS "RTN","SCMSVZEL",73,0) 30 ;;7130;AGENT ORANGE EXPOSURE LOCATION "RTN","SCMSVZEL",74,0) 38 ;;7330;COMBAT VET INDICATOR "RTN","SCMSVZEL",75,0) 39 ;;7340;COMBAT VET END DATE "RTN","SD53325") 0^1^B8544785 "RTN","SD53325",1,0) SD53325 ;BPFO/JRP - Post init for patch 325;11/10/2003 "RTN","SD53325",2,0) ;;5.3;Scheduling;**325**;Aug 13, 1993 "RTN","SD53325",3,0) ; "RTN","SD53325",4,0) PRE ;Main entry point for pre-install "RTN","SD53325",5,0) ;Do AmbCare pre-install (copied from SD53142) "RTN","SD53325",6,0) ;Remove ERROR CODE DESCRIPTION (field #11) as an identifier of the "RTN","SD53325",7,0) ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76) "RTN","SD53325",8,0) ; (this causes problems when installing error codes) "RTN","SD53325",9,0) I ($D(^DD(409.76,0,"ID",11))) D "RTN","SD53325",10,0) .N TMP,X "RTN","SD53325",11,0) .S X(1)=" " "RTN","SD53325",12,0) .S X(2)="Removing ERROR CODE DESCRIPTION (field #11) as an identifier" "RTN","SD53325",13,0) .S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file" "RTN","SD53325",14,0) .S X(4)="(#409.76) as it causes problems when installing error codes." "RTN","SD53325",15,0) .S X(5)=" " "RTN","SD53325",16,0) .D MES^XPDUTL(.X) K X "RTN","SD53325",17,0) .K ^DD(409.76,0,"ID",11) "RTN","SD53325",18,0) .Q:($D(^DD(409.76,0,"ID"))) "RTN","SD53325",19,0) .S TMP=$P(^SD(409.76,0),U,2) "RTN","SD53325",20,0) .S TMP=$TR(TMP,"I","") "RTN","SD53325",21,0) .S $P(^SD(409.76,0),U,2)=TMP "RTN","SD53325",22,0) .Q "RTN","SD53325",23,0) Q "RTN","SD53325",24,0) ; "RTN","SD53325",25,0) POST ;Main entry point for post-install "RTN","SD53325",26,0) N TEXT "RTN","SD53325",27,0) ;Ensure entry 7 doesn't exist in Outpatient Classification Type file "RTN","SD53325",28,0) I $D(^SD(409.41,7)) D "RTN","SD53325",29,0) .;Delete entry 7 "RTN","SD53325",30,0) .N DIK,DA "RTN","SD53325",31,0) .K TEXT "RTN","SD53325",32,0) .S TEXT(1)=" " "RTN","SD53325",33,0) .S TEXT(2)="'Combat Veteran' must be entry number 7 in the Outpatient" "RTN","SD53325",34,0) .S TEXT(3)="Classification Type file (#409.41). The existing entry 7" "RTN","SD53325",35,0) .S TEXT(4)="will be deleted to ensure that it matches the nationally" "RTN","SD53325",36,0) .S TEXT(5)="distributed definition for 'Combat Veteran'." "RTN","SD53325",37,0) .D MES^XPDUTL(.TEXT) "RTN","SD53325",38,0) .S DIK="^SD(409.41," "RTN","SD53325",39,0) .S DA=7 "RTN","SD53325",40,0) .D ^DIK "RTN","SD53325",41,0) ;Create entry in Outpatient Classification Type file (#409.41) "RTN","SD53325",42,0) N SDFDA,SDIEN,SDMSG "RTN","SD53325",43,0) K TEXT "RTN","SD53325",44,0) S TEXT(1)=" " "RTN","SD53325",45,0) S TEXT(2)="Creating 'Combat Veteran' entry in Outpatient Classification" "RTN","SD53325",46,0) S TEXT(3)="Type file (#409.41) as entry number 7 ..." "RTN","SD53325",47,0) D MES^XPDUTL(.TEXT) "RTN","SD53325",48,0) S SDFDA(409.41,"+1,",.01)="COMBAT VETERAN" "RTN","SD53325",49,0) S SDFDA(409.41,"+1,",.02)="Was treatment related to Combat" "RTN","SD53325",50,0) S SDFDA(409.41,"+1,",.03)="YES/NO" "RTN","SD53325",51,0) S SDFDA(409.41,"+1,",.05)="YES" "RTN","SD53325",52,0) S SDFDA(409.41,"+1,",.06)="Combat Vet (Combat Related)" "RTN","SD53325",53,0) S SDFDA(409.41,"+1,",.07)="CV" "RTN","SD53325",54,0) S SDFDA(409.41,"+1,",1)="I $$CV^SDCO22(DFN,$G(SDOE),$G(SDDT))" "RTN","SD53325",55,0) S SDFDA(409.41,"+1,",2)="@" "RTN","SD53325",56,0) S SDFDA(409.41,"+1,",50)="@" "RTN","SD53325",57,0) S SDFDA(409.4175,"+2,+1,",.01)="SEPTEMBER 1, 2002" "RTN","SD53325",58,0) S SDFDA(409.4175,"+2,+1,",.02)="YES" "RTN","SD53325",59,0) S SDIEN(1)=7 "RTN","SD53325",60,0) D UPDATE^DIE("E","SDFDA","SDIEN","SDMSG") "RTN","SD53325",61,0) I $D(SDMSG) D "RTN","SD53325",62,0) .D MES^XPDUTL("** Unable to create entry **") "RTN","SD53325",63,0) .K TEXT "RTN","SD53325",64,0) .D MSG^DIALOG("ASE",.TEXT,60,3,"SDMSG") "RTN","SD53325",65,0) .D MES^XPDUTL(.TEXT) "RTN","SD53325",66,0) I '$D(SDMSG) D "RTN","SD53325",67,0) .K TEXT "RTN","SD53325",68,0) .S TEXT(1)=" " "RTN","SD53325",69,0) .S TEXT(2)="'Combat Veteran' successfully added to Outpatient Classification" "RTN","SD53325",70,0) .S TEXT(3)="Type file (#409.41)" "RTN","SD53325",71,0) .D MES^XPDUTL(.TEXT) "RTN","SD53325",72,0) ;Do AmbCare post-init "RTN","SD53325",73,0) D POST^SD53325A "RTN","SD53325",74,0) Q "RTN","SD53325A") 0^10^B19716057 "RTN","SD53325A",1,0) SD53325A ;BPFO/JRP - PRE/POST INSTALL ROUTINE;5/29/2001 "RTN","SD53325A",2,0) ;;5.3;Scheduling;**325**;Aug 13, 1993 "RTN","SD53325A",3,0) ; "RTN","SD53325A",4,0) ;The bulk of this routine was copied from routine SD53142 "RTN","SD53325A",5,0) ; "RTN","SD53325A",6,0) POST ;Main entry point of post-install "RTN","SD53325A",7,0) N X,ZTRTN,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSK,OLDNAME,NEWNAME "RTN","SD53325A",8,0) ;Make ERROR CODE DESCRIPTION (field #11) an identifier of the "RTN","SD53325A",9,0) ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76) "RTN","SD53325A",10,0) ; (this was removed by the pre init routine) "RTN","SD53325A",11,0) I ('$D(^DD(409.76,0,"ID",11))) D "RTN","SD53325A",12,0) .N TMP "RTN","SD53325A",13,0) .S X(1)=" " "RTN","SD53325A",14,0) .S X(2)="Restoring ERROR CODE DESCRIPTION (field #11) as an identifier" "RTN","SD53325A",15,0) .S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file" "RTN","SD53325A",16,0) .S X(4)="(#409.76) as it was removed by the pre init." "RTN","SD53325A",17,0) .S X(5)=" " "RTN","SD53325A",18,0) .D MES^XPDUTL(.X) K X "RTN","SD53325A",19,0) .S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))" "RTN","SD53325A",20,0) .S TMP=$P(^SD(409.76,0),U,2) "RTN","SD53325A",21,0) .S TMP=$TR(TMP,"I","") "RTN","SD53325A",22,0) .S $P(^SD(409.76,0),U,2)=TMP_"I" "RTN","SD53325A",23,0) ;Change HL7 application name "RTN","SD53325A",24,0) S OLDNAME="AMBCARE-DH293" "RTN","SD53325A",25,0) S NEWNAME="AMBCARE-DH325" "RTN","SD53325A",26,0) ;Patch already installed - skip rest of post-init "RTN","SD53325A",27,0) I $$PATCH^XPDUTL("SD*5.3*325") D Q "RTN","SD53325A",28,0) .K X "RTN","SD53325A",29,0) .S X(1)=" " "RTN","SD53325A",30,0) .S X(2)="This patch was previously installed. Because of this, changing the" "RTN","SD53325A",31,0) .S X(3)="HL7 Application name from "_OLDNAME_" to "_NEWNAME_" and changing" "RTN","SD53325A",32,0) .S X(4)="the status of unacked AmbCare messages to SUCCESSFULLY COMPLETED is" "RTN","SD53325A",33,0) .S X(5)="not required." "RTN","SD53325A",34,0) .S X(6)=" " "RTN","SD53325A",35,0) .D MES^XPDUTL(.X) K X "RTN","SD53325A",36,0) D HLAPP(OLDNAME,NEWNAME) "RTN","SD53325A",37,0) ;Queue changing of HL7 message statuses "RTN","SD53325A",38,0) S ZTRTN="QHLM^SD53325A" "RTN","SD53325A",39,0) S ZTDESC="Change status of unacked AmbCare messages to SUCCESSFULLY COMPLETED" "RTN","SD53325A",40,0) S ZTIO="" "RTN","SD53325A",41,0) S ZTDTH=$H "RTN","SD53325A",42,0) D ^%ZTLOAD "RTN","SD53325A",43,0) K X "RTN","SD53325A",44,0) S X(1)=" " "RTN","SD53325A",45,0) S X(2)="Updating status of AmbCare messages that have not been acknowledged" "RTN","SD53325A",46,0) S X(3)="queued as task number "_$G(ZTSK) "RTN","SD53325A",47,0) S X(4)=" " "RTN","SD53325A",48,0) I '$G(ZTSK) D "RTN","SD53325A",49,0) .S X(1)=" " "RTN","SD53325A",50,0) .S X(2)="***** Updating status of AmbCare messages that have not been" "RTN","SD53325A",51,0) .S X(3)="***** acknowledged was not queued. This process must be done" "RTN","SD53325A",52,0) .S X(4)="***** in order for these messages to be properly purged." "RTN","SD53325A",53,0) .S X(5)="***** Use entry point QHLM^SD53325A to do this process." "RTN","SD53325A",54,0) .S X(6)=" " "RTN","SD53325A",55,0) D MES^XPDUTL(.X) K X "RTN","SD53325A",56,0) Q "RTN","SD53325A",57,0) ; "RTN","SD53325A",58,0) HLAPP(OLDNAME,NEWNAME) ;Change HL7 application name "RTN","SD53325A",59,0) ;Input : OLDNAME - Name of HL7 application to change "RTN","SD53325A",60,0) ; NEWNAME - New name for HL7 application "RTN","SD53325A",61,0) ;Output : None "RTN","SD53325A",62,0) ;Notes : Call designed to be used as a KIDS pre/post init "RTN","SD53325A",63,0) S OLDNAME=$G(OLDNAME) Q:OLDNAME="" "RTN","SD53325A",64,0) S NEWNAME=$G(NEWNAME) Q:NEWNAME="" "RTN","SD53325A",65,0) N DIE,DIC,DA,DR,X,Y,PTCH "RTN","SD53325A",66,0) D BMES^XPDUTL("Changing HL7 Application name from "_OLDNAME_" to "_NEWNAME) "RTN","SD53325A",67,0) S DIC="^HL(771," "RTN","SD53325A",68,0) S DIC(0)="X" "RTN","SD53325A",69,0) S X=OLDNAME "RTN","SD53325A",70,0) D ^DIC "RTN","SD53325A",71,0) I (Y<0) D Q "RTN","SD53325A",72,0) .D BMES^XPDUTL(" *** "_OLDNAME_" application not found ***") "RTN","SD53325A",73,0) S DIE=DIC "RTN","SD53325A",74,0) S DA=+Y "RTN","SD53325A",75,0) S DR=".01///^S X=NEWNAME" "RTN","SD53325A",76,0) D ^DIE "RTN","SD53325A",77,0) D MES^XPDUTL("HL7 application name successfully changed to "_NEWNAME) "RTN","SD53325A",78,0) Q "RTN","SD53325A",79,0) ; "RTN","SD53325A",80,0) QHLM ;Entry point for queued changing of HL7 messages "RTN","SD53325A",81,0) D HLM("AMBCARE-DH325") "RTN","SD53325A",82,0) Q "RTN","SD53325A",83,0) HLM(APPNAME) ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED) "RTN","SD53325A",84,0) ; to enable purging of message "RTN","SD53325A",85,0) ;Input : APPNAME - Name of application generating message "RTN","SD53325A",86,0) ;Output : None "RTN","SD53325A",87,0) ;Notes : Call must be used within KIDS (updates progress bar) "RTN","SD53325A",88,0) S APPNAME=$G(APPNAME) Q:APPNAME="" "RTN","SD53325A",89,0) N DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT "RTN","SD53325A",90,0) N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,SBSCRPT "RTN","SD53325A",91,0) S SBSCRPT="SD "_APPNAME "RTN","SD53325A",92,0) K ^TMP(SBSCRPT,$J) "RTN","SD53325A",93,0) S X=$$NOW^XLFDT() "RTN","SD53325A",94,0) S Y=$$FMTE^XLFDT(X) "RTN","SD53325A",95,0) S TEXT="Updating of HL7 Message Text file (#772) began on " "RTN","SD53325A",96,0) S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2) "RTN","SD53325A",97,0) S ^TMP(SBSCRPT,$J,1,0)=TEXT "RTN","SD53325A",98,0) S DIC="^HL(771," "RTN","SD53325A",99,0) S DIC(0)="M" "RTN","SD53325A",100,0) S X=APPNAME "RTN","SD53325A",101,0) D ^DIC "RTN","SD53325A",102,0) I (Y<0) D G HLMQ "RTN","SD53325A",103,0) .S ^TMP(SBSCRPT,$J,2,0)=" *** "_APPNAME_" application not found" "RTN","SD53325A",104,0) .S ^TMP(SBSCRPT,$J,3,0)=" *** Process aborted" "RTN","SD53325A",105,0) S SDAPP=+Y "RTN","SD53325A",106,0) S HLMID="" "RTN","SD53325A",107,0) S COUNT=0 "RTN","SD53325A",108,0) F S HLMID=$O(^HL(772,"AH",SDAPP,HLMID)) Q:(HLMID="") D "RTN","SD53325A",109,0) .S HLPTR=0 "RTN","SD53325A",110,0) .F S HLPTR=+$O(^HL(772,"AH",SDAPP,HLMID,HLPTR)) Q:('HLPTR) D "RTN","SD53325A",111,0) ..S DIE="^HL(772," "RTN","SD53325A",112,0) ..S DA=HLPTR "RTN","SD53325A",113,0) ..S DR="20////3" "RTN","SD53325A",114,0) ..D ^DIE "RTN","SD53325A",115,0) ..S COUNT=COUNT+1 "RTN","SD53325A",116,0) S X=$$NOW^XLFDT() "RTN","SD53325A",117,0) S Y=$$FMTE^XLFDT(X) "RTN","SD53325A",118,0) S TEXT="Updating of HL7 Message Text file completed on " "RTN","SD53325A",119,0) S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2) "RTN","SD53325A",120,0) S ^TMP(SBSCRPT,$J,2,0)=TEXT "RTN","SD53325A",121,0) S ^TMP(SBSCRPT,$J,3,0)=COUNT_" entries were updated" "RTN","SD53325A",122,0) HLMQ S XMDUZ="Patch SD*5.3*325" "RTN","SD53325A",123,0) S XMSUB="Updating of HL7 Message Text file" "RTN","SD53325A",124,0) S XMTEXT="^TMP("""_SBSCRPT_""",$J," "RTN","SD53325A",125,0) S XMY(DUZ)="" "RTN","SD53325A",126,0) D ^XMD "RTN","SD53325A",127,0) S ZTREQ="@" "RTN","SD53325A",128,0) Q "RTN","SDAMEP2") 0^11^B18686916 "RTN","SDAMEP2",1,0) SDAMEP2 ;ALB/CAW - Extended Display (Patient Data) ; 11/13/02 "RTN","SDAMEP2",2,0) ;;5.3;Scheduling;**258,325**;Aug 13, 1993 "RTN","SDAMEP2",3,0) ; "RTN","SDAMEP2",4,0) PDATA ; Patient Data "RTN","SDAMEP2",5,0) F SD=0,.11,.13,.32,.321,.36,.52 S SD(SD)=$G(^DPT(DFN,SD)) "RTN","SDAMEP2",6,0) S SD("CV")=$$CVEDT^DGCV(DFN,SDT) "RTN","SDAMEP2",7,0) S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10 "RTN","SDAMEP2",8,0) S SDFSTCOL=16,SDSECCOL=60 "RTN","SDAMEP2",9,0) S X="" D SET^SDAMEP1($$SETSTR^VALM1("*** Patient Information ***",X,25,30)) "RTN","SDAMEP2",10,0) D CNTRL^VALM10(SDLN,25,30,IOINHI,IOINORM) "RTN","SDAMEP2",11,0) PTDOB ; Date of Birth and SSN Info "RTN","SDAMEP2",12,0) ; "RTN","SDAMEP2",13,0) S X="",X=$$SETSTR^VALM1("Date of Birth:",X,1,14) "RTN","SDAMEP2",14,0) S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SD(0),U,3)),X,SDFSTCOL,18) "RTN","SDAMEP2",15,0) S X=$$SETSTR^VALM1(" ID:",X,55,4) "RTN","SDAMEP2",16,0) S X=$$SETSTR^VALM1(VA("PID"),X,SDSECCOL,20) "RTN","SDAMEP2",17,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",18,0) PTSEX ; Sex and Marital Status Info "RTN","SDAMEP2",19,0) ; "RTN","SDAMEP2",20,0) S X="",X=$$SETSTR^VALM1("Sex:",X,11,4) "RTN","SDAMEP2",21,0) S X=$$SETSTR^VALM1($S($P(SD(0),U,2)="F":"FEMALE",$P(SD(0),U,2)="M":"MALE",1:"UNKNOWN"),X,SDFSTCOL,18) "RTN","SDAMEP2",22,0) S X=$$SETSTR^VALM1("Marital Status:",X,44,15) "RTN","SDAMEP2",23,0) S X=$$SETSTR^VALM1($P($G(^DIC(11,+$P(SD(0),U,5),0)),U),X,SDSECCOL,20) "RTN","SDAMEP2",24,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",25,0) PTREL ; Religious Pref. Info "RTN","SDAMEP2",26,0) ; "RTN","SDAMEP2",27,0) S X="",X=$$SETSTR^VALM1("Religious Pref.:",X,43,16) "RTN","SDAMEP2",28,0) S X=$$SETSTR^VALM1($P($G(^DIC(13,+$P(SD(0),U,8),0)),U),X,SDSECCOL,20) "RTN","SDAMEP2",29,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",30,0) PTMT ; Means Test Info "RTN","SDAMEP2",31,0) ; "RTN","SDAMEP2",32,0) S SDMT=$$LST^DGMTU(DFN),X="" G:$P(SDMT,U,4)="N" PTCO I +SDMT D G PTMTQ "RTN","SDAMEP2",33,0) .S X=$$SETSTR^VALM1("Means Test:",X,4,11) "RTN","SDAMEP2",34,0) .S X=$$SETSTR^VALM1($P($$FMT^SDUTL2(DFN),U),X,SDFSTCOL,20) "RTN","SDAMEP2",35,0) .S X=$$SETSTR^VALM1("Last Means Test:",X,43,16) "RTN","SDAMEP2",36,0) .S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDMT,U,2)),X,SDSECCOL,20) "RTN","SDAMEP2",37,0) PTCO S SDMT=$$LST^DGMTU(DFN,"",2),X="" I +SDMT D "RTN","SDAMEP2",38,0) .S X=$$SETSTR^VALM1("Co-Pay Test:",X,3,12) "RTN","SDAMEP2",39,0) .S X=$$SETSTR^VALM1($P($$FCO^SDUTL2(DFN),U,2),X,SDFSTCOL,10) "RTN","SDAMEP2",40,0) .S X=$$SETSTR^VALM1("Last Co-Pay Test:",X,42,17) "RTN","SDAMEP2",41,0) .S X=$$SETSTR^VALM1($$FDATE^VALM1($P(SDMT,U,2)),X,SDSECCOL,20) "RTN","SDAMEP2",42,0) PTMTQ D SET^SDAMEP1(X) "RTN","SDAMEP2",43,0) PTELG ; Primary Eligibility and Period of Service Info "RTN","SDAMEP2",44,0) ; "RTN","SDAMEP2",45,0) S X="",X=$$SETSTR^VALM1("Primary Elig.:",X,1,14) "RTN","SDAMEP2",46,0) S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SD(.36),U),0)),U,6),X,SDFSTCOL,21) "RTN","SDAMEP2",47,0) S X=$$SETSTR^VALM1("POS:",X,55,4) "RTN","SDAMEP2",48,0) S X=$$SETSTR^VALM1($P($G(^DIC(21,+$P(SD(.32),U,3),0)),U),X,SDSECCOL,20) "RTN","SDAMEP2",49,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",50,0) PTADD ; Patient Address "RTN","SDAMEP2",51,0) ; "RTN","SDAMEP2",52,0) S X="",X=($$SETSTR^VALM1("Address:",X,7,8)) "RTN","SDAMEP2",53,0) S X=$$SETSTR^VALM1("Phone:",X,53,6) "RTN","SDAMEP2",54,0) S X=$$SETSTR^VALM1($P(SD(.13),U),X,SDSECCOL,20) "RTN","SDAMEP2",55,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",56,0) S X="",X=($$SETSTR^VALM1($P(SD(.11),U),X,10,30)) "RTN","SDAMEP2",57,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",58,0) S X="" "RTN","SDAMEP2",59,0) I $P(SD(.11),U,2)'="" D "RTN","SDAMEP2",60,0) .S X="",X=($$SETSTR^VALM1($P(SD(.11),U,2),X,10,30)) "RTN","SDAMEP2",61,0) D:X'="" SET^SDAMEP1(X) "RTN","SDAMEP2",62,0) N SDZIP S SDZIP=$P(SD(.11),U,12) S:$E(SDZIP,6,10)'="" SDZIP=$E(SDZIP,1,5)_"-"_$E(SDZIP,6,10) "RTN","SDAMEP2",63,0) S X="" D SET^SDAMEP1($$SETSTR^VALM1($P(SD(.11),U,4)_", "_$P($G(^DIC(5,+$P(SD(.11),U,5),0)),U)_" "_SDZIP,X,10,45)) "RTN","SDAMEP2",64,0) PTEXP ; Radiation and Status "RTN","SDAMEP2",65,0) ; "RTN","SDAMEP2",66,0) S X="",X=$$SETSTR^VALM1("Radiation Exposure:",X,1,19) "RTN","SDAMEP2",67,0) S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.321),U,3)),X,21,7) "RTN","SDAMEP2",68,0) S X=$$SETSTR^VALM1("Status:",X,52,7) "RTN","SDAMEP2",69,0) S A=$S("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2)),SDST=$S('A:"IN",1:"")_"ACTIVE ",SDSTA=$S("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",1:"INPATIENT") "RTN","SDAMEP2",70,0) I '$D(^DGPM("C",DFN)) S SDST="NO INPT./LOD. ACT.",SDSTA="" "RTN","SDAMEP2",71,0) S X=$$SETSTR^VALM1(SDST_SDSTA,X,SDSECCOL,20) "RTN","SDAMEP2",72,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",73,0) PTPOW ; Prisoner of War Info and Last Admission Date "RTN","SDAMEP2",74,0) ; "RTN","SDAMEP2",75,0) S X="",X=$$SETSTR^VALM1("Prisoner of War:",X,4,16) "RTN","SDAMEP2",76,0) S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.52),U,5)),X,21,7) "RTN","SDAMEP2",77,0) S X=$$SETSTR^VALM1("Last Admit/Lodger Date:",X,36,23) "RTN","SDAMEP2",78,0) I +DGPMVI(13,1) S X=$$SETSTR^VALM1($$FTIME^VALM1(+DGPMVI(13,1)),X,SDSECCOL,18) "RTN","SDAMEP2",79,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",80,0) PTAO ; Agent Orange Exposure and Last Discharge Date "RTN","SDAMEP2",81,0) S X="",X=$$SETSTR^VALM1("AO Exposure:",X,8,12) "RTN","SDAMEP2",82,0) S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($P(SD(.321),U,2)),X,21,7) "RTN","SDAMEP2",83,0) S X=$$SETSTR^VALM1("Last Disch./Lodger Date:",X,35,24) "RTN","SDAMEP2",84,0) S SDDISCH=+$G(^DGPM(+DGPMVI(17),0)) "RTN","SDAMEP2",85,0) I +SDDISCH S X=$$SETSTR^VALM1($$FTIME^VALM1(SDDISCH),X,SDSECCOL,18) "RTN","SDAMEP2",86,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",87,0) CV ;Combat vet "RTN","SDAMEP2",88,0) S X="",X=$$SETSTR^VALM1("Combat Veteran:",X,5,15) "RTN","SDAMEP2",89,0) S X=$$SETSTR^VALM1($$FYNUNK^SDUTL2($S($P(SD("CV"),U,1)>0:"Y",1:"N")),X,21,7) "RTN","SDAMEP2",90,0) S X=$$SETSTR^VALM1("Combat Veteran End Date:",X,35,24) "RTN","SDAMEP2",91,0) I $P(SD("CV"),U,1)>0 D "RTN","SDAMEP2",92,0) .S X=$$SETSTR^VALM1($$FTIME^VALM1($P(SD("CV"),U,2)),X,SDSECCOL,18) "RTN","SDAMEP2",93,0) E S X=$$SETSTR^VALM1("N/A",X,SDSECCOL,3) "RTN","SDAMEP2",94,0) D SET^SDAMEP1(X) "RTN","SDAMEP2",95,0) D SET^SDAMEP1("") "RTN","SDAMEP2",96,0) Q "RTN","SDCO21") 0^4^B6378751 "RTN","SDCO21",1,0) SDCO21 ;ALB/RMO - Classification Cont. - Check Out;30 MAR 1993 2:10 pm ; 3/12/04 4:33pm "RTN","SDCO21",2,0) ;;5.3;Scheduling;**150,244,325**;Aug 13, 1993 "RTN","SDCO21",3,0) ; "RTN","SDCO21",4,0) CL(DFN,SDDT,SDOE,SDCLY) ;Build Classification Array "RTN","SDCO21",5,0) ; Input -- DFN Patient file IEN "RTN","SDCO21",6,0) ; SDDT Date/Time "RTN","SDCO21",7,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO21",8,0) ; Output -- SDCLY Classification Array "RTN","SDCO21",9,0) ; Subscripted by Class. Type file (#409.41) IEN "RTN","SDCO21",10,0) N SDCTI "RTN","SDCO21",11,0) S SDCTI=0 F S SDCTI=$O(^SD(409.41,SDCTI)) Q:'SDCTI I $$SCR(SDCTI,DFN,SDDT,$G(SDOE)) S SDCLY(SDCTI)="" "RTN","SDCO21",12,0) CLQ Q "RTN","SDCO21",13,0) ; "RTN","SDCO21",14,0) SCR(SDCTI,DFN,SDDT,SDOE) ;Outpatient Classification Type Screen "RTN","SDCO21",15,0) ; Input -- SDCTI Outpatient Classification Type IEN "RTN","SDCO21",16,0) ; DFN Patient file IEN "RTN","SDCO21",17,0) ; SDDT Date/Time "RTN","SDCO21",18,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO21",19,0) ; Output -- 1=Yes and 0=No "RTN","SDCO21",20,0) N Y "RTN","SDCO21",21,0) I $$ACT^SDCODD(SDCTI,SDDT) D "RTN","SDCO21",22,0) .I $D(^SD(409.41,SDCTI,1)) X ^(1) Q:'$T "RTN","SDCO21",23,0) .S Y=1 "RTN","SDCO21",24,0) SCRQ Q +$G(Y) "RTN","SDCO21",25,0) ; "RTN","SDCO21",26,0) CLOE(SDOE,SDCLOEY) ;Set-up Classification Array for Outpatient Encounter "RTN","SDCO21",27,0) ; Input -- SDOE Outpatient Encounter file IEN "RTN","SDCO21",28,0) ; Output -- SDCLOEY Classification Array Set for Outpatient Encounter "RTN","SDCO21",29,0) ; Subscripted by Class Type file IEN "RTN","SDCO21",30,0) ; Null or 409.42 IEN^Internal Value^1=n/a^1=unedt "RTN","SDCO21",31,0) N SDCLY,SDCN0,SDCNI,SDCTI,SDCTIS,SDCTS,SDOE0 "RTN","SDCO21",32,0) S SDOE0=$G(^SCE(+SDOE,0)) "RTN","SDCO21",33,0) D CL($P(SDOE0,"^",2),+SDOE0,SDOE,.SDCLY) "RTN","SDCO21",34,0) S SDCTI=0 F S SDCTI=$O(^SDD(409.42,"AO",SDOE,SDCTI)) Q:'SDCTI S SDCNI=+$O(^(SDCTI,0)) I $D(^SDD(409.42,SDCNI,0)) S SDCN0=^(0) D "RTN","SDCO21",35,0) .S SDCLY(SDCTI)=SDCNI_"^"_$P(SDCN0,"^",3)_"^"_$S('$D(SDCLY(SDCTI)):1,1:"")_"^"_$S($P(SDOE0,"^",10)=2:1,1:"") "RTN","SDCO21",36,0) S SDCTIS=$$SEQ "RTN","SDCO21",37,0) F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI I $D(SDCLY(SDCTI)) S SDCLOEY(SDCTI)=SDCLY(SDCTI) "RTN","SDCO21",38,0) CLOEQ Q "RTN","SDCO21",39,0) ; "RTN","SDCO21",40,0) SC(SDCTI,SDOE,SDSELY,SDCLOEY) ;Service Connected Classification Checks "RTN","SDCO21",41,0) N SDCHGF,SDCLOE,SDSEL "RTN","SDCO21",42,0) S SDSEL=$S(SDCTI=1:2,SDCTI=2:3,SDCTI=4:4,1:"") G SCQ:SDSEL="" "RTN","SDCO21",43,0) D CHK(SDOE,SDCTI,.SDCLOE) "RTN","SDCO21",44,0) I $D(SDCLOE) D G SCQ "RTN","SDCO21",45,0) .I SDCLOE,$P(SDCLOE,"^",3) S SDCHGF=1 "RTN","SDCO21",46,0) .I SDCLOE="" S SDCHGF=1 "RTN","SDCO21",47,0) .I $G(SDCHGF) S:$D(SDSELY) SDSELY(SDSEL)="" S SDCLOEY(SDCTI)=SDCLOE "RTN","SDCO21",48,0) I '$D(SDCLOE) D "RTN","SDCO21",49,0) .K SDCLOEY(SDCTI) "RTN","SDCO21",50,0) SCQ Q "RTN","SDCO21",51,0) ; "RTN","SDCO21",52,0) CHK(SDOE,SDCTI,SDCLOE) ;Check One Classification for Outpatient Encounter "RTN","SDCO21",53,0) ; Input -- SDOE Outpatient Encounter file IEN "RTN","SDCO21",54,0) ; SDCTI Outpatient Classification Type IEN "RTN","SDCO21",55,0) ; Output -- SDCLOE Null or 409.42 IEN^Internal Value^1=n/a^1=unedt "RTN","SDCO21",56,0) N DFN,SDCL,SDCNI,SDDT,SDOE0 "RTN","SDCO21",57,0) S SDOE0=$G(^SCE(+SDOE,0)) "RTN","SDCO21",58,0) S DFN=+$P(SDOE0,"^",2),SDDT=+SDOE0 "RTN","SDCO21",59,0) I $$SCR(SDCTI,DFN,SDDT,SDOE) S SDCL="" "RTN","SDCO21",60,0) S SDCNI=+$O(^SDD(409.42,"AO",SDOE,SDCTI,0)) "RTN","SDCO21",61,0) I $D(^SDD(409.42,SDCNI,0)) S SDCL=SDCNI_"^"_$P(^(0),"^",3)_"^"_$S('$D(SDCL):1,1:"")_"^"_$S($P(SDOE0,"^",10)=2:1,1:"") "RTN","SDCO21",62,0) I $D(SDCL) S SDCLOE=SDCL "RTN","SDCO21",63,0) CHKQ Q "RTN","SDCO21",64,0) ; "RTN","SDCO21",65,0) SEQ() ;Classification Type Sequence by IEN "RTN","SDCO21",66,0) ; Input -- None "RTN","SDCO21",67,0) ; Output -- Classification Type Sequence by IEN "RTN","SDCO21",68,0) ; Current Sequence is: SC, CV, AO, IR, EC, MST, HNC "RTN","SDCO21",69,0) Q "3,7,1,2,4,5,6" "RTN","SDCO22") 0^2^B8515730 "RTN","SDCO22",1,0) SDCO22 ;ALB/RMO/MRY - Classification Cont. - Screen - Check Out;21 JUL 2000 11:15 PM ; 8/30/01 11:19am "RTN","SDCO22",2,0) ;;5.3;Scheduling;**150,222,244,325**;Aug 13, 1993 "RTN","SDCO22",3,0) ; "RTN","SDCO22",4,0) AO(DFN,SDOE) ;Ask Agent Orange Exposure Classification "RTN","SDCO22",5,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",6,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",7,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",8,0) N SDELG0,Y "RTN","SDCO22",9,0) I $P($G(^DPT(DFN,.321)),"^",2)'="Y" G AOQ "RTN","SDCO22",10,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",11,0) I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",12,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",13,0) .I '$$AP(SDOE,1) S Y=0 Q "RTN","SDCO22",14,0) .I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",15,0) AOQ Q +$G(Y) "RTN","SDCO22",16,0) ; "RTN","SDCO22",17,0) IR(DFN,SDOE) ;Ask Ionizing Radiation Exposure Classification "RTN","SDCO22",18,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",19,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",20,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",21,0) N SDELG0,Y "RTN","SDCO22",22,0) I $P($G(^DPT(DFN,.321)),"^",3)'="Y" G IRQ "RTN","SDCO22",23,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",24,0) I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",25,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",26,0) .I '$$AP(SDOE,2) S Y=0 Q "RTN","SDCO22",27,0) .I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",28,0) IRQ Q +$G(Y) "RTN","SDCO22",29,0) ; "RTN","SDCO22",30,0) SC(DFN,SDOE) ;Ask Service Connected Condition Classification "RTN","SDCO22",31,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",32,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",33,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",34,0) N SDELG0,Y "RTN","SDCO22",35,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",36,0) I $P(SDELG0,"^",5)="Y","^1^3^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",37,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",38,0) .I '$$AP(SDOE,3) S Y=0 Q "RTN","SDCO22",39,0) SCQ Q +$G(Y) "RTN","SDCO22",40,0) ; "RTN","SDCO22",41,0) EC(DFN,SDOE) ;Ask Environmental Contaminant Exposure Classification "RTN","SDCO22",42,0) ; Input -- DFN Patient file IEN "RTN","SDCO22",43,0) ; SDOE Outpatient Encounter file IEN [Optional] "RTN","SDCO22",44,0) ; Output -- 1=Yes and 0=No "RTN","SDCO22",45,0) N SDELG0,Y "RTN","SDCO22",46,0) S SDELG0=$$EL(DFN,$G(SDOE)) "RTN","SDCO22",47,0) I $P($G(^DPT(DFN,.322)),"^",13)'="Y" D G ECQ "RTN","SDCO22",48,0) .I $P(SDELG0,"^",5)="N","^4^"[("^"_$P(SDELG0,"^",4)_"^"),"^A^B^C^D^6^"[("^"_($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3))_"^") S Y=1 "RTN","SDCO22",49,0) I $P(SDELG0,"^",5)="Y","^1^2^3^4^5^"[("^"_$P(SDELG0,"^",4)_"^") S Y=1 "RTN","SDCO22",50,0) I $G(Y),$G(SDOE) D "RTN","SDCO22",51,0) .I '$$AP(SDOE,4) S Y=0 Q "RTN","SDCO22",52,0) .I $P(SDELG0,"^",4)=3!($P(SDELG0,"^",4)=1),$P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),"^",3) S Y=0 "RTN","SDCO22",53,0) ECQ Q +$G(Y) "RTN","SDCO22",54,0) ; "RTN","SDCO22",55,0) EL(DFN,SDOE) ;Eligibility "RTN","SDCO22",56,0) Q $G(^DIC(8.1,+$P($G(^DIC(8,+$S($P($G(^SCE(+$G(SDOE),0)),"^",13):+$P(^(0),"^",13),1:+$G(^DPT(DFN,.36))),0)),"^",9),0)) "RTN","SDCO22",57,0) ; "RTN","SDCO22",58,0) AP(SDOE,SDCTI) ;Classification Appointment Type Screen "RTN","SDCO22",59,0) N SDAPTY,Y "RTN","SDCO22",60,0) S SDAPTY=+$P($G(^SCE(+SDOE,0)),"^",10) "RTN","SDCO22",61,0) I SDAPTY=9 S Y=1 "RTN","SDCO22",62,0) I SDAPTY=2,SDCTI=3 S Y=1 "RTN","SDCO22",63,0) APQ Q +$G(Y) "RTN","SDCO22",64,0) ; "RTN","SDCO22",65,0) MST(DFN,SDOE) ;Ask Military Sexual Trauma Classification "RTN","SDCO22",66,0) ;Input - DFN Patient file IEN "RTN","SDCO22",67,0) ; SDOE Outpatient Encounter file IEN "RTN","SDCO22",68,0) ;Output - 1=Yes, 0=No "RTN","SDCO22",69,0) N DGMST "RTN","SDCO22",70,0) S DGMST=$$GETSTAT^DGMSTAPI(DFN) "RTN","SDCO22",71,0) Q +($P(DGMST,U,2)="Y") "RTN","SDCO22",72,0) ; "RTN","SDCO22",73,0) HNC(DFN,SDOE) ;Ask Head & Neck Classification "RTN","SDCO22",74,0) ;Input - DFN Patient file IEN "RTN","SDCO22",75,0) ; SDOE Outpatient Encounter file IEN "RTN","SDCO22",76,0) ;Output - 1=Yes, 0=No "RTN","SDCO22",77,0) N DGARR,SDELG0,Y "RTN","SDCO22",78,0) S SDELG0=$$GETCUR^DGNTAPI(DFN,"DGARR") "RTN","SDCO22",79,0) S SDELG0=+$G(DGARR("STAT")) "RTN","SDCO22",80,0) ;Only a status of 3, 4 or 5 is accepted for the question to be asked "RTN","SDCO22",81,0) S Y=$S((".3.4.5."[("."_SDELG0_".")):1,1:0) "RTN","SDCO22",82,0) HNCQ Q +$G(Y) "RTN","SDCO22",83,0) ; "RTN","SDCO22",84,0) CV(DFN,SDOE,SDDT) ;Ask Combat Veteran Classification "RTN","SDCO22",85,0) ;Input : DFN - Pointer to PATIENT file (#2) "RTN","SDCO22",86,0) ; SDOE - Pointer to OUTPATIENT ENCOUNTER file (#409.68) "RTN","SDCO22",87,0) ; SDDT - Date (FileMan format) (optional - SDOE overrides) "RTN","SDCO22",88,0) ;Output: 1 = Yes / 0 = No "RTN","SDCO22",89,0) N SDCV "RTN","SDCO22",90,0) S SDDT=$G(SDDT) "RTN","SDCO22",91,0) S:$G(SDOE) SDDT=+$G(^SCE(+$G(SDOE),0)) "RTN","SDCO22",92,0) S:'SDDT SDDT=$$DT^XLFDT() "RTN","SDCO22",93,0) S SDCV=$$CVEDT^DGCV(DFN,SDDT) "RTN","SDCO22",94,0) Q $P(SDCV,"^",3) "RTN","SDPCE") 0^3^B41523344 "RTN","SDPCE",1,0) SDPCE ;MJK/ALB - Process PCE Event Data ;01 APR 1993 "RTN","SDPCE",2,0) ;;5.3;Scheduling;**27,91,132,150,244,325**;Aug 13, 1993 "RTN","SDPCE",3,0) ; "RTN","SDPCE",4,0) ; **** See SDPCE0 for variable definitions **** "RTN","SDPCE",5,0) ; "RTN","SDPCE",6,0) EN ; -- main entry pt for PCE event processing "RTN","SDPCE",7,0) ; "RTN","SDPCE",8,0) ; -- start rt monitor "RTN","SDPCE",9,0) D:$D(XRTL) T0^%ZOSV "RTN","SDPCE",10,0) ; "RTN","SDPCE",11,0) N SDVSIT,SDVSIT0,SDEVENT,SDERR,SDCLST,SDCS,SDPCNT,SDVDT,SDELAP "RTN","SDPCE",12,0) S SDVSIT0=0,SDEVENT="SDEVENT" "RTN","SDPCE",13,0) ; -- process each visit (initially will only be 1) "RTN","SDPCE",14,0) F S SDVSIT0=$O(^TMP("PXKCO",$J,SDVSIT0)) Q:'SDVSIT0 D "RTN","SDPCE",15,0) . I $$HISTORIC^VSIT(SDVSIT0) Q "RTN","SDPCE",16,0) . S SDVSIT("AFTER")=$G(^TMP("PXKCO",$J,SDVSIT0,"VST",SDVSIT0,0,"AFTER")),SDVSIT("BEFORE")=$G(^("BEFORE")) "RTN","SDPCE",17,0) .; "RTN","SDPCE",18,0) .; -- new or old visit "RTN","SDPCE",19,0) . IF SDVSIT("AFTER")]"",SDVSIT("BEFORE")]""!(SDVSIT("BEFORE")="") D ADD(.SDVSIT0,.SDEVENT,.SDERR) Q "RTN","SDPCE",20,0) .; "RTN","SDPCE",21,0) .; -- deleted visit "RTN","SDPCE",22,0) . IF SDVSIT("AFTER")="",SDVSIT("BEFORE")]"" D DEL(.SDVSIT0,.SDEVENT,.SDERR) Q "RTN","SDPCE",23,0) ; "RTN","SDPCE",24,0) ; -- stop rt monitor "RTN","SDPCE",25,0) IF $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV "RTN","SDPCE",26,0) ; "RTN","SDPCE",27,0) Q "RTN","SDPCE",28,0) ; "RTN","SDPCE",29,0) ADD(SDVSIT0,SDEVENT,SDERR) ; -- add/update encounter data "RTN","SDPCE",30,0) N DFN,SDT,SDCL,SDRESULT,SDTYPE,SDOE,SDDIS,SDPVSIT,SDELAP "RTN","SDPCE",31,0) ; -- get patient/encounter data "RTN","SDPCE",32,0) D PAT(SDVSIT("AFTER"),.DFN,.SDT,.SDCL) "RTN","SDPCE",33,0) S SDVSIT=$S($P(SDVSIT("AFTER"),U,12):$P(SDVSIT("AFTER"),U,12),1:SDVSIT0) "RTN","SDPCE",34,0) ; -- get encounter data "RTN","SDPCE",35,0) S SDOE=$O(^SCE("AVSIT",+SDVSIT,0)),SDDIS=$P($G(^SCE(+SDOE,0)),U,8) "RTN","SDPCE",36,0) I 'SDDIS,$G(SDOEP) S SDDIS=$P($G(^SCE(+SDOEP,0)),U,8) "RTN","SDPCE",37,0) ; "RTN","SDPCE",38,0) ; -- get elig for visit "RTN","SDPCE",39,0) S @SDEVENT@("ELIGIBILITY")=$S($P(SDVSIT("AFTER"),U,21):$P(SDVSIT("AFTER"),U,21),1:"") "RTN","SDPCE",40,0) ; "RTN","SDPCE",41,0) ; -- get appt type "RTN","SDPCE",42,0) S SDELAP=$G(^TMP("PXKCO",$J,SDVSIT0,"VST",SDVSIT0,"ELAP","AFTER")) "RTN","SDPCE",43,0) S @SDEVENT@("APPT TYPE")=$S($P(SDELAP,U,3):$P(SDELAP,U,3),1:"") "RTN","SDPCE",44,0) ; "RTN","SDPCE",45,0) ; -- get co d/t "RTN","SDPCE",46,0) S @SDEVENT@("DATE/TIME")=$S($P(SDVSIT("AFTER"),U,18):$P(SDVSIT("AFTER"),U,18),1:"") "RTN","SDPCE",47,0) ; "RTN","SDPCE",48,0) ; -- determine the type of event "RTN","SDPCE",49,0) IF SDCL,SDCL=+$G(^DPT(DFN,"S",SDT,0)) D "RTN","SDPCE",50,0) . S @SDEVENT@("EVENT")="CHECK-OUT" "RTN","SDPCE",51,0) ; "RTN","SDPCE",52,0) ELSE I SDDIS,SDDIS=3 D "RTN","SDPCE",53,0) . S @SDEVENT@("EVENT")="DISPOSITION" "RTN","SDPCE",54,0) ; "RTN","SDPCE",55,0) ELSE D Q:$$DELAE() "RTN","SDPCE",56,0) . S @SDEVENT@("EVENT")="ADD/EDIT CHECK-OUT" "RTN","SDPCE",57,0) . I SDVSIT S SDPVSIT=SDVSIT D ENCEVENT^PXKENC(SDPVSIT) "RTN","SDPCE",58,0) ; "RTN","SDPCE",59,0) ; -- get user "RTN","SDPCE",60,0) S @SDEVENT@("USER")=$S($D(^VA(200,+$G(DUZ),0)):+DUZ,1:.5) "RTN","SDPCE",61,0) D CLASS(.SDVSIT,.SDEVENT) "RTN","SDPCE",62,0) S @SDEVENT@("VISIT CHANGE FLAGS")=$$CHANGE(.SDVSIT0) "RTN","SDPCE",63,0) I $G(SDPVSIT),'$D(@SDEVENT@("CLASSIFICATION")) D CLASSAE(SDPVSIT,.SDEVENT) "RTN","SDPCE",64,0) ; -- call api "RTN","SDPCE",65,0) D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"ADDITION") "RTN","SDPCE",66,0) K ^TMP("PXKENC",$J) "RTN","SDPCE",67,0) Q "RTN","SDPCE",68,0) ; "RTN","SDPCE",69,0) DEL(SDVSIT0,SDEVENT,SDERR) ; -- delete co info when visit delete "RTN","SDPCE",70,0) N DFN,SDT,SDCL "RTN","SDPCE",71,0) S SDVSIT=$S($P(SDVSIT("AFTER"),U,12):$P(SDVSIT("AFTER"),U,12),1:SDVSIT0) "RTN","SDPCE",72,0) D PAT(SDVSIT("BEFORE"),.DFN,.SDT,.SDCL) "RTN","SDPCE",73,0) S @SDEVENT@("USER")=$S($P(SDVSIT("BEFORE"),U,23):$P(SDVSIT("BEFORE"),U,23),1:.5) "RTN","SDPCE",74,0) S @SDEVENT@("EVENT")="CHECK-OUT DELETE" "RTN","SDPCE",75,0) D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"DELETION") "RTN","SDPCE",76,0) Q "RTN","SDPCE",77,0) ; "RTN","SDPCE",78,0) DELAE() ; -- delete standalone encounter if no cpt, dx and providers "RTN","SDPCE",79,0) N SDDEL "RTN","SDPCE",80,0) S SDDEL=0 "RTN","SDPCE",81,0) IF '$D(^TMP("PXKENC",$J,SDVSIT,"CPT")),'$D(^("POV")),'$D(^("PRV")) D "RTN","SDPCE",82,0) . S @SDEVENT@("USER")=$S($P(SDVSIT("BEFORE"),U,23):$P(SDVSIT("BEFORE"),U,23),1:.5) "RTN","SDPCE",83,0) . S @SDEVENT@("EVENT")="CHECK-OUT DELETE" "RTN","SDPCE",84,0) . D API(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,"DELETION") "RTN","SDPCE",85,0) . K ^TMP("PXKENC",$J) "RTN","SDPCE",86,0) . S SDDEL=1 "RTN","SDPCE",87,0) Q SDDEL "RTN","SDPCE",88,0) ; "RTN","SDPCE",89,0) API(DFN,SDT,SDCL,SDEVENT,SDERR,SDVSIT,SDACT) ; "RTN","SDPCE",90,0) N SDRET,SDSOR "RTN","SDPCE",91,0) S SDRET=$$EN^SDAPI(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT) "RTN","SDPCE",92,0) ; "RTN","SDPCE",93,0) ; -- is it ok to send bulletin if needed "RTN","SDPCE",94,0) S SDSOR=+$O(^TMP("PXKCO",$J,SDVSIT,"SOR",0)) "RTN","SDPCE",95,0) IF SDSOR,'$P($G(^TMP("PXKCO",$J,SDVSIT,"SOR",SDSOR,0,"AFTER")),U,9) D "RTN","SDPCE",96,0) . Q "RTN","SDPCE",97,0) ELSE D "RTN","SDPCE",98,0) . D BULL^SDPCE2(DFN,SDT,SDCL,.SDEVENT,.SDERR,SDVSIT,SDACT) "RTN","SDPCE",99,0) Q "RTN","SDPCE",100,0) ; "RTN","SDPCE",101,0) PAT(SDVSIT0,DFN,SDT,SDCL) ; -- return patient/encounter data for visit "RTN","SDPCE",102,0) S DFN=+$P(SDVSIT0,U,5),SDT=+SDVSIT0,SDCL=+$P(SDVSIT0,U,22) "RTN","SDPCE",103,0) Q "RTN","SDPCE",104,0) ; "RTN","SDPCE",105,0) CLASS(SDVSIT,SDEVENT) ; -- set-up classification data from visit data "RTN","SDPCE",106,0) N SD800A,SD800B,SDI,CLASS,SDA,SDB "RTN","SDPCE",107,0) S SD800A=$G(^TMP("PXKCO",$J,SDVSIT,"VST",SDVSIT,800,"AFTER")),SD800B=$G(^("BEFORE")) "RTN","SDPCE",108,0) ; -- process each piece "RTN","SDPCE",109,0) F SDI=1:1:7 D "RTN","SDPCE",110,0) . S CLASS=$P("SC^AO^IR^EC^MST^HNC^CV",U,SDI),SDA=$P(SD800A,U,SDI),SDB=$P(SD800B,U,SDI) "RTN","SDPCE",111,0) .; -- changed or same class data "RTN","SDPCE",112,0) . IF SDA]"",SDB]"" S @SDEVENT@("CLASSIFICATION",$S(SDA'=SDB:"CHANGE",1:"ADD"),CLASS)=$$CLASSVAL(SDA) Q "RTN","SDPCE",113,0) .; -- new class data "RTN","SDPCE",114,0) . IF SDA]"",SDB="" S @SDEVENT@("CLASSIFICATION","ADD",CLASS)=$$CLASSVAL(SDA) Q "RTN","SDPCE",115,0) .; -- deleted class data "RTN","SDPCE",116,0) . IF SDA="",SDB]"" S @SDEVENT@("CLASSIFICATION","DELETE",CLASS)="" Q "RTN","SDPCE",117,0) Q "RTN","SDPCE",118,0) CLASSVAL(Y) ; -- yes/no processing "RTN","SDPCE",119,0) Q $S(Y=1:"Y",Y=0:"N",1:"??") "RTN","SDPCE",120,0) ; "RTN","SDPCE",121,0) CLASSAE(SDVSIT,SDEVENT) ; -- set-up classification data from visit data "RTN","SDPCE",122,0) N SD800A,SD800B,SDI,CLASS,SDA,SDB "RTN","SDPCE",123,0) S SD800A=$G(^TMP("PXKENC",$J,SDVSIT,"VST",SDVSIT,800,"AFTER")),SD800B=$G(^("BEFORE")) "RTN","SDPCE",124,0) ; -- process each piece "RTN","SDPCE",125,0) F SDI=1:1:7 D "RTN","SDPCE",126,0) . S CLASS=$P("SC^AO^IR^EC^MST^HNC^CV",U,SDI),SDA=$P(SD800A,U,SDI),SDB=$P(SD800B,U,SDI) "RTN","SDPCE",127,0) .; -- changed or same class data "RTN","SDPCE",128,0) . IF SDA]"",SDB]"" S @SDEVENT@("CLASSIFICATION",$S(SDA'=SDB:"CHANGE",1:"ADD"),CLASS)=$$CLASSVAL(SDA) Q "RTN","SDPCE",129,0) .; -- new class data "RTN","SDPCE",130,0) . IF SDA]"",SDB="" S @SDEVENT@("CLASSIFICATION","ADD",CLASS)=$$CLASSVAL(SDA) Q "RTN","SDPCE",131,0) .; -- deleted class data "RTN","SDPCE",132,0) . IF SDA="",SDB]"" S @SDEVENT@("CLASSIFICATION","DELETE",CLASS)="" Q "RTN","SDPCE",133,0) Q "RTN","SDPCE",134,0) ; "RTN","SDPCE",135,0) ELAP(DFN,SC) ; -- This function will return Elig and Appt Type data "RTN","SDPCE",136,0) ; INPUT: DFN - Patient, SC - Clinic IEN "RTN","SDPCE",137,0) ; OUTPUT: Elig ptr^ Elig text^ Appt Ptr^ Appt Text "RTN","SDPCE",138,0) ; "RTN","SDPCE",139,0) N VAEL,VADM,X,Y,SDAPTYP,SDATD,SDEMP,SDDECOD,SDEC,SDAMBAE "RTN","SDPCE",140,0) S SDAMBAE=1 "RTN","SDPCE",141,0) ;-- get appt type "RTN","SDPCE",142,0) D TYPE^SDM4 "RTN","SDPCE",143,0) S SDEMP="" "RTN","SDPCE",144,0) ;-- get elig if more than 1 "RTN","SDPCE",145,0) I $O(VAEL(1,0))>0 S SDEMP="" D ELIG^SDM4:"369"[SDAPTYP S SDEMP=$S(SDDECOD:SDDECOD,1:SDEMP) "RTN","SDPCE",146,0) I 'SDEMP S SDEMP=VAEL(1) "RTN","SDPCE",147,0) ; "RTN","SDPCE",148,0) Q +SDEMP_U_$P($G(^DIC(8,+SDEMP,0)),U)_U_+SDAPTYP_U_$P($G(^SD(409.1,+SDAPTYP,0)),U) "RTN","SDPCE",149,0) ; "RTN","SDPCE",150,0) NEW(DATE) ;-- This function will return 1 if SD is turned on for "RTN","SDPCE",151,0) ; Visit Tracking and optionally check if the date is past "RTN","SDPCE",152,0) ; the cut over date for the new PCE interface. "RTN","SDPCE",153,0) ; INPUT : DATE (Optional) Date to check for cut over. "RTN","SDPCE",154,0) ; OUTPUT: 1 Yes, 0 No "RTN","SDPCE",155,0) N SDRES,SDX,SDY "RTN","SDPCE",156,0) I '$G(DATE) S DATE=DT "RTN","SDPCE",157,0) ;-- is Scheduling on ? "RTN","SDPCE",158,0) S SDRES=0,SDY=$$PKGON^VSIT("SD") "RTN","SDPCE",159,0) ;-- if date is it pass cut over? "RTN","SDPCE",160,0) S SDX=1 I $G(DATE) S SDX=$$SWITCHCK^PXAPI(DATE) "RTN","SDPCE",161,0) ;-- And together "RTN","SDPCE",162,0) I SDX,SDY S SDRES=1 "RTN","SDPCE",163,0) Q SDRES "RTN","SDPCE",164,0) ; "RTN","SDPCE",165,0) STATUS(SDVSIT) ; Return status of an encounter "RTN","SDPCE",166,0) ; Input: SDOE = Visit File IEN "RTN","SDPCE",167,0) ; Output: Status of the encounter Internal IEN^External Value "RTN","SDPCE",168,0) ; "RTN","SDPCE",169,0) N SDINT,SDEXT,SDOE "RTN","SDPCE",170,0) S SDOE=$O(^SCE("AVSIT",+SDVSIT,0)) "RTN","SDPCE",171,0) S SDINT=$P($G(^SCE(+SDOE,0)),U,12) "RTN","SDPCE",172,0) S SDEXT=$P($G(^SD(409.63,+SDINT,0)),U) "RTN","SDPCE",173,0) STATQ Q SDINT_"^"_SDEXT "RTN","SDPCE",174,0) ; "RTN","SDPCE",175,0) CHANGE(SDVST) ; -- set flags for overall visit change "RTN","SDPCE",176,0) N SDI,SDFLAGS "RTN","SDPCE",177,0) ; "RTN","SDPCE",178,0) ; -- initalize chnage flags "RTN","SDPCE",179,0) ; -- cpt changed ^ provider data changed ^ dx changed "RTN","SDPCE",180,0) S SDFLAGS="0^0^0" "RTN","SDPCE",181,0) ; "RTN","SDPCE",182,0) ; -- set cpt change flag "RTN","SDPCE",183,0) S SDI=0 "RTN","SDPCE",184,0) F S SDI=$O(^TMP("PXKCO",$J,SDVST,"CPT",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"CPT",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,1)=1 "RTN","SDPCE",185,0) ; "RTN","SDPCE",186,0) ; -- set provider change flag "RTN","SDPCE",187,0) S SDI=0 "RTN","SDPCE",188,0) F S SDI=$O(^TMP("PXKCO",$J,SDVST,"PRV",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"PRV",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,2)=1 "RTN","SDPCE",189,0) ; "RTN","SDPCE",190,0) ; -- set dx change flag "RTN","SDPCE",191,0) S SDI=0 "RTN","SDPCE",192,0) F S SDI=$O(^TMP("PXKCO",$J,SDVST,"POV",SDI)) Q:'SDI IF $G(^TMP("PXKCO",$J,SDVST,"POV",SDI,0,"BEFORE"))'=$G(^("AFTER")) S $P(SDFLAGS,U,3)=1 "RTN","SDPCE",193,0) ; "RTN","SDPCE",194,0) Q SDFLAGS "RTN","SDPCE",195,0) ; "VER") 8.0^22.0 "^DD",409.76,409.76,0) FIELD^^41^6 "^DD",409.76,409.76,0,"DDA") N "^DD",409.76,409.76,0,"DT") 2970710 "^DD",409.76,409.76,0,"ID",11) D EN^DDIOL($P(^(1),U,1)) "^DD",409.76,409.76,0,"IX","B",409.76,.01) "^DD",409.76,409.76,0,"IX","C",409.76,11) "^DD",409.76,409.76,0,"IX","D",409.76,11) "^DD",409.76,409.76,0,"LOOK") SOUNDEX "^DD",409.76,409.76,0,"NM","TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE") "^DD",409.76,409.76,0,"PT",409.75,.02) "^DD",409.76,409.76,0,"QUES") SOUNDEX "^DD",409.76,409.76,0,"VRPK") SD "^DD",409.76,409.76,.01,0) ERROR CODE^RF^^0;1^K:$L(X)>10!($L(X)<1)!'(X'?1P.E) X "^DD",409.76,409.76,.01,.1) Error Code "^DD",409.76,409.76,.01,1,0) ^.1 "^DD",409.76,409.76,.01,1,1,0) 409.76^B "^DD",409.76,409.76,.01,1,1,1) S ^SD(409.76,"B",$E(X,1,30),DA)="" "^DD",409.76,409.76,.01,1,1,2) K ^SD(409.76,"B",$E(X,1,30),DA) "^DD",409.76,409.76,.01,3) Enter an error code to use (1-10 characters) "^DD",409.76,409.76,.01,21,0) ^^2^2^2970623^^^ "^DD",409.76,409.76,.01,21,1,0) Error code denoting why an entry in the Transmitted Outpatient Encounter "^DD",409.76,409.76,.01,21,2,0) file could not be transmitted or successfully processed. "^DD",409.76,409.76,.01,23,0) ^^1^1^2970623^ "^DD",409.76,409.76,.01,23,1,0) "^DD",409.76,409.76,.01,"DT") 2960430 "^DD",409.76,409.76,.02,0) SOURCE OF ERROR^RS^N:NPCD;V:VISTA;T:HL7 TRANSMISSION;^0;2^Q "^DD",409.76,409.76,.02,3) Enter the source of the error. "^DD",409.76,409.76,.02,21,0) ^^1^1^2970710^ "^DD",409.76,409.76,.02,21,1,0) This set of codes indicates the source of the error. "^DD",409.76,409.76,.02,"DT") 2970710 "^DD",409.76,409.76,11,0) ERROR CODE DESCRIPTION^F^^1;1^K:$L(X)>80!($L(X)<1) X "^DD",409.76,409.76,11,.1) Error Code Description "^DD",409.76,409.76,11,1,0) ^.1^^-1 "^DD",409.76,409.76,11,1,1,0) 409.76^C^SOUNDEX "^DD",409.76,409.76,11,1,1,1) S I=$E(X,1,27) D SOU^DICM S ^SD(409.76,"C",X_I,DA)="" "^DD",409.76,409.76,11,1,1,2) S I=$E(X,1,27) D SOU^DICM K ^SD(409.76,"C",X_I,DA) "^DD",409.76,409.76,11,1,1,"%D",0) ^^2^2^2970623^^ "^DD",409.76,409.76,11,1,1,"%D",1,0) This cross-references the errror description in a soundex "^DD",409.76,409.76,11,1,1,"%D",2,0) cross-ref to allow lookup on the error description verbage. "^DD",409.76,409.76,11,1,1,"DT") 2970617 "^DD",409.76,409.76,11,1,2,0) 409.76^D "^DD",409.76,409.76,11,1,2,1) S ^SD(409.76,"D",$E(X,1,30),DA)="" "^DD",409.76,409.76,11,1,2,2) K ^SD(409.76,"D",$E(X,1,30),DA) "^DD",409.76,409.76,11,1,2,"%D",0) ^^1^1^2971210^ "^DD",409.76,409.76,11,1,2,"%D",1,0) This is used to aid in the lookup of error codes. "^DD",409.76,409.76,11,1,2,"DT") 2971210 "^DD",409.76,409.76,11,3) Enter a description of the error code (1-80 characters) "^DD",409.76,409.76,11,21,0) ^^1^1^2960524^^ "^DD",409.76,409.76,11,21,1,0) Free text description of the error code. "^DD",409.76,409.76,11,"DT") 2980120 "^DD",409.76,409.76,21,0) CORRECTIVE ACTION DESCRIPTION^409.7621^^2;0 "^DD",409.76,409.76,21,21,0) ^^3^3^2971022^ "^DD",409.76,409.76,21,21,1,0) This field describes the actions necessary to correct the error. "^DD",409.76,409.76,21,21,2,0) This is the text which would be viewed by a user when using the Incomplete "^DD",409.76,409.76,21,21,3,0) Encounter Management Tools. "^DD",409.76,409.76,31,0) VALIDATION LOGIC^K^^CHK;E1,245^K:$L(X)>245 X D:$D(X) ^DIM "^DD",409.76,409.76,31,3) Enter routine entry point to perform error validation "^DD",409.76,409.76,31,9) @ "^DD",409.76,409.76,31,21,0) ^^13^13^2971022^ "^DD",409.76,409.76,31,21,1,0) This field should not be modifed except as directed. "^DD",409.76,409.76,31,21,2,0) "^DD",409.76,409.76,31,21,3,0) This contains the logic that needs to be executed in order to validate the "^DD",409.76,409.76,31,21,4,0) data. If the data does not validate correctly the error code from this "^DD",409.76,409.76,31,21,5,0) entry will be used. The function call contained within this field uses "^DD",409.76,409.76,31,21,6,0) the following variables: "^DD",409.76,409.76,31,21,7,0) Input "^DD",409.76,409.76,31,21,8,0) Data - The value being validated. "^DD",409.76,409.76,31,21,9,0) "^DD",409.76,409.76,31,21,10,0) Returns "^DD",409.76,409.76,31,21,11,0) RES - Result of the function call "^DD",409.76,409.76,31,21,12,0) 1 if entry passed validation "^DD",409.76,409.76,31,21,13,0) 0 if entry does not pass validation "^DD",409.76,409.76,31,"DT") 2970605 "^DD",409.76,409.76,41,0) CORRECTION LOGIC^K^^COR;E1,245^K:$L(X)>245 X D:$D(X) ^DIM "^DD",409.76,409.76,41,3) This is the code that will need to be executed to correct this error. "^DD",409.76,409.76,41,9) @ "^DD",409.76,409.76,41,21,0) ^^16^16^2971022^ "^DD",409.76,409.76,41,21,1,0) This field should not be modifed except as directed. "^DD",409.76,409.76,41,21,2,0) "^DD",409.76,409.76,41,21,3,0) This contains the logic that needs to be executed in order to allow the "^DD",409.76,409.76,41,21,4,0) user to correct the error. The function call contained within this field "^DD",409.76,409.76,41,21,5,0) uses the following variables: "^DD",409.76,409.76,41,21,6,0) Returns "^DD",409.76,409.76,41,21,7,0) RES - Result of the function call "^DD",409.76,409.76,41,21,8,0) 0 - if the corrective action was not successful "^DD",409.76,409.76,41,21,9,0) 1 - if the corrective action succeeded "^DD",409.76,409.76,41,21,10,0) "^DD",409.76,409.76,41,21,11,0) This function call makes the assumption that the ^TMP("SCENI XMT",$J,0) "^DD",409.76,409.76,41,21,12,0) global from the Incomplete Encounter Management List Manager tool is "^DD",409.76,409.76,41,21,13,0) available to retrieve the pointer from the TRANSMITTED OUTPATIENT "^DD",409.76,409.76,41,21,14,0) ENCOUNTER FILE (#409.73) which is used to check the entry and "^DD",409.76,409.76,41,21,15,0) retreive the entry from the TRANSMITTED OUTPATIENT ENCOUNTER ERROR FILE "^DD",409.76,409.76,41,21,16,0) (#409.75). "^DD",409.76,409.76,41,"DT") 2970710 "^DD",409.76,409.7621,0) CORRECTIVE ACTION DESCRIPTION SUB-FIELD^^.01^1 "^DD",409.76,409.7621,0,"DT") 2970710 "^DD",409.76,409.7621,0,"NM","CORRECTIVE ACTION DESCRIPTION") "^DD",409.76,409.7621,0,"UP") 409.76 "^DD",409.76,409.7621,.01,0) CORRECTIVE ACTION DESCRIPTION^W^^0;1^Q "^DD",409.76,409.7621,.01,3) Enter the corrective action a user will need to take in order to correct this error. "^DD",409.76,409.7621,.01,21,0) ^^1^1^2971022^^^ "^DD",409.76,409.7621,.01,21,1,0) This is the corrective action needed to correct this error situation. "^DD",409.76,409.7621,.01,"DT") 2970710 "^DIC",409.76,409.76,0) TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE^409.76 "^DIC",409.76,409.76,0,"GL") ^SD(409.76, "^DIC",409.76,409.76,"%D",0) ^^6^6^2970623^^^^ "^DIC",409.76,409.76,"%D",1,0) This table file contains a list of all error codes that the National "^DIC",409.76,409.76,"%D",2,0) Patient Care Database will report when processing an encounter. "^DIC",409.76,409.76,"%D",3,0) "^DIC",409.76,409.76,"%D",4,0) If an entry needs to be added, modified or deleted a patch will be issued "^DIC",409.76,409.76,"%D",5,0) instructing the site how to make the change. Otherwise, this table should "^DIC",409.76,409.76,"%D",6,0) not be edited in anyway by the site. "^DIC",409.76,"B","TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE",409.76) **INSTALL NAME** DG*5.3*565 "BLD",3651,0) DG*5.3*565^REGISTRATION^0^3040630^y "BLD",3651,1,0) ^^1^1^3031119^^ "BLD",3651,1,1,0) Combat Veteran Phase II "BLD",3651,4,0) ^9.64PA^45^1 "BLD",3651,4,45,0) 45 "BLD",3651,4,45,2,0) ^9.641^45.02^2 "BLD",3651,4,45,2,45,0) PTF (File-top level) "BLD",3651,4,45,2,45,1,0) ^9.6411^79.31^1 "BLD",3651,4,45,2,45,1,79.31,0) POTENTIALLY RELATED TO COMBAT "BLD",3651,4,45,2,45.02,0) 501 (sub-file) "BLD",3651,4,45,2,45.02,1,0) ^9.6411^31^1 "BLD",3651,4,45,2,45.02,1,31,0) POTENTIALLY RELATED TO COMBAT "BLD",3651,4,45,222) y^y^p^^^^n^^n "BLD",3651,4,45,224) "BLD",3651,4,"APDD",45,45) "BLD",3651,4,"APDD",45,45,79.31) "BLD",3651,4,"APDD",45,45.02) "BLD",3651,4,"APDD",45,45.02,31) "BLD",3651,4,"B",45,45) "BLD",3651,"ABPKG") n "BLD",3651,"KRN",0) ^9.67PA^8989.52^19 "BLD",3651,"KRN",.4,0) .4 "BLD",3651,"KRN",.4,"NM",0) ^9.68A^^ "BLD",3651,"KRN",.401,0) .401 "BLD",3651,"KRN",.401,"NM",0) ^9.68A^^ "BLD",3651,"KRN",.402,0) .402 "BLD",3651,"KRN",.402,"NM",0) ^9.68A^4^2 "BLD",3651,"KRN",.402,"NM",3,0) DG501 FILE #45^45^0 "BLD",3651,"KRN",.402,"NM",4,0) DG501F FILE #45^45^0 "BLD",3651,"KRN",.402,"NM","B","DG501 FILE #45",3) "BLD",3651,"KRN",.402,"NM","B","DG501F FILE #45",4) "BLD",3651,"KRN",.403,0) .403 "BLD",3651,"KRN",.403,"NM",0) ^9.68A^^ "BLD",3651,"KRN",.5,0) .5 "BLD",3651,"KRN",.5,"NM",0) ^9.68A^^ "BLD",3651,"KRN",.84,0) .84 "BLD",3651,"KRN",.84,"NM",0) ^9.68A^^ "BLD",3651,"KRN",3.6,0) 3.6 "BLD",3651,"KRN",3.6,"NM",0) ^9.68A^^ "BLD",3651,"KRN",3.8,0) 3.8 "BLD",3651,"KRN",3.8,"NM",0) ^9.68A^^ "BLD",3651,"KRN",9.2,0) 9.2 "BLD",3651,"KRN",9.2,"NM",0) ^9.68A^^ "BLD",3651,"KRN",9.8,0) 9.8 "BLD",3651,"KRN",9.8,"NM",0) ^9.68A^13^11 "BLD",3651,"KRN",9.8,"NM",1,0) DGPTF^^0^B21456772 "BLD",3651,"KRN",9.8,"NM",2,0) DGPTF1^^0^B31122117 "BLD",3651,"KRN",9.8,"NM",3,0) DGPTFM4^^0^B26889694 "BLD",3651,"KRN",9.8,"NM",5,0) DGPTSPQ^^0^B8481189 "BLD",3651,"KRN",9.8,"NM",7,0) DGREGG^^0^B3448816 "BLD",3651,"KRN",9.8,"NM",8,0) DGPTR0^^0^B23146369 "BLD",3651,"KRN",9.8,"NM",9,0) DGPTR1^^0^B25147013 "BLD",3651,"KRN",9.8,"NM",10,0) DGPTAEE1^^0^B21128196 "BLD",3651,"KRN",9.8,"NM",11,0) DGPTAEE2^^0^B14101889 "BLD",3651,"KRN",9.8,"NM",12,0) DGPTR4^^0^B16250205 "BLD",3651,"KRN",9.8,"NM",13,0) DGCV1^^0^B35006164 "BLD",3651,"KRN",9.8,"NM","B","DGCV1",13) "BLD",3651,"KRN",9.8,"NM","B","DGPTAEE1",10) "BLD",3651,"KRN",9.8,"NM","B","DGPTAEE2",11) "BLD",3651,"KRN",9.8,"NM","B","DGPTF",1) "BLD",3651,"KRN",9.8,"NM","B","DGPTF1",2) "BLD",3651,"KRN",9.8,"NM","B","DGPTFM4",3) "BLD",3651,"KRN",9.8,"NM","B","DGPTR0",8) "BLD",3651,"KRN",9.8,"NM","B","DGPTR1",9) "BLD",3651,"KRN",9.8,"NM","B","DGPTR4",12) "BLD",3651,"KRN",9.8,"NM","B","DGPTSPQ",5) "BLD",3651,"KRN",9.8,"NM","B","DGREGG",7) "BLD",3651,"KRN",19,0) 19 "BLD",3651,"KRN",19,"NM",0) ^9.68A^^ "BLD",3651,"KRN",19.1,0) 19.1 "BLD",3651,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3651,"KRN",101,0) 101 "BLD",3651,"KRN",101,"NM",0) ^9.68A^^ "BLD",3651,"KRN",409.61,0) 409.61 "BLD",3651,"KRN",409.61,"NM",0) ^9.68A^^ "BLD",3651,"KRN",771,0) 771 "BLD",3651,"KRN",771,"NM",0) ^9.68A^^ "BLD",3651,"KRN",870,0) 870 "BLD",3651,"KRN",870,"NM",0) ^9.68A^^ "BLD",3651,"KRN",8989.51,0) 8989.51 "BLD",3651,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",3651,"KRN",8989.52,0) 8989.52 "BLD",3651,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",3651,"KRN",8994,0) 8994 "BLD",3651,"KRN",8994,"NM",0) ^9.68A^^ "BLD",3651,"KRN","B",.4,.4) "BLD",3651,"KRN","B",.401,.401) "BLD",3651,"KRN","B",.402,.402) "BLD",3651,"KRN","B",.403,.403) "BLD",3651,"KRN","B",.5,.5) "BLD",3651,"KRN","B",.84,.84) "BLD",3651,"KRN","B",3.6,3.6) "BLD",3651,"KRN","B",3.8,3.8) "BLD",3651,"KRN","B",9.2,9.2) "BLD",3651,"KRN","B",9.8,9.8) "BLD",3651,"KRN","B",19,19) "BLD",3651,"KRN","B",19.1,19.1) "BLD",3651,"KRN","B",101,101) "BLD",3651,"KRN","B",409.61,409.61) "BLD",3651,"KRN","B",771,771) "BLD",3651,"KRN","B",870,870) "BLD",3651,"KRN","B",8989.51,8989.51) "BLD",3651,"KRN","B",8989.52,8989.52) "BLD",3651,"KRN","B",8994,8994) "BLD",3651,"QUES",0) ^9.62^^ "BLD",3651,"REQB",0) ^9.611^7^6 "BLD",3651,"REQB",1,0) DG*5.3*510^2 "BLD",3651,"REQB",3,0) DG*5.3*497^2 "BLD",3651,"REQB",4,0) DG*5.3*576^2 "BLD",3651,"REQB",5,0) DG*5.3*590^2 "BLD",3651,"REQB",6,0) DG*5.3*602^2 "BLD",3651,"REQB",7,0) DG*5.3*524^2 "BLD",3651,"REQB","B","DG*5.3*497",3) "BLD",3651,"REQB","B","DG*5.3*510",1) "BLD",3651,"REQB","B","DG*5.3*524",7) "BLD",3651,"REQB","B","DG*5.3*576",4) "BLD",3651,"REQB","B","DG*5.3*590",5) "BLD",3651,"REQB","B","DG*5.3*602",6) "FIA",45) PTF "FIA",45,0) ^DGPT( "FIA",45,0,0) 45IP "FIA",45,0,1) y^y^p^^^^n^^n "FIA",45,0,10) "FIA",45,0,11) "FIA",45,0,"RLRO") "FIA",45,0,"VR") 5.3^DG "FIA",45,45) 1 "FIA",45,45,79.31) "FIA",45,45.02) 1 "FIA",45,45.02,31) "KRN",.402,87,-1) 0^4 "KRN",.402,87,0) DG501F^3040218.1453^^45^^^3040123 "KRN",.402,87,"DIAB",1,1,45.02,1) TREATED FOR SC CONDITION//NO;"WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?" "KRN",.402,87,"DIAB",2,1,45.02,8) EXPOSED TO ENVIR CONTAMINANTS;"WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?" "KRN",.402,87,"DIAB",2,1,45.02,9) TREATMENT FOR HEAD/NECK CA;"WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?" "KRN",.402,87,"DIAB",3,1,45.02,7) TREATED FOR AO CONDITION;"WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?" "KRN",.402,87,"DIAB",8,1,45.02,8) TREATMENT FOR MST;"WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?" "KRN",.402,87,"DIAB",9,1,45.02,6) POTENTIALLY RELATED TO COMBAT;"WAS TREATMENT RELATED TO COMBAT?" "KRN",.402,87,"DIAB",9,1,45.02,7) TREATED FOR IR CONDITION;"WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?" "KRN",.402,87,"DR",1,45) F X=2:1:7 S DGDUP(X)=0;K DGPTIT;S DGNFLD="@10";50///^S X=+DGMOV; "KRN",.402,87,"DR",2,45.02) S:DGJUMP'[1 Y="@2";10;@10;S DGNFLD="@15";2;@15;S DGNFLD="@16";3;@16;S DGNFLD="@17";4;@17;S:DGJUMP'[2 Y=0;@2;I $D(^DPT(+^DGPT(DGPTF,0),.3)),$P(^(.3),U)="Y" S (DGNFLD,Y)="@25";18////^S X=2;S (DGNFLD,Y)="@27";@25; "KRN",.402,87,"DR",2,45.02,1) 18WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?~//NO;@27;S DGNFLD="@28";S Y="@900";@28;S DGNFLD="@30";5;I X K DGPTIT S DGNFLD="@30",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@30;S DGNFLD="@40";6; "KRN",.402,87,"DR",2,45.02,2) I X K DGPTIT S DGNFLD="@40",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@40;S DGNFLD="@50";7;I X K DGPTIT S DGNFLD="@50",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@50;S DGNFLD="@60";8; "KRN",.402,87,"DR",2,45.02,3) I X K DGPTIT S DGNFLD="@60",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@60;S DGNFLD="@70";9;I X K DGPTIT S DGNFLD="@70",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@70;K DGNFLD,DGDUP S Y="";@800;D SCAN^DGPTSCAN S:'$D(DGBPC) Y="@899"; "KRN",.402,87,"DR",2,45.02,4) I '$D(DGBPC(2))!(DGDUP(2)) S Y="@820";300.02;S:X]"" DGDUP(2)=1;@820;I '$D(DGBPC(3))!(DGDUP(3)) S Y="@830";300.03;S:X]"" DGDUP(3)=1;@830;I '$D(DGBPC(4))!(DGDUP(4)) S Y="@840";D DRUG^DGPTSC01 I $D(DGTX) S Y="@835";300.04; "KRN",.402,87,"DR",2,45.02,5) S:X]"" DGDUP(4)=1;S Y="@840";@835;300.04//^S X=DGTX;S:X]"" DGDUP(4)=1;@840;I '$D(DGBPC(5))!(DGDUP(5)) S Y="@850";300.05;S:X]"" DGDUP(5)=1;@850;I '$D(DGBPC(6))!(DGDUP(6)) S Y="@860";300.06;S:X]"" DGDUP(6)=1;@860; "KRN",.402,87,"DR",2,45.02,6) I '$D(DGBPC(7))!(DGDUP(7)) S Y="@899";300.07;S:X]"" DGDUP(7)=1;@899;K DGPTIT S Y=DGNFLD;@900;K DGEXQ D CHQUES^DGPTSPQ I '$D(DGEXQ) S Y="@999";I '$D(DGEXQ(6)) S Y="@904";31WAS TREATMENT RELATED TO COMBAT?~;S Y="@905";@904;31///@; "KRN",.402,87,"DR",2,45.02,7) @905;I '$D(DGEXQ(1)) S Y="@910";26WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?~;S Y="@915";@910;26///@;@915;I '$D(DGEXQ(2)) S Y="@920";27WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?~;S Y="@925";@920;27///@;@925; "KRN",.402,87,"DR",2,45.02,8) I '$D(DGEXQ(3)) S Y="@930";28WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?~;S Y="@935";@930;28///@;@935;I '$D(DGEXQ(4)) S Y="@940";29WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?~;S Y="@945";@940;29///@;@945; "KRN",.402,87,"DR",2,45.02,9) I '$D(DGEXQ(5)) S Y="@950";30WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?~;I X["Y",$D(DFN),$$FILEHNC^DGNTAPI1(DFN);S Y="@955";@950;30///@;@955;@999;K DGEXQ S Y=DGNFLD; "KRN",.402,87,"ROU") ^DGX5F "KRN",.402,87,"ROUOLD") DGX5F "KRN",.402,88,-1) 0^3 "KRN",.402,88,0) DG501^3040630.1422^^45^^^3040630 "KRN",.402,88,"DIAB",1,1,45.02,1) TREATED FOR SC CONDITION//NO;"WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?" "KRN",.402,88,"DIAB",4,1,45.02,7) POTENTIALLY RELATED TO COMBAT;"WAS TREATMENT RELATED TO COMBAT?" "KRN",.402,88,"DIAB",6,1,45.02,8) TREATED FOR IR CONDITION;"WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?" "KRN",.402,88,"DIAB",6,1,45.02,9) TREATMENT FOR MST;"WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?" "KRN",.402,88,"DIAB",10,1,45.02,7) TREATED FOR AO CONDITION;"WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?" "KRN",.402,88,"DIAB",12,1,45.02,8) EXPOSED TO ENVIR CONTAMINANTS;"WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?" "KRN",.402,88,"DIAB",12,1,45.02,9) TREATMENT FOR HEAD/NECK CA;"WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?" "KRN",.402,88,"DR",1,45) F X=2:1:7 S DGDUP(X)=0;K DGPTIT;S DGHOLD=$S($D(^DGPT(DGPTF,"M",+DGMOV,0)):^(0),1:"");50///^S X=+DGMOV; "KRN",.402,88,"DR",2,45.02) S:'$D(DGADD) DGADD=0;S:DGJUMP'[1 Y="@2";S:DGADD Y="@20";S DGNFLD="@10";3;@10;S DGNFLD="@15";4;I $D(^DPT(+^DGPT(DGPTF,0),.3)),$P(^(.3),U)="Y" S Y="@15";18////^S X=2;S (DGNFLD,Y)="@20";@15; "KRN",.402,88,"DR",2,45.02,1) 18WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?~//NO;@20;S:DGJUMP'[2 Y="";@2;S DGNFLD="@25";S Y="@900";@25;I DGADD,$P(DGHOLD,U,5)["" S Y="@40";S DGNFLD="@40";5;I X K DGPTIT S DGNFLD="@40",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,88,"DR",2,45.02,2) @40;I DGADD,$P(DGHOLD,U,6)]"" S Y="@50";S DGNFLD="@50";6;I X K DGPTIT S DGNFLD="@50",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@50;I DGADD,$P(DGHOLD,U,7)]"" S Y="@60";S DGNFLD="@60";7; "KRN",.402,88,"DR",2,45.02,3) I X K DGPTIT S DGNFLD="@60",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@60;I DGADD,$P(DGHOLD,U,8)]"" S Y="@70";S DGNFLD="@70";8;I X K DGPTIT S DGNFLD="@70",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@70;I DGADD,$P(DGHOLD,U,9)]"" S Y="@80"; "KRN",.402,88,"DR",2,45.02,4) S DGNFLD="@80";9;I X K DGPTIT S DGNFLD="@80",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@80;K DGNFLD,DGDUP,DGADD S Y="";@800;D SCAN^DGPTSCAN S:'$D(DGBPC) Y="@899";I '$D(DGBPC(2))!(DGDUP(2)) S Y="@810";300.02;S:X]"" DGDUP(2)=1;@810; "KRN",.402,88,"DR",2,45.02,5) I '$D(DGBPC(3))!(DGDUP(3)) S Y="@820";300.03;S:X]"" DGDUP(3)=1;@820;I '$D(DGBPC(4))!(DGDUP(4)) S Y="@830";D DRUG^DGPTSC01 I $D(DGTX) S Y="@825";300.04;S:X]"" DGDUP(4)=1;S Y="@830";@825;300.04//^S X=DGTX;S:X]"" DGDUP(4)=1;@830; "KRN",.402,88,"DR",2,45.02,6) I '$D(DGBPC(5))!(DGDUP(5)) S Y="@840";300.05;S:X]"" DGDUP(5)=1;@840;I '$D(DGBPC(6))!(DGDUP(6)) S Y="@850";300.06;S:X]"" DGDUP(6)=1;@850;I '$D(DGBPC(7))!(DGDUP(7)) S Y="@899";300.07;S:X]"" DGDUP(7)=1;@899;K DGPTIT,DGTX S Y=DGNFLD; "KRN",.402,88,"DR",2,45.02,7) @900;K DGEXQ D CHQUES^DGPTSPQ I '$D(DGEXQ) S Y="@999";I '$D(DGEXQ(6)) S Y="@904";31WAS TREATMENT RELATED TO COMBAT?~;S Y="@905";@904;31///@;@905;I '$D(DGEXQ(1)) S Y="@910";26WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?~; "KRN",.402,88,"DR",2,45.02,8) S Y="@915";@910;26///@;@915;I '$D(DGEXQ(2)) S Y="@920";27WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?~;S Y="@925";@920;27///@;@925;I '$D(DGEXQ(3)) S Y="@930";28WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?~; "KRN",.402,88,"DR",2,45.02,9) S Y="@935";@930;28///@;@935;I '$D(DGEXQ(4)) S Y="@940";29WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?~;S Y="@945";@940;29///@;@945;I '$D(DGEXQ(5)) S Y="@950";30WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?~; "KRN",.402,88,"DR",2,45.02,10) I X["Y",$D(DFN),$$FILEHNC^DGNTAPI1(DFN);S Y="@955";@950;30///@;@955;@999;K DGEXQ S Y=DGNFLD; "KRN",.402,88,"ROU") ^DGPTX5 "KRN",.402,88,"ROUOLD") DGPTX5 "MBREQ") 1 "ORD",7,.402) .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) "ORD",7,.402,0) INPUT TEMPLATE "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,20,0) ^9.402P^^ "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 565^3040630^100100 "PKG",114,22,1,"PAH",1,1,0) ^^1^1^3040630 "PKG",114,22,1,"PAH",1,1,1,0) Combat Veteran Phase II "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") 11 "RTN","DGCV1") 0^13^B35006164 "RTN","DGCV1",1,0) DGCV1 ;ALB/ERC,BRM - COMBAT VET REPORTS; 07/10/2003 ; 2/5/04 2:52pm "RTN","DGCV1",2,0) ;;5.3;Registration;**528,565**; Aug 13, 1993 "RTN","DGCV1",3,0) ; "RTN","DGCV1",4,0) ;first report is built during the initial seeding, and called by "RTN","DGCV1",5,0) ;POST^DG53528P "RTN","DGCV1",6,0) RPT(DG) ;if, during initial seeding, a veteran could not be evaluated "RTN","DGCV1",7,0) ;for CV eligibility because of an imprecise date the veteran will be "RTN","DGCV1",8,0) ;added to the appropriate ^XTMP global "RTN","DGCV1",9,0) ; Input: DG - the code corresponding to the missing or imprecise date "RTN","DGCV1",10,0) ; "RTN","DGCV1",11,0) K VADM "RTN","DGCV1",12,0) I $G(DG)']"" Q "RTN","DGCV1",13,0) S ^XTMP("DGCV","REPORT",DFN,DG)="" "RTN","DGCV1",14,0) Q "RTN","DGCV1",15,0) REPORT ;if there are veterans in the ^XTMP globals, create a report. "RTN","DGCV1",16,0) I '$D(^XTMP("DGCV","REPORT")) Q "RTN","DGCV1",17,0) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR "RTN","DGCV1",18,0) K IOP,%ZIS "RTN","DGCV1",19,0) I $G(XPDQUES("POS1","B"))]"" S ZTIO=$G(XPDQUES("POS1","B")) ;result of install question "RTN","DGCV1",20,0) I $G(ZTIO)']"" S IOP=$G(^XTMP("DGCV","DEVICE")) "RTN","DGCV1",21,0) S ZTSAVE("*")="" "RTN","DGCV1",22,0) S ZTRTN="PRINT^DGCV1",ZTDESC="IMPRECISE COMBAT DATE REPORT" "RTN","DGCV1",23,0) D ^%ZTLOAD "RTN","DGCV1",24,0) EXIT ; "RTN","DGCV1",25,0) K XPDQUES "RTN","DGCV1",26,0) Q "RTN","DGCV1",27,0) PRINT ;print report "RTN","DGCV1",28,0) N PAGE,QUIT,DFN "RTN","DGCV1",29,0) S PAGE=1 "RTN","DGCV1",30,0) S QUIT="" "RTN","DGCV1",31,0) D HDR "RTN","DGCV1",32,0) N DGF,DGFD,DGLN,DGNAM,DGSSN "RTN","DGCV1",33,0) S (DGF,DFN)="" "RTN","DGCV1",34,0) F S DFN=$O(^XTMP("DGCV","REPORT",DFN)) Q:DFN']"" D "RTN","DGCV1",35,0) . Q:'$D(^DPT(DFN)) "RTN","DGCV1",36,0) . S (DGNAM,DGSSN)="" "RTN","DGCV1",37,0) . D DEM(DFN) "RTN","DGCV1",38,0) . I $G(DGNAM)']""!($G(DGSSN)']"") Q "RTN","DGCV1",39,0) . S DGLN=DGNAM_"^"_DGSSN "RTN","DGCV1",40,0) . N DGC "RTN","DGCV1",41,0) . F S DGF=$O(^XTMP("DGCV","REPORT",DFN,DGF)) Q:DGF']""!(QUIT) D "RTN","DGCV1",42,0) . . N DGFF "RTN","DGCV1",43,0) . . I $L(DGF)=1 S DGFF=DGF S DGC=1 D SET "RTN","DGCV1",44,0) . . I $L(DGF)=2 D "RTN","DGCV1",45,0) . . . S DGFF=$E(DGF,1),DGC=1 D SET "RTN","DGCV1",46,0) . . . S DGFF=$E(DGF,2),DGC=2 D SET "RTN","DGCV1",47,0) W !,">>>>END OF REPORT" "RTN","DGCV1",48,0) Q "RTN","DGCV1",49,0) SET ; "RTN","DGCV1",50,0) I DGFF["A"!(DGFF["F") S DGFD="SERVICE SEP" "RTN","DGCV1",51,0) I DGFF["B"!(DGFF["G") S DGFD="COMBAT TO" "RTN","DGCV1",52,0) I DGFF["C"!(DGFF["H") S DGFD="YUGOSLAVIA TO" "RTN","DGCV1",53,0) I DGFF["D"!(DGFF["I") S DGFD="SOMALIA TO" "RTN","DGCV1",54,0) I DGFF["E"!(DGFF["J") S DGFD="PERS GULF TO" "RTN","DGCV1",55,0) I $G(DGFD)']"" Q "RTN","DGCV1",56,0) S DGFD=DGFD_" DATE "_$S("ABCDE"[DGFF:"IMPRECISE",1:"MISSING") "RTN","DGCV1",57,0) S DGLN=$S(DGC=1:DGLN_"^"_DGFD,DGC=2:"^^"_DGFD,1:"") "RTN","DGCV1",58,0) D ADD(DGLN) "RTN","DGCV1",59,0) Q "RTN","DGCV1",60,0) DEM(DFN) ; "RTN","DGCV1",61,0) N VADM "RTN","DGCV1",62,0) D DEM^VADPT "RTN","DGCV1",63,0) S DGNAM=$G(VADM(1)) "RTN","DGCV1",64,0) S DGSSN=$P($G(VADM(2)),U,2) "RTN","DGCV1",65,0) Q "RTN","DGCV1",66,0) ADD(DGLN) ;add the line to the report "RTN","DGCV1",67,0) N DGX "RTN","DGCV1",68,0) I $P(DGLN,U)]"" W ! "RTN","DGCV1",69,0) W !?2,$P(DGLN,U),?39,$P(DGLN,U,2),?52,$P(DGLN,U,3) "RTN","DGCV1",70,0) I $E(IOST,1,2)="C-",($Y>(IOSL-4)) D "RTN","DGCV1",71,0) . D PAUSE "RTN","DGCV1",72,0) . Q:QUIT "RTN","DGCV1",73,0) . D TOP "RTN","DGCV1",74,0) I '$E(IOST,1,2)="C-",($Y>(IOSL-2)) D TOP "RTN","DGCV1",75,0) Q "RTN","DGCV1",76,0) ; "RTN","DGCV1",77,0) TOP ; "RTN","DGCV1",78,0) W @IOF "RTN","DGCV1",79,0) D HDR "RTN","DGCV1",80,0) Q "RTN","DGCV1",81,0) ; "RTN","DGCV1",82,0) HDR ;print header for report "RTN","DGCV1",83,0) N Y "RTN","DGCV1",84,0) W !!?5,"REPORT OF UPDATES REQUIRED FOR COMBAT VET STATUS" S Y=DT D DD^%DT W ?62,"Date: ",Y "RTN","DGCV1",85,0) W !,?62,"Page: ",PAGE "RTN","DGCV1",86,0) W !!?5,"The following patients could not be evaluated for Combat Veteran" "RTN","DGCV1",87,0) W !?5,"Eligibility status due to having imprecise or missing dates." "RTN","DGCV1",88,0) W !!!?2,"Patient Name",?39,"SSN",?52,"Date to be updated" "RTN","DGCV1",89,0) W !?2,"===================================",?39,"===========",?52,"==========================" "RTN","DGCV1",90,0) S PAGE=PAGE+1 "RTN","DGCV1",91,0) Q "RTN","DGCV1",92,0) ; "RTN","DGCV1",93,0) RPT2 ;second report is option DG CV STATUS, a report of what veterans were "RTN","DGCV1",94,0) ;assigned CV status during a specified date range "RTN","DGCV1",95,0) N DIR,DIRUT,X1,X2,X,Y,DGBEG,DGDT,DGEND "RTN","DGCV1",96,0) S DIR(0)="DAO^,"_DT "RTN","DGCV1",97,0) S X1=DT,X2=-7 D C^%DTC "RTN","DGCV1",98,0) S Y=X D DD^%DT "RTN","DGCV1",99,0) S DIR("A")="BEGINNING DATE: " "RTN","DGCV1",100,0) S DIR("B")=Y "RTN","DGCV1",101,0) S DIR("?")="ENTER THE BEGINNING DATE FOR THE REPORT" "RTN","DGCV1",102,0) S DIR("??")="^W !,""A BEGINNING AND AN END DATE MUST BE ENTERED FOR THIS REPORT""" "RTN","DGCV1",103,0) D ^DIR "RTN","DGCV1",104,0) Q:$D(DIRUT) "RTN","DGCV1",105,0) S DGBEG=Y "RTN","DGCV1",106,0) S DIR(0)="DAO^"_DGBEG_","_DT "RTN","DGCV1",107,0) S Y=DT D DD^%DT S DGDT=Y "RTN","DGCV1",108,0) S DIR("B")=DGDT "RTN","DGCV1",109,0) S DIR("A")="ENDING DATE: " "RTN","DGCV1",110,0) S DIR("?")="ENTER THE ENDING DATE FOR THE REPORT" "RTN","DGCV1",111,0) D ^DIR "RTN","DGCV1",112,0) Q:$D(DIRUT) "RTN","DGCV1",113,0) S DGEND=Y "RTN","DGCV1",114,0) D REPORT2(DGBEG,DGEND) "RTN","DGCV1",115,0) Q "RTN","DGCV1",116,0) ; "RTN","DGCV1",117,0) REPORT2(DGBEG,DGEND) ; "RTN","DGCV1",118,0) I $G(DGBEG)']""!($G(DGEND)']"") W !!,"DATE RANGE NOT SET. EXITING" Q "RTN","DGCV1",119,0) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR "RTN","DGCV1",120,0) K IOP,%ZIS "RTN","DGCV1",121,0) S %ZIS="Q" D ^%ZIS G:POP EXIT2 "RTN","DGCV1",122,0) I $D(IO("Q")) D Q "RTN","DGCV1",123,0) . S (ZTSAVE("DGBEG"),ZTSAVE("DGEND"))="" "RTN","DGCV1",124,0) . S ZTRTN="PRINT2^DGCV1",ZTDESC="COMBAT VET DATE EDITED REPORT" "RTN","DGCV1",125,0) . D ^%ZTLOAD "RTN","DGCV1",126,0) . D ^%ZISC,HOME^%ZIS "RTN","DGCV1",127,0) . W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!") "RTN","DGCV1",128,0) D PRINT2 "RTN","DGCV1",129,0) EXIT2 D ^%ZISC,HOME^%ZIS "RTN","DGCV1",130,0) ;Q +G(ZTSK) "RTN","DGCV1",131,0) Q "RTN","DGCV1",132,0) PRINT2 ; "RTN","DGCV1",133,0) N DGLN,PAGE,QUIT "RTN","DGCV1",134,0) S QUIT="" "RTN","DGCV1",135,0) U IO "RTN","DGCV1",136,0) I $E(IOST,1,2)="C-" W @IOF "RTN","DGCV1",137,0) S DGLN=0 "RTN","DGCV1",138,0) S PAGE=1 "RTN","DGCV1",139,0) D HDR2 "RTN","DGCV1",140,0) D DATA "RTN","DGCV1",141,0) I DGLN=0 D "RTN","DGCV1",142,0) . W !!!,?30,"No data to report." "RTN","DGCV1",143,0) . I $E(IOST,1,2)="C-" D PAUSE "RTN","DGCV1",144,0) D EXIT2 "RTN","DGCV1",145,0) Q "RTN","DGCV1",146,0) HDR2 ; "RTN","DGCV1",147,0) N DG1,DG2,Y "RTN","DGCV1",148,0) S Y=DGBEG D DD^%DT S DG1=Y "RTN","DGCV1",149,0) S Y=DGEND D DD^%DT S DG2=Y "RTN","DGCV1",150,0) W !!?15,"COMBAT VETERAN STATUS CHANGED REPORT" "RTN","DGCV1",151,0) S Y=DT D DD^%DT W ?60,"Date: ",Y "RTN","DGCV1",152,0) W !?20,DG1_" TO "_DG2 "RTN","DGCV1",153,0) W ?60,"Page: "_PAGE "RTN","DGCV1",154,0) W !!!?3,"NAME",?41,"SSN",?63,"CV END DATE",!?41,"PRIORITY GROUP" "RTN","DGCV1",155,0) W !,?3,"===================================",?41,"=================",?63,"============" "RTN","DGCV1",156,0) S PAGE=PAGE+1 "RTN","DGCV1",157,0) Q "RTN","DGCV1",158,0) DATA ; "RTN","DGCV1",159,0) N DGENR,DFN,DGNAM,DGSSN,DGDT,DGX,QUIT,Y,VADM "RTN","DGCV1",160,0) S QUIT="" "RTN","DGCV1",161,0) Q:$G(DGBEG)']""!($G(DGEND)']"") "RTN","DGCV1",162,0) S DGX=DGBEG-1 "RTN","DGCV1",163,0) F S DGX=$O(^DPT("E",DGX)) Q:DGX'>0!(DGX>DGEND) D "RTN","DGCV1",164,0) . S DFN="" "RTN","DGCV1",165,0) . F S DFN=$O(^DPT("E",DGX,DFN)) Q:DFN']""!(QUIT) D "RTN","DGCV1",166,0) . . Q:'$D(^DPT(DFN)) "RTN","DGCV1",167,0) . . K VADM,DGENR "RTN","DGCV1",168,0) . . D DEM^VADPT "RTN","DGCV1",169,0) . . Q:'$D(VADM) "RTN","DGCV1",170,0) . . S DGNAM=VADM(1) "RTN","DGCV1",171,0) . . S DGSSN=$P(VADM(2),U,2) "RTN","DGCV1",172,0) . . S DGDT=$$GET1^DIQ(2,DFN_",",.5295,"E") "RTN","DGCV1",173,0) . . I $G(DGDT)']"" S DGDT="DELETED!!!!" "RTN","DGCV1",174,0) . . S DGENR=$$PRIOR(DFN) "RTN","DGCV1",175,0) . . I $G(DGENR)']"" S DGENR="NONE" "RTN","DGCV1",176,0) . . D ADD2 "RTN","DGCV1",177,0) Q "RTN","DGCV1",178,0) PRIOR(DFN) ;gets priority and sub group "RTN","DGCV1",179,0) ; "RTN","DGCV1",180,0) N DGEN,DGIEN,DGSUB "RTN","DGCV1",181,0) I $$GET^DGENA($$FINDCUR^DGENA(DFN),.DGEN) D "RTN","DGCV1",182,0) . S DGENR=$G(DGEN("PRIORITY")) "RTN","DGCV1",183,0) . S DGSUB=$G(DGEN("SUBGRP")) "RTN","DGCV1",184,0) . I $G(DGSUB)]"" S DGENR=DGENR_$$EXTERNAL^DILFD(27.11,.12,"F",DGSUB) "RTN","DGCV1",185,0) Q $G(DGENR) "RTN","DGCV1",186,0) PAUSE ; "RTN","DGCV1",187,0) N DIR,DIRUT,X,Y "RTN","DGCV1",188,0) F Q:$Y>(IOSL-3) W ! "RTN","DGCV1",189,0) S DIR(0)="E" "RTN","DGCV1",190,0) D ^DIR "RTN","DGCV1",191,0) I ('(+Y))!($D(DIRUT)) S QUIT=1 "RTN","DGCV1",192,0) Q "RTN","DGCV1",193,0) ADD2 ; "RTN","DGCV1",194,0) I $E(IOST,1,2)="C-",($Y>(IOSL-6)) D "RTN","DGCV1",195,0) . D PAUSE "RTN","DGCV1",196,0) . Q:QUIT "RTN","DGCV1",197,0) . D TOP2 "RTN","DGCV1",198,0) I '$E(IOST,1,2)="C-",($Y>(IOSL-2)) D TOP2 "RTN","DGCV1",199,0) I '(QUIT) D LINE "RTN","DGCV1",200,0) Q "RTN","DGCV1",201,0) TOP2 ; "RTN","DGCV1",202,0) W @IOF "RTN","DGCV1",203,0) D HDR2 "RTN","DGCV1",204,0) Q "RTN","DGCV1",205,0) LINE ;add a line to the report "RTN","DGCV1",206,0) W !?3,DGNAM,?41,DGSSN,?63,DGDT,!?41,DGENR,! "RTN","DGCV1",207,0) S DGLN=1 "RTN","DGCV1",208,0) Q "RTN","DGPTAEE1") 0^10^B21128196 "RTN","DGPTAEE1",1,0) DGPTAEE1 ;ALB/MTC - Austin Edits EAL Listing Continued ; 14 DEC 92 "RTN","DGPTAEE1",2,0) ;;5.3;Registration;**338,565**;Aug 13, 1993 "RTN","DGPTAEE1",3,0) ; "RTN","DGPTAEE1",4,0) H101(REC) ;-- 101 header "RTN","DGPTAEE1",5,0) ; INPUT : REC - Node that contains the error "RTN","DGPTAEE1",6,0) N I,X,X1,X2 "RTN","DGPTAEE1",7,0) S X="ADM SSN ADM-DATE-TIME LAST-NAME INIT SOU FROM SOP POW MS SX" "RTN","DGPTAEE1",8,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",9,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,42)_" "_$E(REC,43,44)_" "_$E(REC,45,46)_SP_$E(REC,47,52)_SP_$E(REC,53)_" "_$E(REC,54)_" "_$E(REC,55)_" "_$E(REC,56) "RTN","DGPTAEE1",10,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",11,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<12 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",12,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",13,0) S X="BIRTHDATE POS AGO ION ST-CNTY ZIP MT INCOME MST CV CV-END" "RTN","DGPTAEE1",14,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",15,0) S X=$E(REC,57,58)_SP_$E(REC,59,60)_SP_$E(REC,61,64)_" "_$E(REC,65,66)_" "_$E(REC,67)_" "_$E(REC,68)_" "_$E(REC,69,73)_" "_$E(REC,74,78)_" "_$E(REC,79,80)_SP_$E(REC,81,86)_" "_$E(REC,87)_" "_$E(REC,88)_" "_$E(REC,89,94) "RTN","DGPTAEE1",16,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",17,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>11 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",18,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",19,0) D WRER^DGPTAEE "RTN","DGPTAEE1",20,0) Q "RTN","DGPTAEE1",21,0) ; "RTN","DGPTAEE1",22,0) H401(REC) ;-- 401 header "RTN","DGPTAEE1",23,0) ; INPUT : REC - Node that contains the error "RTN","DGPTAEE1",24,0) N X,X1,X2 "RTN","DGPTAEE1",25,0) S X="SURG SSN ADM-DATE-TIME SURG-DATE-TIME SPEC CATEG TECH SOP" "RTN","DGPTAEE1",26,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",27,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_" "_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_" " "RTN","DGPTAEE1",28,0) S X=X_$E(REC,41,42)_" "_$E(REC,43)_" "_$E(REC,44)_" "_$E(REC,45)_" "_$E(REC,46) "RTN","DGPTAEE1",29,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",30,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<9 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",31,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",32,0) S X="------------SURGICAL CODES------------- PHY SSN TRNSPLNT" "RTN","DGPTAEE1",33,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",34,0) S X=$E(REC,47,53)_SP_$E(REC,54,60)_SP_$E(REC,61,67)_SP_$E(REC,68,74)_SP_$E(REC,75,81)_" "_$E(REC,82,90)_" "_$E(REC,91) "RTN","DGPTAEE1",35,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",36,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>8 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",37,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",38,0) D WRER^DGPTAEE "RTN","DGPTAEE1",39,0) Q "RTN","DGPTAEE1",40,0) ; "RTN","DGPTAEE1",41,0) H501(REC) ;-- 501 header "RTN","DGPTAEE1",42,0) ; INPUT : REC - Node that contains the error "RTN","DGPTAEE1",43,0) N X,X1,X2 "RTN","DGPTAEE1",44,0) S X="DIAG SSN ADM-DATE-TIME MOVE DATE-TIME CDR CODE SPC LVE PASS SCI" "RTN","DGPTAEE1",45,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",46,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_SP "RTN","DGPTAEE1",47,0) S X=X_" "_$E(REC,41,46)_" "_$E(REC,47,48)_" "_$E(REC,49,51)_" "_$E(REC,52,54)_" "_$E(REC,55) "RTN","DGPTAEE1",48,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",49,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",50,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",51,0) S X="-----------DIAGNOSTIC CODES------------" "RTN","DGPTAEE1",52,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",53,0) S X=$E(REC,56,62)_SP_$E(REC,63,69)_SP_$E(REC,70,76)_SP_$E(REC,77,83)_SP_$E(REC,84,90) "RTN","DGPTAEE1",54,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",55,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")=10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",56,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",57,0) S X="SSN ATTY PHY PHY LOC CDE BSI LI SI DRUG A4 A5 SC AO IR EC" "RTN","DGPTAEE1",58,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",59,0) S X=$E(REC,91,99)_" "_$E(REC,100,105)_" "_$E(REC,106,107)_" "_$E(REC,108)_" "_$E(REC,109)_" "_$E(REC,110)_SP_$E(REC,111,114)_" "_$E(REC,115)_SP_$E(REC,116,119)_" "_$E(REC,120)_" "_$E(REC,121)_" "_$E(REC,122)_" "_$E(REC,123) "RTN","DGPTAEE1",60,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",61,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE1",62,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE1",63,0) D WRER^DGPTAEE "RTN","DGPTAEE1",64,0) Q "RTN","DGPTAEE1",65,0) ; "RTN","DGPTAEE2") 0^11^B14101889 "RTN","DGPTAEE2",1,0) DGPTAEE2 ;ALB/MTC - Austin Edits EAL Report Continued ; 14 DEC 92 "RTN","DGPTAEE2",2,0) ;;5.3;Registration;**8,338,415,565**;Aug 13, 1993 "RTN","DGPTAEE2",3,0) ; "RTN","DGPTAEE2",4,0) H601(REC) ;-- 601 error processing "RTN","DGPTAEE2",5,0) ; INPUT : REC - Record that contains the errors "RTN","DGPTAEE2",6,0) N X,X1 "RTN","DGPTAEE2",7,0) S X="PROC SSN ADM-DATE-TIME PROC-DATE-TIME SPC TYPE TRT" "RTN","DGPTAEE2",8,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",9,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_" " "RTN","DGPTAEE2",10,0) S X=X_$E(REC,41,42)_" "_$E(REC,43)_" "_$E(REC,44,46) "RTN","DGPTAEE2",11,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",12,0) S X="-----------PROCEDURE CODES-------------" "RTN","DGPTAEE2",13,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",14,0) S X=$E(REC,47,53)_SP_$E(REC,54,60)_SP_$E(REC,61,67)_SP_$E(REC,68,74)_SP_$E(REC,75,81) "RTN","DGPTAEE2",15,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",16,0) D WRER^DGPTAEE "RTN","DGPTAEE2",17,0) Q "RTN","DGPTAEE2",18,0) ; "RTN","DGPTAEE2",19,0) H701(REC) ;-- 701 header "RTN","DGPTAEE2",20,0) ; INPUT : REC - Record that contains the errors "RTN","DGPTAEE2",21,0) N X,X1,X2 "RTN","DGPTAEE2",22,0) S X="DISP SSN ADM-DATE-TIME DIS-DATE-TIME SPC TYPE OP/RX VA/AUS PLACE RECVNG" "RTN","DGPTAEE2",23,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",24,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40)_SP "RTN","DGPTAEE2",25,0) S X=X_$E(REC,41,42)_" "_$E(REC,43)_" "_$E(REC,44)_" "_$E(REC,45)_" "_$E(REC,46)_" "_$E(REC,47,52) "RTN","DGPTAEE2",26,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",27,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")<11 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE2",28,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",29,0) S X="ASIH XXXX C/P DXLS ODX CDR CODE PHY LOC %SC LI SI DRUG A4 A5" "RTN","DGPTAEE2",30,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",31,0) S X=$E(REC,53,55)_" "_$E(REC,56)_" "_$E(REC,57)_" "_$E(REC,58,64)_" "_$E(REC,65)_" "_$E(REC,66,71)_" "_$E(REC,72,73)_" "_$E(REC,74,76)_" "_$E(REC,77)_" "_$E(REC,78)_SP_$E(REC,79,82)_" "_$E(REC,83)_SP_$E(REC,84,87) "RTN","DGPTAEE2",32,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",33,0) S X="",$P(X," ",80)=" " F X1=1:1 S I=$P(DGER,",",X1) Q:I="" I $P(I,":")>10 S X2=+$P(I,":",2),X=$E(X,1,X2-1)_"#"_$E(X,X2+1,80) "RTN","DGPTAEE2",34,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",35,0) S X="SC AO IR EC MST HNC ETH RACE CV" "RTN","DGPTAEE2",36,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",37,0) S X=$E(REC,88)_" "_$E(REC,89)_" "_$E(REC,90)_" "_$E(REC,91)_" "_$E(REC,92)_" "_$E(REC,93)_" "_$E(REC,94,95)_" "_$E(REC,96,107)_" "_$E(REC,108) "RTN","DGPTAEE2",38,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",39,0) D WRER^DGPTAEE "RTN","DGPTAEE2",40,0) Q "RTN","DGPTAEE2",41,0) ; "RTN","DGPTAEE2",42,0) H702(REC) ;-- 702 header "RTN","DGPTAEE2",43,0) ; INPUT : REC - Record that contains the errors "RTN","DGPTAEE2",44,0) N X,X1 "RTN","DGPTAEE2",45,0) S X="ADM SSN ADM-DATE-TIME DIS-DATE-TIME" "RTN","DGPTAEE2",46,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",47,0) S X=$E(REC,1,4)_" "_$E(REC,5,14)_SP_$E(REC,15,16)_SP_$E(REC,17,18)_SP_$E(REC,19,20)_SP_$E(REC,21,24)_SP_$E(REC,31,32)_SP_$E(REC,33,34)_SP_$E(REC,35,36)_SP_$E(REC,37,40) "RTN","DGPTAEE2",48,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",49,0) S X="----------------------------DIAGNOSTIC CODES----------------------------" "RTN","DGPTAEE2",50,0) S X=$E(REC,41,47)_SP_$E(REC,48,54)_SP_$E(REC,55,61)_SP_$E(REC,62,68)_SP_$E(REC,69,75)_SP_$E(REC,76,82)_SP_$E(REC,83,89)_SP_$E(REC,90,96)_SP_$E(REC,97,103) "RTN","DGPTAEE2",51,0) S VALMCNT=VALMCNT+1,^TMP("AD",$J,VALMCNT,0)=X "RTN","DGPTAEE2",52,0) D WRER^DGPTAEE "RTN","DGPTAEE2",53,0) Q "RTN","DGPTAEE2",54,0) ; "RTN","DGPTF") 0^1^B21456772 "RTN","DGPTF",1,0) DGPTF ;ALB/JDS/AS - PTF LOAD/EDIT DRIVER ; 11/24/03 12:13pm "RTN","DGPTF",2,0) ;;5.3;Registration;**26,58,164,195,397,565**;Aug 13, 1993 "RTN","DGPTF",3,0) ; "RTN","DGPTF",4,0) D LO^DGUTL "RTN","DGPTF",5,0) I $D(^DISV(DUZ,"^DPT(")),$D(^("^DGPT(")) S A=+^("^DGPT("),B=+^("^DPT(") I $D(^DGPT(A,0)),$D(^DPT(B,0)) S:(+^DGPT(A,0)'=B&$D(^DGPT("B",B))) ^DISV(DUZ,"^DGPT(")="" "RTN","DGPTF",6,0) ASK W !! K DIC S DIC="^DGPT(",DIC(0)="EQMZA",DGPR=0,DIC("S")="I '$P(^DGPT(+Y,0),U,6)!($P(^(0),U,6)=1),$P(^(0),U,11)=1" "RTN","DGPTF",7,0) D ^DIC G Q1:Y'>0 S PTF=+Y,DGREL=$S($D(^XUSEC("DG PTFREL",DUZ)):1,1:0) "RTN","DGPTF",8,0) I '$D(^DGPT(PTF,"M",0))#2 S ^(0)="^45.02^^" "RTN","DGPTF",9,0) K DIC S DFN=+Y(0),DGADM=+$P(Y(0),U,2),^DISV(DUZ,"^DPT(")=DFN,DGST=+$P(Y(0),U,6) "RTN","DGPTF",10,0) N DGPMCA,DGPMAN D PM^DGPTUTL "RTN","DGPTF",11,0) D:DGST=0 MT^DGPTUTL,INCOME^DGPTUTL1 "RTN","DGPTF",12,0) I DGST I 'DGREL!($D(DGQWK))!(DGST>1) W:$X>60 " ???--Already ",$S(DGST=1:"Closed",DGST=2:"Released",1:"Transmitted") G ASK "RTN","DGPTF",13,0) ; "RTN","DGPTF",14,0) EN1 ; "RTN","DGPTF",15,0) K DGPTFE S DGPTFE=$P(^DGPT(PTF,0),"^",4) "RTN","DGPTF",16,0) I 'DGPTFE,'DGST G UP:$P(DGPMAN,"^",16)'=PTF D:'$P(^DGPT(PTF,0),"^",5) SUF D LE^DGPTTS,DC "RTN","DGPTF",17,0) I $D(DGQWK) D ^DGPTFQWK,Q1 S DGQWK=1 G DGPTF "RTN","DGPTF",18,0) ; "RTN","DGPTF",19,0) GETD ; "RTN","DGPTF",20,0) K A "RTN","DGPTF",21,0) I $P(^DGPT(PTF,0),U,11)=1 D CEN^DGPTC1 "RTN","DGPTF",22,0) F I=0,.521,.11,.52,.321,.32,57,.3 S A(I)="" S:$D(^DPT(DFN,I))&('DGST) A(I)=^(I) I DGST S:$D(^DGP(45.84,PTF,$S('I:10,1:I))) A(I)=^($S('I:10,1:I)) "RTN","DGPTF",23,0) ;changed 6/17/98 for MST enhancement "RTN","DGPTF",24,0) S A("MST")=$P($$GETSTAT^DGMSTAPI(DFN),U,2,5) "RTN","DGPTF",25,0) K DGNTARR "RTN","DGPTF",26,0) S A("NTR")=$S($$GETCUR^DGNTAPI(DFN,"DGNTARR")>0:DGNTARR("INTRP"),1:"") "RTN","DGPTF",27,0) K DGNTARR "RTN","DGPTF",28,0) K B F I=0,101,70 S B(I)="" S:$D(^DGPT(PTF,I)) B(I)=^(I) "RTN","DGPTF",29,0) S A("CV")=$$CVEDT^DGCV(DFN,$P($G(B(0)),U,2)) "RTN","DGPTF",30,0) S DGDD=+B(70),DGFC=+$P(B(0),U,3) "RTN","DGPTF",31,0) S Y=DGDD D FMT^DGPTUTL "RTN","DGPTF",32,0) S Y=DGADM D D^DGPTUTL S DGAD=Y,HEAD="Name: "_$P(A(0),U,1)_" SSN: "_$P(A(0),U,9)_" Dt of Adm: "_DGAD "RTN","DGPTF",33,0) S DGN=$S(DGST!DGPR:1,1:0) "RTN","DGPTF",34,0) I DGPR S (DGST,DGPTFE)=1 G FAC^DGPTF1 "RTN","DGPTF",35,0) I DGPTFE,'DGST K DR S DIE="^DGPT(",DA=PTF,DR="2" D ^DIE K DR G Q:$D(Y) S DGADM=$P(^DGPT(PTF,0),U,2),^DISV(DUZ,"PTFAD",DFN)=DGADM,Y=DGADM D D^DGPTUTL S HEAD=$P(HEAD,DGAD,1)_Y "RTN","DGPTF",36,0) G ^DGPTF1 "RTN","DGPTF",37,0) ; "RTN","DGPTF",38,0) Q I '$P(^DGPT(PTF,0),"^",4),'$P(^(0),U,6) W !," Updating TRANSFER DRGs" S DGADM=$P(^DGPT(PTF,0),U,2) D SUDO1^DGPTSUDO "RTN","DGPTF",39,0) D Q1 "RTN","DGPTF",40,0) I $D(DGADPR)!($D(DGPTOUT)) K DGPTOUT Q "RTN","DGPTF",41,0) G DGPTF "RTN","DGPTF",42,0) ; "RTN","DGPTF",43,0) Q1 ; -- housekeeping "RTN","DGPTF",44,0) I $D(IOM) S X=IOM X ^%ZOSF("RM") "RTN","DGPTF",45,0) D KVAR^DGPTUTL1,KVAR^DGPTC1 K SDCLY "RTN","DGPTF",46,0) Q "RTN","DGPTF",47,0) ; "RTN","DGPTF",48,0) SUF I $D(^DIC(42,+$P(DGPMAN,U,6),0)) D "RTN","DGPTF",49,0) .S DGX=$P(^(0),U,3),DGX=$S(DGX="":"",DGX="D":"D NUMACT^DGPTSUF(30)",DGX="NH":"D NUMACT^DGPTSUF(40)",1:"") "RTN","DGPTF",50,0) .Q:DGX="" "RTN","DGPTF",51,0) .X DGX Q:DGANUM'=1 "RTN","DGPTF",52,0) .N DGFDA,DGMSG "RTN","DGPTF",53,0) .S DGFDA(45,PTF_",",5)=DGSUFNAM(DGANUM) "RTN","DGPTF",54,0) .D FILE^DIE("","DGFDA","DGMSG") "RTN","DGPTF",55,0) K DGANUM,DGSUFNAM,DGX "RTN","DGPTF",56,0) Q "RTN","DGPTF",57,0) ORDER ; -- order mvt ; I1 := #mvts+1 ; M() := mvt array "RTN","DGPTF",58,0) N DGRT S DGRT=$S(I1<25:"MT",1:"^UTILITY(""DGPTMT"",$J)") K @DGRT "RTN","DGPTF",59,0) F I=0:0 S I=$O(M(I)) Q:'I S NU=+$P(M(I),U,10),NU=$S('NU:9999999+I,1:NU),NU=$S($D(@DGRT@(NU)):NU+(I*.1),1:NU) S @DGRT@(NU,I)=M(I) "RTN","DGPTF",60,0) S K=0 F I=0:0 S I=$O(@DGRT@(I)) Q:'I S K=K+1,J=$O(@DGRT@(I,0)) S M(K)=@DGRT@(I,J) "RTN","DGPTF",61,0) K @DGRT Q "RTN","DGPTF",62,0) ; "RTN","DGPTF",63,0) ADM S DFN=+^DGPT(DA,0),%=$O(^("M","AM",0)) I %0) K X W !,"Not after first movement" "RTN","DGPTF",64,0) Q:'$D(X) I $D(^DGPT("AAD",DFN,X))&($P(^DGPT(DA,0),U,2)'=X) K X W !,"There is already a PTF entry at that time" "RTN","DGPTF",65,0) Q "RTN","DGPTF",66,0) ; "RTN","DGPTF",67,0) WR Q:'$D(^(0)) S DGNODE=^(0),DGADM=$P(DGNODE,U,2) W " Admitted: ",$TR($$FMTE^XLFDT(DGADM,"5DF")," ","0")," " "RTN","DGPTF",68,0) ; uses new FMTE parameter for XLFDT, Y2K in line WR "RTN","DGPTF",69,0) ; "RTN","DGPTF",70,0) F DGZ=6,4 S %=";"_$S($D(^DD(45,DGZ,0)):$P(^(0),U,3),1:"") W $P($P(%,";"_$P(DGNODE,U,DGZ)_":",2),";",1)_" " "RTN","DGPTF",71,0) K DGNODE,DGZ Q "RTN","DGPTF",72,0) ; "RTN","DGPTF",73,0) DC S DGPDN=$S($D(^DGPM(+$P(DGPMAN,"^",17),0)):^(0),1:"") "RTN","DGPTF",74,0) S DGDC=+DGPDN,DG72=$S($D(^DG(405.2,+$P(DGPDN,"^",18),0)):$P(^(0),"^",8),1:0),DGTY=$S(DGDC:1,1:"") "RTN","DGPTF",75,0) I DGDC F I=0:0 S I=$O(^DGPM("APMV",DFN,DGPMCA,I)) Q:I'>0 I $D(^DGPM(+$O(^(I,0)),0)),$P(^(0),"^",2)=2 S J=U_$P(^(0),"^",18)_U,DGTY=$S("^43^44^13^45^"[J:4,"^1^"[J:2,"^2^3^"[J:3,1:1) Q "RTN","DGPTF",76,0) S X=$S($D(^DGPT(PTF,70)):^(70),1:"") "RTN","DGPTF",77,0) S DR="70///"_$S(DGDC:"/"_DGDC,'X:"",1:"@")_$S(DG72:";72////"_DG72,1:"")_";72.1///"_$S(DGTY:"/"_DGTY,'$P(X,"^",14):"",1:"@"),DIE="^DGPT(",DA=PTF D ^DIE "RTN","DGPTF",78,0) I DGDC>DT,$P(DGPDN,"^",18)=42 W:'$D(ZTQUEUED) !,"Discharge 'While ASIH' is in the future." "RTN","DGPTF",79,0) K DG72,DGTY,DGPDN Q "RTN","DGPTF",80,0) ; "RTN","DGPTF",81,0) UP S DIE="^DGPT(",DR="4///F",DA=PTF D ^DIE W !,"Pointer from Patient file is incorrect. Record changed to Fee Basis",! S DGPTFE=1 G GETD "RTN","DGPTF1") 0^2^B31122117 "RTN","DGPTF1",1,0) DGPTF1 ;ALB/JDS - PTF ENTRY/EDIT ; 11/24/03 3:29pm "RTN","DGPTF1",2,0) ;;5.3;Registration;**69,114,195,397,342,415,565**;Aug 13, 1993 "RTN","DGPTF1",3,0) ; "RTN","DGPTF1",4,0) I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP "RTN","DGPTF1",5,0) S:'$D(IOST) IOST="C" S DGVI="""""",DGVO=DGVI I $D(IOST(0)) S:$D(^%ZIS(2,IOST(0),5)) I=^(5) S:$L($P(I,U,4)) DGVI=$P(I,U,4) S:$L($P(I,U,5)) DGVO=$P(I,U,5) I $L(DGVI_DGVO)>4 S X=132 X ^%ZOSF("RM") "RTN","DGPTF1",6,0) WR G GET:'$D(A)!('$D(B)) W @IOF,HEAD,?72,@DGVI,"<101>",@DGVO "RTN","DGPTF1",7,0) FAC I $D(DGCST) W !?40,"Census Status: ",$P($P($P(^DD(45,6,0),"^",3),+DGCST_":",2),";") "RTN","DGPTF1",8,0) W !! S Z=1 D Z W " Facility: " S Z=$P(B(0),U,3)_$P(B(0),U,5),Z1=23 D Z1 "RTN","DGPTF1",9,0) MAR S Z=2 D Z W " Marit Stat: ",$S($D(^DIC(11,+$P(A(0),U,5),0)):$P(^(0),U,1),1:"") "RTN","DGPTF1",10,0) SA W !," Source of Adm: ",$S($D(^DIC(45.1,+B(101),0)):$P(^(0),U,5),1:"") "RTN","DGPTF1",11,0) N VADM D DEM^VADPT "RTN","DGPTF1",12,0) W ?39,"Ethnic: " D "RTN","DGPTF1",13,0) .I 'VADM(11) W "" Q "RTN","DGPTF1",14,0) .N NODE,NUM,ETHNIC,I "RTN","DGPTF1",15,0) .S I=0 "RTN","DGPTF1",16,0) .F NUM=0:1 S I=+$O(VADM(11,I)) Q:'I D "RTN","DGPTF1",17,0) ..S X=$$PTR2CODE^DGUTL4(+VADM(11,I),2,4) "RTN","DGPTF1",18,0) ..S ETHNIC=$S(X="":"?",1:X) "RTN","DGPTF1",19,0) ..S X=$$PTR2CODE^DGUTL4(+$G(VADM(11,I,1)),3,4) "RTN","DGPTF1",20,0) ..S ETHNIC=ETHNIC_$S(X="":"?",1:X) "RTN","DGPTF1",21,0) ..I NUM S ETHNIC=","_ETHNIC "RTN","DGPTF1",22,0) ..W ETHNIC "RTN","DGPTF1",23,0) W ?55,"Race: " D "RTN","DGPTF1",24,0) .I 'VADM(12) W "" Q "RTN","DGPTF1",25,0) .N NODE,NUM,RACE,I "RTN","DGPTF1",26,0) .S I=0 "RTN","DGPTF1",27,0) .F NUM=0:1 S I=+$O(VADM(12,I)) Q:'I D "RTN","DGPTF1",28,0) ..S X=$$PTR2CODE^DGUTL4(+VADM(12,I),1,4) "RTN","DGPTF1",29,0) ..S RACE=$S(X="":"?",1:X) "RTN","DGPTF1",30,0) ..S X=$$PTR2CODE^DGUTL4(+$G(VADM(12,I,1)),3,4) "RTN","DGPTF1",31,0) ..S RACE=RACE_$S(X="":"?",1:X) "RTN","DGPTF1",32,0) ..I NUM S RACE=","_RACE "RTN","DGPTF1",33,0) ..W RACE "RTN","DGPTF1",34,0) K VADM "RTN","DGPTF1",35,0) W !," Source of Pay: " S L=";"_$P(^DD(45,22,0),U,3),L1=";"_$P(B(101),U,3)_":" W $P($P(L,L1,2),";",1) "RTN","DGPTF1",36,0) SEX S SEX=$P(A(0),U,2) W ?39," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:"") "RTN","DGPTF1",37,0) W !,"Trans Facility: ",$P(B(101),U,5)_$P(B(101),U,6) "RTN","DGPTF1",38,0) DOB S DOB=$P(A(0),U,3),Y=DOB D D^DGPTUTL W ?39," Date of Birth: ",Y "RTN","DGPTF1",39,0) CAT I DGPTFMT<2 W !," Cat of Ben: ",$S($D(^DIC(45.82,+$P(B(101),U,4),0)):$E($P(^(0),U,2),1,26),1:"") "RTN","DGPTF1",40,0) W:$X>50 ! "RTN","DGPTF1",41,0) W " Admit Elig: "_$S(+$P(B(101),U,8):$P($G(^DIC(8,+$P(B(101),U,8),0)),U),1:"UNKNOWN") W ?50,"SCI: " S L=";"_$P(^DD(2,57.4,0),U,3),L1=";"_$P(A(57),U,4)_":" W $P($P(L,L1,2),";",1) "RTN","DGPTF1",42,0) VIET W ! S Z=3 D Z W "Vietnam SRV: " S L=$P(A(.321),U,1),Z=$S(L="Y":"YES",L="N":"NO",1:"UNKNOWN"),Z1=28 D Z1 "RTN","DGPTF1",43,0) ST S Z=4 D Z W " State: ",$S($D(^DIC(5,+$P(A(.11),U,5),0)):$P(^(0),U,1),1:"") "RTN","DGPTF1",44,0) POW W !?11,"POW: " S L=$P(A(.52),U,5) W $S(L="Y":"YES",L="N":"NO",1:"UNKNOWN") "RTN","DGPTF1",45,0) ZIP W ?45,"Zip Code: ",$P(A(.11),U,6) "RTN","DGPTF1",46,0) POS W !,?6," POW SRV: " S L=$P(A(.52),U,6) W $E($S($D(^DIC(22,+L,0)):$P(^(0),U,1),1:""),1,23) "RTN","DGPTF1",47,0) COU W ?47,"County: ",$S($D(^DIC(5,+$P(A(.11),U,5),1,+$P(A(.11),U,7),0)):$P(^(0),U,1),1:"") "RTN","DGPTF1",48,0) ION W !," Ion Rad Exp: " S L=$P(A(.321),U,3) W $S(L="Y":"YES",L="N":"NO",1:"UNKNOWN") "RTN","DGPTF1",49,0) METH S L=$P(A(.321),U,12) W:L'="" ?38,"Exposure Method: ",$S(L="N":"Nagasaki/Hiroshima",L="T":"Nuclear Testing",L="B":"Both",1:"") "RTN","DGPTF1",50,0) AO W !," Agent Or exp: " S L=$P(A(.321),U,2) W $S(L="Y":"YES",L="N":"NO",1:"UNKNOWN") "RTN","DGPTF1",51,0) AOLOC S L=$P(A(.321),U,13) W:L'="" ?36,"Exposure Location: ",$S(L="V":"Vietnam",L="K":"Korean DMZ",1:"") "RTN","DGPTF1",52,0) MST W !," Claims MST: " S L=$P(A("MST"),U) W $S(L="Y":"YES",L="N":"NO",L="D":"DECLINED TO ANSWER",1:"UNKNOWN") ; added 6/17/98 for MST enhancement "RTN","DGPTF1",53,0) NTR W ?39," N/T Radium: " S L=A("NTR") W $S(L'="":L,1:"UNKNOWN") "RTN","DGPTF1",54,0) CV S L=$S($P(A("CV"),U,1)>0:1,1:0) "RTN","DGPTF1",55,0) W !,"Combat Veteran: ",$S(L:"YES",1:"NO") "RTN","DGPTF1",56,0) I L S Y=$P(A("CV"),U,2) D D^DGPTUTL W ?45,"End Date: ",Y "RTN","DGPTF1",57,0) ; "RTN","DGPTF1",58,0) D EN^DGPTF4 K A,B Q:DGPR "RTN","DGPTF1",59,0) ; "RTN","DGPTF1",60,0) JUMP F I=$Y:1:20 W ! "RTN","DGPTF1",61,0) G 101^DGPTFJC:DGN S (DGZM0,DGZS0)=0 "RTN","DGPTF1",62,0) R "Enter: for ,",!,"1-7 to edit,'^N' for screen N, or '^' to abort: // ",X:DTIME S:'$T X="^",DGPTOUT="" "RTN","DGPTF1",63,0) G ^DGPTFM:X="",Q:X="^" "RTN","DGPTF1",64,0) I X?1"^".E S DGPTSCRN=101 G ^DGPTFJ "RTN","DGPTF1",65,0) G PR:X?.N&($L(X)>2) "RTN","DGPTF1",66,0) I X["-" S K=X,X="" F I=1:1 S J=$P(K,",",I) Q:J']"" I +J<8 S:J'["-" X=X_J_"," I J["-"&(+J) I +J<+$P(J,"-",2) F L=+J:1:+$P(J,"-",2) S:L<8 X=X_L_"," "RTN","DGPTF1",67,0) I X'[",",1234567'[X G PR "RTN","DGPTF1",68,0) F I=1:1 S J=$P(X,",",I) Q:'J G:J<1!(J>7)!(J'?1N) PR "RTN","DGPTF1",69,0) I X<1!(X>7) G PR "RTN","DGPTF1",70,0) S (PT(1),PT(2))="",DGJUMP=X,DA=PTF,DIE="^DGPT(",DR="[DG101"_$E("F",DGPTFE)_"]" D ^DIE "RTN","DGPTF1",71,0) ;-- "RTN","DGPTF1",72,0) N DGPMCA,DGPMAN D PM^DGPTUTL "RTN","DGPTF1",73,0) I '$G(DGADM) S DGADM=+^DGPT(PTF,0) "RTN","DGPTF1",74,0) D MT^DGPTUTL "RTN","DGPTF1",75,0) GET F I=.32,.52,57,.521,0,.321,.11,.3 S A(I)="" S:$D(^DPT(DFN,I))&('DGST) A(I)=^(I) I DGN S:$D(^DGP(45.84,PTF,$S('I:10,1:I))) A(I)=^($S('I:10,1:I)) "RTN","DGPTF1",76,0) ; The following line added for MST enhancement 4/21/99 "RTN","DGPTF1",77,0) S A("MST")=$P($$GETSTAT^DGMSTAPI(DFN),U,2,5) "RTN","DGPTF1",78,0) K DGNTARR "RTN","DGPTF1",79,0) S A("NTR")=$S($$GETCUR^DGNTAPI(DFN,"DGNTARR")>0:DGNTARR("INTRP"),1:"") "RTN","DGPTF1",80,0) K DGNTARR "RTN","DGPTF1",81,0) F I=0,101,70 S B(I)="" S:$D(^DGPT(PTF,I)) B(I)=^(I) "RTN","DGPTF1",82,0) S DGDD=+B(70),DGFC=+$P(B(0),U,3) "RTN","DGPTF1",83,0) S A("CV")=$$CVEDT^DGCV(DFN,$P($G(B(0)),U,2)) "RTN","DGPTF1",84,0) K PT G DGPTF1 "RTN","DGPTF1",85,0) PR W !,"Enter '^' to stop the display and edit of data",!,"'^N' to jump to screen #N (screen # appears in upper right of screen '')",!," to continue on to the next screen or 1-7 to edit:" "RTN","DGPTF1",86,0) W !?10,"1-Facility, Source of admis, Payment, Transf facil, and Cat. of Benef",!?10,"2-Marital Stat, Race, Ethnicity, Sex, SCI, DOB" "RTN","DGPTF1",87,0) W !?10,"3-Agent Orange, Prisoner of War, Ionizing Radiation, MST, N/T Radium",!?10,"4-State, County, Zip code" "RTN","DGPTF1",88,0) W !?10,"5-Discharge date, type & specialty",!?10,"6-Outpatient treat & VA Auspices",!?10,"7-Receiving Facility, ASIH Days & C&P Status" "RTN","DGPTF1",89,0) W !,"You may also enter any combination of the above, separated by commas(ex:1,3,5)",! "RTN","DGPTF1",90,0) R !!,"Enter : ",X:DTIME G WR "RTN","DGPTF1",91,0) Q G Q^DGPTF "RTN","DGPTF1",92,0) Q "RTN","DGPTF1",93,0) Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO "RTN","DGPTF1",94,0) E W " " "RTN","DGPTF1",95,0) Q "RTN","DGPTF1",96,0) Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" " "RTN","DGPTF1",97,0) W Z "RTN","DGPTFM4") 0^3^B26889694 "RTN","DGPTFM4",1,0) DGPTFM4 ;ALB/MTC/ADL - PTF ENTRY/EDIT-2 ; 11/19/03 11:37am "RTN","DGPTFM4",2,0) ;;5.3;Registration;**114,195,397,510,565**;Aug 13, 1993 "RTN","DGPTFM4",3,0) ;;ADL;Update for CSV Project;;Mar 26, 2003 "RTN","DGPTFM4",4,0) ; "RTN","DGPTFM4",5,0) S DGZM0=DGZM0+1 "RTN","DGPTFM4",6,0) EN N M3 D MOB:'$D(M) S M(DGZM0)=$S($D(M(DGZM0)):M(DGZM0),1:"") G NEXM:M(DGZM0)="" S (M3,M(DGZM0),M1)=$S($D(^DGPT(PTF,"M",+M(DGZM0),0)):^DGPT(PTF,"M",+M(DGZM0),0),1:"") "RTN","DGPTFM4",7,0) I $D(^DGPT(PTF,"M",+M(DGZM0),"P")) S $P(M(DGZM0),U,20)=^("P"),$P(M1,U,20)=^("P") "RTN","DGPTFM4",8,0) WR S DG300=$S($D(^DGPT(PTF,"M",+M(DGZM0),300)):^(300),1:"") "RTN","DGPTFM4",9,0) W @IOF,HEAD,?70 S Z="<501-"_DGZM0_">" D Z^DGPTFM I +M(DGZM0)=1 W !,?62,"Discharge Movement" "RTN","DGPTFM4",10,0) M S L=+$P(M1,U,10),Y=L D D^DGPTUTL W !! S Z=1 D Z W "Date of Move: " S Z=Y,Z1=20 D Z1 W "Losing Specialty: ",$E($S($D(^DIC(42.4,+$P(M1,U,2),0)):$P(^(0),U,1),1:""),1,25) "RTN","DGPTFM4",11,0) W !," Leave days: ",$P(M1,U,3),?44,"Pass days: ",$P(M1,U,4) "RTN","DGPTFM4",12,0) W !,"Treated for SC Condition: ",$S($P(M3,U,18)=1:"Yes",1:"No") "RTN","DGPTFM4",13,0) N NL S NL=0 "RTN","DGPTFM4",14,0) I $P(M3,U,31)'="" W @($S(NL#2:"!",1:"?37")),"Potentially Related to Combat: ",$S($P(M3,U,31)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",15,0) I $P(M3,U,26)'="" W @($S(NL#2:"!",1:"?37")),"Treated for AO Condition: ",$S($P(M3,U,26)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",16,0) I $P(M3,U,27)'="" W @($S(NL#2:"!",1:"?37")),"Treated for IR Condition: ",$S($P(M3,U,27)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",17,0) I $P(M3,U,28)'="" W @($S(NL#2:"!",1:"?37")),"Treated for EC Condition: ",$S($P(M3,U,28)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",18,0) ; added 6/17/98 for MST enhancement "RTN","DGPTFM4",19,0) I $P(M3,U,29)'="" W @($S(NL#2:"!",1:"?37")),"Treated for MST Condition: ",$S($P(M3,U,29)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",20,0) K DGNTARR "RTN","DGPTFM4",21,0) S DGNTARR=$$GETCUR^DGNTAPI(DFN,"DGNTARR") "RTN","DGPTFM4",22,0) I $P(M3,U,30)="",(",3,4,5,"[(","_$P($G(DGNTARR("STAT")),U)_",")) S $P(M3,U,30)="N" "RTN","DGPTFM4",23,0) I $P(M3,U,30)'="" W @($S(NL#2:"!",1:"?37")),"Treated for HEAD/NECK CA Condition: ",$S($P(M3,U,30)="Y":"Yes",1:"No") "RTN","DGPTFM4",24,0) K NL "RTN","DGPTFM4",25,0) W !! S Z=2 D Z W " DX: " F I=1:1:11 S L=$P(M1,U,I+4) I L'=""&(I'=6) S DGPTTMP=$$ICDDX^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)) D "RTN","DGPTFM4",26,0) . W $S(+DGPTTMP>0&($P(DGPTTMP,U,10)):$P(DGPTTMP,U,4)_" ("_$P(DGPTTMP,U,2)_")",1:"**********-"_L),!?17 "RTN","DGPTFM4",27,0) D PRN2^DGPTFM8:DG300]"" "RTN","DGPTFM4",28,0) I $P(M1,U,20) S DRG=$P(M1,U,20) W:DRG=468!(DRG=469)!(DRG=470) *7 W !!?14,"TRANSFER DRG: ",DRG F DGDRGNM=0:0 S DGDRGNM=$O(^ICD(DRG,1,DGDRGNM)) Q:'DGDRGNM W !,$P(^(DGDRGNM,0),U,1) "RTN","DGPTFM4",29,0) JUMP K DG300 F I=$Y:1:21 W ! "RTN","DGPTFM4",30,0) X S DGNUM=$S($D(M(DGZM0+1)):501_"-"_(DGZM0+1),1:"MAS") G 501^DGPTFJC:DGST "RTN","DGPTFM4",31,0) W "Enter to continue, 1-2 to edit,",!,"'M' ",$S(DGPTFE:" to add a patient movement",1:"to edit Treat. Specialty"),", '^N' for screen N, or '^' to abort:<",DGNUM,">// " R X:DTIME "RTN","DGPTFM4",32,0) K DGNUM G Q:X="^",NEXM:X="",^DGPTFJ:X?1"^".E,M^DGPTFM1:X="M"!(X="m") "RTN","DGPTFM4",33,0) X1 I X[1!(X[2) S DR="[DG501"_$E("F",DGPTFE) X:(+M(DGZM0)=1) "S J=^DGPT(PTF,""M"",1,0) F I=11:1:15 I $P(J,U,I) S DR=DR_1" S DR=DR_"]",DGJUMP=X,DIE="^DGPT(",(DA,DGPTF)=PTF,DGMOV=+M(DGZM0) D ^DIE K M,DR,DIE D CHK501^DGPTSCAN K DGPTF,DGMOV "RTN","DGPTFM4",34,0) ; Determine if NTR HISTORY (#28.11) filer is called if question for "RTN","DGPTFM4",35,0) ; 'Treated for Head/Neck CA Condition:' is answered YES. "RTN","DGPTFM4",36,0) ; Only a NTR screening status of 3=PENDING DIAGNOSIS gets Filed. "RTN","DGPTFM4",37,0) I $P($G(M3),U,30)="Y",$P($G(DGNTARR("STAT")),U)=3 D "RTN","DGPTFM4",38,0) .S DGNTARR=$$FILEHNC^DGNTAPI1(DFN) "RTN","DGPTFM4",39,0) K DGNTARR "RTN","DGPTFM4",40,0) ;- update MT indicator after edit movement "RTN","DGPTFM4",41,0) N DGPMCA,DGPMAN D PM^DGPTUTL "RTN","DGPTFM4",42,0) I '$G(DGADM) S DGADM=+^DGPT(PTF,0) "RTN","DGPTFM4",43,0) D MT^DGPTUTL "RTN","DGPTFM4",44,0) G EN "RTN","DGPTFM4",45,0) PR W !,"Enter '^' to stop the display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen ''",!," to continue on to the next screen or 1-2 to edit:" "RTN","DGPTFM4",46,0) W !?10,"1-",$S(DGPTFE:"Date of movement, Losing Specialty, ",1:""),"Leave and Pass days",!?10,"2-ICD DIAGNOSIS CODES" "RTN","DGPTFM4",47,0) W !,"You may also enter 1-2",! "RTN","DGPTFM4",48,0) R !!,"Enter : ",X:DTIME G WR "RTN","DGPTFM4",49,0) Q "RTN","DGPTFM4",50,0) NEXM S DGZM0=DGZM0+1 G ^DGPTFM:'$D(M(DGZM0)),EN "RTN","DGPTFM4",51,0) ADD S DGZM0=$S($D(DGZM0):DGZM0+1,1:0) S L=$S($D(^DGPT(PTF,"M",0)):^(0),1:"^45.02DA^^"),L1=$P(L,U,3) F I=1:1 Q:'$D(^DGPT(PTF,"M",L1+I)) "RTN","DGPTFM4",52,0) S DA(1)=PTF,DIC="^DGPT("_DA(1)_",""M"",",X=L1+I,DIC(0)="LMZQE" D ^DIC K DIC,DIE G ^DGPTFM:Y'>0 "RTN","DGPTFM4",53,0) S M(DGZM0)=L1+I S X="1-2" G X1 "RTN","DGPTFM4",54,0) Q "RTN","DGPTFM4",55,0) MOB S I=0 K M,M1,M2 S M2=0 F I1=1:1 S I=$O(^DGPT(PTF,"M",I)) Q:'I S M(I1)=^(I,0) "RTN","DGPTFM4",56,0) S PM=I1-1 D ORDER^DGPTF Q "RTN","DGPTFM4",57,0) Q G Q^DGPTF "RTN","DGPTFM4",58,0) Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO "RTN","DGPTFM4",59,0) E W " " "RTN","DGPTFM4",60,0) Q "RTN","DGPTFM4",61,0) Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" " "RTN","DGPTFM4",62,0) W Z "RTN","DGPTFM4",63,0) Q "RTN","DGPTFM4",64,0) R ;DELETE PROCEDURE RECORD "RTN","DGPTFM4",65,0) I '$D(^DGPT(PTF,"P")) G NOPROC "RTN","DGPTFM4",66,0) I $O(^DGPT(PTF,"P",0))']"" G NOPROC "RTN","DGPTFM4",67,0) S DGPNUM="" F DGPROC=0:0 S DGPROC=$O(P(DGPROC)) Q:'DGPROC S:$D(P(DGPROC,1)) DGPNUM=DGPNUM_","_DGPROC "RTN","DGPTFM4",68,0) S DGPNUM=DGPNUM_"," "RTN","DGPTFM4",69,0) ASKPRO W !!,"Delete procedure record <",$P(DGPNUM,",",2,99),"> : " R DGPROC:DTIME I DGPROC[U!(DGPROC="") K DGPNUM,DGPROC G ^DGPTFM "RTN","DGPTFM4",70,0) I DGPNUM'[(","_DGPROC_",") W !!,"Enter the record # to delete from the PTF file <",$P(DGPNUM,",",2,99),">",! G ASKPRO "RTN","DGPTFM4",71,0) K DA N DGJ "RTN","DGPTFM4",72,0) F DGJ=1:1 S DA=+$P(DGPROC,",",DGJ) Q:'DA S DA=$S($D(P(DA,1)):+P(DA,1),1:0) I DA S DA(1)=PTF,DIK="^DGPT("_PTF_",""P""," D ^DIK K DA W " ",$P(DGPROC,",",DGJ),"-DELETED***" H:'$P(DGPROC,",",DGJ+1) 2 "RTN","DGPTFM4",73,0) K DIK,DA,DGPROC,DGPNUM G ^DGPTFM "RTN","DGPTFM4",74,0) NOPROC W !!,*7,"No procedures to delete",! H 3 G ^DGPTFM "RTN","DGPTR0") 0^8^B23146369 "RTN","DGPTR0",1,0) DGPTR0 ;MJK/JS/ADL - PTF TRANSMISSION ; 10/1/03 6:44pm "RTN","DGPTR0",2,0) ;;5.3;Registration;**114,247,338,342,510,524,565**;Aug 13, 1993 "RTN","DGPTR0",3,0) ;;ADL;Update for CSV Project;;Mar 27, 2003 "RTN","DGPTR0",4,0) ; -- setup control data "RTN","DGPTR0",5,0) ; ssn "RTN","DGPTR0",6,0) S X=$P(DG10,U,9),Y=$S($E(X,10)="P":"P",1:" ")_$E(X_" ",1,9) "RTN","DGPTR0",7,0) ; -- adm d/t "RTN","DGPTR0",8,0) S X=$P($P(DG0,U,2),"."),Y=Y_$E(X,4,5)_$E(X,6,7)_$E(X,2,3)_$E($P($P(DG0,U,2),".",2)_"0000",1,4) "RTN","DGPTR0",9,0) ; -- facility # "RTN","DGPTR0",10,0) S L=3,X=DG0,Z=3 D ENTER S Y=Y_$E($P(X,U,5)_" ",1,3) "RTN","DGPTR0",11,0) S DGHEAD=Y,Y=" "_Y D HEAD^DGPTR1 "RTN","DGPTR0",12,0) ; "RTN","DGPTR0",13,0) 101 ; -- setup 101 transation "RTN","DGPTR0",14,0) ; control data and name "RTN","DGPTR0",15,0) ;S Y=$S(T1:"C",1:"N")_"101"_DGHEAD,DGNAM=$P(DG10,U,1) D DGNAM S Y=Y_$E($P(DGNAM,",",1)_" ",1,12)_$J($E($P(DGNAM,",",2),1),1)_$J($E($P($P(DGNAM,",",2)," ",2),1),1) "RTN","DGPTR0",16,0) S Y=$S(T1:"C",1:"N")_"101"_DGHEAD S Y=Y_$$PTFNMFT($P(DG10,U)) "RTN","DGPTR0",17,0) ; source of admission "RTN","DGPTR0",18,0) S Y=Y_$S($D(^DIC(45.1,+DG101,0)):$J($P(^(0),U,1),2),1:" ") "RTN","DGPTR0",19,0) ; xfring fac and suffix "RTN","DGPTR0",20,0) S L=3,X=DG101,Z=5 D ENTER S Y=Y_$E($P(X,U,6)_" ",1,3) "RTN","DGPTR0",21,0) ; source of payment "RTN","DGPTR0",22,0) S Y=Y_$S("A0"[$P(DG0,U,5):" ",1:$J($P(DG101,U,3),1)) "RTN","DGPTR0",23,0) ;POW Location "RTN","DGPTR0",24,0) S Y=Y_$S($P(DG52,U,5)="N":1,$P(DG52,U,5)'="Y":3,$P(DG52,U,6)>0&($P(DG52,U,6)<7):3+$P(DG52,U,6),$P(DG52,U,6)>6&($P(DG52,U,6)<9):$C($P(DG52,U,6)+58),1:" ") "RTN","DGPTR0",25,0) ;marital status, sex "RTN","DGPTR0",26,0) S Y=Y_$S($D(^DIC(11,+$P(DG10,U,5),0)):$E(^(0),1),1:" ")_$J($P(DG10,U,2),1) "RTN","DGPTR0",27,0) ; date of birth "RTN","DGPTR0",28,0) S DGDOB=$P(DG10,U,3)\1,Y=Y_$E(DGDOB,4,5)_$E(DGDOB,6,7)_(1700+$E(DGDOB,1,3)) "RTN","DGPTR0",29,0) ; period of service "RTN","DGPTR0",30,0) S DGPOS=$S($D(^DIC(21,+$P(DG32,U,3),0)):$P(^(0),U,3),1:"") "RTN","DGPTR0",31,0) I $D(^DGPM(+$O(^DGPM("APTF",J,0)),"ODS")),+^("ODS") S DGPOS=6 "RTN","DGPTR0",32,0) ;-- if non vet admitting eligibility make POS 9 "RTN","DGPTR0",33,0) S DGPOS=$$CKPOS^DGPTUTL($P($G(^DGPT(PTF,101)),U,8),DGPOS) "RTN","DGPTR0",34,0) S X=DGPOS,Z=1,L=2 D ENTER "RTN","DGPTR0",35,0) ; agent orange "RTN","DGPTR0",36,0) S G=" " S DGAO=$P(DG321,U,2) S:DGPOS=7 G=$S($P(DG321,U)'="Y":1,DGAO="N":2,DGAO="Y":3,1:4) S:(DGAO="Y")&($P(DG321,U,13)="K") G=5 "RTN","DGPTR0",37,0) ; rad exposure "RTN","DGPTR0",38,0) S E=" " I "^0^2^4^5^7^8^Z^"[(U_DGPOS_U) S DGNT=$P(DG321,U,12),E=$S($P(DG321,U,3)'="Y":1,DGNT="N":2,DGNT="T":3,DGNT="B":4,1:" ") "RTN","DGPTR0",39,0) S Y=Y_G_E K DGPOS,G,E "RTN","DGPTR0",40,0) ; state code "RTN","DGPTR0",41,0) S X=$S($D(^DIC(5,+$P(DG11,U,5),0)):^(0),1:""),L=2,Z=3 D ENTER0 "RTN","DGPTR0",42,0) ; county code "RTN","DGPTR0",43,0) S X=$S($D(^DIC(5,+$P(DG11,U,5),1,+$P(DG11,U,7),0)):^(0),1:""),L=3,Z=3 D ENTER0 "RTN","DGPTR0",44,0) ; zip code "RTN","DGPTR0",45,0) S X=DG11,Z=6,L=5 D ENTER "RTN","DGPTR0",46,0) ; means test "RTN","DGPTR0",47,0) S Y=Y_$S($P(DG70,U,26)="Y":"AS",1:$E($P(DG0,U,10)_" ",1,2)) "RTN","DGPTR0",48,0) ; income "RTN","DGPTR0",49,0) I $L($P(DG101,U,7))>6 S Y=Y_"999999" "RTN","DGPTR0",50,0) E S X=DG101,Z=7,L=6 D ENTER0 "RTN","DGPTR0",51,0) ;MST "RTN","DGPTR0",52,0) S X=$$GETSTAT^DGMSTAPI(+DG0) S Y=Y_$S(X<0:"U",1:$P(X,"^",2)) "RTN","DGPTR0",53,0) ;Combat Vet "RTN","DGPTR0",54,0) S X=$$CVEDT^DGCV(+DG0,$P(DG0,"^",2)) S Y=Y_$S((+X)>0:1,1:0) "RTN","DGPTR0",55,0) S X=$P(X,"^",2)_" " S Y=Y_$E(X,4,5)_$E(X,6,7)_$E(X,2,3) "RTN","DGPTR0",56,0) D FILL^DGPTR2,SAVE "RTN","DGPTR0",57,0) I T1 S Y=$E(Y,1,52)_" "_$E(Y,54,125) "RTN","DGPTR0",58,0) ; "RTN","DGPTR0",59,0) P401 ; -- setup 401P transaction "RTN","DGPTR0",60,0) G 401:'$D(^DGPT(J,"401P"))!(T1) S DG41=^("401P"),Y=$S(T1:"C",1:"N")_"401"_DGHEAD_"P"_" " "RTN","DGPTR0",61,0) S DG41=$S($D(^DGPT(J,"401P")):^("401P"),1:"") "RTN","DGPTR0",62,0) S L=1 F K=1:1:5 S:'$P(DG41,U,K) DG41=$P(DG41,U,1,K-1)_U_$P(DG41,U,K+1,99),K=K-1 S L=L+1 Q:L=5 "RTN","DGPTR0",63,0) F I=1:1:5 S DGPTTMP=$$ICDOP^ICDCODE(+$P(DG41,U,I),$$GETDATE^ICDGTDRG(J)),Y=Y_$S(+DGPTTMP>0:$J($P($P(DGPTTMP,U,2),".",1),2)_$E($P($P(DGPTTMP,U,2),".",2)_" ",1,3),1:" ")_" " "RTN","DGPTR0",64,0) I $E(Y,40)'=" " D FILL^DGPTR2,SAVE "RTN","DGPTR0",65,0) ; "RTN","DGPTR0",66,0) 401 ; -- setup 401 transactions "RTN","DGPTR0",67,0) G 501:'$D(^DGPT(J,"S")) K ^UTILITY($J,"S") S I=0 "RTN","DGPTR0",68,0) SUR S I=$O(^DGPT(J,"S",I)) G 501:'I S DGSUR=^(I,0),DGAUX=$S($D(^DGPT(J,"S",I,300)):^(300),1:"") G SUR:'DGSUR "RTN","DGPTR0",69,0) G SUR:DGSURT2) S DGSUD=+^(0)\1,^UTILITY($J,"S",DGSUD)=$S($D(^UTILITY($J,"S",DGSUD)):^(DGSUD),1:0)+1,F=$S(DGSUD<2871000:0,1:1) "RTN","DGPTR0",70,0) I ^UTILITY($J,"S",DGSUD)>$S(F:3,1:2) D I Y'=1 S DGERR=1 Q "RTN","DGPTR0",71,0) .W !,"**There are more than ",$S(F:"three",1:"two")," surgeries on the same date**" "RTN","DGPTR0",72,0) .S DIR(0)="Y",DIR("B")="YES",DIR("A")="OK to continue?" D ^DIR K DIR "RTN","DGPTR0",73,0) S Y=$S(T1:"C",1:"N")_"40"_^(DGSUD)_DGHEAD_$E(DGSUD,4,5)_$E(DGSUD,6,7)_$E(DGSUD,2,3)_$E($P(+DGSUR,".",2)_"0000",1,4)_$S($D(^DIC(45.3,+$P(DGSUR,U,3),0)):$P(^(0),U,1),1:" ") "RTN","DGPTR0",74,0) S L=1,X=DGSUR F Z=4:1:7 D ENTER "RTN","DGPTR0",75,0) S L=1 F K=8:1:12 S:'$P(DGSUR,U,K) DGSUR=$P(DGSUR,U,1,K-1)_U_$P(DGSUR,U,K+1,99),K=K-1 S L=L+1 Q:L=5 "RTN","DGPTR0",76,0) F K=8:1:12 S DGPTTMP=$$ICDOP^ICDCODE(+$P(DGSUR,U,K),$$GETDATE^ICDGTDRG(J)),Y=Y_$S(+DGPTTMP>0:$J($P($P(DGPTTMP,U,2),".",1),2)_$E($P($P(DGPTTMP,U,2),".",2)_" ",1,3),1:" ")_" " "RTN","DGPTR0",77,0) ;-- att phy "RTN","DGPTR0",78,0) S Y=Y_" " "RTN","DGPTR0",79,0) ;-- additional ptf question "RTN","DGPTR0",80,0) S Y=Y_$E($P(DGAUX,U)_" ") "RTN","DGPTR0",81,0) K DGAUX "RTN","DGPTR0",82,0) D FILL^DGPTR2,SAVE G SUR "RTN","DGPTR0",83,0) 501 G 501^DGPTR2 "RTN","DGPTR0",84,0) Q "RTN","DGPTR0",85,0) ENTER S Y=Y_$J($P(X,U,Z),L) "RTN","DGPTR0",86,0) Q "RTN","DGPTR0",87,0) ENTER0 S Y=Y_$S($P(X,U,Z)]"":$E("000000",$L($P(X,U,Z))+1,L)_$P(X,U,Z),1:$J($P(X,U,Z),L)) "RTN","DGPTR0",88,0) Q "RTN","DGPTR0",89,0) SAVE D START^DGPTR1 S:'DGERR ^XMB(3.9,DGXMZ,2,DGCNT,0)=Y,DGCNT=DGCNT+1 "RTN","DGPTR0",90,0) I DGERR'>0 S DGACNT=DGACNT+1,^TMP("AEDIT",$J,$E(Y,1,4),DGACNT)=Y "RTN","DGPTR0",91,0) Q Q "RTN","DGPTR0",92,0) DGNAM S X=DGNAM I X?.E.P F I=1:1:$L(X) S Z=$E(X,I) Q:Z="," S:Z?.P&(Z]"") X=$E(X,1,I-1)_$E(X,I+1,$L(X)),I=I-1 Q:X'?.E.P "RTN","DGPTR0",93,0) I X?.E.L D UP^DGHELP "RTN","DGPTR0",94,0) S DGNAM=X "RTN","DGPTR0",95,0) Q "RTN","DGPTR0",96,0) ; "RTN","DGPTR0",97,0) PTFNMFT(DG10) ;this function will format the name of the patient for "RTN","DGPTR0",98,0) ; transmission of the 101 record to Austin. In addition, this "RTN","DGPTR0",99,0) ; function will be used by OPC so that the format will be consistent "RTN","DGPTR0",100,0) ; for OPC and PTF. "RTN","DGPTR0",101,0) ; INPUT : DG10 - .01 field from the patient record. "RTN","DGPTR0",102,0) ; OUTPUT: name in the format proper format. "RTN","DGPTR0",103,0) ; A = <12 - characters of last name padded with blanks> "RTN","DGPTR0",104,0) ; B = <1 - first initial of fist name> "RTN","DGPTR0",105,0) ; C = <1 - first initial of middle name> "RTN","DGPTR0",106,0) ; returns :ABC <14 - characters> "RTN","DGPTR0",107,0) N X,I "RTN","DGPTR0",108,0) S DGNAM=DG10 D DGNAM "RTN","DGPTR0",109,0) Q $E($P(DGNAM,",",1)_" ",1,12)_$J($E($P(DGNAM,",",2),1),1)_$J($E($P($P(DGNAM,",",2)," ",2),1),1) "RTN","DGPTR0",110,0) ; "RTN","DGPTR1") 0^9^B25147013 "RTN","DGPTR1",1,0) DGPTR1 ;ALB/MTC - PTF VERIFICATION ; 01 MAR 91 @0800 "RTN","DGPTR1",2,0) ;;5.3;Registration;**58,247,338,342,423,415,565**;Aug 13, 1993 "RTN","DGPTR1",3,0) START S T=$E(Y,2,3),T=$S(T=40&($E(Y,28)="P"):"P40",1:T),ERR=$P($T(@("T"_T)),";;",2,999),W=$P($T(@(T)),";;",2,999),F=31 D L "RTN","DGPTR1",4,0) I T=70 S ERR=$P($T(T701),";;",2,999),W=$P($T(701),";;",2,999),F=72 D L "RTN","DGPTR1",5,0) D @("D"_T) Q "RTN","DGPTR1",6,0) K DGFILL "RTN","DGPTR1",7,0) Q "RTN","DGPTR1",8,0) ; "RTN","DGPTR1",9,0) L F H=1:1 S DGO=$P(W,U,H) Q:'DGO F Z=1:1:$P(DGO,";",3) S DGL=$P(DGLOGIC,U,+DGO),X=$E(Y,F) D @("ERR:"_DGL) S F=F+1 "RTN","DGPTR1",10,0) Q "RTN","DGPTR1",11,0) ; "RTN","DGPTR1",12,0) T10 ;;1:NAME^2:SOURCE OF ADM^3:TRANS FAC.^4:SOURCE OF PAY^5:POW^6:MARITAL ST^7:SEX^8:DOB^9:POS^10:VIETNAM^11:ION RADIATION^12:RESIDENCE^13:MEANS TEST^14:INCOME^15:MST^16:COMBAT VET^17:CV END DT "RTN","DGPTR1",13,0) ; "RTN","DGPTR1",14,0) T70 ;;1:DT OF DISP.^2:DISCH BD SEC^3:TYPE OF DIS^4:OUT TREAT^5:VA AUS^6:PL OF DIS^7:REC FAC^8:ASIH DAYS^9:NOT USED^10:C&P STAT^11:DXLS^12:ONLY DX^13:PHY CDR "RTN","DGPTR1",15,0) ;T701 is part 2 of T70 "RTN","DGPTR1",16,0) T701 ;;1:PHY SPEC^2:%SC^3:LEGION^4:SUICIDE^5:DRUG^6:AXIS-IV^7:AXIS-V^8:SC^9:EXP^10:MST^11:HNC^12:ETHNICITY^13:RACE^14:COMBAT VET "RTN","DGPTR1",17,0) ; "RTN","DGPTR1",18,0) T50 ;;1:DT OF MVMT^2:LOSING BD SEC CDR^3:LOSING BD SEC^4:LEAVE DAYS^5:PASS DAYS^6:SCI^7:DIAG^8:DOCTOR'S SSN^9:PHY CDR^10:PHY SPEC^11:DISCHARGE STAT^^^^^16:LEGION^17:SUICIDE^18:DRUG^19:AXIS-IV^20:AXIS-V^21:SC^22:EXP^23:MST^24:HNC "RTN","DGPTR1",19,0) ; "RTN","DGPTR1",20,0) T53 ;;1:DATE OF PHYSICAL MOVEMENT^2:LOSING PHYSICAL CDR^3:LOSING PHYSICAL SPECIALTY^4:TR SPECIALTY CDR^5:TR SPECIALTY^6:LEAVE DAYS^7:PASS DAYS^8:DOCTOR'S SSN (NOT USED) "RTN","DGPTR1",21,0) ; "RTN","DGPTR1",22,0) T40 ;;1:DATE OF SURGERY^2:SURG SPEC.^3:CAT CHIEF SURGEON^4:CAT FIRST ASS^5:ANEST. TECH.^6:SOURCE OF PAY^7:OP CODE^8:DOCTOR'S SSN (NOT USED)^^^^^13:TRANSPLANT STATUS "RTN","DGPTR1",23,0) ; "RTN","DGPTR1",24,0) TP40 ;;1:OP CODE "RTN","DGPTR1",25,0) ; "RTN","DGPTR1",26,0) T60 ;;1:DATE OF PROCEDURE^2:LOSING BD SEC^3:DIALYSIS TYPE^4:NUMBER OF TREATMENTS^5:PROCEDURE CODE "RTN","DGPTR1",27,0) ; "RTN","DGPTR1",28,0) LOGIC ;;X'?.N^X'?.A^X'=" "^X'?.N&(X'=" ")^X'?.A&(X'=" ")^0^X'?.N&(X'="X")^X'=" "&(X'="P")^X="E"^X="Y"^X=" "^X'="A"&(X'=" ")^(X'?.A)&(X'?.N)&(X'=" ")^(X'?.N)&('$P(DG0,U,4))^((T1)&(X'=" "))!(('T1)&(X'?.N)&('$P(DG0,U,4))) "RTN","DGPTR1",29,0) ; "RTN","DGPTR1",30,0) ; edit check# ; edit field ; # x check preformed ; display error name # "RTN","DGPTR1",31,0) 10 ;;6;;12;1^2;1;1;1^5;1;1;1^1;2;1;2^2;2;1;2^4;3;3;3^6;;3;3^4;4;1;4^6;5;1;5^2;6;1;6^2;7;1;7^1;8;8;8^6;;1;9^11;9;1;9^4;10;1;10^4;10;1;11^1;11;5;12^7;11;5;12^2;12;1;13^6;;1;13^1;;6;14^2;;1;15^1;;1;16^4;;6;17^3;;31 "RTN","DGPTR1",32,0) ; "RTN","DGPTR1",33,0) 70 ;;1;1;10;1^1;2;2;2^1;3;1;3^4;4;1;4^4;5;1;5^6;;1;6^4;7;3;7^6;;3;7^4;8;3;8^6;9;1;9^1;10;1;10^9;11;1;11^11;11;2;11^6;;3;11^10;11;1;11^6;;1;12^15;;6;13 "RTN","DGPTR1",34,0) ;701 is part 2 of 70 "RTN","DGPTR1",35,0) 701 ;;15;;2;1^1;;3;2^4;;1;3^4;;1;4^12;;1;5^4;;3;5^4;;1;6^4;;4;7^4;;1;8^5;;3;9^5;;1;10^5;;1;11^13;12;2;12^13;13;12;13^5;;1;14^3;;17 "RTN","DGPTR1",36,0) ; "RTN","DGPTR1",37,0) 50 ;;1;1;10;1^1;;6;2^1;3;2;3^1;4;3;4^1;5;3;5^6;;1;6^11;7;3;7^6;;32;7^6;;9;8^14;;6;9^14;;2;10^6;;1;11^4;;1;16^4;;1;17^12;;1;18^4;;3;18^4;;1;19^4;;4;20^4;;1;21^5;;3;22^5;;1;23^5;;1;24 "RTN","DGPTR1",38,0) ; "RTN","DGPTR1",39,0) 53 ;;1;;10;1^1;;6;2^1;;2;3^1;;6;4^1;;2;5^1;;3;6^1;;3;7^3;;9;8^3;;54; "RTN","DGPTR1",40,0) ; "RTN","DGPTR1",41,0) 40 ;;1;1;10;1^1;2;2;2^11;3;1;3^4;4;1;4^6;5;1;5^4;6;1;6^11;7;2;7^6;;3;7^3;7;2;7^6;;5;7^3;7;2;7^6;;5;7^3;7;2;7^6;;5;7^3;7;2;7^6;;5;7^3;7;2;7^3;;9;8^4;;1;13^3;;34; "RTN","DGPTR1",42,0) ; "RTN","DGPTR1",43,0) P40 ;;8;;1;^3;;11;^11;1;2;1^6;;3;1^3;1;2;1^6;;5;1^3;;2;1^6;;5;1^3;;2;1^6;;5;1^3;;2;1^6;;5;1^3;;2;1^3;;48 "RTN","DGPTR1",44,0) ; "RTN","DGPTR1",45,0) 60 ;;1;1;10;1^1;2;2;2^4;3;1;3^4;4;3;4^11;5;3;5^6;;32;5^3;;44 "RTN","DGPTR1",46,0) ; "RTN","DGPTR1",47,0) ERR S DGERR=1 "RTN","DGPTR1",48,0) W !,T,$S(T["H":" ",1:$E(Y,4))," " "RTN","DGPTR1",49,0) W:"45"[$E(T,1) $E(Y,31,32),"-",$E(Y,33,34),"-",$E(Y,35,36),"@",$E(Y,37,40) "RTN","DGPTR1",50,0) W ?25,$P($P(ERR,U,$P(DGO,";",4)),":",2),?40,"COL.",F," VALUE: ",$S($E(Y,F)=" ":"BLANK",1:$E(Y,F)) "RTN","DGPTR1",51,0) S I=$S('$D(I):1,I>0:I,1:1),^(I)=$S($D(^UTILITY("DG",$J,T_$S(T["H":"",1:$E(Y,4)),I)):^(I),1:U) I $P(DGO,";",2),^(I)'[(U_$P(DGO,";",2)_U) S ^(I)=^(I)_$P(DGO,";",2)_U "RTN","DGPTR1",52,0) Q "RTN","DGPTR1",53,0) ; "RTN","DGPTR1",54,0) D10 I $E(Y,66)="Z" S (F,H)=68,W="11;10;1;10" D L "RTN","DGPTR1",55,0) I $P(^DGPT(J,0),"^",4),$P(^(0),"^",10)="U",$D(^DGPT(J,70)),+^(70)>2890700 S F=79,DGO="2;12;1;12" D ERR "RTN","DGPTR1",56,0) Q "RTN","DGPTR1",57,0) ; "RTN","DGPTR1",58,0) D40 Q "RTN","DGPTR1",59,0) DP40 Q "RTN","DGPTR1",60,0) D70 I "467"'[$E(Y,43) S F=44,W="4;4;1;4^1;5;1;5^11;6;1;6" D L "RTN","DGPTR1",61,0) Q "RTN","DGPTR1",62,0) D50 I "A0"[$P(DG0,U,5)!("A4"[$P(DG0,U,5))!('$D(^DGPT(J,70))) S W="11;6;1;6",F=55 D L "RTN","DGPTR1",63,0) I $D(^DGPT(J,70)),$S(T1:1,1:+^(70)>2871000) S W="11;6;1;6",F=55 D L "RTN","DGPTR1",64,0) I $E(Y,4)=1 S W="9;7;1;7",F=56 D L "RTN","DGPTR1",65,0) I I=1,'T1 S W="1;11;1;11",F=108 D L "RTN","DGPTR1",66,0) Q "RTN","DGPTR1",67,0) D53 Q "RTN","DGPTR1",68,0) D60 I $E(Y,43) S F=44,W="1;4;3;4" D L "RTN","DGPTR1",69,0) Q "RTN","DGPTR1",70,0) HEAD S ERR="1:SSN^2:ADMISSION DATE^3:FACILITY #",W="8;1;1;1^1;1;9;1^1;2;10;2^1;3;3;3^6;;3;3",F=5,DGLOGIC=$P($T(LOGIC),";;",2),T="HEADER" "RTN","DGPTR1",71,0) D L "RTN","DGPTR1",72,0) Q "RTN","DGPTR1",73,0) LOG S DGLOGIC=$P($T(LOGIC),";;",2) "RTN","DGPTR1",74,0) Q "RTN","DGPTR1",75,0) CEN S T=70,ERR=$P($T(T70),";;",2),W=$P($T(70),";;",2,999),W="13;9;1;9"_$P(W,"13;9;1;9",2,999),F=56 D L "RTN","DGPTR1",76,0) S ERR=$P($T(T701),";;",2),W=$P($T(701),";;",2,999),F=72 D L "RTN","DGPTR1",77,0) Q "RTN","DGPTR4") 0^12^B16250205 "RTN","DGPTR4",1,0) DGPTR4 ;ALB/JDS/MJK/MTC/ADL - ALB/BOK PTF TRANSMISSION ; 01 DEC 87 @0800 "RTN","DGPTR4",2,0) ;;5.3;Registration;**338,423,415,510,565**;Aug 13, 1993 "RTN","DGPTR4",3,0) 701 ; -- setup 701 transaction "RTN","DGPTR4",4,0) S Y=$S(T1:"C",1:"N")_"701"_DGHEAD,DGDDX=$P(+DG70,".")_" ",Y=Y_$E(DGDDX,4,5)_$E(DGDDX,6,7)_$E(DGDDX,2,3)_$E($P(+DG70,".",2)_"0000",1,4) "RTN","DGPTR4",5,0) S X=DG70,(L,Z)=2 D ENTER0 K DGDDX "RTN","DGPTR4",6,0) S X=DG70 I "467"[($P(X,U,3)\1) S Y=Y_$P(X,U,3)_" " G J "RTN","DGPTR4",7,0) S L=1 F Z=3:1:5 D ENTER "RTN","DGPTR4",8,0) S Y=Y_$S($D(^DIC(45.6,+$P(X,U,6),0)):$P(^(0),U,2),1:" "),L=3,Z=12 D ENTER S Y=Y_$E($P(X,U,13)_" ",1,3) "RTN","DGPTR4",9,0) J S L=3,Z=8 D ENTER0 "RTN","DGPTR4",10,0) S Y=Y_"X"_$J($P(DG70,U,9),1) "RTN","DGPTR4",11,0) S DGPTDAT=$$GETDATE^ICDGTDRG(J) "RTN","DGPTR4",12,0) S DGPTTMP=$$ICDDX^ICDCODE(+$P(DG70,U,10),DGPTDAT) S DGXLS=$S(+DGPTTMP>0&($P(DGPTTMP,U,10)):$P(DGPTTMP,U,2),1:""),Y=Y_$S(DGXLS[".":$J($P(DGXLS,".",1),3)_$E($P(DGXLS,".",2)_" ",1,3),1:$J(DGXLS,6))_" " "RTN","DGPTR4",13,0) S L=$P(DG70,U,16,24) S DG702="" F K=1:1:9 S DGPTTMP=$$ICDDX^ICDCODE(+$P(L,U,K),DGPTDAT) I +DGPTTMP>0&($P(DGPTTMP,U,10)) S DG702=DG702_$P(DGPTTMP,U,2)_U "RTN","DGPTR4",14,0) S Y=Y_$S(DG702']"":"X",1:" ") "RTN","DGPTR4",15,0) ; -- get phy cdr @ d/c "RTN","DGPTR4",16,0) S X="",Z=+$O(^DGPT(J,535,"AM",DG70-.0000001)) I $D(^DGPT(J,535,+$O(^(Z,0)),0)) S X=^(0) "RTN","DGPTR4",17,0) ; -- set phy cdr "RTN","DGPTR4",18,0) S Z=$P(X,U,16) D CDR "RTN","DGPTR4",19,0) ; -- set phy spec "RTN","DGPTR4",20,0) S L=2,Z=2 D ENTER0 "RTN","DGPTR4",21,0) S X=$S($P(DG3,U)="Y":$$RTEN($P(DG3,U,2)),1:"0"),L=3,Z=1 D ENTER0 "RTN","DGPTR4",22,0) ;-- additional ptf questions "RTN","DGPTR4",23,0) S DGAUX=$S($D(^DGPT(J,300)):^(300),1:"") "RTN","DGPTR4",24,0) D ADDQUES "RTN","DGPTR4",25,0) K DGAUX,DGDRUG "RTN","DGPTR4",26,0) ;-- sc,ao,ir,ec questions "RTN","DGPTR4",27,0) S X=DG70 "RTN","DGPTR4",28,0) ;-- sc "RTN","DGPTR4",29,0) S Y=Y_$E($P(DG70,U,25)_" ") "RTN","DGPTR4",30,0) ;-- ao "RTN","DGPTR4",31,0) S Y=Y_$E($P(DG70,U,26)_" ") "RTN","DGPTR4",32,0) ;-- ir "RTN","DGPTR4",33,0) S Y=Y_$E($P(DG70,U,27)_" ") "RTN","DGPTR4",34,0) ;-- ec "RTN","DGPTR4",35,0) S Y=Y_$E($P(DG70,U,28)_" ") "RTN","DGPTR4",36,0) ;-- mst "RTN","DGPTR4",37,0) S Y=Y_$E($P(DG70,U,29)_" ") "RTN","DGPTR4",38,0) ;-- Head/Neck CA "RTN","DGPTR4",39,0) S Y=Y_$E($P(DG70,U,30)_" ") "RTN","DGPTR4",40,0) D ETHNIC "RTN","DGPTR4",41,0) D RACE "RTN","DGPTR4",42,0) ;Combat vet "RTN","DGPTR4",43,0) S Y=Y_$E($P(DG70,U,31)_" ") "RTN","DGPTR4",44,0) D FILL "RTN","DGPTR4",45,0) I T1 F K=41:1:55,65:1:73 S Y=$E(Y,1,K-1)_" "_$E(Y,K+1,125) "RTN","DGPTR4",46,0) I T1 D CEN^DGPTR1 S:'DGERR ^XMB(3.9,DGXMZ,2,DGCNT,0)=Y,DGCNT=DGCNT+1 Q "RTN","DGPTR4",47,0) I 'T1 D SAVE "RTN","DGPTR4",48,0) 702 ; "RTN","DGPTR4",49,0) Q:DG702']"" "RTN","DGPTR4",50,0) S Y="N702"_$E(Y,5,40) "RTN","DGPTR4",51,0) F K=1:1:9 S F=$P(DG702,U,K),F=$P(F,".",1)_$E($P(F,".",2)_" ",1,3),F=F_$E(" ",1,7-$L(F)),Y=Y_F "RTN","DGPTR4",52,0) D FILL "RTN","DGPTR4",53,0) I 'DGERR S ^XMB(3.9,DGXMZ,2,DGCNT,0)=Y,DGCNT=DGCNT+1 "RTN","DGPTR4",54,0) I DGERR'>0 S DGACNT=DGACNT+1,^TMP("AEDIT",$J,$E(Y,1,4),DGACNT)=Y "RTN","DGPTR4",55,0) S DG702=$P(DG702,U,6,9) "RTN","DGPTR4",56,0) Q "RTN","DGPTR4",57,0) ; "RTN","DGPTR4",58,0) ENTER S Y=Y_$J($P(X,U,Z),L) "RTN","DGPTR4",59,0) Q "RTN","DGPTR4",60,0) ; "RTN","DGPTR4",61,0) ENTER0 S Y=Y_$S($P(X,U,Z)]"":$E("00000",$L($P(X,U,Z))+1,L)_$P(X,U,Z),1:$J($P(X,U,Z),L)) "RTN","DGPTR4",62,0) Q "RTN","DGPTR4",63,0) ; "RTN","DGPTR4",64,0) SAVE D START^DGPTR1 S:'DGERR ^XMB(3.9,DGXMZ,2,DGCNT,0)=Y,DGCNT=DGCNT+1 "RTN","DGPTR4",65,0) I DGERR'>0 S DGACNT=DGACNT+1,^TMP("AEDIT",$J,$E(Y,1,4),DGACNT)=Y "RTN","DGPTR4",66,0) Q Q "RTN","DGPTR4",67,0) ; "RTN","DGPTR4",68,0) FILL F K=$L(Y):1:124 S Y=Y_" " "RTN","DGPTR4",69,0) Q "RTN","DGPTR4",70,0) ; "RTN","DGPTR4",71,0) CDR S Y=Y_$E($P(Z,".")_"0000",1,4)_$E($P(Z,".",2)_"00",1,2) "RTN","DGPTR4",72,0) Q "RTN","DGPTR4",73,0) ADDQUES ;-- additional PTF questions load records for trans 501/701 "RTN","DGPTR4",74,0) S DGDRUG=$S($D(^DIC(45.61,+$P(DGAUX,U,4),0)):$P(^(0),U,2),1:" ") "RTN","DGPTR4",75,0) S Y=Y_$E($P(DGAUX,U,3)_" ")_$E($P(DGAUX,U,2)_" ")_$J($P(DGDRUG,U),4) "RTN","DGPTR4",76,0) S Y=Y_$E($P(DGAUX,U,5)_" ") "RTN","DGPTR4",77,0) S DGT=0,X=$P(DGAUX,U,6) I X]"" S DGT=1,Z=1,L=2 D ENTER0 "RTN","DGPTR4",78,0) I 'DGT S Y=Y_" " "RTN","DGPTR4",79,0) S DGT=0,X=$P(DGAUX,U,7) I X]"" S DGT=1,Z=1,L=2 D ENTER0 "RTN","DGPTR4",80,0) I 'DGT S Y=Y_" " "RTN","DGPTR4",81,0) Q "RTN","DGPTR4",82,0) RTEN(X) ; This function will round X to the nearest mulitple of ten. "RTN","DGPTR4",83,0) ; 0-4 ->DOWN; 5-9->UP "RTN","DGPTR4",84,0) Q (X\10)*10+$S(X#10>4:10,1:0) "RTN","DGPTR4",85,0) ETHNIC ;-- Ethnicity (use first active value) "RTN","DGPTR4",86,0) N NODE,NUM,ETHNIC,I,X "RTN","DGPTR4",87,0) S ETHNIC="" "RTN","DGPTR4",88,0) S I=0 "RTN","DGPTR4",89,0) S NUM=1 "RTN","DGPTR4",90,0) F S I=+$O(DG06(I)) Q:'I D Q:NUM>1 "RTN","DGPTR4",91,0) .S NODE=$G(DG06(I,0)) "RTN","DGPTR4",92,0) .Q:('NODE)!('$D(^DIC(10.2,+NODE,0))) "RTN","DGPTR4",93,0) .Q:$$INACTIVE^DGUTL4(+NODE) "RTN","DGPTR4",94,0) .S X=$$PTR2CODE^DGUTL4(+NODE,2,4) "RTN","DGPTR4",95,0) .S ETHNIC=$S(X="":" ",1:X) "RTN","DGPTR4",96,0) .S X=$$PTR2CODE^DGUTL4(+$P(NODE,"^",2),3,4) "RTN","DGPTR4",97,0) .S ETHNIC=ETHNIC_$S(X="":" ",1:X) "RTN","DGPTR4",98,0) .S NUM=NUM+1 "RTN","DGPTR4",99,0) S Y=Y_$S(ETHNIC="":" ",1:ETHNIC) "RTN","DGPTR4",100,0) Q "RTN","DGPTR4",101,0) RACE ;-- Race (use first 6 active values) "RTN","DGPTR4",102,0) N NODE,NUM,RACE,I,X "RTN","DGPTR4",103,0) S RACE="" "RTN","DGPTR4",104,0) S I=0 "RTN","DGPTR4",105,0) S NUM=1 "RTN","DGPTR4",106,0) F S I=+$O(DG02(I)) Q:'I D Q:NUM>6 "RTN","DGPTR4",107,0) .S NODE=$G(DG02(I,0)) "RTN","DGPTR4",108,0) .Q:('NODE)!('$D(^DIC(10,+NODE,0))) "RTN","DGPTR4",109,0) .Q:$$INACTIVE^DGUTL4(+NODE) "RTN","DGPTR4",110,0) .S X=$$PTR2CODE^DGUTL4(+NODE,1,4) "RTN","DGPTR4",111,0) .S RACE=RACE_$S(X="":" ",1:X) "RTN","DGPTR4",112,0) .S X=$$PTR2CODE^DGUTL4(+$P(NODE,"^",2),3,4) "RTN","DGPTR4",113,0) .S RACE=RACE_$S(X="":" ",1:X) "RTN","DGPTR4",114,0) .S NUM=NUM+1 "RTN","DGPTR4",115,0) S X="" S $P(X," ",12)="" "RTN","DGPTR4",116,0) S RACE=$S(RACE="":" ",1:RACE)_X "RTN","DGPTR4",117,0) S Y=Y_$E(RACE,1,12) "RTN","DGPTR4",118,0) Q "RTN","DGPTSPQ") 0^5^B8481189 "RTN","DGPTSPQ",1,0) DGPTSPQ ;ALB/MTC - PTF Utility Con; 3/5/93 ; 11/26/03 9:56am "RTN","DGPTSPQ",2,0) ;;5.3;Registration;**195,397,565**;Aug 13, 1993 "RTN","DGPTSPQ",3,0) ; "RTN","DGPTSPQ",4,0) CHQUES ;-- This function will determine if the patient has any of the "RTN","DGPTSPQ",5,0) ; following indicated : AO, IR, EC, MST, NTR "RTN","DGPTSPQ",6,0) ; If so the array DGEXQ will contain: "RTN","DGPTSPQ",7,0) ; DGEXQ(1)="" - AO "RTN","DGPTSPQ",8,0) ; DGEXQ(2)="" - IR "RTN","DGPTSPQ",9,0) ; DGEXQ(3)="" - EC "RTN","DGPTSPQ",10,0) ; DGEXQ(4)="" - MST ;added 6/17/98 for MST enhancement "RTN","DGPTSPQ",11,0) ; DGEXQ(5)="" - NTR ;treatment for Head/Neck CA "RTN","DGPTSPQ",12,0) ; ;ONLY if (#28.11) Nose Throat Radium entered "RTN","DGPTSPQ",13,0) ; DGEXQ(6)="" - CV ;treatment for possible combat related "RTN","DGPTSPQ",14,0) ; ;condition "RTN","DGPTSPQ",15,0) ; Otherwise they will be undefined. "RTN","DGPTSPQ",16,0) ; This routine is called from the PTF input templates. "RTN","DGPTSPQ",17,0) ; The following variables are defined: "RTN","DGPTSPQ",18,0) ; DGHOLD : Movemnent record before any changes been made. "RTN","DGPTSPQ",19,0) ; DGPTF : PTF Record Number. "RTN","DGPTSPQ",20,0) ; DGMOV : PTF Movement Number (optional) "RTN","DGPTSPQ",21,0) N DGHOLD,SDCLY "RTN","DGPTSPQ",22,0) S DGHOLD=^DGPT(DA(1),"M",DA,0),SDCLY="" "RTN","DGPTSPQ",23,0) ;-- call to determine if questions should be asked. OPC uses same "RTN","DGPTSPQ",24,0) ; criteria. "RTN","DGPTSPQ",25,0) D CL^SDCO21(DFN,$P(DGHOLD,U,10),"",.SDCLY) "RTN","DGPTSPQ",26,0) ; "RTN","DGPTSPQ",27,0) ;-- if sc > 50% and treated for sc don't ask AO/IR "RTN","DGPTSPQ",28,0) ;-- ADD KILL OF SDCLY(6) TO SKIP COMBAT VETERAN QUESTION "RTN","DGPTSPQ",29,0) I $P($G(^DGPT(DGPTF,"M",+$G(DGMOV),0)),U,18)=1 K SDCLY(1),SDCLY(2) "RTN","DGPTSPQ",30,0) ; "RTN","DGPTSPQ",31,0) G:'$D(SDCLY) CHQ "RTN","DGPTSPQ",32,0) ; AO "RTN","DGPTSPQ",33,0) I $D(SDCLY(1)) S DGEXQ(1)="" "RTN","DGPTSPQ",34,0) ; IR "RTN","DGPTSPQ",35,0) I $D(SDCLY(2)) S DGEXQ(2)="" "RTN","DGPTSPQ",36,0) ; EC "RTN","DGPTSPQ",37,0) I $D(SDCLY(4)) S DGEXQ(3)="" "RTN","DGPTSPQ",38,0) ; MST "RTN","DGPTSPQ",39,0) I $D(SDCLY(5)) S DGEXQ(4)="" ;added 6/17/98 for MST enhancement "RTN","DGPTSPQ",40,0) ; NTR "RTN","DGPTSPQ",41,0) I $D(SDCLY(6)) S DGEXQ(5)="" "RTN","DGPTSPQ",42,0) ; CV "RTN","DGPTSPQ",43,0) I $D(SDCLY(7)) S DGEXQ(6)="" "RTN","DGPTSPQ",44,0) CHQ Q "RTN","DGPTSPQ",45,0) ; "RTN","DGPTSPQ",46,0) 501 ;-- This is the input transform logic for the following questions: "RTN","DGPTSPQ",47,0) ; AO, IR, EC, MST, NTR "RTN","DGPTSPQ",48,0) ; Process: Make sure that the conditions are indicated before "RTN","DGPTSPQ",49,0) ; allowing data to be entered. If the indicators are "RTN","DGPTSPQ",50,0) ; not present and the question was answered, DGER "RTN","DGPTSPQ",51,0) ; will be set to 1. "RTN","DGPTSPQ",52,0) ; INPUT : DGFLAG - Field to check "RTN","DGPTSPQ",53,0) ; DGER - DGER error code "RTN","DGPTSPQ",54,0) N DGEXQ "RTN","DGPTSPQ",55,0) S DGER=0 "RTN","DGPTSPQ",56,0) D CHQUES "RTN","DGPTSPQ",57,0) I '$D(DGEXQ(+DGFLAG)) S DGER=1 "RTN","DGPTSPQ",58,0) Q "RTN","DGPTSPQ",59,0) ; "RTN","DGPTSPQ",60,0) 701 ;-- This is the input transform logic for the following questions "RTN","DGPTSPQ",61,0) ; for the <701> PTF record: AO, IR, EC, MST, NTR "RTN","DGPTSPQ",62,0) ; Process: Check if the desired indicator was answered on a <501>. "RTN","DGPTSPQ",63,0) ; changed 6/17/98 for MST enhancement "RTN","DGPTSPQ",64,0) ; INPUT DGFLAG - 1=AO, 2=IR, 3=EC, 4=MST, 5=NTR, 6=CV "RTN","DGPTSPQ",65,0) N I "RTN","DGPTSPQ",66,0) S DGER=1 "RTN","DGPTSPQ",67,0) ;-- loop thru <501>'s for indicator specified by DGFLAG "RTN","DGPTSPQ",68,0) S I=0 F S I=$O(^DGPT(DA,"M",I)) Q:'I I $P($G(^DGPT(DA,"M",I,0)),U,DGFLAG+25)'="" S DGER=0 Q "RTN","DGPTSPQ",69,0) Q "RTN","DGPTSPQ",70,0) ; "RTN","DGPTSPQ",71,0) UP701 ;-- This function will loop thru the <501> and determine if any "RTN","DGPTSPQ",72,0) ; of the SC, AO, IR, EC, MST, NTR, and CV questions have been "RTN","DGPTSPQ",73,0) ; answered. If so, the cooresponding <701> will be updated. "RTN","DGPTSPQ",74,0) ; An answer of "yes" will take presidence. "RTN","DGPTSPQ",75,0) ; "RTN","DGPTSPQ",76,0) ; INPUT : DGPTF "RTN","DGPTSPQ",77,0) ; changed 6/17/98 for MST emhancement "RTN","DGPTSPQ",78,0) N I,DGSC,DGAO,DGIR,DGEC,DGMOV,DGMST,DGNTR,DGCV "RTN","DGPTSPQ",79,0) S (DGSC,DGAO,DGIR,DGEC,DGMST,DGNTR,DGCV)="@" "RTN","DGPTSPQ",80,0) ;-- loop thru <501>s "RTN","DGPTSPQ",81,0) S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I S DGMOV=$G(^(I,0)) I DGMOV'="" D "RTN","DGPTSPQ",82,0) .;-- sc "RTN","DGPTSPQ",83,0) .I $P(DGMOV,U,18)'="",DGSC'=1 S DGSC=$P(DGMOV,U,18) "RTN","DGPTSPQ",84,0) .;-- ao "RTN","DGPTSPQ",85,0) .I $P(DGMOV,U,26)'="",DGAO'="Y" S DGAO=$P(DGMOV,U,26) "RTN","DGPTSPQ",86,0) .;-- ir "RTN","DGPTSPQ",87,0) .I $P(DGMOV,U,27)'="",DGIR'="Y" S DGIR=$P(DGMOV,U,27) "RTN","DGPTSPQ",88,0) .;-- ec "RTN","DGPTSPQ",89,0) .I $P(DGMOV,U,28)'="",DGEC'="Y" S DGEC=$P(DGMOV,U,28) "RTN","DGPTSPQ",90,0) .;-- mst ;added 6/17/98 for MST enhancement "RTN","DGPTSPQ",91,0) .I $P(DGMOV,U,29)'="",DGMST'="Y" S DGMST=$P(DGMOV,U,29) "RTN","DGPTSPQ",92,0) .;-- ntr "RTN","DGPTSPQ",93,0) .I $P(DGMOV,U,30)'="",DGNTR'="Y" S DGNTR=$P(DGMOV,U,30) "RTN","DGPTSPQ",94,0) .;-- cv "RTN","DGPTSPQ",95,0) .I $P(DGMOV,U,31)'="",DGCV'="Y" S DGCV=$P(DGMOV,U,31) "RTN","DGPTSPQ",96,0) ;-- update <701> fields "RTN","DGPTSPQ",97,0) ; changed 6/17/98 for MST enhancement "RTN","DGPTSPQ",98,0) S DR="79.25////^S X=DGSC;79.26////^S X=DGAO;79.27////^S X=DGIR;79.28////^S X=DGEC;79.29////^S X=DGMST;79.3////^S X=DGNTR;79.31////^S X=DGCV" "RTN","DGPTSPQ",99,0) S DA=DGPTF,DIE="^DGPT(" "RTN","DGPTSPQ",100,0) D ^DIE K DIE,DA,DR "RTN","DGPTSPQ",101,0) UPQ Q "RTN","DGPTSPQ",102,0) ; "RTN","DGREGG") 0^7^B3448816 "RTN","DGREGG",1,0) DGREGG ;ALB/MRL,LBD - CONTINUATION OF REGISTRATION PROCESS ;16 AUG 88@1303 "RTN","DGREGG",2,0) ;;5.3;Registration;**565**;Aug 13, 1993 "RTN","DGREGG",3,0) K DEF S DEF=0 W !! I $D(^DPT(DA,.15))#10,$P(^(.15),"^",2)?7N W !,"Patient is ineligible for benefits." S DEF(1)=1,DEF=1 "RTN","DGREGG",4,0) I $D(^DPT(DA,.32))#10,$P(^(.32),"^",4)>1 W $S($D(DEF)\10:", He",1:"Patient") W:$X>70 ! W " did not receive an honorable discharge." S DEF(3)=1,DEF=1 "RTN","DGREGG",5,0) I DEF W !! "RTN","DGREGG",6,0) S Y=0,A=$G(^DPT(DFN,.32)) F I=6,11,16 I $P(A,U,I) S:($P(A,U,I)'<2800908) Y=$P(A,U,I) I $P(A,U,I)<2800908 S Y=0 Q "RTN","DGREGG",7,0) I Y D "RTN","DGREGG",8,0) .X ^DD("DD") W !,"Entered Service ",Y "RTN","DGREGG",9,0) .W !,"Veteran must have completed at least 24 consecutive months of active" "RTN","DGREGG",10,0) .W !,"military service. If veteran meets an exception to minimum duty requirements" "RTN","DGREGG",11,0) .W !,"as listed on www.va.gov/elig, veteran is eligible for VA health care." "RTN","DGREGG",12,0) .W !,"Otherwise, enter Ineligible Date and Reason on Screen 10 -- veteran is" "RTN","DGREGG",13,0) .W !,"eligible for care of SC conditions only.",! "RTN","DGREGG",14,0) .K A "RTN","DGREGG",15,0) Q "UP",45,45.02,-1) 45^M "UP",45,45.02,0) 45.02 "VER") 8.0^22.0 "^DD",45,45,79.31,0) POTENTIALLY RELATED TO COMBAT^S^Y:YES;N:NO;^70;31^Q "^DD",45,45,79.31,21,0) ^^6^6^3031110^ "^DD",45,45,79.31,21,1,0) Indicate if inpatient stay at this location may be related to military "^DD",45,45,79.31,21,2,0) service in combat and not from cause other than military service in combat "^DD",45,45,79.31,21,3,0) operations (congenital, developmental, pre-service existing conditions, or "^DD",45,45,79.31,21,4,0) conditions having specific and well-established etiology that began after "^DD",45,45,79.31,21,5,0) military combat service, i.e. bone fractures occuring after separation date, "^DD",45,45,79.31,21,6,0) common colds, etc). This information is copied from the movement records. "^DD",45,45,79.31,"DT") 3031110 "^DD",45,45.02,31,0) POTENTIALLY RELATED TO COMBAT^S^Y:YES;N:NO;^0;31^Q "^DD",45,45.02,31,3) Care is potentially related to military combat. "^DD",45,45.02,31,21,0) ^^7^7^3031209^ "^DD",45,45.02,31,21,1,0) Indicate if the inpatient stay at this location is related to military "^DD",45,45.02,31,21,2,0) service in combat and not from cause other than military service in "^DD",45,45.02,31,21,3,0) combat operations (congenital, developmental, pre-service existing "^DD",45,45.02,31,21,4,0) conditions, or conditions having specific and well-established etiology "^DD",45,45.02,31,21,5,0) that began after military combat service, i.e., bone fractures occurring "^DD",45,45.02,31,21,6,0) after separation date, commond colds, etc). This information can only be "^DD",45,45.02,31,21,7,0) entered if the patient has CV status in Registration. "^DD",45,45.02,31,"DT") 3031209 **INSTALL NAME** EC*2.0*54 "BLD",3654,0) EC*2.0*54^EVENT CAPTURE^0^3040630^y "BLD",3654,4,0) ^9.64PA^721^1 "BLD",3654,4,721,0) 721 "BLD",3654,4,721,2,0) ^9.641^721^1 "BLD",3654,4,721,2,721,0) EVENT CAPTURE PATIENT (File-top level) "BLD",3654,4,721,2,721,1,0) ^9.6411^40^2 "BLD",3654,4,721,2,721,1,30,0) PCE DATA FEED "BLD",3654,4,721,2,721,1,40,0) COMBAT VETERAN "BLD",3654,4,721,222) y^y^p^^^^n "BLD",3654,4,"APDD",721,721) "BLD",3654,4,"APDD",721,721,30) "BLD",3654,4,"APDD",721,721,40) "BLD",3654,4,"B",721,721) "BLD",3654,"ABPKG") n "BLD",3654,"KRN",0) ^9.67PA^8989.52^20 "BLD",3654,"KRN",.4,0) .4 "BLD",3654,"KRN",.4,"NM",0) ^9.68A^^ "BLD",3654,"KRN",.401,0) .401 "BLD",3654,"KRN",.401,"NM",0) ^9.68A^^ "BLD",3654,"KRN",.402,0) .402 "BLD",3654,"KRN",.402,"NM",0) ^9.68A^2^2 "BLD",3654,"KRN",.402,"NM",1,0) EC CREATE PATIENT ENTRY FILE #721^721^0 "BLD",3654,"KRN",.402,"NM",2,0) EC FILE PCE NODE FILE #721^721^0 "BLD",3654,"KRN",.402,"NM","B","EC CREATE PATIENT ENTRY FILE #721",1) "BLD",3654,"KRN",.402,"NM","B","EC FILE PCE NODE FILE #721",2) "BLD",3654,"KRN",.403,0) .403 "BLD",3654,"KRN",.403,"NM",0) ^9.68A^^ "BLD",3654,"KRN",.5,0) .5 "BLD",3654,"KRN",.5,"NM",0) ^9.68A^^ "BLD",3654,"KRN",.84,0) .84 "BLD",3654,"KRN",.84,"NM",0) ^9.68A^^ "BLD",3654,"KRN",3.6,0) 3.6 "BLD",3654,"KRN",3.6,"NM",0) ^9.68A^^ "BLD",3654,"KRN",3.8,0) 3.8 "BLD",3654,"KRN",3.8,"NM",0) ^9.68A^^ "BLD",3654,"KRN",9.2,0) 9.2 "BLD",3654,"KRN",9.2,"NM",0) ^9.68A^^ "BLD",3654,"KRN",9.8,0) 9.8 "BLD",3654,"KRN",9.8,"NM",0) ^9.68A^16^16 "BLD",3654,"KRN",9.8,"NM",1,0) ECUTL1^^0^B26308660 "BLD",3654,"KRN",9.8,"NM",2,0) ECBEN1B^^0^B24119717 "BLD",3654,"KRN",9.8,"NM",3,0) ECPCEU^^0^B17811678 "BLD",3654,"KRN",9.8,"NM",4,0) ECBEPF^^0^B9728135 "BLD",3654,"KRN",9.8,"NM",5,0) ECBENF^^0^B11054581 "BLD",3654,"KRN",9.8,"NM",6,0) ECBEP1B^^0^B46312174 "BLD",3654,"KRN",9.8,"NM",7,0) ECBEP2A^^0^B32048320 "BLD",3654,"KRN",9.8,"NM",8,0) ECMLMF^^0^B30638515 "BLD",3654,"KRN",9.8,"NM",9,0) ECMLMN^^0^B56414304 "BLD",3654,"KRN",9.8,"NM",10,0) ECKILL^^0^B12166861 "BLD",3654,"KRN",9.8,"NM",11,0) ECBEN2U^^0^B36244179 "BLD",3654,"KRN",9.8,"NM",12,0) ECMUTL1^^0^B55736638 "BLD",3654,"KRN",9.8,"NM",13,0) ECBEN^^0^B13713868 "BLD",3654,"KRN",9.8,"NM",14,0) ECBEP^^0^B13997295 "BLD",3654,"KRN",9.8,"NM",15,0) ECUERPC1^^0^B53629201 "BLD",3654,"KRN",9.8,"NM",16,0) ECEFPAT^^0^B54374795 "BLD",3654,"KRN",9.8,"NM","B","ECBEN",13) "BLD",3654,"KRN",9.8,"NM","B","ECBEN1B",2) "BLD",3654,"KRN",9.8,"NM","B","ECBEN2U",11) "BLD",3654,"KRN",9.8,"NM","B","ECBENF",5) "BLD",3654,"KRN",9.8,"NM","B","ECBEP",14) "BLD",3654,"KRN",9.8,"NM","B","ECBEP1B",6) "BLD",3654,"KRN",9.8,"NM","B","ECBEP2A",7) "BLD",3654,"KRN",9.8,"NM","B","ECBEPF",4) "BLD",3654,"KRN",9.8,"NM","B","ECEFPAT",16) "BLD",3654,"KRN",9.8,"NM","B","ECKILL",10) "BLD",3654,"KRN",9.8,"NM","B","ECMLMF",8) "BLD",3654,"KRN",9.8,"NM","B","ECMLMN",9) "BLD",3654,"KRN",9.8,"NM","B","ECMUTL1",12) "BLD",3654,"KRN",9.8,"NM","B","ECPCEU",3) "BLD",3654,"KRN",9.8,"NM","B","ECUERPC1",15) "BLD",3654,"KRN",9.8,"NM","B","ECUTL1",1) "BLD",3654,"KRN",19,0) 19 "BLD",3654,"KRN",19,"NM",0) ^9.68A^^0 "BLD",3654,"KRN",19.1,0) 19.1 "BLD",3654,"KRN",101,0) 101 "BLD",3654,"KRN",409.61,0) 409.61 "BLD",3654,"KRN",771,0) 771 "BLD",3654,"KRN",869.2,0) 869.2 "BLD",3654,"KRN",870,0) 870 "BLD",3654,"KRN",8989.51,0) 8989.51 "BLD",3654,"KRN",8989.52,0) 8989.52 "BLD",3654,"KRN",8994,0) 8994 "BLD",3654,"KRN",8994,"NM",0) ^9.68A^^0 "BLD",3654,"KRN","B",.4,.4) "BLD",3654,"KRN","B",.401,.401) "BLD",3654,"KRN","B",.402,.402) "BLD",3654,"KRN","B",.403,.403) "BLD",3654,"KRN","B",.5,.5) "BLD",3654,"KRN","B",.84,.84) "BLD",3654,"KRN","B",3.6,3.6) "BLD",3654,"KRN","B",3.8,3.8) "BLD",3654,"KRN","B",9.2,9.2) "BLD",3654,"KRN","B",9.8,9.8) "BLD",3654,"KRN","B",19,19) "BLD",3654,"KRN","B",19.1,19.1) "BLD",3654,"KRN","B",101,101) "BLD",3654,"KRN","B",409.61,409.61) "BLD",3654,"KRN","B",771,771) "BLD",3654,"KRN","B",869.2,869.2) "BLD",3654,"KRN","B",870,870) "BLD",3654,"KRN","B",8989.51,8989.51) "BLD",3654,"KRN","B",8989.52,8989.52) "BLD",3654,"KRN","B",8994,8994) "BLD",3654,"QUES",0) ^9.62^^ "BLD",3654,"REQB",0) ^9.611^4^4 "BLD",3654,"REQB",1,0) EC*2.0*49^2 "BLD",3654,"REQB",2,0) PX*1.0*130^2 "BLD",3654,"REQB",3,0) SD*5.3*325^2 "BLD",3654,"REQB",4,0) EC*2.0*50^2 "BLD",3654,"REQB","B","EC*2.0*49",1) "BLD",3654,"REQB","B","EC*2.0*50",4) "BLD",3654,"REQB","B","PX*1.0*130",2) "BLD",3654,"REQB","B","SD*5.3*325",3) "FIA",721) EVENT CAPTURE PATIENT "FIA",721,0) ^ECH( "FIA",721,0,0) 721 "FIA",721,0,1) y^y^p^^^^n "FIA",721,0,10) "FIA",721,0,11) "FIA",721,0,"RLRO") "FIA",721,0,"VR") 2.0^EC "FIA",721,721) 1 "FIA",721,721,30) "FIA",721,721,40) "KRN",.402,1987,-1) 0^1 "KRN",.402,1987,0) EC CREATE PATIENT ENTRY^3031030.1517^^721^^^3031120 "KRN",.402,1987,"DR",1,721) 1////^S X=$G(ECPTR("DFN"));2////^S X=$G(ECPRR("PROCDT"));3////^S X=$G(ECL);4////^S X=$P($G(^ECD(+$P($G(ECDSSU),"^"),0)),"^",2);5////^S X=$P($G(^ECD(+$P($G(ECDSSU),"^"),0)),"^",3);6////^S X=$P($G(ECDSSU),"^"); "KRN",.402,1987,"DR",1,721,1) 7////^S X=+$P($G(ECCAT),"^");8////^S X=$G(ECPRR("PROC"));9////^S X=$G(ECPRR("VOL"));10////^S X=$P($G(ECU(1)),"^");11////^S X=$G(ECPTR("ORDSEC"));13////^S X=$G(DUZ);15////^S X=$P($G(ECU(2)),"^");17////^S X=$P($G(ECU(3)),"^"); "KRN",.402,1987,"DR",1,721,2) 19////^S X=$G(ECPRR("PCEPR"));20////^S X=$G(ECPTR("DX"));21////^S X=$G(ECPTR("AO"));22////^S X=$G(ECPTR("IR"));23////^S X=$G(ECPTR("ENV"));24////^S X=$G(ECPTR("SC"));35////^S X=$G(ECPTR("MST"));39////^S X=$G(ECPTR("HNC")); "KRN",.402,1987,"DR",1,721,3) 40////^S X=$G(ECPTR("CV"));26////^S X=$G(ECPTR("CLIN"));27////^S X=$P($G(^SC(+$G(ECPTR("CLIN")),0)),"^",7);29////^S X=$G(ECPTR("IO"));34////^S X=$G(ECPRR("REAS")); "KRN",.402,1987,"ROU") ^ECMXP "KRN",.402,1987,"ROUOLD") ECMXP "KRN",.402,1988,-1) 0^2 "KRN",.402,1988,0) EC FILE PCE NODE^3031030.1518^^721^^^3031120 "KRN",.402,1988,"DR",1,721) 30////^S X=ECPRR("PROCDT")_"~"_ECPTR("DFN")_"~"_ECPTR("CLIN")_"~"_ECL_"~"_ECDSS_"~"_+ECU(1)_"~"_$P($G(ECU(2)),"^")_"~"_$P($G(ECU(3)),"^")_"~"_ECPRR("VOL")_"~"_ECPRR("PCEPR")_"~"_ECPTR("DX"); "KRN",.402,1988,"DR",1,721,1) 30////^S X=X_"~"_ECAO_"~"_ECIR_"~"_ECEV_"~"_ECSC_"~"_$S(ECNPP]"":ECNPP,1:"")_"~"_ECELIG_"~"_ECMST_"~"_ECHNC_"~"_ECCV;37////^S X=ECMODS; "KRN",.402,1988,"ROU") ^ECMXPC "KRN",.402,1988,"ROUOLD") ECMXPC "MBREQ") 1 "ORD",7,.402) .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) "ORD",7,.402,0) INPUT TEMPLATE "PKG",499,-1) 1^1 "PKG",499,0) EVENT CAPTURE^EC^Event Capture Workload Capture System^ "PKG",499,20,0) ^9.402P^^ "PKG",499,22,0) ^9.49I^1^1 "PKG",499,22,1,0) 2.0^2960508^2970410^11715 "PKG",499,22,1,"PAH",1,0) 54^3040630^100100 "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") 16 "RTN","ECBEN") 0^13^B13713868 "RTN","ECBEN",1,0) ECBEN ;BIR/MAM,JPW-New Batch Entry ;12 Feb 96 "RTN","ECBEN",2,0) ;;2.0; EVENT CAPTURE ;**4,5,10,17,42,54**;8 May 96 "RTN","ECBEN",3,0) S ECOUT=0 "RTN","ECBEN",4,0) LOCA ; get location "RTN","ECBEN",5,0) D ^ECL K LOC I '$D(ECL) G END "RTN","ECBEN",6,0) UNIT ; get DSS unit "RTN","ECBEN",7,0) I $D(^XUSEC("ECALLU",DUZ)) K DIC S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ",DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))" D ^DIC K DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2),NODE=Y(0) D SETU G:'$D(ECD) UNIT D ^ECBEN1A G CHK "RTN","ECBEN",8,0) S (X,CNT)=0 F S X=$O(^VA(200,DUZ,"EC",X)) Q:'X S CNT=CNT+1,UNIT=$P(^VA(200,DUZ,"EC",X,0),"^"),UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^") "RTN","ECBEN",9,0) I '$D(UNIT(1)) W !!,"You do not have access to any DSS Units. Contact your Event Capture",!,"Package Coordinator if you are responsible for entering procedures for ",!,"a DSS Unit. ",!!,"Press to continue " R X:DTIME G END "RTN","ECBEN",10,0) I '$D(UNIT(2)) S ECD=+$P(UNIT(1),"^"),ECDN=$P(^ECD(ECD,0),"^"),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEN1A G CHK "RTN","ECBEN",11,0) SELU S X=0 W @IOF,!,"DSS Units: ",! F S X=$O(UNIT(X)) Q:'X W !,X_".",?5,$P(UNIT(X),"^",2) "RTN","ECBEN",12,0) W !!,"Select Number: " R X:DTIME S:"^"[X ECOUT=1 I '$T!("^"[X) G END "RTN","ECBEN",13,0) I '$D(UNIT(X)) W !!,"Select the number that corresponds with the DSS unit for which you would like",!,"to enter procedures.",!!,"Press to continue " R X:DTIME G SELU "RTN","ECBEN",14,0) S ECD=+$P(UNIT(X),"^"),ECDN=$P(UNIT(X),"^",2),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEN1A "RTN","ECBEN",15,0) CHK ;check to ask unit again "RTN","ECBEN",16,0) I ECOUT=2 D S ECOUT=0 G UNIT "RTN","ECBEN",17,0) .K EC4,ECC,ECCN,ECD,ECDDT,ECDT,ECDN,ECM,ECMN,ECO,ECON,ECP,ECPN,ECPROS "RTN","ECBEN",18,0) .K ECS,ECSN,ECTWO,ECU,ECU2,ECU3,ECUN,ECUN2,ECUN3,ECUC,ECUC2,ECUC3,ECV "RTN","ECBEN",19,0) .K ECYN,ECYNZ,NATN,NODE,SYN,^TMP("ECPRO",$J),ECAO,ECIR,ECSC,ECCPT,ECDX "RTN","ECBEN",20,0) .K ECDXN,ECINP,ECVST,ECZEC,ECID,ECPTSTAT,ECMST,ECHNC,ECCV "RTN","ECBEN",21,0) END D ^ECKILL K ^TMP("ECLKUP",$J),^TMP("ECPRO",$J) W @IOF "RTN","ECBEN",22,0) Q "RTN","ECBEN",23,0) SETU ;set DSS Unit info "RTN","ECBEN",24,0) S MSG1=0 "RTN","ECBEN",25,0) I '$D(NODE) D MSG K ECD,ECDN,NODE S ECOUT=0 Q "RTN","ECBEN",26,0) I $P(NODE,"^",8)'=1 S MSG1=3 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q "RTN","ECBEN",27,0) I $P(NODE,"^",6) S MSG1=2 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q "RTN","ECBEN",28,0) S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N") "RTN","ECBEN",29,0) I $O(^ECJ("AP",ECL,ECD,""))']"" S MSG1=1 D MSG K ECC,ECCN,ECD,ECDDT,ECDN,ECM,ECMN,ECPCL,ECS,ECSN,ECYN,NODE,^TMP("ECPRO",$J) S (ECOUT,MSG1)=0 Q "RTN","ECBEN",30,0) S ECS=+$P(NODE,"^",2),ECM=+$P(NODE,"^",3),ECDDT=$P(NODE,"^",12),ECDDT=$S(ECDDT="T":"NOW",ECDDT="N":"NOW",1:"") "RTN","ECBEN",31,0) S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN") "RTN","ECBEN",32,0) S ECYNZ=+$P(NODE,"^",11) "RTN","ECBEN",33,0) Q "RTN","ECBEN",34,0) MSG ;unit msg "RTN","ECBEN",35,0) W !!,"The DSS Unit ",ECDN," that you selected within ",ECLN "RTN","ECBEN",36,0) W !,$S(MSG1=3:"is not defined for Event Capture use",MSG1=2:"is inactive",MSG1=1:"has no procedures defined",1:"is missing information"),"." "RTN","ECBEN",37,0) W " Please select another DSS Unit." "RTN","ECBEN",38,0) W !!,"Press to continue " R X:DTIME "RTN","ECBEN",39,0) Q "RTN","ECBEN1B") 0^2^B24119717 "RTN","ECBEN1B",1,0) ECBEN1B ;BIR/MAM,JPW-Batch Enter Procedures (cont'd) ;1 May 96 "RTN","ECBEN1B",2,0) ;;2.0; EVENT CAPTURE ;**4,5,10,13,17,23,41,42,50,54**;8 May 96 "RTN","ECBEN1B",3,0) EN ;entry pt "RTN","ECBEN1B",4,0) D HDR "RTN","ECBEN1B",5,0) S CNT=0 "RTN","ECBEN1B",6,0) PATS ; get patients "RTN","ECBEN1B",7,0) W ! Q:ECOUT=1 K ECADD "RTN","ECBEN1B",8,0) K DIC,DUOUT S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S($D(ECPT):"Select Next Patient: ",1:"Select Patient: ") "RTN","ECBEN1B",9,0) D ^DIC K DIC S OK=0 "RTN","ECBEN1B",10,0) I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q "RTN","ECBEN1B",11,0) I Y<0,CNT=0 S ECOUT=2 Q "RTN","ECBEN1B",12,0) I Y<0 D G PATS "RTN","ECBEN1B",13,0) .D LIST Q:ECOUT=1 Q:'$O(ECPT(0)) Q:$G(ECADD)="A" "RTN","ECBEN1B",14,0) .S ECTWO=0 K ECHOICE D ^ECBEN2A "RTN","ECBEN1B",15,0) .I ECOUT=2 D KILL,HDR "RTN","ECBEN1B",16,0) I $O(ECPT(0)) S JJ="" F S JJ=$O(ECPT(JJ)) Q:'JJ!(OK=1) I +$G(ECPT(JJ))=+Y S OK=1 W !!,"Patient already selected. Please select another patient.",! "RTN","ECBEN1B",17,0) I OK=1 G PATS "RTN","ECBEN1B",18,0) N YY,ECUP D I $G(ECUP)="^" G PATS "RTN","ECBEN1B",19,0) . S YY=Y,DFN=+Y D 2^VADPT S Y=YY I +VADM(6) D "RTN","ECBEN1B",20,0) . . ; NOIS MWV-0603-21781:line below changed by VMP. "RTN","ECBEN1B",21,0) . . W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!! "RTN","ECBEN1B",22,0) . . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME "RTN","ECBEN1B",23,0) S CNT=CNT+1,CNT1=CNT,ECPT(CNT)=+Y_"^"_$P(Y,"^",2) D DIAG "RTN","ECBEN1B",24,0) G PATS "RTN","ECBEN1B",25,0) ; "RTN","ECBEN1B",26,0) LIST ; list patients "RTN","ECBEN1B",27,0) K ECADD "RTN","ECBEN1B",28,0) W @IOF,!,"Patients Selected for Batch Entry: ",! F I=0:0 S I=$O(ECPT(I)) Q:'I W:I#2 ! W:I#2=0 ?40 W I_". "_$P(ECPT(I),"^",2) "RTN","ECBEN1B",29,0) W !!,"Is this list correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q "RTN","ECBEN1B",30,0) S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" I "YyNn"'[ECYN W !!,"Enter if this list is complete, or NO to add or delete",!,"patients on the list.",!!,"Press to continue " R X:DTIME G LIST "RTN","ECBEN1B",31,0) I "Yy"[ECYN Q:$O(ECPT(0)) D NOBODY Q:ECOUT "RTN","ECBEN1B",32,0) ADD W !!,"Add or Delete Patients ? ADD// " R ECADD:DTIME I '$T!(ECADD="^") S ECOUT=1 Q "RTN","ECBEN1B",33,0) S ECADD=$E(ECADD) S:ECADD="" ECADD="A" I "AaDd"'[ECADD W !!,"Enter to make additions to the list, or ""D"" to delete a ",!,"patient from the list." G ADD "RTN","ECBEN1B",34,0) I "Aa"[ECADD Q "RTN","ECBEN1B",35,0) DEL ; delete patients from list "RTN","ECBEN1B",36,0) I '$D(ECPT(1)) D NOBODY Q:ECOUT G LIST "RTN","ECBEN1B",37,0) W !!,"Select Number: " R X:DTIME I '$T!(X="^") S ECOUT=1 Q "RTN","ECBEN1B",38,0) I X="" Q "RTN","ECBEN1B",39,0) I '$D(ECPT(X)) W !!,"Select the number corresponding to the patient that you would like",!,"to remove from the list.",!!,"Press to continue " R X:DTIME S ECMORE=1 D LIST Q:ECOUT G DEL "RTN","ECBEN1B",40,0) F I=X+1:1:CNT S ECPT(I-1)=ECPT(I) "RTN","ECBEN1B",41,0) K ECPT(CNT),I S CNT=CNT-1 "RTN","ECBEN1B",42,0) W !!,"Patient deleted.",!!,"Press to continue " R X:DTIME "RTN","ECBEN1B",43,0) G LIST "RTN","ECBEN1B",44,0) Q "RTN","ECBEN1B",45,0) HDR ; "RTN","ECBEN1B",46,0) W @IOF,!,"Location: "_ECLN "RTN","ECBEN1B",47,0) W !,"DSS Unit: "_ECDN "RTN","ECBEN1B",48,0) W !,"Ordering Section: ",ECON "RTN","ECBEN1B",49,0) W !,"Procedure Date: ",ECDATE "RTN","ECBEN1B",50,0) W !!,"Provider:",?14,$P(ECU,"^",2),!?16,$P(ECU,"^",3) "RTN","ECBEN1B",51,0) I +ECU2 W !,"Provider #2:",?14,$P(ECU2,"^",2),!?16,$P(ECU2,"^",3) "RTN","ECBEN1B",52,0) I +ECU3 W !,"Provider #3:",?14,$P(ECU3,"^",2),!?16,$P(ECU3,"^",3) "RTN","ECBEN1B",53,0) W ! "RTN","ECBEN1B",54,0) Q "RTN","ECBEN1B",55,0) ; "RTN","ECBEN1B",56,0) NOBODY ;No patients selected "RTN","ECBEN1B",57,0) I $D(ECADD),ECADD="D" W !!,"You cannot delete patients when your patient list is empty." "RTN","ECBEN1B",58,0) I $G(ECADD)'="D" W !!,"You have selected no patients." "RTN","ECBEN1B",59,0) R !!,"Do you wish to quit? Y//",X:DTIME S X=$E(X) I '$T!(X="^") S ECOUT=1 Q "RTN","ECBEN1B",60,0) S:X="" X="Y" I "yY"[X S ECOUT=1 Q "RTN","ECBEN1B",61,0) I "nN"'[X W !,"Answer N to continue selection, or enter return to quit",! G NOBODY "RTN","ECBEN1B",62,0) Q "RTN","ECBEN1B",63,0) ; "RTN","ECBEN1B",64,0) ADCAT ;add category/procedures for patients "RTN","ECBEN1B",65,0) D ^ECBEN2A I ECOUT=1 Q "RTN","ECBEN1B",66,0) Q "RTN","ECBEN1B",67,0) KILL ;kill arrays "RTN","ECBEN1B",68,0) K ECA,ECHOICE,ECJLP,ECPT,ECC,ECCN,ECP,ECPN,ECV,NATN,NODE,SYN,SYS,VOL "RTN","ECBEN1B",69,0) K ^TMP("ECPRO",$J),ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,EC4,EC4N "RTN","ECBEN1B",70,0) K ECID,ECMST,ECDXS,ECDXIEN,ECHNC,ECCV "RTN","ECBEN1B",71,0) S ECOUT=0 "RTN","ECBEN1B",72,0) Q "RTN","ECBEN1B",73,0) DIAG ;ask dx, etc. questions "RTN","ECBEN1B",74,0) S (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)="" "RTN","ECBEN1B",75,0) S ECDFN=$P(ECPT(CNT),U) "RTN","ECBEN1B",76,0) ;- Determine inpatient/outpatient status "RTN","ECBEN1B",77,0) S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECPT(CNT)),+$G(ECDT)) "RTN","ECBEN1B",78,0) I ECPTSTAT="" D INOUTERR^ECUTL0 Q "RTN","ECBEN1B",79,0) ;- Determine patient eligibility "RTN","ECBEN1B",80,0) I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D "RTN","ECBEN1B",81,0) . I $$MULTELG^ECUTL0(+$G(ECPT(CNT))) S ECELIG=+$$ELGLST^ECUTL0 "RTN","ECBEN1B",82,0) . E S ECELIG=+$G(VAEL(1)) "RTN","ECBEN1B",83,0) K VAEL "RTN","ECBEN1B",84,0) D DSPSTAT^ECUTL0(ECPTSTAT) "RTN","ECBEN1B",85,0) I '$D(EC4) S EC4="",EC4N="NO ASSOCIATED CLINIC" "RTN","ECBEN1B",86,0) I '$D(ECID) S ECID="" "RTN","ECBEN1B",87,0) I $P(ECPCE,"~",2)="N" G SETDX "RTN","ECBEN1B",88,0) D PCEQST^ECBEN2U "RTN","ECBEN1B",89,0) I ECOUT D DELPT(.CNT) Q "RTN","ECBEN1B",90,0) SETDX ;set dx, etc. in pat array "RTN","ECBEN1B",91,0) S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7) "RTN","ECBEN1B",92,0) S ECPT(CNT)=ECPT(CNT)_"^"_ECDX_"^"_$S(ECINP="":$G(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV "RTN","ECBEN1B",93,0) I $D(ECDXS) M ECPT(CNT,"DXS")=ECDXS K ECDXS "RTN","ECBEN1B",94,0) Q "RTN","ECBEN1B",95,0) ; "RTN","ECBEN1B",96,0) DELPT(CNT) ;deselect patient due to missing required data "RTN","ECBEN1B",97,0) N DIR,Y "RTN","ECBEN1B",98,0) K ECPT(CNT) S CNT=CNT-1 "RTN","ECBEN1B",99,0) W !,"Required data missing.",!,"Patient deselected...",! "RTN","ECBEN1B",100,0) S ECOUT=0 "RTN","ECBEN1B",101,0) S DIR(0)="E",DIR("A")="Press RETURN to continue" "RTN","ECBEN1B",102,0) D ^DIR "RTN","ECBEN1B",103,0) W ! "RTN","ECBEN1B",104,0) Q "RTN","ECBEN2U") 0^11^B36244179 "RTN","ECBEN2U",1,0) ECBEN2U ;BIR/MAM,JPW-Categories and Procedures Selection ;12 Feb 96 "RTN","ECBEN2U",2,0) ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,47,54**;8 May 96 "RTN","ECBEN2U",3,0) END Q "RTN","ECBEN2U",4,0) HDR ;screen header "RTN","ECBEN2U",5,0) W @IOF,!,"Location: ",ECLN "RTN","ECBEN2U",6,0) W !,"DSS Unit: ",$E(ECDN,1,30) I $G(ECCN)]"" W ?48,"Category: ",$E(ECCN,1,20) "RTN","ECBEN2U",7,0) W !,"Ordering Section: ",ECON "RTN","ECBEN2U",8,0) W !,"Procedure Date: ",ECDATE "RTN","ECBEN2U",9,0) W !!,"Provider:",?14,$P(ECU,"^",2),!?16,$P(ECU,"^",3) "RTN","ECBEN2U",10,0) I +ECU2 W !,"Provider #2:",?14,$P(ECU2,"^",2),!?16,$P(ECU2,"^",3) "RTN","ECBEN2U",11,0) I +ECU3 W !,"Provider #3:",?14,$P(ECU3,"^",2),!?16,$P(ECU3,"^",3) "RTN","ECBEN2U",12,0) W ! "RTN","ECBEN2U",13,0) Q "RTN","ECBEN2U",14,0) MSG W !!,"No procedures entered. No Action Taken.",!!,"Press to continue " R X:DTIME S ECOUT=1 "RTN","ECBEN2U",15,0) Q "RTN","ECBEN2U",16,0) MSG1 ; "RTN","ECBEN2U",17,0) W !!,"Please enter the number that corresponds to the "_$S(OK:"procedure",1:"category")_" from which",!,"you would like to select a procedure. If you would like to continue",!,"with the list, press . Enter ^ to quit." "RTN","ECBEN2U",18,0) S CNT=CNT-5 "RTN","ECBEN2U",19,0) Q "RTN","ECBEN2U",20,0) HDRP ;hdr batch by proc "RTN","ECBEN2U",21,0) W @IOF,!,"Location: ",ECLN "RTN","ECBEN2U",22,0) I $G(ECCN)]"" W !,"Category: ",ECCN "RTN","ECBEN2U",23,0) W !,"Procedure Date: ",ECDATE "RTN","ECBEN2U",24,0) W !,"Provider:",?14,$E($P(ECU,"^",2),1,24),?42,$E($P(ECU,"^",3),1,36) "RTN","ECBEN2U",25,0) I +ECU2 W !,"Provider #2:",?14,$E($P(ECU2,"^",2),1,24),?42,$E($P(ECU2,"^",3),1,36) "RTN","ECBEN2U",26,0) I +ECU3 W !,"Provider #3:",?14,$E($P(ECU3,"^",2),1,24),?42,$E($P(ECU3,"^",3),1,36) "RTN","ECBEN2U",27,0) W ! "RTN","ECBEN2U",28,0) Q "RTN","ECBEN2U",29,0) PCEQST ;entry pt for PCE questions "RTN","ECBEN2U",30,0) S (ECDX,ECDXN,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)="" "RTN","ECBEN2U",31,0) INP ;- Set inpatient/outpatient status "RTN","ECBEN2U",32,0) S ECINP=$G(ECPTSTAT) "RTN","ECBEN2U",33,0) D CLINIC I ECOUT Q "RTN","ECBEN2U",34,0) ;ask dx "RTN","ECBEN2U",35,0) D DIAG^ECUTL2 I ECOUT Q "RTN","ECBEN2U",36,0) I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q "RTN","ECBEN2U",37,0) D VISIT "RTN","ECBEN2U",38,0) Q "RTN","ECBEN2U",39,0) CLINIC ;display default clinic "RTN","ECBEN2U",40,0) Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q "RTN","ECBEN2U",41,0) K DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT S DIR(0)="721,26",DIR("A")="Associated Clinic",DIR("?")="An active clinic is required. Enter an active clinic or an ^ to exit" "RTN","ECBEN2U",42,0) I EC4,EC4N'["NO ASSOCIATED CLINIC" S DIR("B")=EC4N "RTN","ECBEN2U",43,0) D ^DIR K DIR "RTN","ECBEN2U",44,0) I Y S EC4=+Y,ECID=$P($G(^SC(+EC4,0)),"^",7) "RTN","ECBEN2U",45,0) I $D(DTOUT)!$D(DUOUT) S ECOUT=1 Q "RTN","ECBEN2U",46,0) I +EC4,'$G(ECOUT) D CLIN I 'ECPCL W !!,"You must enter an active clinic now.",! G CLINIC "RTN","ECBEN2U",47,0) I $D(DTOUT)!$D(DUOUT)!('Y)!(Y<0) W:$P(ECPCE,"~",2)'="N" !!,"Please note that this record cannot be sent to PCE without an active clinic.",!! "RTN","ECBEN2U",48,0) Q "RTN","ECBEN2U",49,0) VISIT ;ask visit info "RTN","ECBEN2U",50,0) Q:ECINP="I" "RTN","ECBEN2U",51,0) ; "RTN","ECBEN2U",52,0) ;- Ask classification questions applicable to patient and file in #721 "RTN","ECBEN2U",53,0) I $$ASKCLASS^ECUTL1(+$G(ECPT(CNT)),.ECCLFLDS,.ECOUT,ECPCE,ECINP),($O(ECCLFLDS(""))]"") D SETCLASS^ECUTL1(.ECCLFLDS) "RTN","ECBEN2U",54,0) I +$G(ECOUT) Q "RTN","ECBEN2U",55,0) K ECCLFLDS "RTN","ECBEN2U",56,0) Q "RTN","ECBEN2U",57,0) PCEE ;checks edited data and sets PCE node for filing "RTN","ECBEN2U",58,0) S ECVST=+$P(EC(0),"^",21) I 'ECVST G PCE "RTN","ECBEN2U",59,0) DEL ;delete visit and refresh data to PCE "RTN","ECBEN2U",60,0) K DA,DIE,DR S DA=ECFN,DIE=721,DR="25///@;28///@" D ^DIE K DA,DIE,DR "RTN","ECBEN2U",61,0) ; "RTN","ECBEN2U",62,0) ;* Prepare all EC records with same Visit file entry to resend to PCE "RTN","ECBEN2U",63,0) N ECVAR1 S ECVAR1=$$FNDVST^ECUTL(ECVST,ECFN) K ECVAR1 "RTN","ECBEN2U",64,0) ; "RTN","ECBEN2U",65,0) ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen "RTN","ECBEN2U",66,0) S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST) K ECVST,VALQUIET "RTN","ECBEN2U",67,0) PCE ;set data for PCE filing "RTN","ECBEN2U",68,0) Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q "RTN","ECBEN2U",69,0) S ECREAS="" "RTN","ECBEN2U",70,0) ; "RTN","ECBEN2U",71,0) ;- Kill Reason node "RTN","ECBEN2U",72,0) D KILLR "RTN","ECBEN2U",73,0) I EC4 D CLIN^ECPCEU "RTN","ECBEN2U",74,0) I 'EC4 S ECREAS="Clinic missing;" "RTN","ECBEN2U",75,0) I 'ECDX S ECREAS="Diagnosis not entered;" "RTN","ECBEN2U",76,0) I EC4,'ECPCL S ECREAS=ECREAS_"Clinic inactive;" "RTN","ECBEN2U",77,0) I 'ECCPT S ECREAS=ECREAS_"CPT code missing;" "RTN","ECBEN2U",78,0) I ECREAS]"" S ^ECH(ECFN,"R")=ECREAS K ECPCL,ECREAS Q "RTN","ECBEN2U",79,0) I '$D(^ECH(ECFN,0)) Q "RTN","ECBEN2U",80,0) I '$D(^ECH(ECFN,"P")) Q "RTN","ECBEN2U",81,0) S PN=^ECH(ECFN,0),PNP=^ECH(ECFN,"P") "RTN","ECBEN2U",82,0) S PNMOD="" I $D(^ECH(ECFN,"MOD")) D "RTN","ECBEN2U",83,0) . N MOD,MODS S MODS=0 F S MODS=$O(^ECH(ECFN,"MOD",MODS)) Q:'MODS D "RTN","ECBEN2U",84,0) . . S MOD=$P($G(^ECH(ECFN,"MOD",MODS,0)),U) "RTN","ECBEN2U",85,0) . . S MOD=$$MOD^ICPTMOD(MOD,"I",$P(PN,U,3)) I +MOD<0 Q "RTN","ECBEN2U",86,0) . . S PNMOD=$S(PNMOD'="":PNMOD_";",1:"")_$P(MOD,U,2) "RTN","ECBEN2U",87,0) SET ;set data pieces "RTN","ECBEN2U",88,0) S ECP3=+$P(PN,"^",3) I ECP3'["." K ECP3 D DELNOD Q "RTN","ECBEN2U",89,0) S ECP2=+$P(PN,"^",2) I 'ECP2 K ECP2 D DELNOD Q "RTN","ECBEN2U",90,0) S ECP19=+$P(PN,"^",19) I 'ECP19 K ECP19 D DELNOD Q "RTN","ECBEN2U",91,0) S ECP4=+$P(PN,"^",4) I 'ECP4 K ECP4 D DELNOD Q "RTN","ECBEN2U",92,0) S ECP20=+$P(PN,"^",20) I 'ECP20 K ECP20 D DELNOD Q "RTN","ECBEN2U",93,0) S ECP11=+$P(PN,"^",11) I 'ECP11 K ECP11 D DELNOD Q "RTN","ECBEN2U",94,0) S ECP15=+$P(PN,"^",15) "RTN","ECBEN2U",95,0) S ECP17=+$P(PN,"^",17) "RTN","ECBEN2U",96,0) S ECP10=+$P(PN,"^",10) I 'ECP10 K ECP10 D DELNOD Q "RTN","ECBEN2U",97,0) S ECPP1=+$P(PNP,"^") I 'ECPP1 K ECPP1 D DELNOD Q "RTN","ECBEN2U",98,0) S ECPP2=+$P(PNP,"^",2) I 'ECPP2 K ECPP2 D DELNOD Q "RTN","ECBEN2U",99,0) S ECPP3=$P(PNP,"^",3),ECPP3=$S(ECPP3="Y":1,ECPP3="N":0,1:"") "RTN","ECBEN2U",100,0) S ECPP4=$P(PNP,"^",4),ECPP4=$S(ECPP4="Y":1,ECPP4="N":0,1:"") "RTN","ECBEN2U",101,0) S ECPP5=$P(PNP,"^",5),ECPP5=$S(ECPP5="Y":1,ECPP5="N":0,1:"") "RTN","ECBEN2U",102,0) S ECPP6=$P(PNP,"^",6),ECPP6=$S(ECPP6="Y":1,ECPP6="N":0,1:"") "RTN","ECBEN2U",103,0) S ECPP9=$P(PNP,"^",9),ECPP9=$S(ECPP9="Y":1,ECPP9="N":0,1:"") "RTN","ECBEN2U",104,0) S ECPP10=$P(PNP,"^",10),ECPP10=$S(ECPP10="Y":1,ECPP10="N":0,1:"") "RTN","ECBEN2U",105,0) S ECPP11=$P(PNP,"^",11),ECPP11=$S(ECPP11="Y":1,ECPP11="N":0,1:"") "RTN","ECBEN2U",106,0) S ECPP1A="" I $P(PN,"^",9)["EC" S ECPP1A=$G(^EC(725,+$P(PN,"^",9),0)),ECPP1A=$P(ECPP1A,"^",2)_" "_$P(ECPP1A,"^") "RTN","ECBEN2U",107,0) S ECELIG=$S($G(ECELIG):ECELIG,1:"") "RTN","ECBEN2U",108,0) NODE ;sets "PCE" node "RTN","ECBEN2U",109,0) ;d/t~dfn~hosp loc~inst~dss id~prov~prov2~prov3~vol~cpt~dx~ao~rad~env~sc~ecs nat # & name~eligibility~mst~hnc~cv "RTN","ECBEN2U",110,0) S PNODE=ECP3_"~"_ECP2_"~"_ECP19_"~"_ECP4_"~"_ECP20_"~"_ECP11_"~"_ECP15_"~"_ECP17_"~"_ECP10_"~"_ECPP1_"~"_ECPP2_"~"_ECPP3_"~"_ECPP4_"~"_ECPP5_"~"_ECPP6_"~"_ECPP1A_"~"_ECELIG_"~"_ECPP9_"~"_ECPP10_"~"_ECPP11 "RTN","ECBEN2U",111,0) S ^ECH(ECFN,"PCE")=PNODE "RTN","ECBEN2U",112,0) ;set "PCE1" node "RTN","ECBEN2U",113,0) ;CPT modifier1;CPT modifier 2;CPT modifier 3;...CPT modifier n "RTN","ECBEN2U",114,0) I PNMOD'="" S ^ECH(ECFN,"PCE1")=PNMOD "RTN","ECBEN2U",115,0) S DA=ECFN,DIE=721,DR="31////"_ECDT D ^DIE K DA,DIE,DR "RTN","ECBEN2U",116,0) K ECP2,ECP3,ECP4,ECP10,ECP11,ECP15,ECP17,ECP19,ECP20,ECPP1,ECPP1A,ECPP2,ECPP3,ECPP4,ECPP5,ECPP6,ECPP9,ECPP10,ECPP11,ECREAS,ECPCL,PN,PNP,PNODE,ECELIG,PNMOD "RTN","ECBEN2U",117,0) Q "RTN","ECBEN2U",118,0) CLIN ;check for active associated clinic "RTN","ECBEN2U",119,0) S MSG1=1,MSG2=0 "RTN","ECBEN2U",120,0) D CLIN^ECPCEU "RTN","ECBEN2U",121,0) I 'ECPCL D "RTN","ECBEN2U",122,0) .W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this procedure ",$S(MSG2:"has not been entered",1:"is inactive"),"." "RTN","ECBEN2U",123,0) .W !,"Workload data cannot be sent to PCE for this procedure with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic." "RTN","ECBEN2U",124,0) S (MSG1,MSG2)=0 "RTN","ECBEN2U",125,0) Q "RTN","ECBEN2U",126,0) ; "RTN","ECBEN2U",127,0) ; "RTN","ECBEN2U",128,0) KILLR ;- Kill 'R' (Reason) node "RTN","ECBEN2U",129,0) ; "RTN","ECBEN2U",130,0) K ^ECH(ECFN,"R") "RTN","ECBEN2U",131,0) Q "RTN","ECBEN2U",132,0) ; "RTN","ECBEN2U",133,0) ; "RTN","ECBEN2U",134,0) DELNOD ;- Delete 'PCE' and 'Send' nodes "RTN","ECBEN2U",135,0) ; "RTN","ECBEN2U",136,0) N DA,DIE,DR "RTN","ECBEN2U",137,0) ; "RTN","ECBEN2U",138,0) ;- Lock node "RTN","ECBEN2U",139,0) L +^ECH(ECFN):5 Q:'$T "RTN","ECBEN2U",140,0) S DA=ECFN "RTN","ECBEN2U",141,0) S DIE="^ECH(" "RTN","ECBEN2U",142,0) S DR="30////@;31////@;37////@" "RTN","ECBEN2U",143,0) ; "RTN","ECBEN2U",144,0) ;- Delete contents "RTN","ECBEN2U",145,0) D ^DIE "RTN","ECBEN2U",146,0) ; "RTN","ECBEN2U",147,0) ;- Unlock node "RTN","ECBEN2U",148,0) L -^ECH(ECFN) "RTN","ECBEN2U",149,0) Q "RTN","ECBENF") 0^5^B11054581 "RTN","ECBENF",1,0) ECBENF ;BIR/MAM,JPW-Stuff New Batched Procedures ;12 Feb 96 "RTN","ECBENF",2,0) ;;2.0; EVENT CAPTURE ;**4,5,13,17,18,23,42,54**;8 May 96 "RTN","ECBENF",3,0) CRAM ; entry "RTN","ECBENF",4,0) S ECDT=$P(ECA,"^"),ECL=$P(ECA,"^",2),ECS=$P(ECA,"^",3),ECM=$P(ECA,"^",4),ECD=$P(ECA,"^",5) "RTN","ECBENF",5,0) S ECPCE=$P(ECA,"^",6) "RTN","ECBENF",6,0) S (CNT,CNT1)=0 "RTN","ECBENF",7,0) F S CNT1=$O(ECPT(CNT1)) Q:'CNT1 D "RTN","ECBENF",8,0) .S ECNODE2=$G(ECPT(CNT1)) "RTN","ECBENF",9,0) .S ECELIG=$G(ECELPT(CNT1)) "RTN","ECBENF",10,0) .S ECPS=$P(ECNODE2,"^"),ECDX=$P(ECNODE2,"^",3),ECINP=$P(ECNODE2,"^",4),ECVST=$P(ECNODE2,"^",5),ECSC=$P(ECNODE2,"^",6),ECAO=$P(ECNODE2,"^",7),ECIR=$P(ECNODE2,"^",8),ECZEC=$P(ECNODE2,"^",9),ECMST=$P(ECNODE2,"^",12) "RTN","ECBENF",11,0) .S ECHNC=$P(ECNODE2,"^",13),ECCV=$P(ECNODE2,"^",14) "RTN","ECBENF",12,0) .F S CNT=$O(ECEC(CNT)) Q:'CNT D "RTN","ECBENF",13,0) ..S EC4=$P(ECNODE2,"^",10),ECID=$P(ECNODE2,"^",11) "RTN","ECBENF",14,0) ..D NODE D DIE "RTN","ECBENF",15,0) END D ^ECKILL K DLAYGO S:$D(ZTQUEUED) ZTREQ="@" "RTN","ECBENF",16,0) Q "RTN","ECBENF",17,0) NODE ;set patient array data "RTN","ECBENF",18,0) S ECNODE=ECEC(CNT) "RTN","ECBENF",19,0) S ECC=+$P(ECNODE,"^"),ECP=$P(ECNODE,"^",2),ECU=$P(ECNODE,"^",3),ECO=$P(ECNODE,"^",4),ECV=$P(ECNODE,"^",5) "RTN","ECBENF",20,0) S ECU2=$P(ECNODE,"^",7),ECU3=$P(ECNODE,"^",9),ECCPT=$P(ECNODE,"^",11),ECPRPTR=$P(ECNODE,"^",12) "RTN","ECBENF",21,0) ; "RTN","ECBENF",22,0) ;- Get associated clinic from event code screen if null "RTN","ECBENF",23,0) S:$G(EC4)="" EC4=$P($G(^ECJ(+$O(^ECJ("AP",+ECL,+ECD,+ECC,$G(ECP),0)),"PRO")),"^",4) "RTN","ECBENF",24,0) S:$G(ECID)="" ECID=$P($G(^SC(+EC4,0)),"^",7) "RTN","ECBENF",25,0) Q "RTN","ECBENF",26,0) DIE ; "RTN","ECBENF",27,0) L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1 I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^ECH(0),"^",3)+1 L -^ECH(0) G DIE "RTN","ECBENF",28,0) L -^ECH(0) K DD,DO,DIC S X=ECRN,DIC(0)="L",DLAYGO=721,DIC="^ECH(" D FILE^DICN K DIC S ECFN=+Y "RTN","ECBENF",29,0) ; set the zero node "RTN","ECBENF",30,0) S ^ECH(ECFN,0)=ECFN_"^"_ECPS_"^"_ECDT_"^"_ECL_"^"_ECS_"^"_ECM_"^"_ECD_"^"_ECC_"^"_ECP_"^"_ECV_"^"_$S(+ECU:+ECU,1:"")_"^"_ECO_"^"_ECDUZ_"^^"_$S(+ECU2:+ECU2,1:"")_"^^"_$S(+ECU3:+ECU3,1:"")_"^^"_EC4_"^"_ECID_"^"_ECVST_"^"_ECINP "RTN","ECBENF",31,0) ; "RTN","ECBENF",32,0) ; ALB/JAM add CPT procedure modifiers "RTN","ECBENF",33,0) I $O(ECEC(CNT,"MOD",""))'="" D K MODIEN,MOD "RTN","ECBENF",34,0) . S MOD="" F S MOD=$O(ECEC(CNT,"MOD",MOD)) Q:MOD="" D "RTN","ECBENF",35,0) . . S MODIEN=$P(ECEC(CNT,"MOD",MOD),U,2) I MODIEN<0 Q "RTN","ECBENF",36,0) . . K DIC,DD,DO "RTN","ECBENF",37,0) . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""MOD"""_"," "RTN","ECBENF",38,0) . . S DIC("P")=$P(^DD(721,36,0),U,2),X=MODIEN "RTN","ECBENF",39,0) . . D FILE^DICN "RTN","ECBENF",40,0) ; ALB/ESD - Set procedure reason into zero node "RTN","ECBENF",41,0) I +ECPRPTR S $P(^ECH(ECFN,0),"^",23)=+ECPRPTR "RTN","ECBENF",42,0) ;set the "P" node "RTN","ECBENF",43,0) S ^ECH(ECFN,"P")=ECCPT_"^"_ECDX_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_ECSC "RTN","ECBENF",44,0) S $P(^ECH(ECFN,"P"),"^",9,11)=ECMST_"^"_ECHNC_"^"_ECCV "RTN","ECBENF",45,0) ; ALB/JAM - add secondary diagnosis codes "RTN","ECBENF",46,0) I $O(ECPT(CNT1,"DXS",""))'="" D K DXSIEN,DXS "RTN","ECBENF",47,0) . S DXS="" F S DXS=$O(ECPT(CNT1,"DXS",DXS)) Q:DXS="" D "RTN","ECBENF",48,0) . . S DXSIEN=$P(ECPT(CNT1,"DXS",DXS),U) I DXSIEN<0 Q "RTN","ECBENF",49,0) . . K DIC,DD,DO "RTN","ECBENF",50,0) . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""DX"""_"," "RTN","ECBENF",51,0) . . S DIC("P")=$P(^DD(721,38,0),U,2),X=DXSIEN "RTN","ECBENF",52,0) . . D FILE^DICN "RTN","ECBENF",53,0) K ECDXX M ECDXX=ECPT(CNT1,"DXS") "RTN","ECBENF",54,0) S PXUPD=$$PXUPD^ECUTL2(ECPS,ECDT,ECL,EC4,ECDX,.ECDXX,ECFN) K PXUPD,ECDXX "RTN","ECBENF",55,0) XREF ; sets crossreferences "RTN","ECBENF",56,0) S DIK="^ECH(",DA=ECFN D IX1^DIK K DA,DIK "RTN","ECBENF",57,0) ; "RTN","ECBENF",58,0) PCE ;format PCE data to send "RTN","ECBENF",59,0) Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q "RTN","ECBENF",60,0) D PCE^ECBEN2U "RTN","ECBENF",61,0) Q "RTN","ECBEP") 0^14^B13997295 "RTN","ECBEP",1,0) ECBEP ;BIR/MAM,JPW-Batch Entry by Procedure ;2 Mar 96 "RTN","ECBEP",2,0) ;;2.0; EVENT CAPTURE ;**4,5,10,17,42,54**;8 May 96 "RTN","ECBEP",3,0) S ECOUT=0 "RTN","ECBEP",4,0) LOCA ; get location "RTN","ECBEP",5,0) D ^ECL K LOC I '$D(ECL) G END "RTN","ECBEP",6,0) UNIT ; get DSS unit "RTN","ECBEP",7,0) I $D(^XUSEC("ECALLU",DUZ)) K DIC S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ",DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))" D ^DIC K DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2),NODE=Y(0) D SETU G:'$D(ECD) UNIT D ^ECBEP1A G CHK "RTN","ECBEP",8,0) S (X,CNT)=0 F S X=$O(^VA(200,DUZ,"EC",X)) Q:'X S CNT=CNT+1,UNIT=$P(^VA(200,DUZ,"EC",X,0),"^"),UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^") "RTN","ECBEP",9,0) I '$D(UNIT(1)) W !!,"You do not have access to any DSS Units. Contact your Event Capture",!,"Package Coordinator if you are responsible for entering procedures for ",!,"a DSS Unit. ",!!,"Press to continue " R X:DTIME G END "RTN","ECBEP",10,0) I '$D(UNIT(2)) S ECD=+$P(UNIT(1),"^"),ECDN=$P(^ECD(ECD,0),"^"),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEP1A G CHK "RTN","ECBEP",11,0) SELU S X=0 W @IOF,!,"DSS Units: ",! F S X=$O(UNIT(X)) Q:'X W !,X_".",?5,$P(UNIT(X),"^",2) "RTN","ECBEP",12,0) W !!,"Select Number: " R X:DTIME S:"^"[X ECOUT=1 I '$T!("^"[X) G END "RTN","ECBEP",13,0) I '$D(UNIT(X)) W !!,"Select the number that corresponds with the DSS unit for which you would like",!,"to enter procedures.",!!,"Press to continue " R X:DTIME G SELU "RTN","ECBEP",14,0) S ECD=+$P(UNIT(X),"^"),ECDN=$P(UNIT(X),"^",2),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEP1A "RTN","ECBEP",15,0) CHK ;check to ask unit again "RTN","ECBEP",16,0) I ECOUT=2 D S ECOUT=0 W @IOF,!,"Location: ",ECLN,!! G UNIT "RTN","ECBEP",17,0) .K EC4,EC4N,ECC,ECCN,ECD,ECDDT,ECDT,ECDN,ECM,ECMN,ECO,ECON,ECP,ECPN,ECPROS,ECS,ECSN,ECTWO "RTN","ECBEP",18,0) .K ECU,ECU2,ECU3,ECUN,ECUN2,ECUN3,ECUC,ECUC2,ECUC3,ECV,ECYN,ECYNZ,NATN,NODE,SYN,^TMP("ECPRO",$J) "RTN","ECBEP",19,0) .K ECAO,ECIR,ECSC,ECCPT,ECDX,ECDXN,ECINP,ECVST,ECZEC,ECID,ECONE,ECPCE,ECPTSTAT,ECMST,ECHNC,ECCV "RTN","ECBEP",20,0) END D ^ECKILL K ^TMP("ECPRO",$J) W @IOF "RTN","ECBEP",21,0) Q "RTN","ECBEP",22,0) SETU ;set DSS Unit info "RTN","ECBEP",23,0) S MSG1=0 "RTN","ECBEP",24,0) I '$D(NODE) D MSG K ECD,ECDN,NODE S ECOUT=0 Q "RTN","ECBEP",25,0) I $P(NODE,"^",8)'=1 S MSG1=3 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q "RTN","ECBEP",26,0) I $P(NODE,"^",6) S MSG1=2 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q "RTN","ECBEP",27,0) S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N") "RTN","ECBEP",28,0) I $O(^ECJ("AP",ECL,ECD,""))']"" S MSG1=1 D MSG K ECC,ECCN,ECD,ECDDT,ECDN,ECM,ECMN,ECPCL,ECS,ECSN,ECYN,NODE,^TMP("ECPRO",$J) S (ECOUT,MSG1)=0 Q "RTN","ECBEP",29,0) S ECS=+$P(NODE,"^",2),ECM=+$P(NODE,"^",3),ECDDT=$P(NODE,"^",12),ECDDT=$S(ECDDT="T":"NOW",ECDDT="N":"NOW",1:"") "RTN","ECBEP",30,0) S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN") "RTN","ECBEP",31,0) S ECYNZ=+$P(NODE,"^",11) "RTN","ECBEP",32,0) Q "RTN","ECBEP",33,0) MSG ;unit msg "RTN","ECBEP",34,0) W !!,"The DSS Unit ",ECDN," that you selected within ",ECLN "RTN","ECBEP",35,0) W !,$S(MSG1=3:"is not defined for Event Capture use",MSG1=2:"is inactive",MSG1=1:"has no procedures defined",1:"is missing information"),"." "RTN","ECBEP",36,0) W " Please select another DSS Unit." "RTN","ECBEP",37,0) W !!,"Press to continue " R X:DTIME "RTN","ECBEP",38,0) Q "RTN","ECBEP1B") 0^6^B46312174 "RTN","ECBEP1B",1,0) ECBEP1B ;BIR/MAM,JPW-Batch Entry by Procedure (cont'd) ;30 Apr 96 "RTN","ECBEP1B",2,0) ;;2.0; EVENT CAPTURE ;**1,4,5,10,13,17,18,42,47,54**;8 May 96 "RTN","ECBEP1B",3,0) CHK ; check unit for valid categories "RTN","ECBEP1B",4,0) K ECC,ECCN,ECHOICE,ECEC,ECSTOP "RTN","ECBEP1B",5,0) S (COUNT,EC1)=0 "RTN","ECBEP1B",6,0) D CATS^ECHECK1 S ECONE="" "RTN","ECBEP1B",7,0) I '$D(ECC(1)) S ECC=0,ECCN="None",ECONE=0 G P "RTN","ECBEP1B",8,0) I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2),ECONE=1 G P "RTN","ECBEP1B",9,0) CATS ; select category "RTN","ECBEP1B",10,0) S X="",CNT=0 "RTN","ECBEP1B",11,0) LIST D HDRP^ECBEN2U S JJ=0 W !,"Categories within "_ECDN_": ",! "RTN","ECBEP1B",12,0) S EC1=0 "RTN","ECBEP1B",13,0) F S CNT=$O(ECC(CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_".",?5,$P(ECC(CNT),"^",2) "RTN","ECBEP1B",14,0) I '$D(ECSTOP),$D(ECHOICE) S ECONE=2 G P "RTN","ECBEP1B",15,0) PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q "RTN","ECBEP1B",16,0) I X="" S ECOUT=2 Q "RTN","ECBEP1B",17,0) I '$D(ECC(X)) W !!,"Select the number corresponding to the category, or ^ to quit.",!!,"Press to continue " R X:DTIME S CNT=CNT-5,X="" G LIST "RTN","ECBEP1B",18,0) S ECHOICE=1,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2),ECONE=2 "RTN","ECBEP1B",19,0) P ;check for valid procedures "RTN","ECBEP1B",20,0) D PROS^ECHECK1 "RTN","ECBEP1B",21,0) I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT "RTN","ECBEP1B",22,0) .W !!,"Within the ",ECLN," location there are no procedures defined",! "RTN","ECBEP1B",23,0) .W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!! "RTN","ECBEP1B",24,0) .W "Press to continue " R X:DTIME S ECOUT=2 Q "RTN","ECBEP1B",25,0) D HDRP^ECBEN2U "RTN","ECBEP1B",26,0) P1 ; "RTN","ECBEP1B",27,0) I '$D(^TMP("ECPRO",$J,2)) S CNT=1,ECONE=ECONE_"^1" D SETP W !,"Procedure: " D G CHKP "RTN","ECBEP1B",28,0) . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50) "RTN","ECBEP1B",29,0) . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",! "RTN","ECBEP1B",30,0) P2 ;ask mul proc "RTN","ECBEP1B",31,0) S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP "RTN","ECBEP1B",32,0) S DIR("?")="^D PROS^ECBEP1B" "RTN","ECBEP1B",33,0) S ECX=$$GETPRO^ECDSUTIL "RTN","ECBEP1B",34,0) I +$G(ECX)=-1,(COUNT=0) S ECOUT=2 D KILLV^ECDSUTIL Q "RTN","ECBEP1B",35,0) I +$G(ECX)=-1,COUNT G FILE "RTN","ECBEP1B",36,0) I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX) "RTN","ECBEP1B",37,0) S ECPCNT=+$G(ECPCNT) "RTN","ECBEP1B",38,0) I ECPCNT=-1!(ECPCNT=-2) D G P2 "RTN","ECBEP1B",39,0) .; Don't display spacebar/return error msg since only 1 procedure "RTN","ECBEP1B",40,0) . D ERRMSG^ECDSUTIL "RTN","ECBEP1B",41,0) . D KILLV^ECDSUTIL "RTN","ECBEP1B",42,0) I ECPCNT>0 D G CHKP "RTN","ECBEP1B",43,0) . S CNT=ECPCNT "RTN","ECBEP1B",44,0) . D SETP "RTN","ECBEP1B",45,0) . S OK=1,ECONE=ECONE_"^2" "RTN","ECBEP1B",46,0) . D KILLV^ECDSUTIL "RTN","ECBEP1B",47,0) I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL "RTN","ECBEP1B",48,0) I CNT=-1 D MSG^ECBEN2U,KILLV^ECDSUTIL Q "RTN","ECBEP1B",49,0) I CNT>0 D G CHKP "RTN","ECBEP1B",50,0) . D SETP "RTN","ECBEP1B",51,0) . S OK=1,ECONE=ECONE_"^2" "RTN","ECBEP1B",52,0) . D KILLV^ECDSUTIL "RTN","ECBEP1B",53,0) Q "RTN","ECBEP1B",54,0) ; "RTN","ECBEP1B",55,0) PROS ; "RTN","ECBEP1B",56,0) S X="",CNT=0 K ECHOICE "RTN","ECBEP1B",57,0) LISTP D HDRP^ECBEN2U S JJ=1 W !,"Available Procedures within "_ECDN_": ",! "RTN","ECBEP1B",58,0) W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",! "RTN","ECBEP1B",59,0) S EC1=1 "RTN","ECBEP1B",60,0) F S CNT=$O(^TMP("ECPRO",$J,CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_".",?5,$E($P(^TMP("ECPRO",$J,CNT),"^",4),1,30),?38,$E($P(^(CNT),"^",3),1,30),?72,$P(^(CNT),"^",5) "RTN","ECBEP1B",61,0) I X="" D "RTN","ECBEP1B",62,0) .W !!?5,"Select by number, CPT or national code, procedure name, or synonym.",!?5,"Synonym must be preceded by the & character (example: &TESTSYN).",! "RTN","ECBEP1B",63,0) .W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",! "RTN","ECBEP1B",64,0) Q "RTN","ECBEP1B",65,0) ; "RTN","ECBEP1B",66,0) CHKP ; "RTN","ECBEP1B",67,0) ;Ask CPT procedure modifiers "RTN","ECBEP1B",68,0) I ECCPT'="" D K ECMODF,ECMODS "RTN","ECBEP1B",69,0) . S ECMODS=$G(ECMODS) "RTN","ECBEP1B",70,0) . S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR) "RTN","ECBEP1B",71,0) I $G(ECERR) S ECOUT=2 K ECERR,ECMOD D KILLV^ECDSUTIL Q "RTN","ECBEP1B",72,0) ; "RTN","ECBEP1B",73,0) ;- Ask procedure reason "RTN","ECBEP1B",74,0) I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0)) "RTN","ECBEP1B",75,0) K ECPRPTR "RTN","ECBEP1B",76,0) I ECSCR>0,($P($G(^ECJ(ECSCR,"PRO")),"^",5)=1),(+$O(^ECL("AD",ECSCR,0))) D "RTN","ECBEP1B",77,0) . S ECPRPTR=0 "RTN","ECBEP1B",78,0) . S DIC="^ECL(",DIC(0)="QEAM" "RTN","ECBEP1B",79,0) . S DIC("A")="Procedure Reason: ",DIC("S")="I $P(^(0),U,2)=ECSCR" "RTN","ECBEP1B",80,0) . D ^DIC K DIC "RTN","ECBEP1B",81,0) . I +Y>0 S ECPRPTR=+Y "RTN","ECBEP1B",82,0) K ECSCR W ! "RTN","ECBEP1B",83,0) ; "RTN","ECBEP1B",84,0) I $G(ECCN)]"" W !,"Category: ",ECCN "RTN","ECBEP1B",85,0) W !,"Procedure: ",$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50) "RTN","ECBEP1B",86,0) W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")" "RTN","ECBEP1B",87,0) ; "RTN","ECBEP1B",88,0) ;- Display CPT procedure Modifiers "RTN","ECBEP1B",89,0) I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D "RTN","ECBEP1B",90,0) . W !?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55) "RTN","ECBEP1B",91,0) ;- Display procedure reason "RTN","ECBEP1B",92,0) I +$G(ECPRPTR) S ECPRSL=$P($G(^ECL(+ECPRPTR,0)),"^") W !,"Procedure Reason: ",$P($G(^ECR(+ECPRSL,0)),"^") "RTN","ECBEP1B",93,0) W !,"Provider:",?14,$E($P(ECU,"^",2),1,24),?42,$E($P(ECU,"^",3),1,36) "RTN","ECBEP1B",94,0) I +ECU2 W !,"Provider #2:",?14,$E($P(ECU2,"^",2),1,24),?42,$E($P(ECU2,"^",3),1,36) "RTN","ECBEP1B",95,0) I +ECU3 W !,"Provider #3:",?14,$E($P(ECU3,"^",2),1,24),?42,$E($P(ECU3,"^",3),1,36) "RTN","ECBEP1B",96,0) W ! "RTN","ECBEP1B",97,0) W !!,"Is this information correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") Q "RTN","ECBEP1B",98,0) S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" "RTN","ECBEP1B",99,0) I "YyNn"'[ECYN W !!,"Enter if the information listed above is correct and should be",!,"entered for the patients selected. Enter NO to re-enter the information",!,"for this procedure.",! "RTN","ECBEP1B",100,0) I "YyNn"'[ECYN W !!,"Press to continue " R X:DTIME G CHKP "RTN","ECBEP1B",101,0) I "Nn"[ECYN,$P(ECONE,"^")<2,$P(ECONE,"^",2)<2 S ECOUT=2 Q "RTN","ECBEP1B",102,0) I "Nn"[ECYN K ECHOICE,ECCN,ECP,ECPN,ECMOD,ECONE,^TMP("ECPRO",$J) G CHK "RTN","ECBEP1B",103,0) ; "RTN","ECBEP1B",104,0) ;- File procedure reason in local array ECEC (used in ECBEPF) "RTN","ECBEP1B",105,0) S COUNT=COUNT+1,ECEC(COUNT)=ECC_"^"_ECP_"^"_$S(+ECU:+ECU,1:"")_"^^"_$S(+ECU2:+ECU2,1:"")_"^^"_$S(+ECU3:+ECU3,1:"")_"^^"_ECCPT_"^"_EC4_"^"_ECID_$S(+$G(ECPRPTR):"^"_ECPRPTR,1:"") "RTN","ECBEP1B",106,0) ;- File CPT modifiers in local array ECEC "RTN","ECBEP1B",107,0) I ECCPT'="",$O(ECMOD(ECCPT,""))'="" D "RTN","ECBEP1B",108,0) . M ECEC(COUNT,"MOD")=ECMOD(ECCPT) "RTN","ECBEP1B",109,0) FILE ;file proc "RTN","ECBEP1B",110,0) I '$D(ECEC(1)) W !!,"No procedures have been selected for filing. Please re-enter the ",!,"information for the procedures, or ^ to exit.",!!,"Press to continue" R X:DTIME S:X="^" ECOUT=1 K ECTEMP,^TMP("ECPRO",$J) G P "RTN","ECBEP1B",111,0) D ^ECBEP2A Q:ECOUT K ECA,ECCN,ECEC,ECHOICE,ECJLP,ECP,ECPN,ECPT,ECO,ECON,ECV,NATN,NODE,SYN,^TMP("ECPRO",$J),ECDX,ECDXN,ECINP,ECCPT,ECSC,ECIR,ECZEC,ECAO,ECVST,ECPTSTAT,ECMST,ECHNC,ECCV,ECMOD,ECPTCD G CHK "RTN","ECBEP1B",112,0) END Q "RTN","ECBEP1B",113,0) SETP ;set proc "RTN","ECBEP1B",114,0) S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),SYN=$P(^(CNT),"^",3),NATN=$P(^(CNT),"^",5),VOL=$P(^(CNT),"^",6) "RTN","ECBEP1B",115,0) S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP) "RTN","ECBEP1B",116,0) S ECPTCD="" I ECCPT'="" D "RTN","ECBEP1B",117,0) . S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT) I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2) "RTN","ECBEP1B",118,0) W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50) "RTN","ECBEP1B",119,0) W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",! "RTN","ECBEP1B",120,0) S EC4=$P(^TMP("ECPRO",$J,CNT),"^",2),EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4) "RTN","ECBEP1B",121,0) S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7) "RTN","ECBEP1B",122,0) Q "RTN","ECBEP1B",123,0) SELC ; select category "RTN","ECBEP1B",124,0) W !!,$S(EC1:"Press",1:"Select Number, or press")_" to continue listing "_$S(EC1:"procedures",1:"categories")_" or '^' to stop: " R X:DTIME I '$T!(X="^") S (ECSTOP,ECHOICE)=1 Q "RTN","ECBEP1B",125,0) I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q "RTN","ECBEP1B",126,0) I 'EC1,'$D(ECC(X)) D MSG1^ECBEN2U S ECOUT=2 Q "RTN","ECBEP1B",127,0) I EC1,'$D(^TMP("ECPRO",$J,X)) D MSG1^ECBEN2U S ECOUT=2 Q "RTN","ECBEP1B",128,0) S ECHOICE=1 "RTN","ECBEP1B",129,0) I 'EC1 S ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q "RTN","ECBEP1B",130,0) Q "RTN","ECBEP2A") 0^7^B32048320 "RTN","ECBEP2A",1,0) ECBEP2A ;BIR/MAM,JPW-Batch Enter by Procedure (cont'd) ;1 May 96 "RTN","ECBEP2A",2,0) ;;2.0; EVENT CAPTURE ;**4,5,10,13,17,18,23,33,41,42,54**;8 May 96 "RTN","ECBEP2A",3,0) EN ;entry pt "RTN","ECBEP2A",4,0) D HDR "RTN","ECBEP2A",5,0) S CNT=0 "RTN","ECBEP2A",6,0) PATS ; get patients "RTN","ECBEP2A",7,0) W ! Q:ECOUT=1 K ECADD "RTN","ECBEP2A",8,0) K DIC,DUOUT S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S($D(ECPT):"Select Next Patient: ",1:"Select Patient: ") "RTN","ECBEP2A",9,0) D ^DIC K DIC S OK=0 "RTN","ECBEP2A",10,0) I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q "RTN","ECBEP2A",11,0) I Y<0,CNT=0 S ECOUT=2 Q "RTN","ECBEP2A",12,0) I Y<0 D G:ECOUT'=2 PATS I ECOUT=2 D KILL Q "RTN","ECBEP2A",13,0) .D LIST Q:ECOUT Q:'$O(ECPT(0)) Q:$G(ECADD)="A" "RTN","ECBEP2A",14,0) .S ECTWO=0 K ECHOICE D ^ECBEP2B S ECOUT=2 "RTN","ECBEP2A",15,0) I $O(ECPT(0)) S JJ="" F S JJ=$O(ECPT(JJ)) Q:'JJ!(OK=1) I +$G(ECPT(JJ))=+Y S OK=1 W !!,"Patient already selected. Please select another patient.",! "RTN","ECBEP2A",16,0) I OK=1 G PATS "RTN","ECBEP2A",17,0) N YY,ECUP D I $G(ECUP)="^" G PATS "RTN","ECBEP2A",18,0) . S YY=Y,DFN=+Y D 2^VADPT S Y=YY I +VADM(6) D "RTN","ECBEP2A",19,0) . . W !!,"WARNING ",VADM(7),!! "RTN","ECBEP2A",20,0) . . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME "RTN","ECBEP2A",21,0) S CNT=CNT+1,CNT1=CNT,ECPT(CNT)=+Y_"^"_$P(Y,"^",2) D ASK "RTN","ECBEP2A",22,0) G PATS "RTN","ECBEP2A",23,0) ; "RTN","ECBEP2A",24,0) LIST ; list patients "RTN","ECBEP2A",25,0) K ECADD "RTN","ECBEP2A",26,0) W @IOF,!,"Patients Selected for Batch Entry: ",! F I=0:0 S I=$O(ECPT(I)) Q:'I W:I#2 ! W:I#2=0 ?40 W I_". "_$P(ECPT(I),"^",2) "RTN","ECBEP2A",27,0) W !!,"Is this list correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q "RTN","ECBEP2A",28,0) S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" I "YyNn"'[ECYN W !!,"Enter if this list is complete, or NO to add or delete",!,"patients on the list.",!!,"Press to continue " R X:DTIME G LIST "RTN","ECBEP2A",29,0) I "Yy"[ECYN Q:$O(ECPT(0)) D NOBODY Q:ECOUT "RTN","ECBEP2A",30,0) ADD W !!,"Add or Delete Patients ? ADD// " R ECADD:DTIME I '$T!(ECADD="^") S ECOUT=1 Q "RTN","ECBEP2A",31,0) S ECADD=$E(ECADD) S:ECADD="" ECADD="A" I "AaDd"'[ECADD W !!,"Enter to make additions to the list, or D to delete a ",!,"patient from the list." K ECADD G ADD "RTN","ECBEP2A",32,0) Q:ECADD="A" "RTN","ECBEP2A",33,0) DEL ; delete patients from list "RTN","ECBEP2A",34,0) I '$D(ECPT(1)) D NOBODY Q:ECOUT G LIST "RTN","ECBEP2A",35,0) W !!,"Select Number: " R X:DTIME I '$T!(X="^") S ECOUT=1 Q "RTN","ECBEP2A",36,0) I X="" Q "RTN","ECBEP2A",37,0) I '$D(ECPT(X)) W !!,"Select the number corresponding to the patient that you would like",!,"to remove from the list.",!!,"Press to continue " R X:DTIME S ECMORE=1 D LIST Q:ECOUT G DEL "RTN","ECBEP2A",38,0) F I=X+1:1:CNT S ECPT(I-1)=ECPT(I) "RTN","ECBEP2A",39,0) K ECPT(CNT),I S CNT=CNT-1 "RTN","ECBEP2A",40,0) W !!,"Patient deleted.",!!,"Press to continue " R X:DTIME "RTN","ECBEP2A",41,0) G LIST "RTN","ECBEP2A",42,0) Q "RTN","ECBEP2A",43,0) HDR ; "RTN","ECBEP2A",44,0) W @IOF,!,"Location: ",ECLN "RTN","ECBEP2A",45,0) W !,"DSS Unit: ",ECDN "RTN","ECBEP2A",46,0) I $G(ECCN)]"" W !,"Category: ",ECCN "RTN","ECBEP2A",47,0) W !,"Procedure: "_$S(ECCPT'="":ECPTCD_" ",1:"")_$E(ECPN,1,50) "RTN","ECBEP2A",48,0) W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")" "RTN","ECBEP2A",49,0) ;- Display CPT procedure Modifiers "RTN","ECBEP2A",50,0) I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D "RTN","ECBEP2A",51,0) . W !?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55) "RTN","ECBEP2A",52,0) W !,"Procedure Date: ",ECDATE "RTN","ECBEP2A",53,0) W !!,"Provider:",?14,$P(ECU,"^",2),!?16,$P(ECU,"^",3) "RTN","ECBEP2A",54,0) I +ECU2 W !,"Provider #2:",?14,$P(ECU2,"^",2),!?16,$P(ECU2,"^",3) "RTN","ECBEP2A",55,0) I +ECU3 W !,"Provider #3:",?14,$P(ECU3,"^",2),!?16,$P(ECU3,"^",3) "RTN","ECBEP2A",56,0) W ! "RTN","ECBEP2A",57,0) Q "RTN","ECBEP2A",58,0) ; "RTN","ECBEP2A",59,0) NOBODY ;No patients selected "RTN","ECBEP2A",60,0) I $D(ECADD),ECADD="D" W !!,"You cannot delete patients when your patient list is empty." "RTN","ECBEP2A",61,0) I $G(ECADD)'="D" W !!,"You have selected no patients." "RTN","ECBEP2A",62,0) R !!,"Do you wish to quit? Y//",X:DTIME S X=$E(X) I '$T!(X="^") S ECOUT=1 Q "RTN","ECBEP2A",63,0) S:X="" X="Y" I "yY"[X S ECOUT=1 Q "RTN","ECBEP2A",64,0) I "nN"'[X W !,"Answer ""N"" to continue selection, or enter return to quit",! G NOBODY "RTN","ECBEP2A",65,0) Q "RTN","ECBEP2A",66,0) ADCAT ;add category/procedures for patients "RTN","ECBEP2A",67,0) ;D ^ECBEN2A I ECOUT=1 Q "RTN","ECBEP2A",68,0) ;W !!! K DIR,DIRUT,DA S DIR(0)="Y",DIR("A")="Do you want to enter another category and procedure for these patients" D ^DIR Q:$D(DIRUT)!'Y "RTN","ECBEP2A",69,0) Q "RTN","ECBEP2A",70,0) KILL ;kill arrays and variables "RTN","ECBEP2A",71,0) K ECSC,ECZEC,ECIR,ECDX,ECDXN,ECVST,ECINP,ECAO,ECPTSTAT,ECMST,ECHNC,ECCV "RTN","ECBEP2A",72,0) K ECA,ECHOICE,ECJLP,ECPT,ECO,ECON,ECV,ECDXS,ECDXIEN "RTN","ECBEP2A",73,0) S ECOUT=0 "RTN","ECBEP2A",74,0) Q "RTN","ECBEP2A",75,0) ASK ; ask ord sect & vol "RTN","ECBEP2A",76,0) W !!,"DSS Unit: "_ECDN,?50,"Category: "_ECCN,! "RTN","ECBEP2A",77,0) W "Procedure: "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50) "RTN","ECBEP2A",78,0) W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",! "RTN","ECBEP2A",79,0) ;- Display CPT procedure Modifiers "RTN","ECBEP2A",80,0) I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D "RTN","ECBEP2A",81,0) . W ?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55),! "RTN","ECBEP2A",82,0) W "Patient: ",$P(ECPT(CNT),"^",2),! "RTN","ECBEP2A",83,0) ; "RTN","ECBEP2A",84,0) ;- Determine inpatient/outpatient status "RTN","ECBEP2A",85,0) S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECPT(CNT)),+$G(ECDT)) "RTN","ECBEP2A",86,0) I ECPTSTAT="" D INOUTERR^ECUTL0 Q "RTN","ECBEP2A",87,0) ; "RTN","ECBEP2A",88,0) ;- Determine patient eligibility "RTN","ECBEP2A",89,0) I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D "RTN","ECBEP2A",90,0) . I $$MULTELG^ECUTL0(+$G(ECPT(CNT))) S ECELIG=+$$ELGLST^ECUTL0 "RTN","ECBEP2A",91,0) . E S ECELIG=+$G(VAEL(1)) "RTN","ECBEP2A",92,0) K VAEL "RTN","ECBEP2A",93,0) ; "RTN","ECBEP2A",94,0) ;- Display inpatient/outpatient status message "RTN","ECBEP2A",95,0) D DSPSTAT^ECUTL0(ECPTSTAT) "RTN","ECBEP2A",96,0) ; "RTN","ECBEP2A",97,0) O ; ord sect "RTN","ECBEP2A",98,0) K DIC,DUOUT S DIC=723,DIC(0)="QEAMZ",DIC("A")="Ordering Section: " "RTN","ECBEP2A",99,0) D ^DIC K DIC I Y<0 D DELPT(.CNT) Q "RTN","ECBEP2A",100,0) S ECO=+Y,ECON=$P(Y,"^",2) "RTN","ECBEP2A",101,0) V ; vol "RTN","ECBEP2A",102,0) S:'VOL VOL=1 "RTN","ECBEP2A",103,0) W !,"Volume: "_VOL_"//" R X:DTIME I '$T S ECOUT=1 Q "RTN","ECBEP2A",104,0) I X="^" D DELPT(.CNT) Q "RTN","ECBEP2A",105,0) S:X="" X=VOL I X'?1.2N!'X W !!,"Enter a whole number between 1 and 99." G V "RTN","ECBEP2A",106,0) S ECV=X "RTN","ECBEP2A",107,0) DIAG ;diagnosis, in/outpatient, visit "RTN","ECBEP2A",108,0) S (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)="" "RTN","ECBEP2A",109,0) S ECDFN=$P(ECPT(CNT),U) "RTN","ECBEP2A",110,0) I $P(ECPCE,"~",2)="N" G NODE "RTN","ECBEP2A",111,0) D PCEQST^ECBEN2U "RTN","ECBEP2A",112,0) I ECOUT D DELPT(.CNT) Q "RTN","ECBEP2A",113,0) NODE ;set node "RTN","ECBEP2A",114,0) ;- Get associated clinic from event code screen and DSS ID if null "RTN","ECBEP2A",115,0) S:$G(EC4)="" EC4=$P($G(^ECJ(+$O(^ECJ("AP",+ECL,+ECD,+ECC,$G(ECP),0)),"PRO")),"^",4) "RTN","ECBEP2A",116,0) S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7) "RTN","ECBEP2A",117,0) S ECPT(CNT)=ECPT(CNT)_"^"_ECO_"^"_ECON_"^"_ECV_"^"_ECDX_"^"_$S(ECINP="":$G(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV "RTN","ECBEP2A",118,0) I $D(ECDXS) M ECPT(CNT,"DXS")=ECDXS K ECDXS "RTN","ECBEP2A",119,0) S ECELPT(CNT)=$S($G(ECELIG):ECELIG,1:"") K ECPTSTAT "RTN","ECBEP2A",120,0) Q "RTN","ECBEP2A",121,0) ; "RTN","ECBEP2A",122,0) DELPT(CNT) ;deselect patient due to missing required data "RTN","ECBEP2A",123,0) N DIR,Y "RTN","ECBEP2A",124,0) K ECPT(CNT) S CNT=CNT-1 "RTN","ECBEP2A",125,0) W !,"Required data missing.",!,"Patient deselected...",! "RTN","ECBEP2A",126,0) S ECOUT=0 "RTN","ECBEP2A",127,0) S DIR(0)="E",DIR("A")="Press RETURN to continue" "RTN","ECBEP2A",128,0) D ^DIR "RTN","ECBEP2A",129,0) W ! "RTN","ECBEP2A",130,0) Q "RTN","ECBEPF") 0^4^B9728135 "RTN","ECBEPF",1,0) ECBEPF ;BIR/MAM,JPW-Stuff Batch Entry by Procedure (cont'd) ;2 Mar 96 "RTN","ECBEPF",2,0) ;;2.0; EVENT CAPTURE ;**4,5,13,17,18,23,42,54**;8 May 96 "RTN","ECBEPF",3,0) CRAM ; entry "RTN","ECBEPF",4,0) S ECDT=$P(ECA,"^"),ECL=$P(ECA,"^",2),ECS=$P(ECA,"^",3),ECM=$P(ECA,"^",4),ECD=$P(ECA,"^",5) "RTN","ECBEPF",5,0) S ECPCE=$P(ECA,"^",6) "RTN","ECBEPF",6,0) S (CNT,CNT1)=0 F S CNT1=$O(ECPT(CNT1)) Q:'CNT1 D SET F S CNT=$O(ECEC(CNT)) Q:'CNT D DIE "RTN","ECBEPF",7,0) END D ^ECKILL K DLAYGO S:$D(ZTQUEUED) ZTREQ="@" "RTN","ECBEPF",8,0) Q "RTN","ECBEPF",9,0) SET ; "RTN","ECBEPF",10,0) S ECPS=$P(ECPT(CNT1),"^"),ECO=$P(ECPT(CNT1),"^",3),ECV=+$P(ECPT(CNT1),"^",5) "RTN","ECBEPF",11,0) S ECDX=$P(ECPT(CNT1),"^",6),ECINP=$P(ECPT(CNT1),"^",7),ECVST=$P(ECPT(CNT1),"^",8),ECSC=$P(ECPT(CNT1),"^",9),ECAO=$P(ECPT(CNT1),"^",10),ECIR=$P(ECPT(CNT1),"^",11) "RTN","ECBEPF",12,0) S ECZEC=$P(ECPT(CNT1),"^",12),EC4=$P(ECPT(CNT1),"^",13),ECID=$P(ECPT(CNT1),"^",14) "RTN","ECBEPF",13,0) S ECMST=$P(ECPT(CNT1),"^",15),ECHNC=$P(ECPT(CNT1),"^",16),ECCV=$P(ECPT(CNT1),"^",17) "RTN","ECBEPF",14,0) S ECELIG=$G(ECELPT(CNT1)) "RTN","ECBEPF",15,0) Q "RTN","ECBEPF",16,0) DIE ; "RTN","ECBEPF",17,0) L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1 I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^ECH(0),"^",3)+1 L -^ECH(0) G DIE "RTN","ECBEPF",18,0) L -^ECH(0) K DD,DO,DIC S X=ECRN,DIC(0)="L",DLAYGO=721,DIC="^ECH(" D FILE^DICN K DIC S ECFN=+Y "RTN","ECBEPF",19,0) S ECNODE=ECEC(CNT),ECC=+$P(ECNODE,"^"),ECP=$P(ECNODE,"^",2),ECU=$P(ECNODE,"^",3),ECPRPTR=$P(ECNODE,"^",12) "RTN","ECBEPF",20,0) S ECU2=$P(ECNODE,"^",5),ECU3=$P(ECNODE,"^",7) "RTN","ECBEPF",21,0) S ECCPT=$P(ECNODE,"^",9) "RTN","ECBEPF",22,0) ; set the zero node "RTN","ECBEPF",23,0) S ^ECH(ECFN,0)=ECFN_"^"_ECPS_"^"_ECDT_"^"_ECL_"^"_ECS_"^"_ECM_"^"_ECD_"^"_ECC_"^"_ECP_"^"_ECV_"^"_$S(+ECU:+ECU,1:"")_"^"_ECO_"^"_ECDUZ_"^^"_$S(+ECU2:+ECU2,1:"")_"^^"_$S(+ECU3:+ECU3,1:"")_"^^"_EC4_"^"_ECID_"^"_ECVST_"^"_ECINP "RTN","ECBEPF",24,0) ; "RTN","ECBEPF",25,0) ;ALB/ESD - Set procedure reason into zero node "RTN","ECBEPF",26,0) I +ECPRPTR S $P(^ECH(ECFN,0),"^",23)=+ECPRPTR "RTN","ECBEPF",27,0) ;set the "P" node "RTN","ECBEPF",28,0) S ^ECH(ECFN,"P")=ECCPT_"^"_ECDX_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_ECSC "RTN","ECBEPF",29,0) S $P(^ECH(ECFN,"P"),"^",9,11)=ECMST_"^"_ECHNC_"^"_ECCV "RTN","ECBEPF",30,0) ;add secondary diagnosis codes "RTN","ECBEPF",31,0) I $O(ECPT(CNT1,"DXS",""))'="" D K DXSIEN,DXS "RTN","ECBEPF",32,0) . S DXS="" F S DXS=$O(ECPT(CNT1,"DXS",DXS)) Q:DXS="" D "RTN","ECBEPF",33,0) . . S DXSIEN=$P(ECPT(CNT1,"DXS",DXS),U) I DXSIEN<0 Q "RTN","ECBEPF",34,0) . . K DIC,DD,DO "RTN","ECBEPF",35,0) . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""DX"""_"," "RTN","ECBEPF",36,0) . . S DIC("P")=$P(^DD(721,38,0),U,2),X=DXSIEN "RTN","ECBEPF",37,0) . . D FILE^DICN "RTN","ECBEPF",38,0) K ECDXX M ECDXX=ECPT(CNT1,"DXS") "RTN","ECBEPF",39,0) S PXUPD=$$PXUPD^ECUTL2(ECPS,ECDT,ECL,EC4,ECDX,.ECDXX,ECFN) K PXUPD,ECDXX "RTN","ECBEPF",40,0) ;add CPT procedure modifiers "RTN","ECBEPF",41,0) I $O(ECEC(CNT,"MOD",""))'="" D K MODIEN,MOD "RTN","ECBEPF",42,0) . S MOD="" F S MOD=$O(ECEC(CNT,"MOD",MOD)) Q:MOD="" D "RTN","ECBEPF",43,0) . . S MODIEN=$P(ECEC(CNT,"MOD",MOD),U,2) I MODIEN<0 Q "RTN","ECBEPF",44,0) . . K DIC,DD,DO "RTN","ECBEPF",45,0) . . S DIC(0)="L",DA(1)=ECFN,DIC="^ECH("_DA(1)_","_"""MOD"""_"," "RTN","ECBEPF",46,0) . . S DIC("P")=$P(^DD(721,36,0),U,2),X=MODIEN "RTN","ECBEPF",47,0) . . D FILE^DICN "RTN","ECBEPF",48,0) XREF ; sets crossreferences "RTN","ECBEPF",49,0) S DIK="^ECH(",DA=ECFN D IX1^DIK K DA,DIK "RTN","ECBEPF",50,0) PCE ;format data to send PCE "RTN","ECBEPF",51,0) Q:$P(ECPCE,"~",2)="N" I $P(ECPCE,"~",2)="O"&(ECINP'="O") Q "RTN","ECBEPF",52,0) D PCE^ECBEN2U "RTN","ECBEPF",53,0) Q "RTN","ECEFPAT") 0^16^B54374795 "RTN","ECEFPAT",1,0) ECEFPAT ;ALB/JAM-Enter Event Capture Data Patient Filer ;12 Oct 00 "RTN","ECEFPAT",2,0) ;;2.0; EVENT CAPTURE ;**25,32,39,42,47,49,54**;8 May 96 "RTN","ECEFPAT",3,0) ; "RTN","ECEFPAT",4,0) FILE ;Used by the RPC broker to file patient encounter in file #721 "RTN","ECEFPAT",5,0) ; Variables passed in "RTN","ECEFPAT",6,0) ; ECIEN - IEN of #721, if editing "RTN","ECEFPAT",7,0) ; ECDEL - Delete record. 1- YES; 0- 0, null or undefine for NO. "RTN","ECEFPAT",8,0) ; ECDFN - Patient IEN for file #2 "RTN","ECEFPAT",9,0) ; ECDT - Date and time of procedure "RTN","ECEFPAT",10,0) ; ECL - Location "RTN","ECEFPAT",11,0) ; ECD - DSS Unit "RTN","ECEFPAT",12,0) ; ECC - Category "RTN","ECEFPAT",13,0) ; ECP - Procedure "RTN","ECEFPAT",14,0) ; ECVOL - Volume "RTN","ECEFPAT",15,0) ; ECU - Provider "RTN","ECEFPAT",16,0) ; ECMN - Ordering Section "RTN","ECEFPAT",17,0) ; ECDUZ - Entered/Edited by, pointer to #200 "RTN","ECEFPAT",18,0) ; ECU2 - Provider 2, optional "RTN","ECEFPAT",19,0) ; ECU3 - Provider 3, optional "RTN","ECEFPAT",20,0) ; ECDX - Primary Diagnosis "RTN","ECEFPAT",21,0) ; ECDXS - Seconday Diagnosis; multiple, optional "RTN","ECEFPAT",22,0) ; EC4 - Asssociated Clinic, required if sending data to PCE "RTN","ECEFPAT",23,0) ; ECPTSTAT- Patient Status "RTN","ECEFPAT",24,0) ; ECPXREAS- Procedure reason, optional "RTN","ECEFPAT",25,0) ; ECMOD - CPT modifiers, optional "RTN","ECEFPAT",26,0) ; ECLASS - Classification, optional "RTN","ECEFPAT",27,0) ; ECELIG - Eligibility, optional "RTN","ECEFPAT",28,0) ; "RTN","ECEFPAT",29,0) ; Variable return "RTN","ECEFPAT",30,0) ; ^TMP($J,"ECMSG",n)=Success or failure to file in #721^Message "RTN","ECEFPAT",31,0) ; "RTN","ECEFPAT",32,0) N NODE,ECS,ECM,ECID,ECCPT,ECINT,ECPCE,ECX,ECERR,ECOUT,ECFLG "RTN","ECEFPAT",33,0) S ECFLG=1,ECERR=0 D CHKDT(1) I ECERR Q "RTN","ECEFPAT",34,0) F ECX="ECU","ECU2","ECU3" D I ECERR Q "RTN","ECEFPAT",35,0) .I $G(@ECX)="" Q "RTN","ECEFPAT",36,0) .S NODE=$$GET^XUA4A72(@ECX,ECDT) I +NODE'>0 S ECERR=1 D Q "RTN","ECEFPAT",37,0) ..S ^TMP($J,"ECMSG",1)="0^Provider doesn't have an active Person class" "RTN","ECEFPAT",38,0) I $G(ECIEN)'="" S ECFLG=0 D I ECERR Q "RTN","ECEFPAT",39,0) . I '$D(^ECH(ECIEN)) S ECERR=1,^TMP($J,"ECMSG",1)="0^Pat IEN Not Found" "RTN","ECEFPAT",40,0) I $G(ECDEL) K ^TMP($J,"ECMSG") D Q "RTN","ECEFPAT",41,0) .S ECVST=$P($G(^ECH(ECIEN,0)),"^",21) I ECVST D "RTN","ECEFPAT",42,0) ..;* Resend all EC records with same Visit file entry to PCE "RTN","ECEFPAT",43,0) ..;* Remove Visit entry from ^ECH( so DELVFILE will complete cleanup "RTN","ECEFPAT",44,0) ..S ECVAR1=$$FNDVST^ECUTL(ECVST) K ECVAR1 "RTN","ECEFPAT",45,0) ..;Set VALQUIET to stop Amb Care validator from broadcasting to screen "RTN","ECEFPAT",46,0) ..S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST) K ECVST,VALQUIET "RTN","ECEFPAT",47,0) .S DA=ECIEN,DIK="^ECH(" D ^DIK K DA,DIK,ECVV "RTN","ECEFPAT",48,0) .S ^TMP($J,"ECMSG",1)="1^Procedure Deleted" "RTN","ECEFPAT",49,0) S ECDT=+ECDT,NODE=$G(^ECD(ECD,0)) I NODE="" D MSG Q "RTN","ECEFPAT",50,0) S ECFN=$G(ECIEN),ECVOL=$G(ECVOL,1),ECS=$P(NODE,U,2),ECM=$P(NODE,U,3) "RTN","ECEFPAT",51,0) S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N") "RTN","ECEFPAT",52,0) ;S ECPTSTAT=$$INOUTPT^ECUTL0(ECDFN,+ECDT) ;pat stat may not need "RTN","ECEFPAT",53,0) I $G(EC4)="" D GETCLN^ECEDF "RTN","ECEFPAT",54,0) S ECID=$S(+EC4:$P($G(^SC(+EC4,0)),"^",7),1:""),ECINP=ECPTSTAT "RTN","ECEFPAT",55,0) I $S($P(ECPCE,"~",2)="N":0,$P(ECPCE,"~",2)="O"&(ECINP'="O"):0,1:1) D "RTN","ECEFPAT",56,0) .D CHKDT(2) "RTN","ECEFPAT",57,0) Q:ECERR I ECFLG D NEWIEN "RTN","ECEFPAT",58,0) S ECCPT=$S(ECP["ICPT":+ECP,1:$P($G(^EC(725,+ECP,0)),U,5)) "RTN","ECEFPAT",59,0) K DA,DR,DIE S DIE="^ECH(",(DA,ECFN)=ECIEN K ECIEN "RTN","ECEFPAT",60,0) S DR=".01////"_ECFN_";1////"_ECDFN_";3////"_ECL_";4////"_ECS "RTN","ECEFPAT",61,0) S DR=DR_";5////"_ECM_";6////"_ECD_";7////"_+ECC_";9////"_ECVOL "RTN","ECEFPAT",62,0) S $P(^ECH(ECFN,0),"^",9)=ECP "RTN","ECEFPAT",63,0) D ^DIE I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",64,0) S DA=ECFN,DR="10////"_ECU_";11////"_ECMN_";13////"_ECDUZ_";2////"_ECDT "RTN","ECEFPAT",65,0) S ECU2=$G(ECU2),ECU3=$G(ECU3),ECPXREAS=$G(ECPXREAS) "RTN","ECEFPAT",66,0) S DR=DR_";15////"_$S(+ECU2:+ECU2,1:"@")_";17////"_$S(+ECU3:+ECU3,1:"@") "RTN","ECEFPAT",67,0) S DR=DR_";19////"_$S(+ECCPT:ECCPT,1:"@")_";20////"_ECDX "RTN","ECEFPAT",68,0) S DR=DR_";26////"_$G(EC4)_";27////"_$G(ECID)_";29////"_ECPTSTAT "RTN","ECEFPAT",69,0) S DR=DR_";34////"_$S(ECPXREAS="":"@",1:ECPXREAS) "RTN","ECEFPAT",70,0) D ^DIE I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",71,0) S ^DISV(DUZ,"^VA(200,")=$S(+ECU3>0:ECU3,+ECU2>0:ECU2,1:ECU) ;5/30/03 "RTN","ECEFPAT",72,0) ;Remove Old CPT modifiers "RTN","ECEFPAT",73,0) I 'ECFLG D "RTN","ECEFPAT",74,0) . K OLDMOD S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""MOD"",",DA=0 "RTN","ECEFPAT",75,0) . F S DA=$O(^ECH(ECDA,"MOD",DA)) Q:'DA S OLDMOD(DA)="" D ^DIK "RTN","ECEFPAT",76,0) . K DA,ECDA,DIK,^ECH(ECFN,"MOD") "RTN","ECEFPAT",77,0) .;Remove old secondary diagnosis codes "RTN","ECEFPAT",78,0) . K OLDDXS S (ECDA,DA(1))=ECFN,DIK="^ECH("_DA(1)_",""DX"",",DA=0 "RTN","ECEFPAT",79,0) . F S DA=$O(^ECH(ECDA,"DX",DA)) Q:'DA S OLDDXS(DA)="" D ^DIK "RTN","ECEFPAT",80,0) . K DA,ECDA,DIK,^ECH(ECFN,"DX") "RTN","ECEFPAT",81,0) I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",82,0) ;File CPT modifiers "RTN","ECEFPAT",83,0) I $G(ECMOD)'="" D "RTN","ECEFPAT",84,0) . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2) "RTN","ECEFPAT",85,0) . S DIC="^ECH("_DA(1)_","_"""MOD"""_"," "RTN","ECEFPAT",86,0) . F ECX=1:1:$L(ECMOD,"^") S MODIEN=$P(ECMOD,U,ECX) I +MODIEN>0 D "RTN","ECEFPAT",87,0) . . K DD,DO S X=MODIEN D FILE^DICN "RTN","ECEFPAT",88,0) . K MODIEN,DIC "RTN","ECEFPAT",89,0) I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",90,0) ; File multiple secondary diagnosis codes "RTN","ECEFPAT",91,0) I $G(ECDXS)'="" D "RTN","ECEFPAT",92,0) . S DXS="",DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2) "RTN","ECEFPAT",93,0) . S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECDXY=ECDX K ECDXX "RTN","ECEFPAT",94,0) . F ECX=1:1:$L(ECDXS,"^") S DXSIEN=$P(ECDXS,U,ECX) I +DXSIEN>0 D "RTN","ECEFPAT",95,0) . . S DXCDE=$$ICDDX^ICDCODE(DXSIEN,ECDT) Q:+DXCDE<0 I '$P(DXCDE,U,10) Q "RTN","ECEFPAT",96,0) . . K DD,DO S X=DXSIEN D FILE^DICN "RTN","ECEFPAT",97,0) . . S DXCDE=$P(DXCDE,U,2),ECDXX(DXCDE)=DXSIEN "RTN","ECEFPAT",98,0) . ; Update all procedures for an encounter with same primary & second dx "RTN","ECEFPAT",99,0) . S PXUPD=$$PXUPD^ECUTL2(ECDFN,ECDT,ECL,EC4,ECDXY,.ECDXX,ECFN) "RTN","ECEFPAT",100,0) . K PXUPD,ECDXY,ECDXX,DXS,DXSIEN,DIC,DXCDE,DA,DD,DO "RTN","ECEFPAT",101,0) I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",102,0) S DA=ECFN "RTN","ECEFPAT",103,0) ;File classification AO^IR^SC^EC^MST^HNC^CV "RTN","ECEFPAT",104,0) I $G(ECLASS)'="" D "RTN","ECEFPAT",105,0) . S CLSTR="21^22^24^23^35^39^40",DR="" "RTN","ECEFPAT",106,0) . F ECX=1:1:$L(CLSTR,"^") D "RTN","ECEFPAT",107,0) . . S DR=DR_$P(CLSTR,U,ECX)_"////"_$P(ECLASS,U,ECX)_";" "RTN","ECEFPAT",108,0) . S DR=$E(DR,1,($L(DR)-1)) D ^DIE "RTN","ECEFPAT",109,0) . K CLSTR,DR,DIE "RTN","ECEFPAT",110,0) I $D(DTOUT) D RECDEL,MSG Q "RTN","ECEFPAT",111,0) ; "RTN","ECEFPAT",112,0) PCE ; format PCE data to send "RTN","ECEFPAT",113,0) I ($P(ECPCE,"~",2)="N")!($P(ECPCE,"~",2)="O"&(ECINP'="O")) D Q "RTN","ECEFPAT",114,0) .S ^TMP($J,"ECMSG",1)="1^Record Filed" "RTN","ECEFPAT",115,0) D:ECFLG PCE^ECBEN2U I 'ECFLG S EC(0)=^ECH(ECFN,0) D PCEE^ECBEN2U K EC "RTN","ECEFPAT",116,0) I $G(ECOUT)!(ECERR) D Q "RTN","ECEFPAT",117,0) . D RECDEL S STR=$S($G(^ECH(ECFN,"R")):^("R"),1:" PCE Data Missing") "RTN","ECEFPAT",118,0) . S ^TMP($J,"ECMSG",1)="0^Record Not Filed, "_STR K STR "RTN","ECEFPAT",119,0) S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_$G(ECIEN) "RTN","ECEFPAT",120,0) Q "RTN","ECEFPAT",121,0) ; "RTN","ECEFPAT",122,0) NEWIEN ;Create new IEN in file #721 "RTN","ECEFPAT",123,0) N DIC,DA,DD,DO,ECRN "RTN","ECEFPAT",124,0) RLCK L +^ECH(0) S ECRN=$P(^ECH(0),"^",3)+1 "RTN","ECEFPAT",125,0) I $D(^ECH(ECRN)) S $P(^ECH(0),"^",3)=$P(^(0),"^",3)+1 L -^ECH(0) G RLCK "RTN","ECEFPAT",126,0) L -^ECH(0) S DIC(0)="L",DIC="^ECH(",X=ECRN "RTN","ECEFPAT",127,0) D FILE^DICN S ECIEN=+Y "RTN","ECEFPAT",128,0) Q "RTN","ECEFPAT",129,0) RECDEL ; Delete record "RTN","ECEFPAT",130,0) ;restore old data "RTN","ECEFPAT",131,0) I 'ECFLG D Q "RTN","ECEFPAT",132,0) . I $O(OLDMOD("")) D "RTN","ECEFPAT",133,0) . . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,36,0),U,2) "RTN","ECEFPAT",134,0) . . S DIC="^ECH("_DA(1)_","_"""MOD"""_",",ECX=0 "RTN","ECEFPAT",135,0) . . F S ECX=$O(OLDMOD(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN "RTN","ECEFPAT",136,0) . I $O(OLDDXS("")) D "RTN","ECEFPAT",137,0) . . S DIC(0)="L",DA(1)=ECFN,DIC("P")=$P(^DD(721,38,0),U,2) "RTN","ECEFPAT",138,0) . . S DIC="^ECH("_DA(1)_","_"""DX"""_",",ECX=0 "RTN","ECEFPAT",139,0) . . F S ECX=$O(OLDDXS(ECX)) Q:'ECX I ECX>0 K DD,DO S X=ECX D FILE^DICN "RTN","ECEFPAT",140,0) . K DIC,DA,DD,DO,OLDMOD,OLDDXS,ECX "RTN","ECEFPAT",141,0) S DA=ECFN,DIK="^ECH(" D ^DIK K DA,DIK "RTN","ECEFPAT",142,0) Q "RTN","ECEFPAT",143,0) MSG ;Record not filed "RTN","ECEFPAT",144,0) S ^TMP($J,"ECMSG",1)="0^Record not Filed" "RTN","ECEFPAT",145,0) Q "RTN","ECEFPAT",146,0) CHKDT(FLG) ;Required Data Check "RTN","ECEFPAT",147,0) N I,C "RTN","ECEFPAT",148,0) S C=1 "RTN","ECEFPAT",149,0) I FLG=1 D Q "RTN","ECEFPAT",150,0) .F I="ECD","ECC","ECL","ECDT","ECP","ECDFN","ECU","ECMN","ECDUZ","ECPTSTAT" D "RTN","ECEFPAT",151,0) ..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1 "RTN","ECEFPAT",152,0) .I $G(ECDEL),$D(ECIEN) K ^TMP($J,"ECMSG") S ECERR=0 "RTN","ECEFPAT",153,0) ;check PCE data "RTN","ECEFPAT",154,0) I FLG=2 D Q "RTN","ECEFPAT",155,0) .F I="EC4","ECDX" D Q "RTN","ECEFPAT",156,0) ..I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key PCE data missing "_I,C=C+1,ECERR=1 "RTN","ECEFPAT",157,0) Q "RTN","ECEFPAT",158,0) VALDATA ;validate data "RTN","ECEFPAT",159,0) N ECRRX "RTN","ECEFPAT",160,0) D CHK^DIE(721,1,,"`"_ECDFN,.ECRRX) I ECRRX'=ECDFN D Q "RTN","ECEFPAT",161,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Patient" "RTN","ECEFPAT",162,0) D CHK^DIE(721,2,,ECDT,.ECRRX) I ECRRX'=ECDT D Q "RTN","ECEFPAT",163,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure Date" "RTN","ECEFPAT",164,0) D CHK^DIE(721,3,,"`"_ECL,.ECRRX) I ECRRX'=ECL D Q "RTN","ECEFPAT",165,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Location" "RTN","ECEFPAT",166,0) D CHK^DIE(721,6,,"`"_ECD,.ECRRX) I ECRRX'=ECD D Q "RTN","ECEFPAT",167,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit" "RTN","ECEFPAT",168,0) D CHK^DIE(721,7,,"`"_ECC,.ECRRX) I ECRRX'=ECC D Q "RTN","ECEFPAT",169,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Category" "RTN","ECEFPAT",170,0) D I ECERR Q "RTN","ECEFPAT",171,0) .I ECP["ICPT" S ECRRX=$$CPT^ICPTCOD(+ECP,ECDT) I +ECRRX>0,$P(ECRRX,U,7) Q "RTN","ECEFPAT",172,0) .I ECP["EC",$D(^EC(725,+ECP,0)) Q "RTN","ECEFPAT",173,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure" "RTN","ECEFPAT",174,0) D CHK^DIE(721,10,,"`"_ECU,.ECRRX) I ECRRX'=ECU D Q "RTN","ECEFPAT",175,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Provider" "RTN","ECEFPAT",176,0) I $G(ECU2)'="" D CHK^DIE(721,15,,"`"_ECU2,.ECRRX) I ECRRX'=ECU2 D Q "RTN","ECEFPAT",177,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Provider #2" "RTN","ECEFPAT",178,0) I $G(ECU3)'="" D CHK^DIE(721,10,,"`"_ECU3,.ECRRX) I ECRRX'=ECU3 D Q "RTN","ECEFPAT",179,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Provider #3" "RTN","ECEFPAT",180,0) D CHK^DIE(721,11,,"`"_ECMN,.ECRRX) I ECRRX'=ECMN D Q "RTN","ECEFPAT",181,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Orddering Section" "RTN","ECEFPAT",182,0) D CHK^DIE(721,20,,"`"_ECDX,.ECRRX) I ECRRX'=ECDX D Q "RTN","ECEFPAT",183,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Primary Diagnosis" "RTN","ECEFPAT",184,0) I $G(EC4)'="" D CHK^DIE(721,26,,"`"_EC4,.ECRRX) I ECRRX'=EC4 D Q "RTN","ECEFPAT",185,0) .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic" "RTN","ECEFPAT",186,0) Q "RTN","ECKILL") 0^10^B12166861 "RTN","ECKILL",1,0) ECKILL ;BIR/MAM,RHK,JPW-Kill Local Variables ;13 Apr 95 "RTN","ECKILL",2,0) ;;2.0; EVENT CAPTURE ;**4,5,10,17,18,23,42,54**;8 May 96 "RTN","ECKILL",3,0) K %,%DT,%ZIS,A,AA,B,CNT,CNT1,COUNT,D,D0,D1,DA,DATA,DATA0,DATE,DFN,DHD,DIC,DIE,DINUM,DIOEND,DIR,DIROUT,DIRUT,DISYS,DTOUT,DUOUT,DLAYGO "RTN","ECKILL",4,0) K EC,EC1,EC2,EC23,EC7,ECA,ECAC,ECACA,ECACC,ECAD,ECADD,ECALL,ECANE,ECAT,ECB,ECBDH,ECBSZ,ECC,ECC1,ECCAC,ECCAT,ECCC "RTN","ECKILL",5,0) K ECCD,ECCH,ECCLC,ECCN,ECCS,ECCSC,ECCSN,ECD,ECD0,ECDA,ECDAT,ECDATA,ECDATA1,ECDATE,ECDFN,ECDI,ECDIA,ECDICA,ECDIV,ECDN,ECDOC,ECDR,ECDRG,ECDS1,ECDT,ECDT1,ECDU,ECDUZ "RTN","ECKILL",6,0) K ECEC,ECED,ECED1,ECEDH,ECEDN,ECEXT,ECF,ECFCP,ECFD,ECFILE,ECFN,ECGRP,ECH "RTN","ECKILL",7,0) K ECHD,ECHEAD,ECHOICE,ECI,ECID,ECINC,ECINST,ECINZ,ECIOP,ECITEM,ECJLP,ECL,ECL1,ECL2,ECL3,ECL4,ECL5,ECL6,ECLALL,ECLDT,ECLDT1,ECLL,ECLN,ECLOC,ECLR,ECLRO "RTN","ECKILL",8,0) K ECM,ECMAX,ECMESG,ECMESS,ECMG,ECMIN,ECMN,ECMNTH,ECMOD,ECMODS,ECMODF,ECMORE,ECMS,ECMSG,ECMSN,ECMW,ECN,ECNEW,ECNO,ECNODE,ECNR,ECNT "RTN","ECKILL",9,0) K PA,PR,V,ECPCNT,ECELPT,ECPNAME,ECPRSL,VOL,ECPROCED,ECDTM,ECDSSU,ECDXO "RTN","ECKILL",10,0) ; "RTN","ECKILL",11,0) ;- Kill ordering section default variables (ECODFN,ECOM) "RTN","ECKILL",12,0) K ECO,ECO0,ECO1,ECO2,ECOB,ECOD0,ECODE,ECODE0,ECODFN,ECOLD,ECOM,ECON,ECOST,ECOUT "RTN","ECKILL",13,0) ; "RTN","ECKILL",14,0) ;- Kill procedure reason variables (ECPRPTR,ECPRSN,ECREAS) "RTN","ECKILL",15,0) K ECP,ECP1,ECP2,ECPACK,ECPAD,ECPAT,ECPG,ECPIECE,ECPN,ECPO,ECPR,ECPRC,ECPRO,ECPROC,ECPROF,ECPROS,ECPRPTR,ECPRSN,ECPS,ECPT,ECPTF "RTN","ECKILL",16,0) K ECQ,ECQTY,ECRAD0,ECRD,ECREAS,ECREDO,ECREPL,ECRFL,ECRL,ECRN,ECRPL1,ECRTN,ECRX,ECS,ECSA,ECSD,ECSD1,ECSDN,ECSEC,ECSECS,ECSN,ECSSN,ECST,ECSTAT,ECSU "RTN","ECKILL",17,0) K ECT,ECTEMP,ECTEST,ECTR,ECTREAT,ECTRN,ECTWO,ECU,ECU2,ECU2A,ECU3,ECU3A,ECUCNT,ECUN,ECUN1,ECUN2,ECUN3,ECUNIT "RTN","ECKILL",18,0) K ECUNM,ECURG,ECUSER,ECUSR,ECUT,ECUT2,ECUT3,ECUTN,ECUTN2,ECUTN3,ECV,ECWORD,ECX,ECXID,ECXMDA,ECXMDT,ECY,ECYN,ECYNZ,ECRY "RTN","ECKILL",19,0) K FAC,FLDS,FR,I,IOP,J,JJ,K,LINE,LIST,LOC,LOS,MM,MSG,MSG1,MSG2,NODE,NODE1,OK,P1,P11,P2,P3,POP,Q,SC,SDATE,SSN,STC,SU,TEST,TIME,TO,TOTD,UNIT,USER,USRCNT,W,X,XMDUZ "RTN","ECKILL",20,0) K X,XMDUZ,XMSUB,XMTEST,XMTEXT,XMY,Y,ECCNTCHK,ECP1N,ECPI,RK,ECPSYN,C,DI,DQ,DR,ECLINE,ECPIEN,ECSYN,MINCNT,MAXCNT,ECFLG,ECZ,ECPATN,ECFILN,ECPC,ECPF,ECPP,ECR,ECSUB,ECV1,ECVOL,ECDIR,EZCNT,ECERR "RTN","ECKILL",21,0) K ECCODE,ECDDT,ECNATN,ECDONE,NATN,ECPSY,ECRDT,ECPG1,ECNOPE,SYN,ECOLD,ECOLDN,RK,ECOS,ECOSN,PRO,SS,ECPA,ANS "RTN","ECKILL",22,0) PCE K ECAO,ECSC,ECZEC,ECIR,ECINP,ECID,EC4,EC4N,ECDX,ECDXN,ECVST,ECVV,ECZZ,LOCP,LOCPX,LOCX,PN,PNP,PNODE,ECMST,ECDXS,ECHNC,ECCV "RTN","ECKILL",23,0) K ECPCL,ECPCID,ECPCRD,ECPKG,ECCPT,EC725,ECONE,ECNODE2,ECCLFLDS,ECELANS,ECELCOD,ECELDSP,ECELIG,ECIOFLG,ECNEWDT,ECPTSTAT,VAEL,ECPTCD "RTN","ECKILL",24,0) K ECP10,ECP11,ECP15,ECP17,ECP19,ECP2,ECP20,ECP3,ECP4,ECPCE,ECPP1,ECPP1A,ECPP2,ECPP3,ECPP4,ECPP5,ECPP6,ECPP9 "RTN","ECKILL",25,0) K ^TMP($J) "RTN","ECKILL",26,0) Q "RTN","ECMLMF") 0^8^B30638515 "RTN","ECMLMF",1,0) ECMLMF ;ALB/ESD - File Multiple Dates/Multiple Procedures - 29 AUG 97 08:51 "RTN","ECMLMF",2,0) ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,54**;8 May 96 "RTN","ECMLMF",3,0) ; "RTN","ECMLMF",4,0) EN ;- Entry point to file selected patients and procedures "RTN","ECMLMF",5,0) ; "RTN","ECMLMF",6,0) N DIR,DIRUT,I,J,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE "RTN","ECMLMF",7,0) I '$D(^TMP("ECMPIDX",$J))!('$D(^TMP("ECMPTIDX",$J))) W !!,*7,"No patient data found. No patient record(s) have been filed." D MSG G ENQ "RTN","ECMLMF",8,0) ; "RTN","ECMLMF",9,0) W !!,"You have selected the following patients for filing:",! "RTN","ECMLMF",10,0) ; "RTN","ECMLMF",11,0) ;- List patients "RTN","ECMLMF",12,0) S I=0 "RTN","ECMLMF",13,0) F S I=$O(^TMP("ECMPTIDX",$J,I)) Q:'I D "RTN","ECMLMF",14,0) . W !?5,I_". ",$P($G(^TMP("ECMPTIDX",$J,I)),"^",3) "RTN","ECMLMF",15,0) W !! S DIR(0)="YA",DIR("A")="Is this correct? ",DIR("B")="YES" "RTN","ECMLMF",16,0) S DIR("?")="Answer YES to continue, NO to exit." "RTN","ECMLMF",17,0) D ^DIR K DIR "RTN","ECMLMF",18,0) I '$G(Y)!($D(DIRUT)) W !,"Exiting option...no patients filed.",! D MSG G ENQ "RTN","ECMLMF",19,0) ; "RTN","ECMLMF",20,0) ;- Task job "RTN","ECMLMF",21,0) F J="DUZ","ECL","ECDSSU","ECCAT","ECU*" S ZTSAVE(J)="" "RTN","ECMLMF",22,0) S ZTSAVE("^TMP(""ECMPIDX"",$J,")="",ZTSAVE("^TMP(""ECMPTIDX"",$J,")="" "RTN","ECMLMF",23,0) S ZTIO="",ZTDESC="EC MULT DATES/MULT PROCS DATA ENTRY",ZTRTN="GETNODS^ECMLMF",ZTDTH=$H "RTN","ECMLMF",24,0) ; "RTN","ECMLMF",25,0) W !!,"These patients will be sent to the background for filing.",! "RTN","ECMLMF",26,0) D ^%ZTLOAD "RTN","ECMLMF",27,0) I $D(ZTSK) W !,"Queued as Task #",ZTSK,! "RTN","ECMLMF",28,0) D MSG "RTN","ECMLMF",29,0) ; "RTN","ECMLMF",30,0) ENQ K ^TMP("ECPLST",$J) "RTN","ECMLMF",31,0) Q "RTN","ECMLMF",32,0) ; "RTN","ECMLMF",33,0) ; "RTN","ECMLMF",34,0) GETNODS ;- Get procedure node and patient node for processing "RTN","ECMLMF",35,0) ; "RTN","ECMLMF",36,0) N ECI,ECJ,ECPRNOD,ECPTNOD,ECDXX "RTN","ECMLMF",37,0) S (ECI,ECJ)=0 "RTN","ECMLMF",38,0) F S ECI=$O(^TMP("ECMPTIDX",$J,ECI)) Q:'ECI D "RTN","ECMLMF",39,0) . S ECPTNOD="",ECPTNOD=$G(^TMP("ECMPTIDX",$J,ECI)) "RTN","ECMLMF",40,0) . K ECDXX M ECDXX=^TMP("ECMPTIDX",$J,ECI,"DXS") "RTN","ECMLMF",41,0) . F S ECJ=$O(^TMP("ECMPIDX",$J,ECJ)) Q:'ECJ D "RTN","ECMLMF",42,0) .. S ECPRNOD="",ECPRNOD=$G(^TMP("ECMPIDX",$J,ECJ)) "RTN","ECMLMF",43,0) .. D FILREC "RTN","ECMLMF",44,0) D ENQ^ECMLMD "RTN","ECMLMF",45,0) S ZTREQ="@" "RTN","ECMLMF",46,0) Q "RTN","ECMLMF",47,0) ; "RTN","ECMLMF",48,0) ; "RTN","ECMLMF",49,0) FILREC ;- Create record in #721 and file fields "RTN","ECMLMF",50,0) ; "RTN","ECMLMF",51,0) N DA,ECIEN,ECNOGO,ECPRR,ECPTR,ECREAS,ECSND,DIC,DLAYGO,DIE,DR,I,Y "RTN","ECMLMF",52,0) S ECNOGO=0 "RTN","ECMLMF",53,0) S I=$P(^ECH(0),"^",3) "RTN","ECMLMF",54,0) LOCKHD S I=I+1 L +^ECH(I):2 I '$T!$D(^ECH(I)) L -^ECH(I) G LOCKHD "RTN","ECMLMF",55,0) L -^ECH(0) "RTN","ECMLMF",56,0) K DD,DO S X=I,DIC(0)="L",DLAYGO=721,DIC="^ECH(" D FILE^DICN "RTN","ECMLMF",57,0) K DIC,DLAYGO,X "RTN","ECMLMF",58,0) I Y=-1 G FILRECQ "RTN","ECMLMF",59,0) S (ECIEN,DA)=+Y "RTN","ECMLMF",60,0) L +^ECH(ECIEN):2 I '$T G FILRECQ "RTN","ECMLMF",61,0) ; "RTN","ECMLMF",62,0) D SETARRY "RTN","ECMLMF",63,0) ; "RTN","ECMLMF",64,0) ;- File zero node and "P" node "RTN","ECMLMF",65,0) S DIE="^ECH(",DR="[EC CREATE PATIENT ENTRY]" D ^DIE K DR "RTN","ECMLMF",66,0) ; "RTN","ECMLMF",67,0) ;- File secondary diagnoses codes, ALB/JAM "RTN","ECMLMF",68,0) S (DXS,DXSIEN)="" "RTN","ECMLMF",69,0) F S DXS=$O(ECDXX(DXS)) Q:DXS="" D "RTN","ECMLMF",70,0) . S DXSIEN=+ECDXX(DXS) I DXSIEN<0 Q "RTN","ECMLMF",71,0) . K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(721,38,0),U,2) "RTN","ECMLMF",72,0) . S X=DXSIEN,DIC="^ECH("_DA(1)_","_"""DX"""_"," D FILE^DICN "RTN","ECMLMF",73,0) K DXS,DXSIEN,DIC "RTN","ECMLMF",74,0) ;update encounter's procedures to have same primary & secondary dx "RTN","ECMLMF",75,0) S PXUPD=$$PXUPD^ECUTL2(ECPTR("DFN"),ECPRR("PROCDT"),ECL,ECPTR("CLIN"),ECPTR("DX"),.ECDXX,ECIEN) K PXUPD "RTN","ECMLMF",76,0) ; "RTN","ECMLMF",77,0) ;File CPT modifiers, ALB/JAM "RTN","ECMLMF",78,0) N MOD,MODIEN "RTN","ECMLMF",79,0) S (ECMODS,MOD)="" "RTN","ECMLMF",80,0) F S MOD=$O(^TMP("ECMPIDX",$J,ECJ,"MOD",MOD)) Q:MOD="" D "RTN","ECMLMF",81,0) . S MODIEN=$P(^TMP("ECMPIDX",$J,ECJ,"MOD",MOD),U,2) I MODIEN<0 Q "RTN","ECMLMF",82,0) . K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(721,36,0),U,2) "RTN","ECMLMF",83,0) . S X=MODIEN,DIC="^ECH("_DA(1)_","_"""MOD"""_"," D FILE^DICN "RTN","ECMLMF",84,0) . S ECMODS=ECMODS_$S(ECMODS="":"",1:";")_MOD "RTN","ECMLMF",85,0) ; "RTN","ECMLMF",86,0) S ECSND=$P($G(^ECD(+$P($G(ECDSSU),"^"),0)),"^",14),DA=ECIEN "RTN","ECMLMF",87,0) I ECSND="" S ECSND="N" "RTN","ECMLMF",88,0) I ECSND="A"!((ECSND="O")&(ECPTR("IO")="O")) D "RTN","ECMLMF",89,0) . S ECNOGO=$$BADFLDS(.ECREAS) "RTN","ECMLMF",90,0) . I ECNOGO S DR="33////^S X=$G(ECREAS)" D ^DIE Q "RTN","ECMLMF",91,0) . I 'ECNOGO D PCE "RTN","ECMLMF",92,0) ; "RTN","ECMLMF",93,0) FILRECQ L -^ECH(ECIEN) "RTN","ECMLMF",94,0) Q "RTN","ECMLMF",95,0) ; "RTN","ECMLMF",96,0) ; "RTN","ECMLMF",97,0) SETARRY ;- Set local arrays with procedure and patient data for filing "RTN","ECMLMF",98,0) ; "RTN","ECMLMF",99,0) N I "RTN","ECMLMF",100,0) F I="PROCDT","PROC","REAS","VOL" S ECPRR(I)=$P(ECPRNOD,"^",+$P($T(@I),";;",2)) "RTN","ECMLMF",101,0) I ECPRR("REAS")=0 S ECPRR("REAS")="" "RTN","ECMLMF",102,0) S I="PCEPR" S ECPRR(I)=$S($P($G(ECPRR("PROC")),";",2)="ICPT(":$P($G(ECPRR("PROC")),";"),1:$P($G(^EC(725,+$P($G(ECPRR("PROC")),";"),0)),"^",5)) "RTN","ECMLMF",103,0) F I="DFN","ORDSEC","IO","CLIN","DX","AO","ENV","IR","SC","ELIG","MST","HNC","CV" S ECPTR(I)=$P(ECPTNOD,"^",+$P($T(@I),";;",2)) "RTN","ECMLMF",104,0) Q "RTN","ECMLMF",105,0) ; "RTN","ECMLMF",106,0) ; "RTN","ECMLMF",107,0) BADFLDS(ECRS) ; - Validation checks on fields to be set in "PCE" node "RTN","ECMLMF",108,0) ; "RTN","ECMLMF",109,0) S ECRS="" "RTN","ECMLMF",110,0) I ECPTR("CLIN")="" S ECRS="Clinic missing;" "RTN","ECMLMF",111,0) I ECPTR("CLIN")=0 S ECRS="Clinic inactive;" "RTN","ECMLMF",112,0) I ECPTR("DX")="" S ECRS=$G(ECRS)_"Diagnosis missing;" "RTN","ECMLMF",113,0) I ECPRR("PCEPR")="" S ECRS=$G(ECRS)_"CPT code missing;" "RTN","ECMLMF",114,0) Q $S($G(ECRS)="":0,1:1) "RTN","ECMLMF",115,0) ; "RTN","ECMLMF",116,0) ; "RTN","ECMLMF",117,0) PCE ;- More validation checks on fields to be set in "PCE" node "RTN","ECMLMF",118,0) ; "RTN","ECMLMF",119,0) N ECDSS,I,ECAO,ECELIG,ECEV,ECIR,ECSC,ECNP,ECNPP,ECPCENOD,ECMST,ECHNC,ECCV "RTN","ECMLMF",120,0) G PCEQ:$G(ECPRR("PROCDT"))'["."!('$G(ECPRR("PCEPR"))) "RTN","ECMLMF",121,0) F I="DFN","CLIN","DX" G PCEQ:'$G(ECPTR(I)) "RTN","ECMLMF",122,0) G PCEQ:'$G(ECPRR("VOL")) "RTN","ECMLMF",123,0) S ECDSS=$P($G(^ECH(ECIEN,0)),"^",20) "RTN","ECMLMF",124,0) G PCEQ:'$G(ECL)!('ECDSS)!('$G(ECU(1))) "RTN","ECMLMF",125,0) ; "RTN","ECMLMF",126,0) S ECPTR("AO")=$G(ECPTR("AO")) "RTN","ECMLMF",127,0) S ECAO=$S(ECPTR("AO")="Y":1,ECPTR("AO")="N":0,1:"") "RTN","ECMLMF",128,0) ; "RTN","ECMLMF",129,0) S ECPTR("ENV")=$G(ECPTR("ENV")) "RTN","ECMLMF",130,0) S ECEV=$S(ECPTR("ENV")="Y":1,ECPTR("ENV")="N":0,1:"") "RTN","ECMLMF",131,0) ; "RTN","ECMLMF",132,0) S ECPTR("IR")=$G(ECPTR("IR")) "RTN","ECMLMF",133,0) S ECIR=$S(ECPTR("IR")="Y":1,ECPTR("IR")="N":0,1:"") "RTN","ECMLMF",134,0) ; "RTN","ECMLMF",135,0) S ECPTR("SC")=$G(ECPTR("SC")) "RTN","ECMLMF",136,0) S ECSC=$S(ECPTR("SC")="Y":1,ECPTR("SC")="N":0,1:"") "RTN","ECMLMF",137,0) ; "RTN","ECMLMF",138,0) S ECNPP="" I $G(ECPRR("PROC"))["EC" S ECNP=$G(^EC(725,+ECPRR("PROC"),0)),ECNPP=$P(ECNP,"^",2)_" "_$P(ECNP,"^",1) "RTN","ECMLMF",139,0) ; "RTN","ECMLMF",140,0) S ECELIG=$S($G(ECPTR("ELIG")):ECPTR("ELIG"),1:"") "RTN","ECMLMF",141,0) ; "RTN","ECMLMF",142,0) S ECPTR("MST")=$G(ECPTR("MST")) "RTN","ECMLMF",143,0) S ECMST=$S(ECPTR("MST")="Y":1,ECPTR("MST")="N":0,1:"") "RTN","ECMLMF",144,0) ; "RTN","ECMLMF",145,0) ;JAM;09/30/02,Head/Neck Cancer "RTN","ECMLMF",146,0) S ECPTR("HNC")=$G(ECPTR("HNC")) "RTN","ECMLMF",147,0) S ECHNC=$S(ECPTR("HNC")="Y":1,ECPTR("HNC")="N":0,1:"") "RTN","ECMLMF",148,0) ; "RTN","ECMLMF",149,0) ;JAM;10/29/03,Combat Veteran "RTN","ECMLMF",150,0) S ECPTR("CV")=$G(ECPTR("CV")) "RTN","ECMLMF",151,0) S ECCV=$S(ECPTR("CV")="Y":1,ECPTR("CV")="N":0,1:"") "RTN","ECMLMF",152,0) ; "RTN","ECMLMF",153,0) ;- File "PCE" and "PCE1" nodes "RTN","ECMLMF",154,0) ; "RTN","ECMLMF",155,0) S DR="[EC FILE PCE NODE]" D ^DIE K DR "RTN","ECMLMF",156,0) S DR="31////"_$$NOW^XLFDT D ^DIE "RTN","ECMLMF",157,0) PCEQ Q "RTN","ECMLMF",158,0) ; "RTN","ECMLMF",159,0) ; "RTN","ECMLMF",160,0) MSG ;- Message displayed so error message can be read on screen "RTN","ECMLMF",161,0) ; "RTN","ECMLMF",162,0) S DIR(0)="E" D ^DIR "RTN","ECMLMF",163,0) Q "RTN","ECMLMF",164,0) ; "RTN","ECMLMF",165,0) ;- Subscripts used in creating ECPRR and ECPTR arrays "RTN","ECMLMF",166,0) ; "RTN","ECMLMF",167,0) PROCDT ;;2 "RTN","ECMLMF",168,0) PROC ;;3 "RTN","ECMLMF",169,0) REAS ;;5 "RTN","ECMLMF",170,0) VOL ;;7 "RTN","ECMLMF",171,0) ; "RTN","ECMLMF",172,0) DFN ;;2 "RTN","ECMLMF",173,0) ORDSEC ;;4 "RTN","ECMLMF",174,0) IO ;;5 "RTN","ECMLMF",175,0) CLIN ;;6 "RTN","ECMLMF",176,0) DX ;;8 "RTN","ECMLMF",177,0) AO ;;10 "RTN","ECMLMF",178,0) ENV ;;11 "RTN","ECMLMF",179,0) IR ;;12 "RTN","ECMLMF",180,0) SC ;;13 "RTN","ECMLMF",181,0) ELIG ;;14 "RTN","ECMLMF",182,0) MST ;;15 "RTN","ECMLMF",183,0) HNC ;;16 "RTN","ECMLMF",184,0) CV ;;17 "RTN","ECMLMN") 0^9^B56414304 "RTN","ECMLMN",1,0) ECMLMN ;ALB/ESD - Multiple patients processing ;26 AUG 1997 14:42 "RTN","ECMLMN",2,0) ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,18,23,42,47,54**;8 May 96 "RTN","ECMLMN",3,0) ; "RTN","ECMLMN",4,0) ; "RTN","ECMLMN",5,0) EN ;- Entry point for multiple patients (part of Multiple Dates/Procs option) "RTN","ECMLMN",6,0) ; "RTN","ECMLMN",7,0) N ECGO,ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS "RTN","ECMLMN",8,0) ; "RTN","ECMLMN",9,0) ;- Ask patient related questions "RTN","ECMLMN",10,0) D ENPAT(.ECGO) "RTN","ECMLMN",11,0) ; "RTN","ECMLMN",12,0) ;- ListMan entry point "RTN","ECMLMN",13,0) I +$G(ECGO)=1 D EN^VALM("EC MUL PATIENTS") "RTN","ECMLMN",14,0) ; "RTN","ECMLMN",15,0) Q "RTN","ECMLMN",16,0) ; "RTN","ECMLMN",17,0) ENPAT(ECFL,ECONE) ;- Ask patient name, ordering section, inpat/outpat, "RTN","ECMLMN",18,0) ; dx, assoc clinic, and classification questions "RTN","ECMLMN",19,0) ; (AO, IR, EC, SC, MST, HNC, CV) "RTN","ECMLMN",20,0) ; "RTN","ECMLMN",21,0) SEL K ECNXT,ECPAT,ECORD,ECPCE,ECPCEQ,ECS "RTN","ECMLMN",22,0) S ECFL=1,ECS="" "RTN","ECMLMN",23,0) ; "RTN","ECMLMN",24,0) ;- Patient name "RTN","ECMLMN",25,0) S ECNXT=$$ASKPAT^ECMUTL1(.ECPAT) "RTN","ECMLMN",26,0) I ECNXT=-1!((ECNXT=-2)&('$D(^TMP("ECPAT",$J)))) S ECFL=-1 G ENPATQ "RTN","ECMLMN",27,0) I ECNXT=-2,$D(^TMP("ECPAT",$J)) G ENPATQ "RTN","ECMLMN",28,0) ; "RTN","ECMLMN",29,0) ;- Inpatient/outpatient status (in ECPCE("I/O")) "RTN","ECMLMN",30,0) I '$$INOUT^ECMUTL1(ECPAT) G ENPATQ "RTN","ECMLMN",31,0) ; "RTN","ECMLMN",32,0) ;- Patient eligibility (in ECPCE("ELIG")) "RTN","ECMLMN",33,0) D ASKELIG^ECMUTL1(ECDSSU,ECPCE("I/O"),ECPAT) "RTN","ECMLMN",34,0) ; "RTN","ECMLMN",35,0) ;- Display inpatient/outpatient status on screen "RTN","ECMLMN",36,0) D DSPSTAT^ECUTL0(ECPCE("I/O")) "RTN","ECMLMN",37,0) ; "RTN","ECMLMN",38,0) ;- Ordering section "RTN","ECMLMN",39,0) S ECORD=$$ASKORD^ECMUTL1 "RTN","ECMLMN",40,0) I 'ECORD D REMOVE^ECMUTL1(ECPAT) G ENPATQ "RTN","ECMLMN",41,0) ; "RTN","ECMLMN",42,0) ;- Send Event Code Screen IEN of first procedure (used only if 'Send to "RTN","ECMLMN",43,0) ; PCE' fld in DSS Unit file is 'N' and patient is an inpatient) "RTN","ECMLMN",44,0) ; "RTN","ECMLMN",45,0) I $P($G(^TMP("ECMPIDX",$J,1)),"^",3)]"" S ECS=$O(^ECJ("AP",ECL,+$P(ECDSSU,"^"),+ECCAT,$P($G(^TMP("ECMPIDX",$J,1)),"^",3),0)) "RTN","ECMLMN",46,0) ; "RTN","ECMLMN",47,0) ;- Dx, associated clinic, and classification questions "RTN","ECMLMN",48,0) S ECPCEQ=$$PCEDAT^ECMUTL1(+$P(ECDSSU,"^"),ECS,.ECPCE) "RTN","ECMLMN",49,0) I ECPCEQ>0 D REMOVE^ECMUTL1(ECPAT) G ENPATQ "RTN","ECMLMN",50,0) I ECPCEQ=0 D BLDPAT "RTN","ECMLMN",51,0) ENPATQ I '$G(ECONE),ECNXT>0 W ! G SEL "RTN","ECMLMN",52,0) Q "RTN","ECMLMN",53,0) ; "RTN","ECMLMN",54,0) ; "RTN","ECMLMN",55,0) BLDPAT ;- Build ^TMP("ECPAT",$J) array with patient data "RTN","ECMLMN",56,0) ; "RTN","ECMLMN",57,0) N ECNODE,ECNUM "RTN","ECMLMN",58,0) S ECNUM=2 "RTN","ECMLMN",59,0) S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",12)="" "RTN","ECMLMN",60,0) S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",1)=$P(ECPAT,"^",2) "RTN","ECMLMN",61,0) S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",2)=+$P(ECORD,"^") "RTN","ECMLMN",62,0) F ECNODE="I/O","CLIN","CLINNM","DX","DXNM","AO","ENV","IR","SC","ELIG","MST","HNC","CV" D "RTN","ECMLMN",63,0) . S ECNUM=ECNUM+1 "RTN","ECMLMN",64,0) . S $P(^TMP("ECPAT",$J,$P(ECPAT,"^")),"^",ECNUM)=$S(ECNODE="CLINNM":$P($G(ECPCE("CLIN")),"^",2),ECNODE="DXNM":$P($G(ECPCE("DX")),"^",2),1:$P($G(ECPCE(ECNODE)),"^")) "RTN","ECMLMN",65,0) I $D(ECPCE("DXS")) M ^TMP("ECPAT",$J,$P(ECPAT,"^"),"DXS")=ECPCE("DXS") "RTN","ECMLMN",66,0) Q "RTN","ECMLMN",67,0) ; "RTN","ECMLMN",68,0) ; "RTN","ECMLMN",69,0) HDR ;- Header "RTN","ECMLMN",70,0) ; "RTN","ECMLMN",71,0) S VALMHDR(1)=" Location: "_$G(ECLN)_" ("_$G(ECL)_")" "RTN","ECMLMN",72,0) S VALMHDR(1)=$$SETSTR^VALM1("Provider #1: "_$P(ECU(1),"^",2),VALMHDR(1),40,30) "RTN","ECMLMN",73,0) S VALMHDR(2)=" DSS Unit: "_$P(ECDSSU,"^",2) "RTN","ECMLMN",74,0) S VALMHDR(2)=$$SETSTR^VALM1(" Category: "_$P(ECCAT,"^",2),VALMHDR(2),40,30) "RTN","ECMLMN",75,0) Q "RTN","ECMLMN",76,0) ; "RTN","ECMLMN",77,0) ; "RTN","ECMLMN",78,0) INIT ;-- Init vars and display selected procedures for patient(s) "RTN","ECMLMN",79,0) ; "RTN","ECMLMN",80,0) N ECPTCNT,BL,X,IC,IW,DC,DW,NC,NW,PC,PW,RC,RW,SC,SW "RTN","ECMLMN",81,0) K ^TMP("ECMPT",$J),^TMP("ECMPTIDX",$J) "RTN","ECMLMN",82,0) D CLEAN^VALM10 "RTN","ECMLMN",83,0) ; "RTN","ECMLMN",84,0) S (VALMCNT,ECPTCNT)=0 "RTN","ECMLMN",85,0) S BL="",$P(BL," ",30)="" "RTN","ECMLMN",86,0) S X=VALMDDF("INDEX"),IC=$P(X,"^",2),IW=$P(X,"^",3) "RTN","ECMLMN",87,0) S X=VALMDDF("PATIENT"),PC=$P(X,"^",2),PW=$P(X,"^",3) "RTN","ECMLMN",88,0) S X=VALMDDF("SSN"),SC=$P(X,"^",2),SW=$P(X,"^",3) "RTN","ECMLMN",89,0) ; "RTN","ECMLMN",90,0) D BLD "RTN","ECMLMN",91,0) S $P(^TMP("ECMPT",$J,0),"^",4)=VALMCNT "RTN","ECMLMN",92,0) Q "RTN","ECMLMN",93,0) ; "RTN","ECMLMN",94,0) ; "RTN","ECMLMN",95,0) BLD ;- Get data from array for screen display "RTN","ECMLMN",96,0) ; "RTN","ECMLMN",97,0) N DFN,ECDFN,ECX,VA,VAERR "RTN","ECMLMN",98,0) S ECDFN=0 F S ECDFN=$O(^TMP("ECPAT",$J,ECDFN)) Q:'ECDFN D "RTN","ECMLMN",99,0) . K DFN S DFN=ECDFN D PID^VADPT6 "RTN","ECMLMN",100,0) . D BLDLM "RTN","ECMLMN",101,0) . D PRDSP "RTN","ECMLMN",102,0) Q "RTN","ECMLMN",103,0) ; "RTN","ECMLMN",104,0) ; "RTN","ECMLMN",105,0) BLDLM ;- Display patient data "RTN","ECMLMN",106,0) ; "RTN","ECMLMN",107,0) K ECX "RTN","ECMLMN",108,0) S ECPTCNT=ECPTCNT+1,ECX="",$P(ECX," ",VALMWD+1)="" "RTN","ECMLMN",109,0) S ECX=$E(ECX,1,IC-1)_$E(ECPTCNT_BL,1,IW)_$E(ECX,IC+IW+1,VALMWD) "RTN","ECMLMN",110,0) S ECX=$E(ECX,1,PC-1)_$E($P(^TMP("ECPAT",$J,ECDFN),"^")_BL,1,PW)_$E(ECX,PC+PW+1,VALMWD) "RTN","ECMLMN",111,0) S ECX=$E(ECX,1,SC-1)_$E($G(VA("PID"))_BL,1,SW)_$E(ECX,SC+SW+1,VALMWD) "RTN","ECMLMN",112,0) ; "RTN","ECMLMN",113,0) D SET(ECX) "RTN","ECMLMN",114,0) ; "RTN","ECMLMN",115,0) ;- Tmp array ECMPTIDX contains: "RTN","ECMLMN",116,0) ; Cnt^DFN^Name^Ord Sect^In/Out^Clin^Clin Nam^DX^DX Nam^AO^EC^IR^SC^Elig^MST^HNC^CV "RTN","ECMLMN",117,0) ; "RTN","ECMLMN",118,0) S ^TMP("ECMPTIDX",$J,ECPTCNT)=VALMCNT_"^"_ECDFN_"^"_$G(^TMP("ECPAT",$J,ECDFN)) "RTN","ECMLMN",119,0) ;- Set secondary diagnosis codes in array ECMPTIDX "RTN","ECMLMN",120,0) I $D(^TMP("ECPAT",$J,ECDFN,"DXS")) D "RTN","ECMLMN",121,0) . M ^TMP("ECMPTIDX",$J,ECPTCNT,"DXS")=^TMP("ECPAT",$J,ECDFN,"DXS") "RTN","ECMLMN",122,0) Q "RTN","ECMLMN",123,0) ; "RTN","ECMLMN",124,0) ; "RTN","ECMLMN",125,0) SET(X) ;- Create ^TMP("ECMPT",$J) array for screen display "RTN","ECMLMN",126,0) ; "RTN","ECMLMN",127,0) S VALMCNT=VALMCNT+1,^TMP("ECMPT",$J,VALMCNT,0)=X "RTN","ECMLMN",128,0) S ^TMP("ECMPT",$J,"IDX",VALMCNT,ECPTCNT)="" "RTN","ECMLMN",129,0) Q "RTN","ECMLMN",130,0) ; "RTN","ECMLMN",131,0) ; "RTN","ECMLMN",132,0) PRDSP ;- Display selected procedure dates/times and procedures "RTN","ECMLMN",133,0) ; "RTN","ECMLMN",134,0) N I,X,J,ECCPT,ECPR "RTN","ECMLMN",135,0) S I=0 "RTN","ECMLMN",136,0) D SET("") "RTN","ECMLMN",137,0) D SET($$SETSTR^VALM1("Procedure(s):","",8,13)) "RTN","ECMLMN",138,0) D CNTRL^VALM10(VALMCNT,8,13,IORVON,IORVOFF) "RTN","ECMLMN",139,0) ; "RTN","ECMLMN",140,0) F S I=$O(^TMP("ECMPIDX",$J,I)) Q:'I D "RTN","ECMLMN",141,0) . S X="" "RTN","ECMLMN",142,0) . S X=$$SETSTR^VALM1($$FTIME^VALM1($P($G(^TMP("ECMPIDX",$J,I)),"^",2)),X,10,18) "RTN","ECMLMN",143,0) . S X=$$SETSTR^VALM1($P($P($G(^TMP("ECMPIDX",$J,I)),"^",3),";"),X,34,5) "RTN","ECMLMN",144,0) . S ECCPT=$P(^TMP("ECMPIDX",$J,I),"^",3) "RTN","ECMLMN",145,0) . S ECCPT=$S(ECCPT["ICPT":+ECCPT,1:$P($G(^EC(725,+ECCPT,0)),"^",5)) "RTN","ECMLMN",146,0) . I ECCPT'="" S ECCPT=$P($$CPT^ICPTCOD(ECCPT,$P(^TMP("ECMPIDX",$J,I),"^",2)),"^",2) "RTN","ECMLMN",147,0) . S ECPR=$S(ECCPT'="":ECCPT_" ",1:ECCPT)_$P(^TMP("ECMPIDX",$J,I),"^",4) "RTN","ECMLMN",148,0) . S X=$$SETSTR^VALM1(ECPR,X,42,VALMWD) "RTN","ECMLMN",149,0) . D SET(X) "RTN","ECMLMN",150,0) . ;set modifier in ^TMP global for display "RTN","ECMLMN",151,0) . S J="" F S J=$O(^TMP("ECMPIDX",$J,I,"MOD",J)) Q:J="" S X="" D "RTN","ECMLMN",152,0) . . S X=$$SETSTR^VALM1(" - "_J_" "_$P(^TMP("ECMPIDX",$J,I,"MOD",J),"^"),X,41,VALMWD) "RTN","ECMLMN",153,0) . . D SET(X) "RTN","ECMLMN",154,0) ; "RTN","ECMLMN",155,0) D SET("") "RTN","ECMLMN",156,0) ; "RTN","ECMLMN",157,0) PRDSPQ Q "RTN","ECMLMN",158,0) ; "RTN","ECMLMN",159,0) HLPS ;- Brief help "RTN","ECMLMN",160,0) ; "RTN","ECMLMN",161,0) S X="?" D DISP^XQORM1 W !! "RTN","ECMLMN",162,0) Q "RTN","ECMLMN",163,0) ; "RTN","ECMLMN",164,0) HELP ;- Help for list "RTN","ECMLMN",165,0) S ECZ="" "RTN","ECMLMN",166,0) I $D(X),X'["??" D HLPS,PAUSE^VALM1 G HLPQ "RTN","ECMLMN",167,0) D CLEAR^VALM1 "RTN","ECMLMN",168,0) F I=1:1 S ECZ=$P($T(HELPTXT+I),";",3,99) Q:ECZ="$END" D PAUSE^VALM1:ECZ="$PAUSE" Q:'Y W !,$S(ECZ["$PAUSE":"",1:ECZ) "RTN","ECMLMN",169,0) W !,"Possible actions are the following:" "RTN","ECMLMN",170,0) D HLPS,PAUSE^VALM1 S VALMBCK="R" "RTN","ECMLMN",171,0) HLPQ K ECZ,Y,I Q "RTN","ECMLMN",172,0) ; "RTN","ECMLMN",173,0) EXIT ;- Clean up and exit "RTN","ECMLMN",174,0) ; "RTN","ECMLMN",175,0) K ECPLST "RTN","ECMLMN",176,0) K ^TMP("ECPAT",$J),^TMP("ECMPT",$J) "RTN","ECMLMN",177,0) K VALMDDF "RTN","ECMLMN",178,0) D CLEAN^VALM10,CLEAR^VALM1 "RTN","ECMLMN",179,0) Q "RTN","ECMLMN",180,0) ; "RTN","ECMLMN",181,0) ; "RTN","ECMLMN",182,0) PATDEL ;- Entry point for EC MUL PAT DEL protocol "RTN","ECMLMN",183,0) ; "RTN","ECMLMN",184,0) N ECFND,ECI,ECSEL,VALMY "RTN","ECMLMN",185,0) S VALMBCK="" "RTN","ECMLMN",186,0) D FULL^VALM1 "RTN","ECMLMN",187,0) D EN^VALM2(XQORNOD(0)) "RTN","ECMLMN",188,0) S (ECFND,ECSEL)=0 "RTN","ECMLMN",189,0) F S ECSEL=$O(VALMY(ECSEL)) Q:'ECSEL D "RTN","ECMLMN",190,0) . I $D(^TMP("ECMPTIDX",$J,ECSEL)) K ECDAT S ECDAT=^(ECSEL) D "RTN","ECMLMN",191,0) .. S ECI=0 F S ECI=$O(^TMP("ECPAT",$J,ECI)) Q:'ECI!(ECFND) D "RTN","ECMLMN",192,0) ... I $P(ECDAT,"^",2)=ECI S ECFND=1 K ^TMP("ECPAT",$J,ECI) D REMOVNM(ECI) "RTN","ECMLMN",193,0) .. I ECFND=0 W !!,*7,">>> This patient could not be found. <<<" D PAUSE^VALM1 Q "RTN","ECMLMN",194,0) I ECFND=1 D INIT^ECMLMN "RTN","ECMLMN",195,0) S VALMBCK="R" "RTN","ECMLMN",196,0) K ECDAT "RTN","ECMLMN",197,0) PATDELQ Q "RTN","ECMLMN",198,0) ; "RTN","ECMLMN",199,0) ; "RTN","ECMLMN",200,0) REMOVNM(ECI) ;- Remove patient name from array which tracks dup patients "RTN","ECMLMN",201,0) ; "RTN","ECMLMN",202,0) Q:'$G(ECI) "RTN","ECMLMN",203,0) N ECX "RTN","ECMLMN",204,0) S ECX=0 "RTN","ECMLMN",205,0) F S ECX=$O(^TMP("ECPLST",$J,ECX)) Q:'ECX D "RTN","ECMLMN",206,0) . I +$P($G(^TMP("ECPLST",$J,ECX)),"^")=ECI K ^TMP("ECPLST",$J,ECX) "RTN","ECMLMN",207,0) Q "RTN","ECMLMN",208,0) ; "RTN","ECMLMN",209,0) ; "RTN","ECMLMN",210,0) ADDPAT ;- Entry point for EC MUL PAT ADD protocol "RTN","ECMLMN",211,0) ; "RTN","ECMLMN",212,0) N ECADD,ECOK "RTN","ECMLMN",213,0) S VALMBCK="" "RTN","ECMLMN",214,0) D FULL^VALM1 "RTN","ECMLMN",215,0) D ENPAT(.ECOK,1) "RTN","ECMLMN",216,0) I +$G(ECOK)=1 D INIT^ECMLMN "RTN","ECMLMN",217,0) I +$G(ECOK)<0 W !!,*7,">>> No patient entered. <<<" D PAUSE^VALM1 "RTN","ECMLMN",218,0) S VALMBCK="R" "RTN","ECMLMN",219,0) ADDPATQ Q "RTN","ECMLMN",220,0) ; "RTN","ECMLMN",221,0) ; "RTN","ECMLMN",222,0) HELPTXT ; - Help text "RTN","ECMLMN",223,0) ;;Enter actions(s) by typing the name(s), or abbreviation(s). "RTN","ECMLMN",224,0) ;; "RTN","ECMLMN",225,0) ;;ACTION DEFINITIONS: "RTN","ECMLMN",226,0) ;; AP - Add a Patient allows the user to add a Patient to those "RTN","ECMLMN",227,0) ;; patients previously entered "RTN","ECMLMN",228,0) ;; DP - Delete a Patient allows the user to delete a patient from "RTN","ECMLMN",229,0) ;; those patients previously entered "RTN","ECMLMN",230,0) ;; FP - File Patients will enter the patients into the Event Capture "RTN","ECMLMN",231,0) ;; procedure database "RTN","ECMLMN",232,0) ;; "RTN","ECMLMN",233,0) ;; NOTE: The procedures you have entered with this option MUST be filed "RTN","ECMLMN",234,0) ;; with the 'FP' action for the data to be filed into the Event "RTN","ECMLMN",235,0) ;; Capture system. "RTN","ECMLMN",236,0) ;;------------------------------------------------------------------------------ "RTN","ECMLMN",237,0) ;;$PAUSE "RTN","ECMLMN",238,0) ;;$END "RTN","ECMUTL1") 0^12^B55736638 "RTN","ECMUTL1",1,0) ECMUTL1 ;ALB/ESD - Utilities for Multiple Dates/Mult Procs ;20 AUG 1997 13:56 "RTN","ECMUTL1",2,0) ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,23,41,42,50,54**;8 May 96 "RTN","ECMUTL1",3,0) ; "RTN","ECMUTL1",4,0) ; "RTN","ECMUTL1",5,0) ASKPAT(ECPAT) ; Ask patient "RTN","ECMUTL1",6,0) ; "RTN","ECMUTL1",7,0) ; Input: ECPAT = patient DFN and name (passed by reference) "RTN","ECMUTL1",8,0) ; "RTN","ECMUTL1",9,0) ; Output: 1 = successful "RTN","ECMUTL1",10,0) ; -1 = unsuccessful (timed out or uparrowed) "RTN","ECMUTL1",11,0) ; -2 = unsuccessful (returned out) "RTN","ECMUTL1",12,0) ; "RTN","ECMUTL1",13,0) N DIC,DUOUT,DTOUT,Y,YY,ECDUP,ECI,ECUP "RTN","ECMUTL1",14,0) SEL ; "RTN","ECMUTL1",15,0) S (ECDUP,ECI)=0 "RTN","ECMUTL1",16,0) S DIC="^DPT(",DIC(0)="QEAMZ" "RTN","ECMUTL1",17,0) S DIC("A")="Select Patient: " "RTN","ECMUTL1",18,0) D ^DIC "RTN","ECMUTL1",19,0) I Y=-1!($D(DUOUT))!($D(DTOUT)) G ASKPATQ "RTN","ECMUTL1",20,0) ; "RTN","ECMUTL1",21,0) ;- Create ECPLST local array to track duplicate names "RTN","ECMUTL1",22,0) I $O(^TMP("ECPLST",$J,0)) D "RTN","ECMUTL1",23,0) . F S ECI=$O(^TMP("ECPLST",$J,ECI)) Q:'ECI D "RTN","ECMUTL1",24,0) .. I +$G(^TMP("ECPLST",$J,ECI))=+Y D "RTN","ECMUTL1",25,0) ... S ECDUP=1 "RTN","ECMUTL1",26,0) ... W !!,"Patient already selected. Please select another patient.",! "RTN","ECMUTL1",27,0) I ECDUP G SEL "RTN","ECMUTL1",28,0) I 'ECDUP D I $G(ECUP)="^" G SEL "RTN","ECMUTL1",29,0) . S ECPAT=+Y_"^"_$P(Y,"^",2) "RTN","ECMUTL1",30,0) . S YY=Y,DFN=+Y,ECUP="" D 2^VADPT S Y=YY I +VADM(6) D I ECUP="^" Q "RTN","ECMUTL1",31,0) .. ;NOIS MWV-0603-21781: line below changed by VMP. "RTN","ECMUTL1",32,0) .. W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!! "RTN","ECMUTL1",33,0) .. R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME "RTN","ECMUTL1",34,0) . S ^TMP("ECPLST",$J,($S('$O(^TMP("ECPLST",$J,0)):1,1:$O(^TMP("ECPLST",$J,""),-1)+1)))=+Y_"^"_$P(Y,"^",2) "RTN","ECMUTL1",35,0) ASKPATQ Q $S((Y=-1)&($D(DUOUT)!$D(DTOUT)):-1,(Y=-1)&('$D(DUOUT))&('$D(DTOUT)):-2,1:1) "RTN","ECMUTL1",36,0) ; "RTN","ECMUTL1",37,0) ; "RTN","ECMUTL1",38,0) ASKORD() ; Ask ordering section "RTN","ECMUTL1",39,0) ; "RTN","ECMUTL1",40,0) ; Input: None "RTN","ECMUTL1",41,0) ; "RTN","ECMUTL1",42,0) ; Output: Ordering Section ien if successful "RTN","ECMUTL1",43,0) ; 0 if not successful "RTN","ECMUTL1",44,0) ; "RTN","ECMUTL1",45,0) N DIR,DIRUT,Y,ECORD "RTN","ECMUTL1",46,0) S ECORD=0 "RTN","ECMUTL1",47,0) S DIR(0)="721,11",DIR("A")="Ordering Section" "RTN","ECMUTL1",48,0) D ^DIR "RTN","ECMUTL1",49,0) I Y=""!($D(DIRUT)) G ASKORDQ "RTN","ECMUTL1",50,0) S ECORD=+Y "RTN","ECMUTL1",51,0) ASKORDQ Q +ECORD "RTN","ECMUTL1",52,0) ; "RTN","ECMUTL1",53,0) ; "RTN","ECMUTL1",54,0) PCEDAT(ECUNIT,ECSCR,ECPCE) ;get needed PCE data "RTN","ECMUTL1",55,0) ; "RTN","ECMUTL1",56,0) ; input "RTN","ECMUTL1",57,0) ; ECUNIT = ien of DSS unit in file #724 (required) "RTN","ECMUTL1",58,0) ; ECSCR = ien of event code screen in file #720.3 (required); "RTN","ECMUTL1",59,0) ; but may be null value "RTN","ECMUTL1",60,0) ; ECPCE = array, passed by reference (required) "RTN","ECMUTL1",61,0) ; "RTN","ECMUTL1",62,0) ; output "RTN","ECMUTL1",63,0) ; ECPCE("CLIN") = associated clinic ien in file #44^clinic name "RTN","ECMUTL1",64,0) ; ECPCE("DX") = ien in file #80^icd code "RTN","ECMUTL1",65,0) ; ECPCE("DXS",) = array of multiple secondary diagnosis, where "RTN","ECMUTL1",66,0) ; = ecpce("dxs",n)=v n=dx code and v=dx ien "RTN","ECMUTL1",67,0) ; ECPCE("AO") = agent orange indicator "RTN","ECMUTL1",68,0) ; ECPCE("IR") = ionizing radiation indicator "RTN","ECMUTL1",69,0) ; ECPCE("ENV") = environmental contaminants indicator "RTN","ECMUTL1",70,0) ; ECPCE("SC") = service connected indicator (Y/N) "RTN","ECMUTL1",71,0) ; ECPCE("MST") = military sexual trauma indicator (Y/N) "RTN","ECMUTL1",72,0) ; ECPCE("HNC") = head/neck cancer indicator (Y/N) "RTN","ECMUTL1",73,0) ; ECPCE("CV") = combat veteran indicator (Y/N "RTN","ECMUTL1",74,0) ; "RTN","ECMUTL1",75,0) ; returns "RTN","ECMUTL1",76,0) ; ECOUT = if normal user input, then "0" "RTN","ECMUTL1",77,0) ; if user times-out, then "1" "RTN","ECMUTL1",78,0) ; if user up-arrows out, then "2" "RTN","ECMUTL1",79,0) ; "RTN","ECMUTL1",80,0) N SEND,ECOUT,EC4,EC4N,ECPCL,ECPCID,ECPCRD "RTN","ECMUTL1",81,0) S ECOUT=0 "RTN","ECMUTL1",82,0) S ECSCR=+$G(ECSCR) "RTN","ECMUTL1",83,0) S SEND=$P(^ECD(+ECUNIT,0),"^",14) "RTN","ECMUTL1",84,0) I SEND="" S SEND="N" "RTN","ECMUTL1",85,0) S ECPCE("CLIN")="",ECPCE("DX")="",ECPCE("AO")="",ECPCE("IR")="" "RTN","ECMUTL1",86,0) S ECPCE("ENV")="",ECPCE("SC")="",ECPCE("MST")="",ECPCE("HNC")="" "RTN","ECMUTL1",87,0) S ECPCE("CV")="" "RTN","ECMUTL1",88,0) K ECPCE("DXS") "RTN","ECMUTL1",89,0) I "AO"[SEND D "RTN","ECMUTL1",90,0) .;- Don't write message if Send to PCE = "O" and patient is an inpatient "RTN","ECMUTL1",91,0) .I SEND="A"!(SEND="O"&(ECPCE("I/O")="O")) D "RTN","ECMUTL1",92,0) ..W !!,?5,"Please Note: The following prompt(s) cannot be by-passed with" "RTN","ECMUTL1",93,0) ..W !,?5,", since the data is sent to PCE for workload reporting." "RTN","ECMUTL1",94,0) ..W !,?5,"If data cannot be provided, respond with ""^"". This will" "RTN","ECMUTL1",95,0) ..W !,?5,"remove the current patient from the selected patient list.",! "RTN","ECMUTL1",96,0) .D CLINIC I $G(ECOUT) D MSGCLN Q "RTN","ECMUTL1",97,0) .D ASKDX I $G(ECOUT) D MSGDX Q "RTN","ECMUTL1",98,0) .D VISIT I $G(ECOUT) D CLMSG Q "RTN","ECMUTL1",99,0) I ECSCR,(ECPCE("CLIN")=""),('$G(ECOUT)) D "RTN","ECMUTL1",100,0) .Q:'$D(^ECJ(ECSCR)) "RTN","ECMUTL1",101,0) .I ECUNIT'=$P($P(^ECJ(ECSCR,0),"^",1),"-",2) Q "RTN","ECMUTL1",102,0) .S EC4=$P($G(^ECJ(ECSCR,"PRO")),"^",4) I +EC4 D "RTN","ECMUTL1",103,0) ..S EC4N=$P($G(^SC(+EC4,0)),"^",1) "RTN","ECMUTL1",104,0) ..D CLIN(EC4,.ECPCL) "RTN","ECMUTL1",105,0) ..S:ECPCL ECPCE("CLIN")=EC4_"^"_EC4N "RTN","ECMUTL1",106,0) ..S:'ECPCL ECPCE("CLIN")="" "RTN","ECMUTL1",107,0) Q ECOUT "RTN","ECMUTL1",108,0) ; "RTN","ECMUTL1",109,0) ASKDX ;ask dx "RTN","ECMUTL1",110,0) N ECDX,ECDXN,DTOUT,DUOUT,DIRUT,DIR,Y,EC4,ECDXS "RTN","ECMUTL1",111,0) S (ECDX,ECDXN)="",EC4=$P(ECPCE("CLIN"),U) "RTN","ECMUTL1",112,0) D PDX^ECUTL2 I ECOUT Q "RTN","ECMUTL1",113,0) S ECPCE("DX")=ECDX_"^"_ECDXN "RTN","ECMUTL1",114,0) D SDX^ECUTL2 I ECOUT Q "RTN","ECMUTL1",115,0) M ECPCE("DXS")=ECDXS "RTN","ECMUTL1",116,0) Q "RTN","ECMUTL1",117,0) ; "RTN","ECMUTL1",118,0) CLINIC ;get associated clinic "RTN","ECMUTL1",119,0) N ECDATA,EC4,EC4N,ECID,ECPCL,DTOUT,DUOUT,DIRUT,DIR,Y "RTN","ECMUTL1",120,0) Q:SEND="O"&(ECPCE("I/O")'="O") "RTN","ECMUTL1",121,0) F D Q:$G(ECOUT) Q:$G(ECPCL) "RTN","ECMUTL1",122,0) .K DA,DIR,DIRUT,DTOUT,DUOUT "RTN","ECMUTL1",123,0) .S (EC4,ECPCL)=0,EC4N="" "RTN","ECMUTL1",124,0) .S DIR(0)="721,26",DIR("A")="Associated Clinic",DIR("?")="An active clinic is required. Enter an active clinic or an ^ to exit" "RTN","ECMUTL1",125,0) .D ^DIR "RTN","ECMUTL1",126,0) .S:$D(DTOUT) ECOUT=1 S:$D(DUOUT) ECOUT=2 "RTN","ECMUTL1",127,0) .Q:$G(ECOUT) "RTN","ECMUTL1",128,0) .I 'Y W !!?5,"You must enter an active clinic now.",! Q "RTN","ECMUTL1",129,0) .I Y S EC4=+Y,ECDATA=$G(^SC(+EC4,0)),ECID=$P(ECDATA,"^",7),EC4N=$P(ECDATA,"^",1) "RTN","ECMUTL1",130,0) .I $G(EC4) D CLIN(EC4,.ECPCL) I 'ECPCL D "RTN","ECMUTL1",131,0) ..W !!,?5,"The clinic you selected is inactive." "RTN","ECMUTL1",132,0) ..W !,?5,"Workload data cannot be sent to PCE for Event" "RTN","ECMUTL1",133,0) ..W !,?5,"Capture procedures without an active clinic." "RTN","ECMUTL1",134,0) .I 'ECPCL W !!?5,"You must enter an active clinic now.",! "RTN","ECMUTL1",135,0) Q:'$G(ECPCL) "RTN","ECMUTL1",136,0) S ECPCE("CLIN")=EC4_"^"_EC4N "RTN","ECMUTL1",137,0) Q "RTN","ECMUTL1",138,0) ; "RTN","ECMUTL1",139,0) ; "RTN","ECMUTL1",140,0) VISIT ;ask visit info "RTN","ECMUTL1",141,0) N ECFLG,ECCLFLDS,ECCLVAR,ECX,ECAO,ECIR,ECMST,ECMST,ECSC,ECZEC,ECHNC,ECCV "RTN","ECMUTL1",142,0) N ECMDT,ECY,ECMD,ECDT "RTN","ECMUTL1",143,0) Q:ECPCE("I/O")="I" "RTN","ECMUTL1",144,0) S (ECAO,ECIR,ECSC,ECZEC,ECX,ECMST,ECHNC,ECCV)="",ECY=0 "RTN","ECMUTL1",145,0) F S ECY=$O(^TMP("ECMPIDX",$J,ECY)) Q:'ECY S ECMD=^(ECY) I $P(ECMD,U,2) D "RTN","ECMUTL1",146,0) .S ECMDT($P(ECMD,U,2))="" "RTN","ECMUTL1",147,0) S ECDT=$O(ECMDT(0)) ;use earliest date to evaluate classifications "RTN","ECMUTL1",148,0) ; "RTN","ECMUTL1",149,0) ;- Ask classification questions applicable to patient and file in #721 "RTN","ECMUTL1",150,0) I $$ASKCLASS^ECUTL1(+$G(ECPAT),.ECCLFLDS,.ECOUT,SEND,ECPCE("I/O")),($O(ECCLFLDS(""))]"") D SETCLASS^ECUTL1(.ECCLFLDS) "RTN","ECMUTL1",151,0) Q:+$G(ECOUT) "RTN","ECMUTL1",152,0) ; "RTN","ECMUTL1",153,0) ;- Store classification variables into ECPCE array "RTN","ECMUTL1",154,0) F ECCLVAR="ECAO","ECIR","ECZEC","ECSC","ECMST","ECHNC","ECCV" I @($G(ECCLVAR))]"" S ECPCE($S($E(ECCLVAR,3,$L(ECCLVAR))'="ZEC":$E(ECCLVAR,3,$L(ECCLVAR)),1:"ENV"))=@ECCLVAR "RTN","ECMUTL1",155,0) Q "RTN","ECMUTL1",156,0) ; "RTN","ECMUTL1",157,0) ; "RTN","ECMUTL1",158,0) CLIN(EC4,ECPCL) ;check for active associated clinic "RTN","ECMUTL1",159,0) N ECPCID,ECPCRD "RTN","ECMUTL1",160,0) D CLIN^ECPCEU "RTN","ECMUTL1",161,0) Q "RTN","ECMUTL1",162,0) ; "RTN","ECMUTL1",163,0) ; "RTN","ECMUTL1",164,0) MSGDX ;if ecout & essential data missing, display msg "RTN","ECMUTL1",165,0) Q:SEND="N" Q:SEND="O"&(ECPCE("I/O")'="O") "RTN","ECMUTL1",166,0) I ECPCE("DX")="" D Q "RTN","ECMUTL1",167,0) .W !!,?5,"Please note that data cannot be sent to PCE" "RTN","ECMUTL1",168,0) .W !,?5,"for workload reporting without an ICD-9 code.",! "RTN","ECMUTL1",169,0) .D MSG1 "RTN","ECMUTL1",170,0) Q "RTN","ECMUTL1",171,0) ; "RTN","ECMUTL1",172,0) MSGCLN ;if ecout & essential data missing, display msg "RTN","ECMUTL1",173,0) Q:SEND="N" Q:SEND="O"&(ECPCE("I/O")'="O") "RTN","ECMUTL1",174,0) I ECPCE("CLIN")="" D Q "RTN","ECMUTL1",175,0) .W !!,?5,"Please note that data cannot be sent to PCE for workload" "RTN","ECMUTL1",176,0) .W !,?5,"reporting without an active associated clinic.",! "RTN","ECMUTL1",177,0) .D MSG1 "RTN","ECMUTL1",178,0) Q "RTN","ECMUTL1",179,0) ; "RTN","ECMUTL1",180,0) CLMSG ; Display classification questions error message "RTN","ECMUTL1",181,0) Q:SEND="N" Q:ECPCE("I/O")'="O" "RTN","ECMUTL1",182,0) W !!,?5,"Please note that data cannot be sent to PCE for workload reporting" "RTN","ECMUTL1",183,0) W !,?5,"unless the classification questions are answered.",! "RTN","ECMUTL1",184,0) D MSG1 "RTN","ECMUTL1",185,0) Q "RTN","ECMUTL1",186,0) ; "RTN","ECMUTL1",187,0) ; "RTN","ECMUTL1",188,0) MSG1 ;Error message display "RTN","ECMUTL1",189,0) N DIR,Y "RTN","ECMUTL1",190,0) S DIR(0)="E",DIR("A")="Press RETURN to continue" "RTN","ECMUTL1",191,0) D ^DIR "RTN","ECMUTL1",192,0) W ! "RTN","ECMUTL1",193,0) Q "RTN","ECMUTL1",194,0) ; "RTN","ECMUTL1",195,0) ; "RTN","ECMUTL1",196,0) INOUT(ECPTIEN,ECARRY) ; Determine inpatient/outpatient status "RTN","ECMUTL1",197,0) ; "RTN","ECMUTL1",198,0) N ECOUT "RTN","ECMUTL1",199,0) S ECOUT=0 "RTN","ECMUTL1",200,0) S ECARRY=$G(ECARRY) "RTN","ECMUTL1",201,0) S ECPTIEN=+$G(ECPTIEN) "RTN","ECMUTL1",202,0) ; "RTN","ECMUTL1",203,0) ; - If ECARRY not defined, use ^TMP("ECMPIDX",$J) "RTN","ECMUTL1",204,0) S:(ECARRY="") ECARRY="^TMP(""ECMPIDX"",$J)" "RTN","ECMUTL1",205,0) ; "RTN","ECMUTL1",206,0) S ECPCE("I/O")=$$INOUTPT^ECUTL0(ECPTIEN,+$P(@ECARRY@(+$O(@ECARRY@(""),-1)),"^",2)) "RTN","ECMUTL1",207,0) I ECPCE("I/O")="" D INOUTERR^ECUTL0 "RTN","ECMUTL1",208,0) Q $S(+$G(ECOUT)=0:1,1:0) "RTN","ECMUTL1",209,0) ; "RTN","ECMUTL1",210,0) ; "RTN","ECMUTL1",211,0) ASKELIG(ECDSS,ECIO,ECPTIEN) ; Determine patient eligibility "RTN","ECMUTL1",212,0) ; "RTN","ECMUTL1",213,0) ; Input: "RTN","ECMUTL1",214,0) ; ECDSS - DSS Unit IEN "RTN","ECMUTL1",215,0) ; ECIO - Inpatient or Outpatient "RTN","ECMUTL1",216,0) ; ECPTIEN - DFN of Patient file (#2) "RTN","ECMUTL1",217,0) ; "RTN","ECMUTL1",218,0) ; Output: "RTN","ECMUTL1",219,0) ; ECPCE("ELIG") - containing patient eligibility "RTN","ECMUTL1",220,0) ; "RTN","ECMUTL1",221,0) N VAEL "RTN","ECMUTL1",222,0) S ECDSS=+$G(ECDSS) "RTN","ECMUTL1",223,0) S ECIO=$G(ECIO) "RTN","ECMUTL1",224,0) S ECPTIEN=+$G(ECPTIEN) "RTN","ECMUTL1",225,0) ; "RTN","ECMUTL1",226,0) ;- Get elig if Send to PCE="A" or Send to PCE="O" and outpatient "RTN","ECMUTL1",227,0) I $$CHKDSS^ECUTL0(+$G(ECDSS),ECIO) D "RTN","ECMUTL1",228,0) . ; "RTN","ECMUTL1",229,0) . ;- If dual elig, ask user to select otherwise use primary elig "RTN","ECMUTL1",230,0) . I $$MULTELG^ECUTL0(+$G(ECPTIEN)) S ECPCE("ELIG")=+$$ELGLST^ECUTL0 "RTN","ECMUTL1",231,0) . E S ECPCE("ELIG")=+$G(VAEL(1)) "RTN","ECMUTL1",232,0) Q "RTN","ECMUTL1",233,0) ; "RTN","ECMUTL1",234,0) REMOVE(ECPAT) ; Remove patient from selected patient list because required data missing "RTN","ECMUTL1",235,0) N DFN,ECI "RTN","ECMUTL1",236,0) S DFN=+ECPAT,ECI=0 "RTN","ECMUTL1",237,0) F S ECI=$O(^TMP("ECPLST",$J,ECI)) Q:'ECI D "RTN","ECMUTL1",238,0) .I +$G(^TMP("ECPLST",$J,ECI))=DFN D "RTN","ECMUTL1",239,0) ..K ^TMP("ECPLST",$J,ECI),^TMP("ECMPTIDX",$J,ECI),^TMP("ECPAT",$J,DFN) "RTN","ECMUTL1",240,0) ..W !?5,"Patient deselected because required data missing.",! "RTN","ECMUTL1",241,0) ..D MSG1 "RTN","ECMUTL1",242,0) Q "RTN","ECPCEU") 0^3^B17811678 "RTN","ECPCEU",1,0) ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97 "RTN","ECPCEU",2,0) ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54**;8 May 96 "RTN","ECPCEU",3,0) CLIN ;check for active inactive clinic "RTN","ECPCEU",4,0) N ECCLDT "RTN","ECPCEU",5,0) I $L($G(ECDT))>6,+ECDT=ECDT S ECCLDT=ECDT "RTN","ECPCEU",6,0) I '$G(ECCLDT) S ECCLDT=DT "RTN","ECPCEU",7,0) K ECPCL "RTN","ECPCEU",8,0) I '$D(EC4) S ECPCL=0 Q "RTN","ECPCEU",9,0) I 'EC4 S ECPCL=0 Q "RTN","ECPCEU",10,0) I '$D(^SC(+EC4,"I")) S ECPCL=1 Q "RTN","ECPCEU",11,0) S ECPCID=+$P(^SC(+EC4,"I"),"^"),ECPCRD=+$P(^("I"),"^",2) "RTN","ECPCEU",12,0) I ECPCID,ECPCID'>ECCLDT I 'ECPCRD!(ECPCRD>ECCLDT) S ECPCL=0 Q "RTN","ECPCEU",13,0) I ECPCID,ECPCRD,ECPCRD'>ECCLDT S ECPCL=1 Q "RTN","ECPCEU",14,0) I ECPCID,ECPCID>ECCLDT S ECPCL=1 Q "RTN","ECPCEU",15,0) S ECPCL=1 "RTN","ECPCEU",16,0) K ECPCID,ECPCRD "RTN","ECPCEU",17,0) Q "RTN","ECPCEU",18,0) NITE ;start nightly job "RTN","ECPCEU",19,0) K ^TMP("ECPXAPI",$J) "RTN","ECPCEU",20,0) D NOW^%DTC S ECCKDT=+$E(%,1,12) "RTN","ECPCEU",21,0) S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA" "RTN","ECPCEU",22,0) S ECJJ=0 F S ECJJ=$O(^ECH("AD",ECJJ)) Q:'ECJJ S ECJJ1=0 F S ECJJ1=$O(^ECH("AD",ECJJ,ECJJ1)) Q:'ECJJ1 I $D(^ECH(ECJJ1,"PCE")) D SET "RTN","ECPCEU",23,0) K DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECU,ECU2,ECU3,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV "RTN","ECPCEU",24,0) K %,%H,%I,ECCKDT "RTN","ECPCEU",25,0) K ^TMP("ECPXAPI",$J) "RTN","ECPCEU",26,0) Q "RTN","ECPCEU",27,0) SET ;set variables "RTN","ECPCEU",28,0) S ECNODE=^ECH(ECJJ1,"PCE"),ECDT=$P(ECNODE,"~"),ECPS=$P(ECNODE,"~",2),ECHL=$P(ECNODE,"~",3),ECL=$P(ECNODE,"~",4),ECID=$P(ECNODE,"~",5),ECU=$P(ECNODE,"~",6),ECU2=$P(ECNODE,"~",7),ECU3=$P(ECNODE,"~",8),ECV=$P(ECNODE,"~",9) "RTN","ECPCEU",29,0) S ECCPT=$P(ECNODE,"~",10),ECDX=$P(ECNODE,"~",11),ECAO=$P(ECNODE,"~",12),ECIR=$P(ECNODE,"~",13),ECZEC=$P(ECNODE,"~",14),ECSC=$P(ECNODE,"~",15),EC725=$P(ECNODE,"~",16),ECELIG=$P(ECNODE,"~",17),ECMST=$P(ECNODE,"~",18) "RTN","ECPCEU",30,0) S ECHNC=$P(ECNODE,"~",19),ECCV=$P(ECNODE,"~",20) "RTN","ECPCEU",31,0) TMP ;set ^TMP for PCE call "RTN","ECPCEU",32,0) ENC S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=ECDT "RTN","ECPCEU",33,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"PATIENT")=ECPS "RTN","ECPCEU",34,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=ECHL "RTN","ECPCEU",35,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=ECL "RTN","ECPCEU",36,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SC")=ECSC "RTN","ECPCEU",37,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"AO")=ECAO "RTN","ECPCEU",38,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"IR")=ECIR "RTN","ECPCEU",39,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"EC")=ECZEC "RTN","ECPCEU",40,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"MST")=ECMST "RTN","ECPCEU",41,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HNC")=ECHNC "RTN","ECPCEU",42,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CV")=ECCV "RTN","ECPCEU",43,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X" "RTN","ECPCEU",44,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A" "RTN","ECPCEU",45,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"DSS ID")=ECID "RTN","ECPCEU",46,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT "RTN","ECPCEU",47,0) S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG "RTN","ECPCEU",48,0) PROV S ^TMP("ECPXAPI",$J,"PROVIDER",1,"NAME")=ECU "RTN","ECPCEU",49,0) S ^TMP("ECPXAPI",$J,"PROVIDER",1,"PRIMARY")=1 "RTN","ECPCEU",50,0) S:ECU2 ^TMP("ECPXAPI",$J,"PROVIDER",2,"NAME")=ECU2 "RTN","ECPCEU",51,0) S:ECU3 ^TMP("ECPXAPI",$J,"PROVIDER",3,"NAME")=ECU3 "RTN","ECPCEU",52,0) DX S ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS")=ECDX "RTN","ECPCEU",53,0) S ^TMP("ECPXAPI",$J,"DX/PL",1,"PRIMARY")=1 "RTN","ECPCEU",54,0) ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis "RTN","ECPCEU",55,0) S DXS=0 F ECI=2:1 S DXS=$O(^ECH(ECJJ1,"DX",DXS)) Q:DXS="" D "RTN","ECPCEU",56,0) . S DXSIEN=$G(^ECH(ECJJ1,"DX",DXS,0)) I DXSIEN="" Q "RTN","ECPCEU",57,0) . S ^TMP("ECPXAPI",$J,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN "RTN","ECPCEU",58,0) PROC S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"ENC PROVIDER")=ECU "RTN","ECPCEU",59,0) S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"EVENT D/T")=ECDT "RTN","ECPCEU",60,0) S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"PROCEDURE")=ECCPT "RTN","ECPCEU",61,0) S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"QTY")=ECV "RTN","ECPCEU",62,0) S:EC725]"" ^TMP("ECPXAPI",$J,"PROCEDURE",1,"NARRATIVE")=EC725 "RTN","ECPCEU",63,0) MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier "RTN","ECPCEU",64,0) I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D "RTN","ECPCEU",65,0) . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D "RTN","ECPCEU",66,0) . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)="" "RTN","ECPCEU",67,0) D2PCE S VALQUIET=1,ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST) "RTN","ECPCEU",68,0) I ECVST K DA,DIE,DR S DA=ECJJ1,DIE=721,DR="25////1;31///@;28////"_ECVST_";32////"_ECCKDT D ^DIE K DA,DIE,DR "RTN","ECPCEU",69,0) K ^TMP("ECPXAPI",$J),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS "RTN","ECPCEU",70,0) K DA,D0,DIE,DR,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECNODE,ECPS,ECSC,ECU,ECU2,ECU3,ECV,ECVV,ECZEC,ECELIG,ECMST,ECHNC,ECCV "RTN","ECPCEU",71,0) Q "RTN","ECUERPC1") 0^15^B53629201 "RTN","ECUERPC1",1,0) ECUERPC1 ;ALB/JAM;Event Capture Data Entry Broker Util ; 5/21/01 7:30pm "RTN","ECUERPC1",2,0) ;;2.0; EVENT CAPTURE ;**25,33,42,46,47,54**;8 May 96 "RTN","ECUERPC1",3,0) PATINF(RESULTS,ECARY) ; "RTN","ECUERPC1",4,0) ;Broker entry point to get various types of data from EVENT CAPTURE "RTN","ECUERPC1",5,0) ;PATIENT FILE #721 "RTN","ECUERPC1",6,0) ; RPC: EC GETPATINFO "RTN","ECUERPC1",7,0) ;INPUTS ECARY - Contains the following subscripted elements "RTN","ECUERPC1",8,0) ; ECIEN - Event Capture Patient ien "RTN","ECUERPC1",9,0) ; ECTYP - Data type to return "RTN","ECUERPC1",10,0) ; "RTN","ECUERPC1",11,0) ;OUTPUTS RESULTS - Array of Event Capture Patient data "RTN","ECUERPC1",12,0) ; "RTN","ECUERPC1",13,0) N ECTYP,ECIEN "RTN","ECUERPC1",14,0) S ECARY=$G(ECARY),ECIEN=$P(ECARY,U),ECTYP=$P(ECARY,U,2) I ECIEN="" Q "RTN","ECUERPC1",15,0) I '$D(^ECH(ECIEN)) Q "RTN","ECUERPC1",16,0) D SETENV^ECUMRPC "RTN","ECUERPC1",17,0) I ECTYP="DXS" D PATDXS(ECIEN) Q "RTN","ECUERPC1",18,0) I ECTYP="MOD" D PATMOD(ECIEN) Q "RTN","ECUERPC1",19,0) I ECTYP="CLASS" D PATCLASS(ECIEN) Q "RTN","ECUERPC1",20,0) I ECTYP="OTH" D PATOTH(ECIEN) Q "RTN","ECUERPC1",21,0) Q "RTN","ECUERPC1",22,0) PATDXS(ECIEN) ; "RTN","ECUERPC1",23,0) ;Returns to broker a patient secondary DXs entries from EVENT "RTN","ECUERPC1",24,0) ;CAPTURE PATIENT FILE #721 "RTN","ECUERPC1",25,0) ;INPUTS ECIEN - Event Capture Patient ien "RTN","ECUERPC1",26,0) ; "RTN","ECUERPC1",27,0) ;OUTPUTS RESULTS - Array of Event Capture Patient file contains "RTN","ECUERPC1",28,0) ; 721 IEN^secondary dx ien #80^secondary dx code^dx desription "RTN","ECUERPC1",29,0) ; "RTN","ECUERPC1",30,0) N DXS,DXSIEN,DXSD,CNT "RTN","ECUERPC1",31,0) I '$D(^ECH(ECIEN,"DX")) Q "RTN","ECUERPC1",32,0) K ^TMP($J,"ECDXS") "RTN","ECUERPC1",33,0) S (CNT,DXS)=0 F S DXS=$O(^ECH(ECIEN,"DX",DXS)) Q:'DXS D "RTN","ECUERPC1",34,0) . S DXSIEN=$G(^ECH(ECIEN,"DX",DXS,0)) I DXSIEN="" Q "RTN","ECUERPC1",35,0) . S DXSD=$$ICDDX^ICDCODE(DXSIEN,$P($G(^ECH(ECIEN,0)),U,3)) "RTN","ECUERPC1",36,0) . S DXSD=$P(DXSD,U,2)_" "_$P(DXSD,U,4) "RTN","ECUERPC1",37,0) . S CNT=CNT+1,^TMP($J,"ECDXS",CNT)=ECIEN_U_DXSIEN_U_DXSD "RTN","ECUERPC1",38,0) S RESULTS=$NA(^TMP($J,"ECDXS")) "RTN","ECUERPC1",39,0) Q "RTN","ECUERPC1",40,0) PATMOD(ECIEN) ; "RTN","ECUERPC1",41,0) ;Returns to broker a patient procedure modifier from EVENT CAPTURE "RTN","ECUERPC1",42,0) ;PATIENT FILE #721 "RTN","ECUERPC1",43,0) ;INPUTS ECIEN - Event Capture Patient ien "RTN","ECUERPC1",44,0) ; "RTN","ECUERPC1",45,0) ;OUTPUTS RESULTS - Array of procedure modifiers "RTN","ECUERPC1",46,0) ; 721 IEN^modifier ien #81.3^modifier^modifier name "RTN","ECUERPC1",47,0) ; "RTN","ECUERPC1",48,0) N MOD,MODIEN,CNT,MODS "RTN","ECUERPC1",49,0) I '$D(^ECH(ECIEN,"MOD")) Q "RTN","ECUERPC1",50,0) K ^TMP($J,"ECMOD") "RTN","ECUERPC1",51,0) S (CNT,MOD)=0 F S MOD=$O(^ECH(ECIEN,"MOD",MOD)) Q:'MOD D "RTN","ECUERPC1",52,0) . S MODIEN=$G(^ECH(ECIEN,"MOD",MOD,0)) I MODIEN="" Q "RTN","ECUERPC1",53,0) . S MODS=$$MOD^ICPTMOD(MODIEN,"I",$P($G(^ECH(ECIEN,0)),U,3)) I +MODS<0 Q "RTN","ECUERPC1",54,0) . S CNT=CNT+1 "RTN","ECUERPC1",55,0) . S ^TMP($J,"ECMOD",CNT)=ECIEN_U_$P(MODS,U,1,2)_" "_$P(MODS,U,3) "RTN","ECUERPC1",56,0) S RESULTS=$NA(^TMP($J,"ECMOD")) "RTN","ECUERPC1",57,0) Q "RTN","ECUERPC1",58,0) PATCLASS(ECIEN) ; "RTN","ECUERPC1",59,0) ;Returns to broker a patient classification & eligibility data from "RTN","ECUERPC1",60,0) ;EVENT CAPTURE PATIENT FILE #721 "RTN","ECUERPC1",61,0) ; INPUTS ECIEN - Event Capture Patient ien "RTN","ECUERPC1",62,0) ; OUTPUTS RESULTS - Array of procedure modifiers "RTN","ECUERPC1",63,0) ; 721 IEN^agent orange^radiation exposure^service connect^environmental "RTN","ECUERPC1",64,0) ; contaminants^military sexual trauma^eligibility code #8^eligibility "RTN","ECUERPC1",65,0) ; description^head/neck cancer^combat veteran "RTN","ECUERPC1",66,0) ; "RTN","ECUERPC1",67,0) N CLA,ELIG,ELCOD,ECAO,ECIR,ECEC,ECSC,ECMST,STR,ECHNC,ECCV "RTN","ECUERPC1",68,0) I '$D(^ECH(ECIEN,"P")),'$D(^ECH(ECIEN,"PCE")) Q "RTN","ECUERPC1",69,0) K ^TMP($J,"ECLASS") "RTN","ECUERPC1",70,0) S ELIG=$P($G(^ECH(ECIEN,"PCE")),"~",17),ELCOD="",CLA=$G(^ECH(ECIEN,"P")) "RTN","ECUERPC1",71,0) S:ELIG'="" ELCOD=$P($G(^DIC(8,ELIG,0)),U) "RTN","ECUERPC1",72,0) S ECAO=$P(CLA,U,3),ECIR=$P(CLA,U,4),ECEC=$P(CLA,U,5),ECSC=$P(CLA,U,6) "RTN","ECUERPC1",73,0) S ECMST=$P(CLA,U,9),ECHNC=$P(CLA,U,10),ECCV=$P(CLA,U,11) "RTN","ECUERPC1",74,0) S STR=ECIEN_U_ECAO_U_ECIR_U_ECSC_U_ECEC_U_ECMST_U_ELIG_U_ELCOD_U_ECHNC "RTN","ECUERPC1",75,0) S STR=STR_U_ECCV,^TMP($J,"ECLASS",1)=STR,RESULTS=$NA(^TMP($J,"ECLASS")) "RTN","ECUERPC1",76,0) Q "RTN","ECUERPC1",77,0) PATOTH(ECIEN) ; "RTN","ECUERPC1",78,0) ;Returns to broker a patient remaining data from EVENT CAPTURE "RTN","ECUERPC1",79,0) ;PATIENT FILE #721 "RTN","ECUERPC1",80,0) ;INPUTS ECIEN - Event Capture Patient ien "RTN","ECUERPC1",81,0) ; "RTN","ECUERPC1",82,0) ;OUTPUTS RESULTS - Array of procedure modifiers "RTN","ECUERPC1",83,0) ; 721 IEN^procedure reason^provider #2^provider #3 "RTN","ECUERPC1",84,0) ; ^provider #2 IEN^provider #3 IEN "RTN","ECUERPC1",85,0) ; "RTN","ECUERPC1",86,0) N REAS,PRV2,PRV3,ECX "RTN","ECUERPC1",87,0) K ^TMP($J,"ECOTH") "RTN","ECUERPC1",88,0) S ECX=^ECH(ECIEN,0) "RTN","ECUERPC1",89,0) S REAS=$$GET1^DIQ(721,ECIEN,34,"E") "RTN","ECUERPC1",90,0) S PRV2=$$GET1^DIQ(721,ECIEN,15,"E") "RTN","ECUERPC1",91,0) S PRV3=$$GET1^DIQ(721,ECIEN,17,"E") "RTN","ECUERPC1",92,0) S ^TMP($J,"ECOTH",1)=REAS_U_PRV2_U_PRV3_U_$P(ECX,U,15)_U_$P(ECX,U,17) "RTN","ECUERPC1",93,0) S RESULTS=$NA(^TMP($J,"ECOTH")) "RTN","ECUERPC1",94,0) Q "RTN","ECUERPC1",95,0) PATCLAST(RESULTS,ECARY) ; "RTN","ECUERPC1",96,0) ;Returns to broker a patient status (in/out) and classification "RTN","ECUERPC1",97,0) ; RPC: EC GETPATCLASTAT "RTN","ECUERPC1",98,0) ;INPUTS ECARY - Contains the following subscripted elements "RTN","ECUERPC1",99,0) ; ECDFN - Patient ien (#2) "RTN","ECUERPC1",100,0) ; ECD - DSS Unit ien (#724) "RTN","ECUERPC1",101,0) ; ECDT - Procedure date and time (fileman format) "RTN","ECUERPC1",102,0) ;OUTPUTS RESULTS - Patient status and classifications delimited by (^) "RTN","ECUERPC1",103,0) ; Patient Status: I for inpatient or O for outpatient "RTN","ECUERPC1",104,0) ; Classification: 2- Agent Orange, 3- Ionizing Radiation "RTN","ECUERPC1",105,0) ; 4- SC Condition, 5- Environmental Contaminants 6- Military "RTN","ECUERPC1",106,0) ; Sexual Trauma 7- Head/Neck Cancer 8- Combat Veteran "RTN","ECUERPC1",107,0) ; Data after the '~' refers to those class. that must be asked "RTN","ECUERPC1",108,0) ; by Delphi appl. when the answer to SC=No. "RTN","ECUERPC1",109,0) ; Data after "~" 1- Agent Orange 2- Ionizing Radi. 3- Env Cont "RTN","ECUERPC1",110,0) N ECDFN,ECDT,ECX,I,ECCLARY,SCDAT,PATSTAT "RTN","ECUERPC1",111,0) D SETENV^ECUMRPC "RTN","ECUERPC1",112,0) S ECDFN=$P(ECARY,U),ECD=$P(ECARY,U,2),ECDT=$P(ECARY,U,3) Q:ECDFN="" "RTN","ECUERPC1",113,0) I ECDT="" D NOW^%DTC S ECDT=% "RTN","ECUERPC1",114,0) S PATSTAT=$$INOUTPT^ECUTL0(ECDFN,ECDT),RESULTS="^^^^^^",SCDAT=";;;" "RTN","ECUERPC1",115,0) I PATSTAT="I" D Q ;added to be consisent w roll-n-scoll 11/25/03 JAM "RTN","ECUERPC1",116,0) .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"") "RTN","ECUERPC1",117,0) I '$$CHKDSS^ECUTL0(+$G(ECD),PATSTAT) D Q "RTN","ECUERPC1",118,0) .S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"") "RTN","ECUERPC1",119,0) D CL^SDCO21(ECDFN,ECDT,"",.ECCLARY) F ECX=3,1,2,4,5,6,7 D "RTN","ECUERPC1",120,0) .I ECX=1,$P($G(^DPT(ECDFN,.321)),"^",2)'="Y" Q "RTN","ECUERPC1",121,0) .I ECX=2,$P($G(^DPT(ECDFN,.321)),"^",3)'="Y" Q "RTN","ECUERPC1",122,0) .I ECX=4,$P($G(^DPT(ECDFN,.322)),"^",13)'="Y",'$$EC^SDCO22(ECDFN,"") Q "RTN","ECUERPC1",123,0) .I ECX=3,$D(ECCLARY(ECX)) F I=1,2,4 S ECCLARY(I)="SC" "RTN","ECUERPC1",124,0) .I '$D(ECCLARY(ECX)) Q "RTN","ECUERPC1",125,0) .;Check SC, if answer to SC is NO then these questions will be asked "RTN","ECUERPC1",126,0) .I ECCLARY(ECX)="SC" S $P(SCDAT,";",ECX)="E" "RTN","ECUERPC1",127,0) .E S $P(RESULTS,"^",ECX)="E" "RTN","ECUERPC1",128,0) S RESULTS=PATSTAT_"^"_RESULTS_$S(SCDAT'="":"~"_SCDAT,1:"") "RTN","ECUERPC1",129,0) Q "RTN","ECUERPC1",130,0) ENCDXS(RESULTS,ECARY) ; "RTN","ECUERPC1",131,0) ;Broker call returns a patient encounter primary & secondary dx (#721) "RTN","ECUERPC1",132,0) ; RPC: EC GETENCDXS "RTN","ECUERPC1",133,0) ;INPUTS ECDFN - Patient ien (#2) "RTN","ECUERPC1",134,0) ; ECDT - Procedure date and time (fileman format) "RTN","ECUERPC1",135,0) ; ECL - Location ien "RTN","ECUERPC1",136,0) ; EC4 - Clinic ien "RTN","ECUERPC1",137,0) ; "RTN","ECUERPC1",138,0) ;OUTPUTS RESULTS - array of patient encounter diagnosis "RTN","ECUERPC1",139,0) ; primary/secondary flag^DX ien^DX code DX description. "RTN","ECUERPC1",140,0) ; "RTN","ECUERPC1",141,0) N ECDFN,ECDT,ECL,EC4,ECPDX,ECDX,ECDXN,ECDXS,CNT,STR,ECPDX,SDXCNT "RTN","ECUERPC1",142,0) D SETENV^ECUMRPC "RTN","ECUERPC1",143,0) K ^TMP($J,"ECENCDXS") "RTN","ECUERPC1",144,0) S ECDFN=$P(ECARY,U),ECDT=+$P(ECARY,U,2),ECL=$P(ECARY,U,3) "RTN","ECUERPC1",145,0) S EC4=$P(ECARY,U,4) I ECDT="" D NOW^%DTC S ECDT=% "RTN","ECUERPC1",146,0) I ECDFN=""!(ECL="")!(EC4="") Q "RTN","ECUERPC1",147,0) S (ECDX,ECDXN)="",ECPDX=$$PDXCK^ECUTL2(ECDFN,ECDT,ECL,EC4) I ECDX="" Q "RTN","ECUERPC1",148,0) S IEN=0,STR=1_U_ECDX_U_ECDXN_" "_$P($$ICDDX^ICDCODE(ECDX,ECDT),U,4) "RTN","ECUERPC1",149,0) S CNT=1,^TMP($J,"ECENCDXS",CNT)=STR "RTN","ECUERPC1",150,0) ;*ACS concat description to 2nd diag code, in the order entered by the user "RTN","ECUERPC1",151,0) F S IEN=$O(ECDXS(IEN)) Q:'IEN D "RTN","ECUERPC1",152,0) . S CNT=CNT+1,^TMP($J,"ECENCDXS",CNT)=0_U_ECDXS(IEN)_U_IEN_" "_$P($$ICDDX^ICDCODE(ECDXS(IEN),ECDT),U,4) "RTN","ECUERPC1",153,0) S RESULTS=$NA(^TMP($J,"ECENCDXS")) "RTN","ECUERPC1",154,0) Q "RTN","ECUERPC1",155,0) ; "RTN","ECUERPC1",156,0) PROCBAT(RESULTS,ECARY) ; "RTN","ECUERPC1",157,0) ;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721 "RTN","ECUERPC1",158,0) ;for patients for a specific procedure "RTN","ECUERPC1",159,0) ; RPC: EC GETBATPROCS "RTN","ECUERPC1",160,0) ;INPUTS ECARY - Contains the following subscripted elements "RTN","ECUERPC1",161,0) ; ECLOC - Location ien "RTN","ECUERPC1",162,0) ; ECUNT - DSS unit ien "RTN","ECUERPC1",163,0) ; ECC - Category ien "RTN","ECUERPC1",164,0) ; ECP - Procedure ien "RTN","ECUERPC1",165,0) ; ECSD - Start Date "RTN","ECUERPC1",166,0) ; ECED - End Date "RTN","ECUERPC1",167,0) ; "RTN","ECUERPC1",168,0) ;OUTPUTS RESULTS - Array of Event Capture Patient data containing:- "RTN","ECUERPC1",169,0) ; 721 IEN^Patient name^Procedure Date/Time^Primary Dx "RTN","ECUERPC1",170,0) ; ^Ordering Section^Associated Clinic "RTN","ECUERPC1",171,0) ;^SSN^DOB^Procedure Date and Time "RTN","ECUERPC1",172,0) N IEN,CNT,ECLOC,ECUNT,NODE,DATA,PXDT,ECV,ECC,ECP,ECSD,ECED,DATE,DFN "RTN","ECUERPC1",173,0) N CAT,ECI,VADM,ORC,ASC,ECDX "RTN","ECUERPC1",174,0) S ECV="ECLOC^ECUNT^ECC^ECP^ECSD^ECED" "RTN","ECUERPC1",175,0) D PARSE^ECUERPC(ECV,ECARY) "RTN","ECUERPC1",176,0) I (ECLOC="")!(ECUNT="")!(ECC="")!(ECP="") Q "RTN","ECUERPC1",177,0) D SETENV^ECUMRPC K ^TMP($J,"ECBATPX") S CNT=0 "RTN","ECUERPC1",178,0) S %DT="STX" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y "RTN","ECUERPC1",179,0) S ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999 "RTN","ECUERPC1",180,0) Q:ECED'>ECSD S DATE=ECSD "RTN","ECUERPC1",181,0) F S DATE=$O(^ECH("AC1",ECLOC,DATE)) Q:'DATE!(DATE>ECED) S IEN=0 D "RTN","ECUERPC1",182,0) . F S IEN=$O(^ECH("AC1",ECLOC,DATE,IEN)) Q:'IEN D "RTN","ECUERPC1",183,0) . . S NODE=$G(^ECH(IEN,0)) Q:NODE="" Q:$P(NODE,U,7)'=ECUNT "RTN","ECUERPC1",184,0) . . Q:$P(NODE,U,8)'=ECC Q:$P(NODE,U,9)'=ECP "RTN","ECUERPC1",185,0) . . S ECDX=$P($G(^ECH(IEN,"P")),U,2) I ECDX'="" D "RTN","ECUERPC1",186,0) . . . S ECDX=$$ICDDX^ICDCODE(ECDX,DATE) "RTN","ECUERPC1",187,0) . . . S ECDX=$P(ECDX,U,2)_" "_$P(ECDX,U,4) "RTN","ECUERPC1",188,0) . . S ASC=$P(NODE,U,19) S:ASC'="" ASC=$$GET1^DIQ(44,ASC,.01,"I") "RTN","ECUERPC1",189,0) . . S ORC=$P(NODE,U,12) S:ORC'="" ORC=$$GET1^DIQ(723,ORC,.01,"I") "RTN","ECUERPC1",190,0) . . S Y=DATE X ^DD("DD") S PXDT=Y,DFN=$P(NODE,U,2) D DEM^VADPT "RTN","ECUERPC1",191,0) . . S DATA=$E(VADM(1),1,30)_U_PXDT_U_ECDX_U_ORC_U_ASC "RTN","ECUERPC1",192,0) . . S CNT=CNT+1,^TMP($J,"ECBATPX",CNT)=IEN_U_DATA "RTN","ECUERPC1",193,0) S RESULTS=$NA(^TMP($J,"ECBATPX")) "RTN","ECUERPC1",194,0) Q "RTN","ECUERPC1",195,0) ; "RTN","ECUERPC1",196,0) CLHLP(RESULTS,ECARY) ;RPC Broker entry point for classification help "RTN","ECUERPC1",197,0) ; RPC: EC CLASHELP "RTN","ECUERPC1",198,0) ;INPUTS ECARY - Contains the following elements for report printing "RTN","ECUERPC1",199,0) ; ECDFN - Patient DFN from file (#2) "RTN","ECUERPC1",200,0) ; ECKY - Key to provide help on "RTN","ECUERPC1",201,0) ; "RTN","ECUERPC1",202,0) ;OUTPUTS RESULTS - Array of help text for classification "RTN","ECUERPC1",203,0) ; "RTN","ECUERPC1",204,0) N ECFILER,ECERR,ECDIRY,ECUFILE,ECDFN,ECKY,ECHNDL "RTN","ECUERPC1",205,0) D SETENV^ECUMRPC "RTN","ECUERPC1",206,0) K ^TMP("ECMSG",$J) "RTN","ECUERPC1",207,0) S ECERR=0,ECDFN=$P(ECARY,U),ECKY=$P(ECARY,U,2) D I ECERR D CLEND Q "RTN","ECUERPC1",208,0) .I ECDFN="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not defined" Q "RTN","ECUERPC1",209,0) .I ECKY="" S ECERR=1,^TMP("ECMSG",$J,1)="0^Help Key not defined" Q "RTN","ECUERPC1",210,0) .S DIC=2,DIC(0)="NMZX",X=ECDFN D ^DIC I Y<0 D "RTN","ECUERPC1",211,0) ..S ECERR=1,^TMP("ECMSG",$J,1)="0^Patient IEN not found" "RTN","ECUERPC1",212,0) S ECHNDL="ECLASHLP" D HFSOPEN^ECRRPC(ECHNDL) I ECERR D CLEND Q "RTN","ECUERPC1",213,0) U IO "RTN","ECUERPC1",214,0) I ECKY="SC" D SC^SDCO23(ECDFN) "RTN","ECUERPC1",215,0) D HFSCLOSE^ECRRPC(ECFILER) "RTN","ECUERPC1",216,0) CLEND ; "RTN","ECUERPC1",217,0) I $D(^TMP("ECMSG",$J)) S RESULTS=$NA(^TMP("ECMSG",$J)) Q "RTN","ECUERPC1",218,0) S RESULTS=$NA(^TMP($J)) "RTN","ECUERPC1",219,0) Q "RTN","ECUERPC1",220,0) ECDEF(RESULTS,ECARY) ;RPC Broker entry point to get a default for space bar "RTN","ECUERPC1",221,0) ; RPC: EC SPACEBAR "RTN","ECUERPC1",222,0) ;INPUTS ECARY - Contains the following elements for report printing "RTN","ECUERPC1",223,0) ; ECFILE - File to obtain value from "RTN","ECUERPC1",224,0) ; "RTN","ECUERPC1",225,0) ;OUTPUTS RESULTS - IEN^Description of Text "RTN","ECUERPC1",226,0) ; "RTN","ECUERPC1",227,0) N DIC,ECFILE,X,Y "RTN","ECUERPC1",228,0) D SETENV^ECUMRPC "RTN","ECUERPC1",229,0) S ECFILE=$P(ECARY,U) "RTN","ECUERPC1",230,0) I ECFILE="" S ECERR=1,RESULTS="0^File not defined" Q "RTN","ECUERPC1",231,0) S X=" ",DIC(0)="MZX",DIC=ECFILE D ^DIC I Y<0 D I ECERR Q "RTN","ECUERPC1",232,0) . S ECERR=1,RESULTS="0^Nothing found" "RTN","ECUERPC1",233,0) S RESULTS=Y "RTN","ECUERPC1",234,0) Q "RTN","ECUTL1") 0^1^B26308660 "RTN","ECUTL1",1,0) ECUTL1 ;ALB/ESD - Event Capture Classification Utilities ;19 May 98 "RTN","ECUTL1",2,0) ;;2.0; EVENT CAPTURE ;**10,13,17,42,54**;8 May 96 "RTN","ECUTL1",3,0) ; "RTN","ECUTL1",4,0) ASKCLASS(DFN,ECANS,ERR,ECTOPCE,ECPATST,ECHDA) ; Ask classification questions (Agent Orange, Ionizing Radiation, Environmental Contaminants, Service Conn) "RTN","ECUTL1",5,0) ; "RTN","ECUTL1",6,0) ; Input: "RTN","ECUTL1",7,0) ; DFN - IEN of Patient file (#2) "RTN","ECUTL1",8,0) ; ECTOPCE - Variable which indicates if DSS Unit is sending to PCE "RTN","ECUTL1",9,0) ; ECPATST - Inpatient/outpatient status "RTN","ECUTL1",10,0) ; ECHDA - IEN in file #721 if editing existing record [optional] "RTN","ECUTL1",11,0) ; "RTN","ECUTL1",12,0) ; Output: "RTN","ECUTL1",13,0) ; ECANS - array subscripted by classification abbreviation "RTN","ECUTL1",14,0) ; (i.e. ECANS("AO")) and passed by reference containing: "RTN","ECUTL1",15,0) ; field # of class from EC Patient file (#721)^answer "RTN","ECUTL1",16,0) ; ERR - Error indicator if user uparrows or times out (set to 1) "RTN","ECUTL1",17,0) ; "RTN","ECUTL1",18,0) ; Function value - 1 if successful, 0 otherwise "RTN","ECUTL1",19,0) ; "RTN","ECUTL1",20,0) N ANS,DIR,ECCL,ECCLFLD,SUCCESS,ECVST,ECVSTDT,ECPXB,PXBDATA,ECNT,ECOLD,ECPIECE,ECXX "RTN","ECUTL1",21,0) S (ECANS,ECCL)="" "RTN","ECUTL1",22,0) S ERR=0 "RTN","ECUTL1",23,0) S SUCCESS=1 "RTN","ECUTL1",24,0) S DFN=+$G(DFN) "RTN","ECUTL1",25,0) S ECTOPCE=$G(ECTOPCE) "RTN","ECUTL1",26,0) I ECTOPCE["~" S ECTOPCE=$P(ECTOPCE,"~",2) "RTN","ECUTL1",27,0) S ECPATST=$G(ECPATST) "RTN","ECUTL1",28,0) ;- Drop out if invalid condition found OR if DSS Unit not sending to "RTN","ECUTL1",29,0) ; PCE or patient is an inpatient "RTN","ECUTL1",30,0) I ('DFN)!(ECTOPCE="")!(ECPATST="")!(ECTOPCE="N")!(ECPATST="I") S SUCCESS=0 Q SUCCESS "RTN","ECUTL1",31,0) D NOW^%DTC S ECVSTDT=$S(+$G(ECDT):ECDT,1:%),ECVST="" ;modified to use event date;JAM/11/24/03 "RTN","ECUTL1",32,0) ;- If editing an existing record, get visit data & display classification "RTN","ECUTL1",33,0) I $G(ECHDA) D "RTN","ECUTL1",34,0) .S ECVSTDT=$P($G(^ECH(ECHDA,0)),U,3) "RTN","ECUTL1",35,0) .S ECVST=$P($G(^ECH(ECHDA,0)),U,21) "RTN","ECUTL1",36,0) .F ECCL="AO","IR","EC","SC","MST","HNC","CV" D "RTN","ECUTL1",37,0) ..S ECCLFLD=$S(ECCL="AO":"Agent Orange",ECCL="IR":"Ionizing Radiation",ECCL="EC":"Environmental Contaminants",ECCL="SC":"Service Connected",ECCL="HNC":"Head/Neck Cancer",ECCL="CV":"Combat Veteran",1:"Military Sexual Trauma") "RTN","ECUTL1",38,0) ..S ECPIECE=$S(ECCL="AO":3,ECCL="IR":4,ECCL="EC":5,ECCL="SC":6,ECCL="MST":9,ECCL="HNC":10,1:11) "RTN","ECUTL1",39,0) ..S ECXX=$P($G(^ECH(ECHDA,"P")),U,ECPIECE),ECXX=$S(ECXX="Y":"YES",ECXX="N":"NO",1:"") "RTN","ECUTL1",40,0) ..I ECXX]"" S ECOLD(ECCL)=ECCLFLD_": "_ECXX "RTN","ECUTL1",41,0) .I $D(ECOLD) D "RTN","ECUTL1",42,0) ..W !,"*** Current encounter classification ***",! "RTN","ECUTL1",43,0) ..F ECCL="SC","CV","AO","IR","EC","MST","HNC" D "RTN","ECUTL1",44,0) ...I $D(ECOLD(ECCL)) W !?4,ECOLD(ECCL) "RTN","ECUTL1",45,0) ;- Ask user classification question "RTN","ECUTL1",46,0) D CLASS^PXBAPI21("",DFN,ECVSTDT,1,ECVST) W ! "RTN","ECUTL1",47,0) ;- Check error; exit if error condition "RTN","ECUTL1",48,0) I $D(PXBDATA("ERR")) D I ERR S SUCCESS=0 Q SUCCESS "RTN","ECUTL1",49,0) .F ECPXB=1:1:4 I $D(PXBDATA("ERR",ECPXB)) D "RTN","ECUTL1",50,0) ..I (PXBDATA("ERR",ECPXB)=1)!(PXBDATA("ERR",ECPXB)=4) S ERR=1 "RTN","ECUTL1",51,0) ;- Otherwise, continue to setup ecans array, i.e., new classification data "RTN","ECUTL1",52,0) F ECCL="AO","IR","SC","EC","MST","HNC","CV" D "RTN","ECUTL1",53,0) .S ECCLFLD=$S(ECCL="AO":21,ECCL="IR":22,ECCL="EC":23,ECCL="SC":24,ECCL="MST":35,ECCL="HNC":39,1:40) "RTN","ECUTL1",54,0) .S ECPXB=$S(ECCL="AO":1,ECCL="IR":2,ECCL="EC":4,ECCL="SC":3,ECCL="MST":5,ECCL="CV":7,1:6) "RTN","ECUTL1",55,0) .S ANS=$P($G(PXBDATA(ECPXB)),U,2),ANS=$S(ANS=1:"Y",ANS=0:"N",1:"") "RTN","ECUTL1",56,0) .S ECANS(ECCL)=ECCLFLD_"^"_ANS "RTN","ECUTL1",57,0) ;- Delete old data if it exists "RTN","ECUTL1",58,0) I $G(ECHDA) D DELCLASS(ECHDA) "RTN","ECUTL1",59,0) Q SUCCESS "RTN","ECUTL1",60,0) ; "RTN","ECUTL1",61,0) ; "RTN","ECUTL1",62,0) EDCLASS(ECIEN,ECANS) ; Edit classifications fields in EC Patient "RTN","ECUTL1",63,0) ; file (#721) "RTN","ECUTL1",64,0) ; "RTN","ECUTL1",65,0) ; Input: "RTN","ECUTL1",66,0) ; ECIEN - EC Patient record (#721) IEN "RTN","ECUTL1",67,0) ; ECANS - Array of answers to classification questions asked "RTN","ECUTL1",68,0) ; "RTN","ECUTL1",69,0) ; Output: "RTN","ECUTL1",70,0) ; Classification fields 21,22,23,24,35,39,40 edited in file #721 "RTN","ECUTL1",71,0) ; "RTN","ECUTL1",72,0) N DA,DIE,DR,ECCL "RTN","ECUTL1",73,0) S (DR,ECCL)="" "RTN","ECUTL1",74,0) ; "RTN","ECUTL1",75,0) ;- Drops out if invalid condition found "RTN","ECUTL1",76,0) D "RTN","ECUTL1",77,0) . I '$G(ECIEN)!('$D(ECANS)) Q "RTN","ECUTL1",78,0) . ; "RTN","ECUTL1",79,0) . ;- Lock main node "RTN","ECUTL1",80,0) . I '$$LOCK(ECIEN) Q "RTN","ECUTL1",81,0) . S DA=ECIEN "RTN","ECUTL1",82,0) . S DIE="^ECH(" "RTN","ECUTL1",83,0) . ; "RTN","ECUTL1",84,0) . ;- Edit classification fields (AO, IR, EC, SC, MST, HNC, CV) "RTN","ECUTL1",85,0) . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" S DR=DR_+$P($G(ECANS(ECCL)),"^")_"////"_$P($G(ECANS(ECCL)),"^",2)_";" "RTN","ECUTL1",86,0) . ; "RTN","ECUTL1",87,0) . ;- Remove last ";" from DR string before editing "RTN","ECUTL1",88,0) . S DR=$E(DR,1,($L(DR)-1)) "RTN","ECUTL1",89,0) . D ^DIE "RTN","ECUTL1",90,0) ; "RTN","ECUTL1",91,0) ;- Unlock main node "RTN","ECUTL1",92,0) D UNLOCK(ECIEN) "RTN","ECUTL1",93,0) ; "RTN","ECUTL1",94,0) Q "RTN","ECUTL1",95,0) ; "RTN","ECUTL1",96,0) ; "RTN","ECUTL1",97,0) SETCLASS(ECANS) ; Set answers to classification questions in EC variables "RTN","ECUTL1",98,0) ; (used in EC data entry options when filing EC Patient record) "RTN","ECUTL1",99,0) ; "RTN","ECUTL1",100,0) ; Input: "RTN","ECUTL1",101,0) ; ECANS - array of answers to class questions asked containing: "RTN","ECUTL1",102,0) ; field number of class ques from file #721^answer "RTN","ECUTL1",103,0) ; "RTN","ECUTL1",104,0) ; Output: "RTN","ECUTL1",105,0) ; EC classification var - ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV "RTN","ECUTL1",106,0) ; "RTN","ECUTL1",107,0) N ECCL,ECCLFLD "RTN","ECUTL1",108,0) S (ECCL,ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV)="" "RTN","ECUTL1",109,0) ; "RTN","ECUTL1",110,0) ;- Drops out if invalid condition found "RTN","ECUTL1",111,0) D "RTN","ECUTL1",112,0) . ; "RTN","ECUTL1",113,0) . ;- If array containing class flds^answers is not created, exit "RTN","ECUTL1",114,0) . I '$D(ECANS) Q "RTN","ECUTL1",115,0) . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" D "RTN","ECUTL1",116,0) .. ; "RTN","ECUTL1",117,0) .. ;- Get field number of classification "RTN","ECUTL1",118,0) .. S ECCLFLD=+$P($G(ECANS(ECCL)),"^") "RTN","ECUTL1",119,0) .. ; "RTN","ECUTL1",120,0) .. ;- Agent Orange variable "RTN","ECUTL1",121,0) .. S:ECCLFLD=21 ECAO=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",122,0) .. ; "RTN","ECUTL1",123,0) .. ;- Ionizing Radiation variable "RTN","ECUTL1",124,0) .. S:ECCLFLD=22 ECIR=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",125,0) .. ; "RTN","ECUTL1",126,0) .. ;- Environmental Contaminants variable "RTN","ECUTL1",127,0) .. S:ECCLFLD=23 ECZEC=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",128,0) .. ; "RTN","ECUTL1",129,0) .. ;- Service Connected variable "RTN","ECUTL1",130,0) .. S:ECCLFLD=24 ECSC=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",131,0) .. ; "RTN","ECUTL1",132,0) .. ;- Military Sexual Trauma variable "RTN","ECUTL1",133,0) .. S:ECCLFLD=35 ECMST=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",134,0) .. ; "RTN","ECUTL1",135,0) .. ;- Head/Neck Cancer "RTN","ECUTL1",136,0) .. S:ECCLFLD=39 ECHNC=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",137,0) .. ; "RTN","ECUTL1",138,0) .. ;- Combat Veteran "RTN","ECUTL1",139,0) .. S:ECCLFLD=40 ECCV=$P(ECANS(ECCL),"^",2) "RTN","ECUTL1",140,0) Q "RTN","ECUTL1",141,0) ; "RTN","ECUTL1",142,0) ; "RTN","ECUTL1",143,0) DELCLASS(ECIEN) ; Delete classification fields in EC Patient file (#721) "RTN","ECUTL1",144,0) ; "RTN","ECUTL1",145,0) ; Input: "RTN","ECUTL1",146,0) ; ECIEN - EC Patient record (#721) IEN "RTN","ECUTL1",147,0) ; "RTN","ECUTL1",148,0) ; Output: "RTN","ECUTL1",149,0) ; Classification fields 21,22,23,24,35,39,40 deleted in file #721 "RTN","ECUTL1",150,0) ; "RTN","ECUTL1",151,0) N DA,DIE,DR,ECCL "RTN","ECUTL1",152,0) S DR="" "RTN","ECUTL1",153,0) ; "RTN","ECUTL1",154,0) ;- Drops out if invalid condition found "RTN","ECUTL1",155,0) D "RTN","ECUTL1",156,0) . I '$G(ECIEN) Q "RTN","ECUTL1",157,0) . ; "RTN","ECUTL1",158,0) . ;- Lock main node "RTN","ECUTL1",159,0) . I '$$LOCK(ECIEN) Q "RTN","ECUTL1",160,0) . S DA=ECIEN "RTN","ECUTL1",161,0) . S DIE="^ECH(" "RTN","ECUTL1",162,0) . ; "RTN","ECUTL1",163,0) . ;- Delete classification fields (AO, IR, EC, SC, MST, HNC, CV) "RTN","ECUTL1",164,0) . F ECCL=21:1:24,35,39,40 S DR=DR_ECCL_"////@;" "RTN","ECUTL1",165,0) . ; "RTN","ECUTL1",166,0) . ;- Remove last ";" from DR string before editing "RTN","ECUTL1",167,0) . S DR=$E(DR,1,($L(DR)-1)) "RTN","ECUTL1",168,0) . D ^DIE "RTN","ECUTL1",169,0) ; "RTN","ECUTL1",170,0) ;- Unlock main node "RTN","ECUTL1",171,0) D UNLOCK(ECIEN) "RTN","ECUTL1",172,0) ; "RTN","ECUTL1",173,0) Q "RTN","ECUTL1",174,0) ; "RTN","ECUTL1",175,0) ; "RTN","ECUTL1",176,0) LOCK(ECIEN) ; Lock EC Patient record "RTN","ECUTL1",177,0) ; "RTN","ECUTL1",178,0) ; Input: "RTN","ECUTL1",179,0) ; ECIEN - EC Patient record IEN "RTN","ECUTL1",180,0) ; "RTN","ECUTL1",181,0) ; Output: "RTN","ECUTL1",182,0) ; Function Value - 1 if record can be locked, 0 otherwise "RTN","ECUTL1",183,0) ; "RTN","ECUTL1",184,0) I $G(ECIEN) L +^ECH(ECIEN):5 "RTN","ECUTL1",185,0) Q $T "RTN","ECUTL1",186,0) ; "RTN","ECUTL1",187,0) ; "RTN","ECUTL1",188,0) UNLOCK(ECIEN) ; Unlock EC Patient record "RTN","ECUTL1",189,0) ; "RTN","ECUTL1",190,0) ; Input: "RTN","ECUTL1",191,0) ; ECIEN - EC Patient record IEN "RTN","ECUTL1",192,0) ; "RTN","ECUTL1",193,0) ; Output: "RTN","ECUTL1",194,0) ; EC Patient record unlocked "RTN","ECUTL1",195,0) ; "RTN","ECUTL1",196,0) I $G(ECIEN) L -^ECH(ECIEN) "RTN","ECUTL1",197,0) Q "VER") 8.0^22.0 "^DD",721,721,30,0) PCE DATA FEED^F^^PCE;1^K:$L(X)>240!($L(X)<1) X "^DD",721,721,30,3) Answer must be 1-240 characters in length. "^DD",721,721,30,21,0) ^.001^2^2^3031030^^^^ "^DD",721,721,30,21,1,0) The field contains the ECS data formatted to feed the Patient Care "^DD",721,721,30,21,2,0) Encounter (PCE) software. "^DD",721,721,30,23,0) ^.001^5^5^3031030^^^^ "^DD",721,721,30,23,1,0) Data stored at this node is transmitted to PCE and contains the following:- "^DD",721,721,30,23,2,0) date/time~patient dfn~hospital location~institution~dss id~provider #1~ "^DD",721,721,30,23,3,0) provider 2~provider 3~volume~cpt code~diagnosis~agent orange~radiation~ "^DD",721,721,30,23,4,0) enviromental contaminants~service connected~ecs national # & name~eligibility "^DD",721,721,30,23,5,0) ~military sexual trauma~head/neck cancer~combat veteran "^DD",721,721,30,"DT") 2970116 "^DD",721,721,40,0) COMBAT VETERAN^S^Y:YES;N:NO;U:UNKNOWN;^P;11^Q "^DD",721,721,40,3) Select the appropriate status if this procedure is treating a problem related to Combat Veteran. "^DD",721,721,40,21,0) ^.001^2^2^3031030^^^ "^DD",721,721,40,21,1,0) This field indicates that the EC procedure represents treatment of a "^DD",721,721,40,21,2,0) VA patient for a problem that is related to Combat Veteran. "^DD",721,721,40,"DT") 3031030 **END** **END**