Released DG*5.3*517 SEQ #500 Extracted from mail message **KIDS**:DG*5.3*517^ **INSTALL NAME** DG*5.3*517 "BLD",4960,0) DG*5.3*517^REGISTRATION^0^3040226^y "BLD",4960,4,0) ^9.64PA^46.1^3 "BLD",4960,4,45,0) 45 "BLD",4960,4,45,2,0) ^9.641^45^2 "BLD",4960,4,45,2,45,0) PTF (File-top level) "BLD",4960,4,45,2,45,1,0) ^9.6411^79.244^14 "BLD",4960,4,45,2,45,1,79,0) PRIMARY DIAGNOSIS "BLD",4960,4,45,2,45,1,79.16,0) SECONDARY DIAGNOSIS 1 "BLD",4960,4,45,2,45,1,79.17,0) SECONDARY DIAGNOSIS 2 "BLD",4960,4,45,2,45,1,79.18,0) SECONDARY DIAGNOSIS 3 "BLD",4960,4,45,2,45,1,79.19,0) SECONDARY DIAGNOSIS 4 "BLD",4960,4,45,2,45,1,79.201,0) SECONDARY DIAGNOSIS 5 "BLD",4960,4,45,2,45,1,79.21,0) SECONDARY DIAGNOSIS 6 "BLD",4960,4,45,2,45,1,79.22,0) SECONDARY DIAGNOSIS 7 "BLD",4960,4,45,2,45,1,79.23,0) SECONDARY DIAGNOSIS 8 "BLD",4960,4,45,2,45,1,79.24,0) SECONDARY DIAGNOSIS 9 "BLD",4960,4,45,2,45,1,79.241,0) SECONDARY DIAGNOSIS 10 "BLD",4960,4,45,2,45,1,79.242,0) SECONDARY DIAGNOSIS 11 "BLD",4960,4,45,2,45,1,79.243,0) SECONDARY DIAGNOSIS 12 "BLD",4960,4,45,2,45,1,79.244,0) SECONDARY DIAGNOSIS 13 "BLD",4960,4,45,2,45.06,0) PROFESSIONAL SERVICE DATE/TIME (sub-file) "BLD",4960,4,45,2,45.06,1,0) ^9.6411^^0 "BLD",4960,4,45,222) y^n^p^^^^n^^n "BLD",4960,4,45,224) "BLD",4960,4,46,0) 46 "BLD",4960,4,46,222) y^y^f^^^^n "BLD",4960,4,46.1,0) 46.1 "BLD",4960,4,46.1,222) y^y^f^^^^n "BLD",4960,4,"APDD",45,45) "BLD",4960,4,"APDD",45,45,79) "BLD",4960,4,"APDD",45,45,79.16) "BLD",4960,4,"APDD",45,45,79.17) "BLD",4960,4,"APDD",45,45,79.18) "BLD",4960,4,"APDD",45,45,79.19) "BLD",4960,4,"APDD",45,45,79.201) "BLD",4960,4,"APDD",45,45,79.21) "BLD",4960,4,"APDD",45,45,79.22) "BLD",4960,4,"APDD",45,45,79.23) "BLD",4960,4,"APDD",45,45,79.24) "BLD",4960,4,"APDD",45,45,79.241) "BLD",4960,4,"APDD",45,45,79.242) "BLD",4960,4,"APDD",45,45,79.243) "BLD",4960,4,"APDD",45,45,79.244) "BLD",4960,4,"APDD",45,45.06) "BLD",4960,4,"B",45,45) "BLD",4960,4,"B",46,46) "BLD",4960,4,"B",46.1,46.1) "BLD",4960,"ABPKG") n "BLD",4960,"KRN",0) ^9.67PA^8989.52^19 "BLD",4960,"KRN",.4,0) .4 "BLD",4960,"KRN",.4,"NM",0) ^9.68A^^ "BLD",4960,"KRN",.401,0) .401 "BLD",4960,"KRN",.402,0) .402 "BLD",4960,"KRN",.402,"NM",0) ^9.68A^2^2 "BLD",4960,"KRN",.402,"NM",1,0) DG701 FILE #45^45^0 "BLD",4960,"KRN",.402,"NM",2,0) DG801 FILE #46.1^46.1^0 "BLD",4960,"KRN",.402,"NM","B","DG701 FILE #45",1) "BLD",4960,"KRN",.402,"NM","B","DG801 FILE #46.1",2) "BLD",4960,"KRN",.403,0) .403 "BLD",4960,"KRN",.403,"NM",0) ^9.68A^^ "BLD",4960,"KRN",.5,0) .5 "BLD",4960,"KRN",.84,0) .84 "BLD",4960,"KRN",3.6,0) 3.6 "BLD",4960,"KRN",3.8,0) 3.8 "BLD",4960,"KRN",9.2,0) 9.2 "BLD",4960,"KRN",9.8,0) 9.8 "BLD",4960,"KRN",9.8,"NM",0) ^9.68A^24^14 "BLD",4960,"KRN",9.8,"NM",2,0) DGPTFDEL^^0^B17558288 "BLD",4960,"KRN",9.8,"NM",3,0) DGPTFM^^0^B40972538 "BLD",4960,"KRN",9.8,"NM",11,0) DGPTFJ^^0^B7281563 "BLD",4960,"KRN",9.8,"NM",14,0) DGPTFQWK^^0^B15643450 "BLD",4960,"KRN",9.8,"NM",15,0) DGPMVDL^^0^B16911207 "BLD",4960,"KRN",9.8,"NM",16,0) DGAPI^^0^B21486035 "BLD",4960,"KRN",9.8,"NM",17,0) DGPTFM1^^0^B19596855 "BLD",4960,"KRN",9.8,"NM",18,0) DGPTFM2^^0^B74512082 "BLD",4960,"KRN",9.8,"NM",19,0) DGPTFM1A^^0^B7332308 "BLD",4960,"KRN",9.8,"NM",20,0) DGPTFJC^^0^B38290310 "BLD",4960,"KRN",9.8,"NM",21,0) DGPTF4^^0^B22563442 "BLD",4960,"KRN",9.8,"NM",22,0) DGPTFM0^^0^B11221145 "BLD",4960,"KRN",9.8,"NM",23,0) DGPTFM3^^0^B7367126 "BLD",4960,"KRN",9.8,"NM",24,0) DGPTUTL1^^0^B18314344 "BLD",4960,"KRN",9.8,"NM","B","DGAPI",16) "BLD",4960,"KRN",9.8,"NM","B","DGPMVDL",15) "BLD",4960,"KRN",9.8,"NM","B","DGPTF4",21) "BLD",4960,"KRN",9.8,"NM","B","DGPTFDEL",2) "BLD",4960,"KRN",9.8,"NM","B","DGPTFJ",11) "BLD",4960,"KRN",9.8,"NM","B","DGPTFJC",20) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM",3) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM0",22) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM1",17) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM1A",19) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM2",18) "BLD",4960,"KRN",9.8,"NM","B","DGPTFM3",23) "BLD",4960,"KRN",9.8,"NM","B","DGPTFQWK",14) "BLD",4960,"KRN",9.8,"NM","B","DGPTUTL1",24) "BLD",4960,"KRN",19,0) 19 "BLD",4960,"KRN",19,"NM",0) ^9.68A^^ "BLD",4960,"KRN",19.1,0) 19.1 "BLD",4960,"KRN",101,0) 101 "BLD",4960,"KRN",409.61,0) 409.61 "BLD",4960,"KRN",771,0) 771 "BLD",4960,"KRN",870,0) 870 "BLD",4960,"KRN",8989.51,0) 8989.51 "BLD",4960,"KRN",8989.52,0) 8989.52 "BLD",4960,"KRN",8994,0) 8994 "BLD",4960,"KRN","B",.4,.4) "BLD",4960,"KRN","B",.401,.401) "BLD",4960,"KRN","B",.402,.402) "BLD",4960,"KRN","B",.403,.403) "BLD",4960,"KRN","B",.5,.5) "BLD",4960,"KRN","B",.84,.84) "BLD",4960,"KRN","B",3.6,3.6) "BLD",4960,"KRN","B",3.8,3.8) "BLD",4960,"KRN","B",9.2,9.2) "BLD",4960,"KRN","B",9.8,9.8) "BLD",4960,"KRN","B",19,19) "BLD",4960,"KRN","B",19.1,19.1) "BLD",4960,"KRN","B",101,101) "BLD",4960,"KRN","B",409.61,409.61) "BLD",4960,"KRN","B",771,771) "BLD",4960,"KRN","B",870,870) "BLD",4960,"KRN","B",8989.51,8989.51) "BLD",4960,"KRN","B",8989.52,8989.52) "BLD",4960,"KRN","B",8994,8994) "BLD",4960,"QUES",0) ^9.62^^ "BLD",4960,"REQB",0) ^9.611^9^9 "BLD",4960,"REQB",1,0) DG*5.3*510^2 "BLD",4960,"REQB",2,0) DG*5.3*114^2 "BLD",4960,"REQB",3,0) DG*5.3*158^2 "BLD",4960,"REQB",4,0) DG*5.3*161^2 "BLD",4960,"REQB",5,0) DG*5.3*375^2 "BLD",4960,"REQB",6,0) DG*5.3*397^2 "BLD",4960,"REQB",7,0) DG*5.3*441^2 "BLD",4960,"REQB",8,0) ICD*18.0*6^2 "BLD",4960,"REQB",9,0) ICPT*6.0*14^2 "BLD",4960,"REQB","B","DG*5.3*114",2) "BLD",4960,"REQB","B","DG*5.3*158",3) "BLD",4960,"REQB","B","DG*5.3*161",4) "BLD",4960,"REQB","B","DG*5.3*375",5) "BLD",4960,"REQB","B","DG*5.3*397",6) "BLD",4960,"REQB","B","DG*5.3*441",7) "BLD",4960,"REQB","B","DG*5.3*510",1) "BLD",4960,"REQB","B","ICD*18.0*6",8) "BLD",4960,"REQB","B","ICPT*6.0*14",9) "FIA",45) PTF "FIA",45,0) ^DGPT( "FIA",45,0,0) 45IP "FIA",45,0,1) y^n^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,30) "FIA",45,45,79) "FIA",45,45,79.16) "FIA",45,45,79.17) "FIA",45,45,79.18) "FIA",45,45,79.19) "FIA",45,45,79.201) "FIA",45,45,79.21) "FIA",45,45,79.22) "FIA",45,45,79.23) "FIA",45,45,79.24) "FIA",45,45,79.241) "FIA",45,45,79.242) "FIA",45,45,79.243) "FIA",45,45,79.244) "FIA",45,45.06) 0 "FIA",46) INPATIENT CPT CODE "FIA",46,0) ^DGCPT(46, "FIA",46,0,0) 46P "FIA",46,0,1) y^y^f^^^^n "FIA",46,0,10) "FIA",46,0,11) "FIA",46,0,"RLRO") "FIA",46,0,"VR") 5.3^DG "FIA",46,46) 0 "FIA",46.1) INPATIENT POV "FIA",46.1,0) ^DGICD9(46.1, "FIA",46.1,0,0) 46.1P "FIA",46.1,0,1) y^y^f^^^^n "FIA",46.1,0,10) "FIA",46.1,0,11) "FIA",46.1,0,"RLRO") "FIA",46.1,0,"VR") 5.3^DG "FIA",46.1,46.1) 0 "KRN",.402,246,-1) 0^1 "KRN",.402,246,0) DG701^3030606.1142^^45^^^3040219 "KRN",.402,246,"%D",0) ^^1^1^2950809^ "KRN",.402,246,"%D",1,0) "KRN",.402,246,"DR",1,45) F X=2:1:7 S DGDUP(X)=0;K DGPTIT D FLAGCHK^DGPTSCAN;S DGNFLD="@10";79;I X K DGPTIT S DGNFLD="@10",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,1) S:$P($G(^DGPT(D0,70)),U,10)_$P($G(^DGPT(D0,70)),U,16,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";Q;@10;S DGNFLD="@20";Q;79.16;I X K DGPTIT S DGNFLD="@20",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,2) S:$P($G(^DGPT(D0,70)),U,16,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@20;Q;S DGNFLD="@30";79.17;I X K DGPTIT S DGNFLD="@30",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,3) S:$P($G(^DGPT(D0,70)),U,17,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";Q;@30;S DGNFLD="@40";79.18;I X K DGPTIT S DGNFLD="@40",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";Q; "KRN",.402,246,"DR",1,45,4) S:$P($G(^DGPT(D0,70)),U,18,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@40;S DGNFLD="@50";79.19;Q;I X K DGPTIT S DGNFLD="@50",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,5) S:$P($G(^DGPT(D0,70)),U,19,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@50;S DGNFLD="@55";Q;79.201;I X K DGPTIT S DGNFLD="@55",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,6) S:$P($G(^DGPT(D0,70)),U,20,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@55;Q;S DGNFLD="@60";79.21;I X K DGPTIT S DGNFLD="@60",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,7) S:$P($G(^DGPT(D0,70)),U,21,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";Q;@60;S DGNFLD="@70";79.22;I X K DGPTIT S DGNFLD="@70",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";Q; "KRN",.402,246,"DR",1,45,8) S:$P($G(^DGPT(D0,70)),U,22,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@70;S DGNFLD="@80";79.23;I X K DGPTIT S DGNFLD="@80",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,9) S:$P($G(^DGPT(D0,70)),U,23,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@80;S DGNFLD="@90";79.24;I X K DGPTIT S DGNFLD="@90",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";S:$P($G(^DGPT(D0,70)),U,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"; "KRN",.402,246,"DR",1,45,10) @90;S DGNFLD="@100";79.241;I X K DGPTIT S DGNFLD="@100",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";S:$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120";@100;S DGNFLD="@110";79.242;I X K DGPTIT S DGNFLD="@110",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""; "KRN",.402,246,"DR",1,45,11) S:$P($G(^DGPT(D0,71)),U,2,3)?."^" Y="@120";@110;S DGNFLD="@120";79.243;I X K DGPTIT S DGNFLD="@120",Y="@800",DGPTIT(X_$C(59)_"ICD9(")="";@120;K DGNFLD,DGDUP S Y="";@800;D SCAN^DGPTSCAN,ANYPSY^DGPTSCAN S:'$D(DGBPC) Y="@890"; "KRN",.402,246,"DR",1,45,12) I '$D(DGBPC(2))!(DGDUP(2)) S Y="@820";I $P(DG701,U,2)]"" S Y="@820";300.02;S:X]"" DGDUP(2)=1;@820;I '$D(DGBPC(3))!(DGDUP(3)) S Y="@840";I $P(DG701,U,3)]"" S Y="@840";300.03;S:X]"" DGDUP(3)=1;@840; "KRN",.402,246,"DR",1,45,13) I '$D(DGBPC(4))!(DGDUP(4)) S Y="@860";I $P(DG701,U,4)]"" S Y="@860";D DRUG^DGPTSC01 I $D(DGTX) S Y="@850";300.04;S:X]"" DGDUP(4)=1;S Y="@860";@850;300.04//^S X=DGTX;S:X]"" DGDUP(4)=1;@860;I '$D(DGPBC(5))!(DGDUP(5)) S Y="@870"; "KRN",.402,246,"DR",1,45,14) I $P(DG701,U,5)]"" S Y="@870";300.05;S:X]"" DGDUP(5)=1;@870;I '$D(DGBPC(6))!(DGDUP(6)) S Y="@880";I $P(DG701,U,6)]"" S Y="@880";300.06;S:X]"" DGDUP(6)=1;@880;I '$D(DGBPC(7))!(DGDUP(7)) S Y="@890";I $P(DG701,U,7)]"" S Y="@890"; "KRN",.402,246,"DR",1,45,15) 300.07;S:X]"" DGDUP(7)=1;@890;K DGIT,DGPTIT S Y=DGNFLD; "KRN",.402,246,"ROU") ^DGPTX7 "KRN",.402,246,"ROUOLD") DGPTX7 "KRN",.402,2663,-1) 0^2 "KRN",.402,2663,0) DG801^3040204.1537^@^46.1^^@^3040226 "KRN",.402,2663,"DIAB",1,0,46.1,2) .03;"WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?" "KRN",.402,2663,"DIAB",1,0,46.1,5) .07;"WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?" "KRN",.402,2663,"DIAB",2,0,46.1,1) .08;"WAS TREATMENT RELATED TO COMBAT?" "KRN",.402,2663,"DIAB",2,0,46.1,4) .06;"WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?" "KRN",.402,2663,"DIAB",3,0,46.1,0) .02;"WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?" "KRN",.402,2663,"DIAB",4,0,46.1,3) .05;"WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?" "KRN",.402,2663,"DIAB",7,0,46.1,2) .04;"WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?" "KRN",.402,2663,"DR",1,46.1) I '$D(SDCLY(3)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,2)="":"@11",1:"@10");D ELIG^DGPTUTL1;.02WAS TREATMENT FOR A SERVICE CONNECTED CONDITION?~;S Y="@11";@10;.02////0;@11; "KRN",.402,2663,"DR",1,46.1,1) I '$D(SDCLY(7)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,8)="":"@21",1:"@20");.08WAS TREATMENT RELATED TO COMBAT?~;S Y="@21";@20;.08////N;@21;I '$D(SDCLY(1)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,3)="":"@31",1:"@30"); "KRN",.402,2663,"DR",1,46.1,2) .03WAS TREATMENT RELATED TO AGENT ORANGE EXPOSURE?~;S Y="@31";@30;.03////0;@31;I '$D(SDCLY(2)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,4)="":"@41",1:"@40");.04WAS TREATMENT RELATED TO IONIZING RADIATION EXPOSURE?~;S Y="@41";@40; "KRN",.402,2663,"DR",1,46.1,3) .04////0;@41;I '$D(SDCLY(4)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,5)="":"@51",1:"@50");.05WAS TREATMENT RELATED TO ENVIRONMENTAL CONTAMINANT EXPOSURE?~;S Y="@51";@50;.05////0;@51; "KRN",.402,2663,"DR",1,46.1,4) I '$D(SDCLY(5)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,6)="":"@61",1:"@60");.06WAS TREATMENT RELATED TO MILITARY SEXUAL TRAUMA?~;S Y="@61";@60;.06////0;@61;I '$D(SDCLY(6)) S Y=$S($P($G(^DGICD9(46.1,D0,0)),U,7)="":"@71",1:"@70"); "KRN",.402,2663,"DR",1,46.1,5) .07WAS TREATMENT RELATED TO HEAD AND/OR NECK CANCER?~;S Y="@71";@70;.07////0;@71;@99;1////^S X=PTF; "KRN",.402,2663,"ROU") ^DGPTX8 "KRN",.402,2663,"ROUOLD") DGPTX8 "MBREQ") 0 "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",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 517^3040226^2438 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3040223 "PKG",5,22,1,"PAH",1,1,1,0) Please see the National Patch Module for details "PKG",5,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") 14 "RTN","DGAPI") 0^16^B21486035 "RTN","DGAPI",1,0) DGAPI ;DWS - PTF's APIs ; 2/11/04 10:43am "RTN","DGAPI",2,0) ;;5.3;Registration;**517**; Aug 13, 1993 "RTN","DGAPI",3,0) Q "RTN","DGAPI",4,0) ; "RTN","DGAPI",5,0) DATA2PTF(DFN,PTF,PSDATE,USER,FLAG,SOURCE) ;API to pass data for add/edit/delete to PTF "RTN","DGAPI",6,0) I $G(PTF) Q:'$D(^DGPT(PTF)) -2 "RTN","DGAPI",7,0) I '$G(PTF) Q:'$G(PSDATE) -2 D FIND Q:'$G(PTF) -2 "RTN","DGAPI",8,0) I $P($G(^DGPT(PTF,0)),U,6) S ERR="INPATIENT STAY CLOSED, THE PTF SYSTEM CAN BE USED TO RE-OPEN IT." D Q -1 "RTN","DGAPI",9,0) .I +$G(FLAG) W !,ERR Q "RTN","DGAPI",10,0) .S ^TMP("PTF",$J,"DIERR")=ERR "RTN","DGAPI",11,0) Q:'$D(^TMP("PTF",$J)) -3 S FL=0 D PROV I $G(Y)'>0!FL K FL,Y Q -1 "RTN","DGAPI",12,0) K ERR,FL Q PTF "RTN","DGAPI",13,0) CPTINFO(DFN,PTF,PSDATE) ;API to get CPT data from PTF "RTN","DGAPI",14,0) I '$G(PTF) Q:'$G(PSDATE) D FIND Q:'$G(PTF) "RTN","DGAPI",15,0) S I=0 F S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 I +^(I,0)=PSDATE S ^TMP("PTF",$J,46,0)=$P(^(0),U,2,5),(K,K1)=0 D Q "RTN","DGAPI",16,0) .F S K=$O(^DGCPT(46,"C",PTF,K)) Q:K'>0 I PSDATE=+$G(^DGCPT(46,K,1)),'$G(^(9)) S K1=K1+1,^TMP("PTF",$J,46,K1)=K_U_^(0) "RTN","DGAPI",17,0) K I,K,K1 Q "RTN","DGAPI",18,0) PTFINFOR(DFN,PTF,PSDATE) ;API to get a list of CPT records from PTF "RTN","DGAPI",19,0) I '$G(PTF) Q:'$G(PSDATE) D FIND Q:'$G(PTF) "RTN","DGAPI",20,0) S I=0 F I1=1:1 S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 S ^TMP("PTF",$J,I1)=^(I,0) "RTN","DGAPI",21,0) K I,I1 Q "RTN","DGAPI",22,0) DELCPT(DA) ;API to delete cpt code from PTF "RTN","DGAPI",23,0) S PTF=$P($G(^DGCPT(46,DA,1)),U,3) I $P(^DGPT(PTF,0),U,6) K PTF Q -1 "RTN","DGAPI",24,0) S REC=DA,DIE="^DGCPT(46,",DR="1////^S X=%" L +^DGCPT(46,REC):2 I D NOW^%DTC,^DIE K DIE,DR L -^DGCPT(46,REC) K REC Q 1 "RTN","DGAPI",25,0) K REC Q -1 "RTN","DGAPI",26,0) DELPOV(DA) ;API to delete a diagnosis from PTF "RTN","DGAPI",27,0) S PTF=+$G(^DGICD9(46.1,DA,1)) I $P(^DGPT(PTF,0),U,6) Q -1 "RTN","DGAPI",28,0) S REC=DA,DIE="^DGICD9(46.1,",DR="9////^S X=%" L +^DGCPT(46.1,REC):2 I D NOW^%DTC,^DIE K DIE,DR L -^DGCPT(46.1,REC) K REC Q 1 "RTN","DGAPI",29,0) K REC Q -1 "RTN","DGAPI",30,0) ICDINFO(DFN,PTF,PSDATE,DGI) ;API to get Diagnosis data from PTF "RTN","DGAPI",31,0) I '$G(PTF),'$G(DGI) Q:'$G(PSDATE) D FIND Q:'$G(PTF) "RTN","DGAPI",32,0) I $G(PTF) S I=0 F I1=1:1 S I=$O(^DGICD9(46.1,"C",PTF,I)) Q:I'>0 I '$G(^DGICD9(46.1,I,9)) S ^TMP("PTF",$J,46.1,I1)=I_U_^DGICD9(46.1,I,0) "RTN","DGAPI",33,0) I '$G(PTF),$G(DGI) S ^TMP("PTF",$J,46.1,1)=DGI_U_$G(^DGICD9(46.1,DGI,0)) "RTN","DGAPI",34,0) K I,I1 Q "RTN","DGAPI",35,0) FIND ;Find the IEN for the PTF file "RTN","DGAPI",36,0) S (I,K)=0 F S I=$O(^DGPT("B",DFN,I)) Q:'I S J=$G(^DGPT(I,70)) I J'PSDATE D "RTN","DGAPI",37,0) .Q:L0 Q "RTN","DGAPI",43,0) .S DA(1)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,REC)=+Y,DR="",I=^TMP("PTF",$J,46,0) "RTN","DGAPI",44,0) .S REFPROV=+I,PERFPROV=$P(I,U,2) S:REFPROV DR=DR_".02////^S X=REFPROV;" S DR=DR_".03////^S X=PERFPROV;" "RTN","DGAPI",45,0) .S DIAG=$P(I,U,3),LOC=$P(I,U,4) K I S DR=DR_".04////^S X=DIAG;" S:LOC DR=DR_".05////^S X=LOC;" "RTN","DGAPI",46,0) .L +^DGPT(REC):2 I '$T D ERR(46,"CPT entry is being edited by another user") K DIE,DR,REC Q "RTN","DGAPI",47,0) .D ^DIE L -^DGPT(REC) K DIE,DR,REFPROV,PERFPROV,REC S DGI=0 F S DGI=$O(^TMP("PTF",$J,46,DGI)) Q:'DGI D CPT "RTN","DGAPI",48,0) S DGI=0 F S DGI=$O(^TMP("PTF",$J,46.1,DGI)) Q:'DGI D DIAG "RTN","DGAPI",49,0) K DGI S Y=1 Q "RTN","DGAPI",50,0) CPT ;FILE CPT INFORMATION IN ^DGCPT "RTN","DGAPI",51,0) S DGJ=0,STR=^TMP("PTF",$J,46,DGI),DLAYGO=46 "RTN","DGAPI",52,0) I STR S Y=+STR G CPTFL ;if rec num in DGCPT is passed, overlay without any verification of CPT code passed "RTN","DGAPI",53,0) F S DGJ=$O(^DGCPT(46,"C",PTF,DGJ)) Q:DGJ'>0 I +^DGCPT(46,DGJ,1)=PSDATE,$P(^(0),U)=$P(STR,U,2),'$D(^(9)) S STR=DGJ_STR,Y=DGJ,^TMP("PTF",$J,46,DGI)=STR Q "RTN","DGAPI",54,0) I 'STR K DO S DIC="^DGCPT(46,",DIC(0)="F",X=$P(STR,U,2) D FILE^DICN K DIC,X Q:Y'>0 S STR=+Y_STR,^TMP("PTF",$J,46,DGI)=STR "RTN","DGAPI",55,0) CPTFL S Y=+Y_"," F I=1:1:13 S CPT(46,Y,I/100)=$P(STR,U,I+1) "RTN","DGAPI",56,0) F I=20:1:24 S CPT(46,Y,I/100)=$P(STR,U,I-5) "RTN","DGAPI",57,0) S CPT(46,Y,.14)=PSDATE,CPT(46,Y,.16)=PTF "RTN","DGAPI",58,0) S CPT(46,Y,.17)=$G(SOURCE),CPT(46,Y,.18)=$G(USER) "RTN","DGAPI",59,0) D FILE^DIE("K","CPT","^TMP(""PTF"",$J,46,DGI)") "RTN","DGAPI",60,0) I $D(^TMP("PTF",$J,46,DGI,"DIERR")) S FL=1 I +$G(FLAG),$D(^("DIERR",1,"TEXT",1)) W !,^(1) "RTN","DGAPI",61,0) K STR,CPT,DGJ,I Q "RTN","DGAPI",62,0) DIAG ;FILE DIAGNOSIS INFORMATION IN ^DGCPT "RTN","DGAPI",63,0) S DGJ=0,STR=^TMP("PTF",$J,46.1,DGI),DLAYGO=46.1 "RTN","DGAPI",64,0) I STR S Y=+STR G DIAGFL ;if rec num in DGICD9 is passed, overlay without any verification of DGN code passed "RTN","DGAPI",65,0) F S DGJ=$O(^DGICD9(46.1,"C",PTF,DGJ)) Q:DGJ'>0 I $P(^DGICD9(46.1,DGJ,0),U)=$P(STR,U,2),'$G(^(9)) S STR=DGJ_STR,Y=DGJ,^TMP("PTF",$J,46.1,DGI)=STR Q "RTN","DGAPI",66,0) I 'STR K DO S DIC="^DGICD9(46.1,",DIC(0)="F",X=$P(STR,U,2) D FILE^DICN K DIC,X Q:Y'>0 S STR=+Y_STR,^TMP("PTF",$J,46.1,DGI)=STR "RTN","DGAPI",67,0) DIAGFL S Y=+Y_"," F I=1:1:8 S DIAG(46.1,Y,I/100)=$P(STR,U,I+1) "RTN","DGAPI",68,0) S DIAG(46.1,Y,1.1)=$G(SOURCE),DIAG(46.1,Y,1.2)=$G(USER) "RTN","DGAPI",69,0) S DIAG(46.1,Y,1)=PTF D FILE^DIE("K","DIAG","^TMP(""PTF"",$J,46.1,DGI)") "RTN","DGAPI",70,0) I $D(^TMP("PTF",$J,46.1,DGI,"DIERR")) S FL=1 I +$G(FLAG),$D(^("DIERR",1,"TEXT",1)) W !,^(1) "RTN","DGAPI",71,0) K STR,CPT,DGJ,DIAG,I Q "RTN","DGAPI",72,0) ERR(FILE,MESS) ;DISPLAY OR PRINT ERROR MESSAGES BASED ON FLAG PARAMETER FOR DATA2PTF "RTN","DGAPI",73,0) S FL=1 I +$G(FLAG) W !,MESS Q "RTN","DGAPI",74,0) S ^TMP("PTF",$J,FILE,DGI,"DIERR")=MESS Q "RTN","DGPMVDL") 0^15^B16911207 "RTN","DGPMVDL",1,0) DGPMVDL ;ALB/MIR - DELETE PATIENT MOVEMENTS ; 2/13/04 1:01pm "RTN","DGPMVDL",2,0) ;;5.3;Registration;**161,517**;Aug 13, 1993 "RTN","DGPMVDL",3,0) ; "RTN","DGPMVDL",4,0) ;D_DGPMT - these lines are used as DEL nodes. If DGPMER=1, movement can "RTN","DGPMVDL",5,0) ; not be deleted. "RTN","DGPMVDL",6,0) ;DGPMT - once the movement is to be deleted, these are the other "RTN","DGPMVDL",7,0) ; updates that must also occur. "RTN","DGPMVDL",8,0) ; "RTN","DGPMVDL",9,0) D1 S DGPMER=0 F I=0:0 S I=$O(^DGPM("APMV",DFN,DGPMCA,I)) Q:I'>0 S J=$O(^(I,0)) I $D(^DGPM(J,0)),($P(^(0),"^",15)]"") S DGPMER=1 Q "RTN","DGPMVDL",10,0) I DGPMER W !,"Cannot delete before ASIH transfers are removed" Q "RTN","DGPMVDL",11,0) I $P(DGPMAN,"^",21),$P(DGPMAN,"^",17) S DGPMER=1 W !,"Must delete discharge first" "RTN","DGPMVDL",12,0) I $O(^DGPT("ACENSUS",+$P(DGPMAN,U,16),0)) S DGPMER=1 W !,"Cannot delete while PTF Census record #",$O(^(0))," is closed." "RTN","DGPMVDL",13,0) Q "RTN","DGPMVDL",14,0) 1 S DA=$P(DGPMAN,U,16),DIK="^DGPT(",FLAG=1,I=0 F S I=$O(^DGCPT(46,"C",DA,I)) Q:'I I '$G(^DGCPT(I,9)) S FLAG=0 Q "RTN","DGPMVDL",15,0) I FLAG S I=0 F S I=$O(^DGICD9(46.1,"C",DA,I)) Q:'I I '$G(^DGICD9(I,9)) S FLAG=0 Q "RTN","DGPMVDL",16,0) I 'FLAG W !,"CANNOT DELETE THE PTF RECORD WHEN THERE ARE ACTIVE ORDERS OR CPT ENTRIES." K FLAG H 2 Q "RTN","DGPMVDL",17,0) S DGMSG="Patient admission has been deleted for admit date: "_$$FMTE^XLFDT(+DGPMAN,"5DZ"),DGMSG1="Deleted Admission" "RTN","DGPMVDL",18,0) D MSG^DGPTMSG1 S DA=$P(DGPMAN,U,16),DIK="^DGPT(" D ^DIK:DA>0 K FLAG,I,DA,DIK ; delete PTF record "RTN","DGPMVDL",19,0) S DA=$O(^DGS(41.1,"AMVT",DGPMDA,0)) I DA S DIE="^DGS(41.1,",DR="17///@" D ^DIE ;remove scheduled admission reference in 41.1 "RTN","DGPMVDL",20,0) F DGI=DGPMDA:0 S DGI=$O(^DGPM("CA",DGPMDA,DGI)) Q:'DGI I $D(^DGPM(DGI,0)) S DGPMTYP=$P(^(0),"^",2),DA=DGI,DIK="^DGPM(",^UTILITY("DGPM",$J,DGPMTYP,DA,"P")=^(0),^("A")="" D ^DIK "RTN","DGPMVDL",21,0) S DGX=$P(DGPMAN,"^",21) G Q1:'DGX S DIK="^DGPM(",DA=DGX I $D(^DGPM(+DA,0)) S DGX1=^(0),^UTILITY("DGPM",$J,2,DA,"P")=^(0),^("A")="" D ^DIK W !,"ASIH transfer deleted",! "RTN","DGPMVDL",22,0) G Q1:($P(DGX1,"^",18)'=13) S DGPMADM=$P(DGX1,"^",14) D DD^DGPMVDL1 "RTN","DGPMVDL",23,0) Q1 K ORQUIT Q "RTN","DGPMVDL",24,0) Q Q "RTN","DGPMVDL",25,0) D2 ;Can this transfer be deleted? "RTN","DGPMVDL",26,0) I $P(DGPMP,"^",18)=43,($P(DGPM2,"^",18)=42) S DGPMER=0 Q "RTN","DGPMVDL",27,0) I DGPM2,'$D(^DG(405.1,+$P(DGPM2,"^",4),"F",+$P(DGPM0,"^",4),0)) S DGPMER=1 W !,"Cannot delete transfer - would create an invalid transfer pair" Q "RTN","DGPMVDL",28,0) I "^13^44^"[("^"_$P(DGPMP,"^",18)_"^") S DGPMER=1 W !,"Must delete through corresponding hospital admission" Q "RTN","DGPMVDL",29,0) I $P(DGPMP,"^",18)=14,$P(DGPMAN,"^",17) S DGPMER=1 W !,"Cannot delete while discharge exists" Q "RTN","DGPMVDL",30,0) I $D(^DGPM(+$P(DGPMP,"^",15),0)),$D(^DGP(45.84,+$P(^(0),"^",16))) S DGPMER=1 W !,"Cannot delete when corresponding admission PTF closed out" Q "RTN","DGPMVDL",31,0) I "^14^43^45^"[("^"_$P(DGPMP,"^",18)_"^"),("^13^14^43^44^45^"[("^"_$P(DGPM2,"^",18)_"^")) S DGX=$S($D(^DG(405.1,+$P(DGPM2,"^",4),0)):$P(^(0),"^",1),1:"") W !,DGX," movement must be removed first" S DGPMER=1 Q "RTN","DGPMVDL",32,0) Q "RTN","DGPMVDL",33,0) 2 I DGPMABL,DGPM0 S DGPMND=DGPM0 D AB^DGPMV32 "RTN","DGPMVDL",34,0) S DGPMTYP=$P(DGPMP,"^",18) I DGPMTYP=43 S DGPMADM=DGPMCA D DD^DGPMVDL1 Q "RTN","DGPMVDL",35,0) I DGPMTYP=45 Q:'$P(DGPMP,"^",22) S DGX=$O(^DGPM("APTT3",DFN,DGPMP+.0000001,0)) I $D(^DGPM(+DGX,0)) S DGPMADM=$P(^(0),"^",14) D DD^DGPMVDL1 Q "RTN","DGPMVDL",36,0) Q:DGPMTYP'=14 S DGX=0 F I=(9999999.9999999-DGPMP):0 S I=$O(^DGPM("ATID2",DFN,I)) Q:'I S DGJ=$O(^(I,0)) I $D(^DGPM(+DGJ,0)),("^13^43^44^"[("^"_$P(^(0),"^",18)_"^")) S DGX=1 Q "RTN","DGPMVDL",37,0) Q:'DGX I "^13^44^"[("^"_$P(^DGPM(DGJ,0),"^",18)_"^") S DGPMADM=$P(^(0),"^",15) I $P(DGPMP,"^",22) D DD^DGPMVDL1 "RTN","DGPMVDL",38,0) Q:$P(^DGPM(DGJ,0),"^",18)=44 S DGPMAB=+^DGPM(DGJ,0) D ASIHOF^DGPMV321 ;recreate 30 days "RTN","DGPMVDL",39,0) Q "RTN","DGPTF4") 0^21^B22563442 "RTN","DGPTF4",1,0) DGPTF4 ;ALB/JDS - PTF ENTRY/EDIT-4 ; 2/19/04 9:33am "RTN","DGPTF4",2,0) ;;5.3;Registration;**114,115,397,510,517**;Aug 13, 1993 "RTN","DGPTF4",3,0) ; "RTN","DGPTF4",4,0) WR ; "RTN","DGPTF4",5,0) W @IOF,HEAD,?72 S Z="<701>" D Z^DGPTFM K X S $P(X,"-",81)="" W !,X "RTN","DGPTF4",6,0) Q "RTN","DGPTF4",7,0) EN S Y=+B(70) D D^DGPTUTL W ! S Z=5 D Z W $S($P(B(0),U,11)=1:"Date of Disch: ",1:"Census Date : ") S Z=Y,Z1=20 D Z1 W "Disch Specialty: ",$S($D(^DIC(42.4,+$P(B(70),U,2),0)):$E($P(^(0),U,1),1,$S(DGPR:45,1:25)),1:"") "RTN","DGPTF4",8,0) W !," Type of Disch: " S L=";"_$P(^DD(45,72,0),U,3),L1=";"_$P(B(70),U,3)_":" W $P($P(L,L1,2),";",1),?41 S L=";"_$P(^DD(45,72.1,0),U,3),L1=";"_$P(B(70),U,14)_":" W "Disch Status: ",$P($P(L,L1,2),";",1) "RTN","DGPTF4",9,0) W !," Place of Disp: ",$S($D(^DIC(45.6,+$P(B(70),U,6),0)):$E($P(^(0),U,1),1,21),1:"") "RTN","DGPTF4",10,0) W ?40 S Z=6 D Z W " Out Treat: ",$P("YES^^NO",U,+$P(B(70),U,4)) "RTN","DGPTF4",11,0) W !?6,"Means Test: " S L=";"_$P(^DD(45,10,0),U,3),L1=";"_$P(B(0),U,10)_":" W $P($P(L,L1,2),";",1) "RTN","DGPTF4",12,0) W ?42,"VA Auspices: ",$S($P(B(70),U,5)=1:"YES",$P(B(70),U,5)=2:"NO",1:"") "RTN","DGPTF4",13,0) W ! S Z=7 D Z W " Receiv facil: " S Z=$P(B(70),U,12)_$P(B(70),U,13),Z1=18 D Z1 W ?38 S Z="Other Fields" D Z "RTN","DGPTF4",14,0) S DGINC=$P(B(101),U,7) "RTN","DGPTF4",15,0) I DGINC>1000 S DGINC=$E(DGINC,1,$L(DGINC)-3)_","_$E(DGINC,$L(DGINC)-2,$L(DGINC)) "RTN","DGPTF4",16,0) W !," C&P Status: " S L=";"_$P(^DD(45,78,0),U,3),L1=";"_$P(B(70),U,9)_":" W $E($P($P(L,L1,2),";",1),1,24),?47,"Income: $",DGINC "RTN","DGPTF4",17,0) K DGINC "RTN","DGPTF4",18,0) AS ; "RTN","DGPTF4",19,0) N DGRSC "RTN","DGPTF4",20,0) S DGRSC=$S($P(A(.3),U)="Y":$$RTEN^DGPTR4($P(A(.3),U,2)),1:"") "RTN","DGPTF4",21,0) W !," ASIH Days: ",$P(B(70),U,8) "RTN","DGPTF4",22,0) W ?40,"SC Percentage: ",$S($P(A(.3),U)="Y":$P(A(.3),U,2)_"%",1:"") "RTN","DGPTF4",23,0) I DGRSC]"",DGRSC'=$P(A(.3),U,2) W ?60,"Transmitted: ["_DGRSC_"%]" "RTN","DGPTF4",24,0) ;W !,?39,"Period Of Serv: ",$S($D(^DIC(21,$S('$D(^DGPM(+$O(^DGPM("APTF",PTF,0)),"ODS")):+$P(A(.32),U,3),+^("ODS"):+$O(^DIC(21,"D",6,0)),1:+$P(A(.32),U,3)),0)):$E($P(^(0),U),1,26),1:""),! "RTN","DGPTF4",25,0) W !,?39,"Period Of Serv: " "RTN","DGPTF4",26,0) W $S($D(^DIC(21,$S('$D(^DGPM(+$O(^DGPM("APTF",PTF,0)),"ODS")):+$$CKPOS^DGPTUTL($P(B(101),U,8),+$P(A(.32),U,3)),+^("ODS"):+$O(^DIC(21,"D",6,0)),1:$$CKPOS^DGPTUTL($P(B(101),U,8),+$P(A(.32),U,3))),0)):$E($P(^(0),U),1,26),1:""),! "RTN","DGPTF4",27,0) Q "RTN","DGPTF4",28,0) ; "RTN","DGPTF4",29,0) EN1 ;LOAD AND DISPLAY DIAGNOSES FOR PTF 701 SCREEN "RTN","DGPTF4",30,0) K DRG S B(70)=$S($D(^DGPT(PTF,70)):^(70),1:""),B(71)=$S($D(^DGPT(PTF,71)):^(71),1:"") D WR "RTN","DGPTF4",31,0) S DGPTDAT=$$GETDATE^ICDGTDRG(PTF) ;Get correct effective date "RTN","DGPTF4",32,0) S DGPTTMP=$$ICDDX^ICDCODE(+$P(B(70),U,10),DGPTDAT) "RTN","DGPTF4",33,0) W ! S Z=1 D Z W " Principal Diagnosis: ",$S(DGPTTMP&$P(DGPTTMP,U,10):$P(DGPTTMP,U,4)_"("_$P(DGPTTMP,U,2)_")",1:"") "RTN","DGPTF4",34,0) S DGPTTMP=$$ICDDX^ICDCODE(+$P(B(70),U,11),DGPTDAT) "RTN","DGPTF4",35,0) W:$P(B(70),U,11)&('$P(B(70),U,10)) !," Principal Diag: ",$S(DGPTTMP&$P(DGPTTMP,U,10):$P(DGPTTMP,U,4)_" ("_$P(DGPTTMP,U,2)_")",1:"") "RTN","DGPTF4",36,0) S K=B(70) F I=16:1:24 D DSP "RTN","DGPTF4",37,0) S K=B(71) F I=1:1:4 D DSP "RTN","DGPTF4",38,0) S DGPTF=PTF D:'DGST CHK701^DGPTSCAN,UP701^DGPTSPQ "RTN","DGPTF4",39,0) ; display contents of 300th node "RTN","DGPTF4",40,0) S DG300=$S($D(^DGPT(PTF,300)):^(300),1:"") D:DG300]"" PRN2^DGPTFM8 K DG300 "RTN","DGPTF4",41,0) EN2 K DRG "RTN","DGPTF4",42,0) I $D(^DGPT(PTF,0)),$P(^(0),U,11)=1 S DA=DFN D EN1^DGPTFD I $D(DRG),$D(^DGP(45.84,PTF,0)),$P(^(0),U,6)'=DRG S $P(^(0),U,6)=DRG "RTN","DGPTF4",43,0) JUMP K AGE,B,CC,DA,DAM,DOB,DXLS,EXP,I,L1,L2,SEX,DRGCAL,S,DIC,DR,DIE "RTN","DGPTF4",44,0) Q:DGPR "RTN","DGPTF4",45,0) ;F I=$Y:1:18 W ! "RTN","DGPTF4",46,0) K X S $P(X,"-",81)="" W X "RTN","DGPTF4",47,0) ; "RTN","DGPTF4",48,0) G O:DGST&(('$D(DRG))!('DGDD)!('$D(^DGP(45.84,PTF)))) "RTN","DGPTF4",49,0) X G ACT^DGPTF41 "RTN","DGPTF4",50,0) CLS G NOT:('$D(DRG))!('DGDD)!('DGFC) "RTN","DGPTF4",51,0) ;I DRG=470!(DRG=469) W !!,*7,"Unable to release DRG ",DRG,". Please verify data entered.",*7 D HANG^DGPTUTL G EN1 "RTN","DGPTF4",52,0) ; "RTN","DGPTF4",53,0) ;change made to allow release of 470, before grouper released to vamc's "RTN","DGPTF4",54,0) ; patch 115 "RTN","DGPTF4",55,0) I DRG=469 W !!,*7,"Unable to release DRG ",DRG,". Please verify data entered.",*7 D HANG^DGPTUTL G EN1 "RTN","DGPTF4",56,0) I $D(DGCST),'DGCST D CEN G EN1:'DGCST "RTN","DGPTF4",57,0) I '$P(^DGPT(PTF,0),"^",4) W !,"Updating TRANSFER DRGs..." S DGADM=$P(^DGPT(PTF,0),U,2) D SUDO1^DGPTSUDO "RTN","DGPTF4",58,0) I DGDD>(DT+1) W !,"Cannot close with Discharge date in future." D HANG^DGPTUTL G EN1 "RTN","DGPTF4",59,0) I $D(^DGM("PT",DFN)) F I=0:0 S I=$O(^DGM("PT",DFN,I)) Q:'I I '$D(^DGM(I,0)) K ^DGM(I),^DGM("PT",DFN,I) "RTN","DGPTF4",60,0) I $D(^DGM("PT",DFN)) W !!,"Not all messages have been cleared up for this patient--cannot close.",*7,*7 S DGPTF=DFN,X="??" K DGALL D HELP^DGPTMSGD K DGPTF G EN1:'$D(DGALL) K DGALL "RTN","DGPTF4",61,0) G CLS^DGPTF2 "RTN","DGPTF4",62,0) ; "RTN","DGPTF4",63,0) O I '$D(^DGP(45.84,PTF,0)) S DR="6///0",DIE="^DGPT(",DA=PTF,(DGST,DGN)=0 D ^DIE W !," NOT CLOSED " D HANG^DGPTUTL G EN1 "RTN","DGPTF4",64,0) S (DGST,DGN)=0 "RTN","DGPTF4",65,0) S DGPTIFN=PTF,DGRTY=1 D OPEN^DGPTFDEL S DGST=0 "RTN","DGPTF4",66,0) K DGPTIFN,DGRTY G EN1 "RTN","DGPTF4",67,0) ; "RTN","DGPTF4",68,0) Q G Q^DGPTF "RTN","DGPTF4",69,0) ; "RTN","DGPTF4",70,0) NOT I 'DGFC S DR="3//^S X=$P($$SITE^VASITE,U,2);5",DIE="^DGPT(",DA=PTF D ^DIE S DGFC=$P(^DGPT(PTF,0),U,3) I DGFC G EN1 "RTN","DGPTF4",71,0) W !!,"Unable to close without a ",$S('$D(DRG):"DRG being calculated.",'DGDD:" discharge date.",1:" facility specified"),!!,*7,*7 H 4 G EN1 "RTN","DGPTF4",72,0) Q "RTN","DGPTF4",73,0) ; "RTN","DGPTF4",74,0) Z D Z^DGPTF5 Q "RTN","DGPTF4",75,0) Z1 D Z1^DGPTF5 Q "RTN","DGPTF4",76,0) CEN D CEN^DGPTF5 Q "RTN","DGPTF4",77,0) DSP S J=$$ICDDX^ICDCODE(+$P(K,U,I),DGPTDAT) I J&$P(J,U,10) D "RTN","DGPTF4",78,0) .I I#2 W ?40,$P(J,U,4)_"("_$P(J,U,2)_")" Q "RTN","DGPTF4",79,0) .W !,$P(J,U,4)_"("_$P(J,U,2)_")" "RTN","DGPTF4",80,0) Q "RTN","DGPTFDEL") 0^2^B17558288 "RTN","DGPTFDEL",1,0) DGPTFDEL ;ALB/JDS - PTF ENTRY DELETION ; 1/15/04 8:23am "RTN","DGPTFDEL",2,0) ;;5.3;Registration;**517**;Aug 13, 1993 "RTN","DGPTFDEL",3,0) ; "RTN","DGPTFDEL",4,0) A D LO^DGUTL 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","DGPTFDEL",5,0) Q "RTN","DGPTFDEL",6,0) ; "RTN","DGPTFDEL",7,0) ASK D A W !! "RTN","DGPTFDEL",8,0) S Y=1 D RTY^DGPTUTL "RTN","DGPTFDEL",9,0) S DIC("S")="I $P(^(0),U,11)=1,'$D(^DGP(45.84,+Y))",DIC="^DGPT(",DIC(0)="NEAQ",DIC("A")="Enter PTF record to delete: " "RTN","DGPTFDEL",10,0) D ^DIC G Q:Y'>0 S DA=+Y,DIC(0)="NE",X=DA D CEN G ASK:'$D(DA) "RTN","DGPTFDEL",11,0) A1 W !! D ^DIC S %=2 W !,"Ok to delete" D YN^DICN "RTN","DGPTFDEL",12,0) I %=1 S DGPTIFN=DA D KDGPT W !,"****** DELETED ******" D HANG^DGPTUTL G Q "RTN","DGPTFDEL",13,0) AD I '% W !,"Anwer Yes or No",!,"On deletion pointers will be updated" G A1 "RTN","DGPTFDEL",14,0) ; "RTN","DGPTFDEL",15,0) ; "RTN","DGPTFDEL",16,0) Q K DA,DFN,A,B,L,I,ANS,DIE,DR,DIK,DIC,DGRTY,DGRTY0,DGPTIFN Q "RTN","DGPTFDEL",17,0) ; "RTN","DGPTFDEL",18,0) HEL ; "RTN","DGPTFDEL",19,0) I '$D(DGRTY) S Y=1 D RTY^DGPTUTL "RTN","DGPTFDEL",20,0) D A W !! "RTN","DGPTFDEL",21,0) S DIC(0)="NEAQ",DIC="^DGP(45.84,",DIC("S")="I '$D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$P(^(0),U,11)="_DGRTY,DIC("A")="Enter "_$P(DGRTY0,U)_" record to re-open: " "RTN","DGPTFDEL",22,0) D ^DIC G Q:Y'>0 S (X,DGPTIFN)=+Y,%=2 "RTN","DGPTFDEL",23,0) A2 I '% W !!,DGPTIFN," ",$P(^DPT(+^DGPT(DGPTIFN,0),0),U) S DGSENFLG="",X=DGPTIFN,DIC(0)="NE",DIC="^DGP(45.84," D ^DIC K DIC,DGSENFLG "RTN","DGPTFDEL",24,0) I DGRTY=2 D CHK G Q:'DGPTIFN "RTN","DGPTFDEL",25,0) S %=2 W !,"Ok to reactivate" D YN^DICN "RTN","DGPTFDEL",26,0) I '% W !,"Answer Yes or No" G A2 "RTN","DGPTFDEL",27,0) G Q:%'=1 "RTN","DGPTFDEL",28,0) D OPEN G Q "RTN","DGPTFDEL",29,0) ; "RTN","DGPTFDEL",30,0) OLD I '$D(^DISV(DUZ,"PTFAD",DFN)) W " ???",*7,*7 G AD "RTN","DGPTFDEL",31,0) S X=^(DFN) "RTN","DGPTFDEL",32,0) Q "RTN","DGPTFDEL",33,0) DREL ; -- open released rec "RTN","DGPTFDEL",34,0) I '$D(DGRTY) S Y=1 D RTY^DGPTUTL "RTN","DGPTFDEL",35,0) W ! S DIC("A")="Enter Released "_$P(DGRTY0,U)_" Record to Re-open: ",DIC("S")="I $D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$D(^(70)),+^(70)>2901000,$P(^(0),U,11)="_DGRTY,DIC="^DGP(45.84,",DIC(0)="MEQA" "RTN","DGPTFDEL",36,0) D ^DIC K DIC G Q:+Y'>0 S DGPTIFN=+Y "RTN","DGPTFDEL",37,0) I DGRTY=2 D CHK G Q:'DGPTIFN "RTN","DGPTFDEL",38,0) OK W !,"Ok to Re-open" S %=2 D YN^DICN "RTN","DGPTFDEL",39,0) I '% W !!?14,"Enter to exit routine",!?10,"Enter 'Y' for YES to RE-OPEN Record",! G OK "RTN","DGPTFDEL",40,0) G Q:%'=1 "RTN","DGPTFDEL",41,0) S DA(1)=$O(^DGP(45.83,"C",DGPTIFN,0)) I DA(1) S DIK="^DGP(45.83,"_DA(1)_",""P"",",DA=DGPTIFN D ^DIK K DIK,DA "RTN","DGPTFDEL",42,0) D OPEN G Q "RTN","DGPTFDEL",43,0) ; "RTN","DGPTFDEL",44,0) OPEN ; "RTN","DGPTFDEL",45,0) D KDGP,KDGPT:DGRTY=2 "RTN","DGPTFDEL",46,0) W !,"****** RECORD RE-OPENED ******" D HANG^DGPTUTL "RTN","DGPTFDEL",47,0) Q "RTN","DGPTFDEL",48,0) ; "RTN","DGPTFDEL",49,0) KDGP ; -- kill close-out rec ; input DGPTIFN := ifn "RTN","DGPTFDEL",50,0) S DA=DGPTIFN,DIK="^DGP(45.84," D ^DIK K DIK,DA "RTN","DGPTFDEL",51,0) Q "RTN","DGPTFDEL",52,0) ; "RTN","DGPTFDEL",53,0) KDGPT ; -- kill DGPT rec ; input DGPTIFN := ifn "RTN","DGPTFDEL",54,0) S DA=DGPTIFN,DIK="^DGPT(",FLAG=1,I=0 F S I=$O(^DGCPT(46,"C",DA,I)) Q:'I I '$G(^DGCPT(I,9)) S FLAG=0 Q "RTN","DGPTFDEL",55,0) I FLAG S I=0 F S I=$O(^DGICD9(46.1,"C",DA,I)) Q:'I I '$G(^DGICD9(I,9)) S FLAG=0 Q "RTN","DGPTFDEL",56,0) I 'FLAG W !,"CANNOT DELETE THE PTF RECORD WHEN THERE ARE ACTIVE ORDERS OR CPT RECORDS." H 2 K FLAG Q "RTN","DGPTFDEL",57,0) D ^DIK K DA,DIK,I,FLAG "RTN","DGPTFDEL",58,0) I DGRTY=1 S DA=+$O(^DGPM("APTF",DGPTIFN,0)) I $D(^DGPM(DA,0)),$P(^(0),U,16)=DGPTIFN S DR=".16///@",DIE="^DGPM(" D ^DIE K DR,DIE "RTN","DGPTFDEL",59,0) K DA Q "RTN","DGPTFDEL",60,0) ; "RTN","DGPTFDEL",61,0) CHK ; -- check to see if PTF is open ; return DGPTIFN="" is not open "RTN","DGPTFDEL",62,0) I $D(^DGPT(+$P(^DGPT(DGPTIFN,0),U,12),0)),$P(^(0),U,6) W !!,*7,?5,"Associated PTF record #",+$P(^DGPT(DGPTIFN,0),U,12)," must be RE-OPENED",!?5,"in order to re-open Census record #",DGPTIFN,"." S DGPTIFN="" "RTN","DGPTFDEL",63,0) Q "RTN","DGPTFDEL",64,0) ; "RTN","DGPTFDEL",65,0) CEN ; -- check if closed for census "RTN","DGPTFDEL",66,0) K DGI "RTN","DGPTFDEL",67,0) F DGI=0:0 S DGI=$O(^DGPT("ACENSUS",DA,DGI)) Q:'DGI I $D(^DGPT(DGI,0)),$P(^(0),U,12)=DA,$D(^DG(45.86,+$P(^(0),U,13),0)) S Y=+^(0) X ^DD("DD") S DGI(DGI)=Y "RTN","DGPTFDEL",68,0) G CENQ:$D(DGI)<10 "RTN","DGPTFDEL",69,0) W !!?2,*7,"This PTF record is associated with the following Census records:" "RTN","DGPTFDEL",70,0) F DGI=0:0 S DGI=$O(DGI(DGI)) Q:'DGI W !?10,"Census Record #",DGI,?35,"==>",?40,"Census Date: ",DGI(DGI) "RTN","DGPTFDEL",71,0) W !!?2,"PTF record can not be deleted." "RTN","DGPTFDEL",72,0) K DA "RTN","DGPTFDEL",73,0) CENQ K DGI Q "RTN","DGPTFJ") 0^11^B7281563 "RTN","DGPTFJ",1,0) DGPTFJ ;ALB/MRL - JUMP BETWEEN PTF SCREENS ; 1/15/04 8:06am "RTN","DGPTFJ",2,0) ;;5.3;Registration;**58,517**;Aug 13, 1993 "RTN","DGPTFJ",3,0) ; "RTN","DGPTFJ",4,0) TEST K S,M G Q^DGPTF:X="^" S Z="^101^401^501^601^701^801^MAS^CDR",X1=X,X=$P($E(X,2,99),"-",1) G QUES:X1?1"^?".E Q:X="" D IN^DGHELP G QUES:%=-1 "RTN","DGPTFJ",5,0) S Z=$T(@X) I Z="" W !!,"*** Undefined screen number. Valid screens are: ",! G QUES "RTN","DGPTFJ",6,0) I X=4!(X=5) S @($S(+X=5:"DGZM0",1:"DGZS0"))=$S(X1["-":+$P(X1,"-",2),1:1) "RTN","DGPTFJ",7,0) I X=6 S DGZP=$S(X1["-":+$P(X1,"-",2),1:1) "RTN","DGPTFJ",8,0) K M,L1,T G @($P(Z,";",3)) "RTN","DGPTFJ",9,0) ; "RTN","DGPTFJ",10,0) HELP W !!,"PTF Screens are: ",! F I=1,5,4,6,7,8,"M","C" S T=$T(@I) Q:T="" W !?5,I,?10,$P(T,";",4) "RTN","DGPTFJ",11,0) Q "RTN","DGPTFJ",12,0) QUES D HELP W !!,"Press Return to continue: " R X:4 "RTN","DGPTFJ",13,0) I $D(DGPTSCRN) S Z=$P($T(@$E(DGPTSCRN)),";",3) K DGPTSCRN G:Z]"" @Z "RTN","DGPTFJ",14,0) G WR^DGPTF1 "RTN","DGPTFJ",15,0) Q G Q^DGPTF "RTN","DGPTFJ",16,0) ; "RTN","DGPTFJ",17,0) PROG ; "RTN","DGPTFJ",18,0) 1 ;;WR^DGPTF1;'101' Screen--Admission/disposition Transaction "RTN","DGPTFJ",19,0) 5 ;;EN^DGPTFM4;'501' Screen--Patient movement transaction "RTN","DGPTFJ",20,0) 4 ;;EN^DGPTFM5;'401' Screen--Surgical/procedure entry "RTN","DGPTFJ",21,0) 6 ;;E^DGPTFM1;'601' Screen--Procedure entry (AVAILABLE FOR DISCHARGES AFTER 10/1/87) "RTN","DGPTFJ",22,0) 7 ;;EN1^DGPTF4;'701' Screen--DXLS/DRG print "RTN","DGPTFJ",23,0) 8 ;;F^DGPTFM2;'801' Screen--CPT entry (CPT and HCPCS) "RTN","DGPTFJ",24,0) M ;;^DGPTFM;'MAS' screen--surgery/procedure/diagnosis code edits "RTN","DGPTFJ",25,0) C ;;EN^DGPTFM7;'CDR' screen--displays CDR information "RTN","DGPTFJ",26,0) Q "RTN","DGPTFJ",27,0) SA ;called from input transform on SOURCE OF ADMISSION field (#20) PTF file (#45) "RTN","DGPTFJ",28,0) S DGER=$S('$D(PTF):1,'$D(^DGPT(PTF,0)):1,1:0) Q:DGER!("^48^49^50^"'[(U_Y_U)) S DGSU1=$P(^(0),"^",5),DGSU0=$S($D(^DGPT(PTF,101)):$P(^(101),"^",6),1:"") "RTN","DGPTFJ",29,0) S DGSTATYP=$S(Y=48:11,Y=49:40,Y=50:30) "RTN","DGPTFJ",30,0) D NUMACT^DGPTSUF(DGSTATYP) "RTN","DGPTFJ",31,0) I DGANUM>0 D "RTN","DGPTFJ",32,0) .I Y=48 F I=1:1:DGANUM S DGER=$S(((DGSU1=DGSUFNAM(DGANUM))!(DGSU1=""))&((DGSU0=DGSUFNAM(DGANUM))!(DGSU0="")):0,1:1) "RTN","DGPTFJ",33,0) .I Y=49!(Y=50) F I=1:1:DGANUM S DGER=$S((Y=49&(DGSU1=DGSUFNAM(DGANUM))&("^9AA^9AB^9AC^9AD^9AE^"[(U_DGSU0_U))):0,(Y=50&(DGSU1=DGSUFNAM(DGANUM))&("^BU^BV^BW^BX^"[(U_DGSU0_U))):0,1:1) "RTN","DGPTFJ",34,0) K DGANUM,DGSTATYP,DGSUFNAM,I "RTN","DGPTFJ",35,0) Q "RTN","DGPTFJC") 0^20^B38290310 "RTN","DGPTFJC",1,0) DGPTFJC ;ALB/ADL - CLOSED PTF ; 2/23/04 2:10pm "RTN","DGPTFJC",2,0) ;;5.3;Registration;**158,510,517**;Aug 13, 1993 "RTN","DGPTFJC",3,0) ;;ADL;;Update for CSV Project;;Mar 25, 2003 "RTN","DGPTFJC",4,0) 101 W !,"Enter '^N' for Screen N, RETURN for ,'^' to Abort: //" "RTN","DGPTFJC",5,0) D READ G Q^DGPTF:X=U,^DGPTFM:X="",^DGPTFJ:X?1"^".E D H G 101 "RTN","DGPTFJC",6,0) ; "RTN","DGPTFJC",7,0) H D HELP^DGPTFJ W ! Q "RTN","DGPTFJC",8,0) ; "RTN","DGPTFJC",9,0) MAS W !!,"Enter '^N' for Screen N, RETURN for <",DGNUM,">,'^' to Abort: <",DGNUM,">//" "RTN","DGPTFJC",10,0) D READ G Q^DGPTF:X=U,^DGPTFJ:X?1"^".E "RTN","DGPTFJC",11,0) I X="" S (ST,ST1)=J+2 G @($S($D(DGZDIAG):"NDG",$D(DGZSER):"NSR",$D(DGZPRO):"NPR",$D(DGZSUR):"EN^DGPTFMO",+DGZPRF-1'=$P(DGZPRF,U,3):"NPS",1:"DONE")_"^DGPTFM") "RTN","DGPTFJC",12,0) D H G MAS "RTN","DGPTFJC",13,0) ; "RTN","DGPTFJC",14,0) 401 S DGNUM=$S($D(S(DGZS0+1)):401_"-"_(DGZS0+1),1:"MAS") "RTN","DGPTFJC",15,0) W !,"Enter '^N' for Screen N, RETURN for <",DGNUM,">,'^' to Abort: <",DGNUM,">//" "RTN","DGPTFJC",16,0) D READ G Q^DGPTF:X=U,NEXM^DGPTFM5:X="",^DGPTFJ:X?1"^".E D H G 401 "RTN","DGPTFJC",17,0) ; "RTN","DGPTFJC",18,0) 501 W !,"Enter '^N' for Screen N, RETURN for <",DGNUM,">,'^' to Abort: <",DGNUM,">//" "RTN","DGPTFJC",19,0) D READ G Q^DGPTF:X=U,NEXM^DGPTFM4:X="",^DGPTFJ:X?1"^".E D H G 501 "RTN","DGPTFJC",20,0) ; "RTN","DGPTFJC",21,0) 601 W !,"Enter '^N' for Screen N, RETURN for <",DGNUM,">,'^' to Abort: <",DGNUM,">//" "RTN","DGPTFJC",22,0) D READ G Q^DGPTF:X=U,NEXP^DGPTFM6:X="",^DGPTFJ:X?1"^".E D H G 601 "RTN","DGPTFJC",23,0) ; "RTN","DGPTFJC",24,0) 701 ; "RTN","DGPTFJC",25,0) G ACT1^DGPTF41 ; new code "RTN","DGPTFJC",26,0) ; "RTN","DGPTFJC",27,0) ;Display screen prompt and process user response for 801 screen "RTN","DGPTFJC",28,0) 801 W !,"Enter '^N' for Screen N, RETURN for <",DGNUM,">,'^' to Abort: <",DGNUM,">//" "RTN","DGPTFJC",29,0) D READ G Q^DGPTF:X=U,NEXP^DGPTFM2:X="",^DGPTFJ:X?1"^".E D H G 801 "RTN","DGPTFJC",30,0) READ ; -- read X "RTN","DGPTFJC",31,0) R X:DTIME S:'$T X="^",DGPTOUT="" "RTN","DGPTFJC",32,0) Q "RTN","DGPTFJC",33,0) ; "RTN","DGPTFJC",34,0) EN S K=$S($D(K):K,1:1),DGER=0 S DGPTDAT=$$GETDATE^ICDGTDRG(DA(1)),DGPTTMP=$$ICDDX^ICDCODE(+Y,DGPTDAT) I +DGPTTMP=-1!('$P(DGPTTMP,U,10)) S DGER=1 Q "RTN","DGPTFJC",35,0) I $P(DGPTTMP,U,11)]""&($P(DGPTTMP,U,11)'=$S($D(^DPT(+^DGPT(DA(1),0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(DGPTTMP,U,2)," can only be used with ",$S($P(DGPTTMP,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",36,0) S %=$P(^DGPT(DA(1),"M",DA,0),U,DGI) I $D(^DGPT(DA(1),"M","AC",Y,DA)),%'=Y S DGER=1 Q "RTN","DGPTFJC",37,0) F I=0:0 S I=$O(^ICD9(+Y,"N",I)) Q:I'>0 I $D(^DGPT(DA(1),"M","AC",I,DA)),%'=I W !,"Cannot use ",$S($D(^ICD9(+Y,0)):$P(^(0),U),1:"")," with ",$S($D(^ICD9(I,0)):$P(^(0),U),1:"") S DGER=1 Q "RTN","DGPTFJC",38,0) Q:DGER S DG1=1 F I=0:0 S I=$O(^ICD9(+Y,"R",I)) Q:I'>0 S DG1=0 I $D(^DGPT(DA(1),"M","AC",I,DA)),%'=I S DG1=1 Q "RTN","DGPTFJC",39,0) I 'DG1 W !,$S(+DGPTTMP>0&('$P(DGPTTMP,U,10)):$P(DGPTTMP,U,2),1:"")," requires additional code." "RTN","DGPTFJC",40,0) Q "RTN","DGPTFJC",41,0) EN1 S K=$S($D(K):K,1:1),DGER=0,DGPTDAT=$$GETDATE^ICDGTDRG(DA(1)),DGICD0=$$ICDOP^ICDCODE(+Y,DGPTDAT) I +DGICD0,0!('$P(DGICD0,U,10)) S DGER=1 Q "RTN","DGPTFJC",42,0) I $P(DGICD0,U,11)]""&($P(DGICD0,U,11)'=$S($D(^DPT(+^DGPT(DA(1),0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(DGICD0,U,2)," can only be used with ",$S($P(DGICD0,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",43,0) S %=$P(^DGPT(DA(1),DGSB,DA,0),U,DGI) I $D(^DGPT(DA(1),DGSB,DGCR,Y,DA)),%'=Y S DGER=1 W !,"Cannot enter the same code more than once within a ",$S(DGSB="S":"401",1:"601")," transaction" Q "RTN","DGPTFJC",44,0) F I=0:0 S I=$O(^ICD0(+Y,"N",I)) Q:I'>0 I $D(^DGPT(DA(1),DGSB,DGCR,I,DA)),%'=I S DGPTTMP2=$$ICDOP^ICDCODE(I,DGPTDAT) W !,"Cannot use ",$P(DGICD0,U,2)," with ",$S(+DGPTTMP2>0:$P(DGPTTMP2,U,2),1:"") S DGER=1 Q "RTN","DGPTFJC",45,0) Q:DGER S DG1=1 F I=0:0 S I=$O(^ICD0(+Y,"R",I)) Q:I'>0 S DG1=0 I $D(^DGPT(DA(1),DGSB,DGCR,I,DA)),%'=I S DG1=1 Q "RTN","DGPTFJC",46,0) I 'DG1 W !,$P(DGICD0,U,2)," requires additional code." "RTN","DGPTFJC",47,0) Q "RTN","DGPTFJC",48,0) EN2 S K=$S($D(K):K,1:1),DGER=0,DGPTTMP=$$ICDOP^ICDCODE(+Y,$$GETDATE^ICDGTDRG(DA)) I +DGPTTMP<0!('$P(DGPTTMP,U,10)) S DGER=1 Q "RTN","DGPTFJC",49,0) I $P(DGPTTMP,U,11)]""&($P(DGPTTMP,U,11)'=$S($D(^DPT(+^DGPT(DA,0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(DGPTTMP,U,2)," can only be used with ",$S($P(DGPTTMP,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",50,0) S L=$P($S($D(^DGPT((DA),"401P")):^("401P"),1:0),U,1,5),%=$P(L,U,DGI),L=$P(L,U,1,DGI-1)_U_$P(L,U,DGI+1,5) I L[Y S DGER=1 Q "RTN","DGPTFJC",51,0) Q "RTN","DGPTFJC",52,0) EN3 S K=$S($D(K):K,1:1),DGER=0,DGPTTMP=$$ICDDX^ICDCODE(+Y,$$GETDATE^ICDGTDRG(DA)) I +DGPTTMP<0!('$P(DGPTTMP,U,10)) S DGER=1 Q "RTN","DGPTFJC",53,0) I DGI=1,$P(DGPTTMP,U,5) S DGER=1 Q "RTN","DGPTFJC",54,0) I $P(DGPTTMP,U,11)]""&($P(DGPTTMP,U,11)'=$S($D(^DPT(+^DGPT(DA,0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(DGPTTMP,U,2)," can only be used with ",$S($P(DGPTTMP,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",55,0) S %=$S($D(^DGPT(DA,70)):^(70),1:""),%=U_$P(%,U,10)_U_$P(%,U,16,24)_U "RTN","DGPTFJC",56,0) S:$G(^DGPT(DA,71))'="" %=%_^(71)_U S $P(%,U,DGI+1)=U I %[(U_+Y_U) S DGER=1 Q "RTN","DGPTFJC",57,0) F I=0:0 S I=$O(^ICD9(+Y,"N",I)) Q:I'>0 I %[(U_I_U) S DGPTTMP2=$$ICDDX^ICDCODE(I,DGPTDAT) W !,"Cannot use ",$P($G(DGPTTMP),U,2)," with ",$S(+DGPTTMP2>0:$P(DGPTTMP2,U,2),1:"") S DGER=1 Q "RTN","DGPTFJC",58,0) Q:DGER S DG1=1 F I=0:0 S I=$O(^ICD9(+Y,"R",I)) Q:I'>0 S DG1=0 I %[(U_I_U) S DG1=1 Q "RTN","DGPTFJC",59,0) I 'DG1 W !,$S(+DGPTTMP>0:$P(DGPTTMP,U,2),1:"")," requires additional code." "RTN","DGPTFJC",60,0) Q "RTN","DGPTFJC",61,0) EN4 S K=$S($D(K):K,1:1),DGER=0,N=$$ICDDX^ICDCODE(+Y,$$GETDATE^ICDGTDRG(DA)) I N<0!'$P(N,U,10) S DGER=1 Q "RTN","DGPTFJC",62,0) I DGI=1,$P(N,U,5) S DGER=1 Q "RTN","DGPTFJC",63,0) I $P(N,U,11)]""&($P(N,U,11)'=$S($D(^DPT(+^DGPT(DA(2),0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(N,U,2)," can only be used with ",$S($P(N,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",64,0) S %=$S($D(^DGPT(DA(2),"C",DA(1),"CPT",DA,0)):^(0),1:""),%=U_$P(%,U,4,7)_U,$P(%,U,DGI+1)=U I %[(U_+Y_U) S DGER=1 Q "RTN","DGPTFJC",65,0) F I=0:0 S I=$O(^ICD9(+Y,"N",I)) Q:I'>0 I %[(U_I_U) W !,"Cannot use ",$S($D(^ICD9(+Y,0)):$P(^(0),U),1:"")," with ",$S($D(^ICD9(I,0)):$P(^(0),U),1:"") S DGER=1 Q "RTN","DGPTFJC",66,0) Q:DGER S DG1=1 F I=0:0 S I=$O(^ICD9(+Y,"R",I)) Q:I'>0 S DG1=0 I %[(U_I_U) S DG1=1 Q "RTN","DGPTFJC",67,0) I 'DG1 W !,$P(N,U,2)," requires additional code." Q "RTN","DGPTFJC",68,0) Q "RTN","DGPTFJC",69,0) EN5 S K=$S($D(K):K,1:1),DGER=0,DGPTTMP=$$ICDDX^ICDCODE(+Y,+DGZPRF(DGZP)) I +DGPTTMP<0!('$P(DGPTTMP,U,10)) S DGER=1 Q "RTN","DGPTFJC",70,0) I $P(DGPTTMP,U,11)]""&($P(DGPTTMP,U,11)'=$S($D(^DPT(+^DGPT(PTF,0),0)):$P(^(0),U,2),1:"M")) W:K<24 !,$P(DGPTTMP,U,2)," can only be used with ",$S($P(DGPTTMP,U,11)="F":"FEMALES",1:"MALES") S K=K+1,DGER=1 Q "RTN","DGPTFJC",71,0) S K=^DGCPT(46,DA,0) I $P(K,U,4,7)_U_$P(K,U,15,18)[Y S DGER=1 Q "RTN","DGPTFJC",72,0) Q "RTN","DGPTFJC",73,0) EN6 I $P($G(^(0)),U,2)?.N S DGER=1 Q "RTN","DGPTFJC",74,0) S DGER=0,N=$$CPT^ICPTCOD(+Y,$$GETDATE^ICDGTDRG(DA)) I N<0!'$P(N,"^",7) S DGER=1 Q "RTN","DGPTFJC",75,0) S L=0 F S L=$O(^DGCPT(46,L)) Q:L'>0 I +$G(^(L,1))=DGPRD,$P(^(1),U,3)=PTF,+^(0)=Y S DGER=1 Q "RTN","DGPTFJC",76,0) K L Q "RTN","DGPTFM") 0^3^B40972538 "RTN","DGPTFM",1,0) DGPTFM ;ALB/MTC - PTF OP-PRO-DIAG ; 2/11/04 9:30am "RTN","DGPTFM",2,0) ;;5.3;Registration;**510,517**;Aug 13, 1993 "RTN","DGPTFM",3,0) K M,S,M1,M2,M3,S1,S2,PS2,SDCLY,^TMP("PTF",$J) "RTN","DGPTFM",4,0) GET S I=0 F I1=1:1 S I=$O(^DGPT(PTF,"M",I)) Q:'I S (M3(I1),M(I1))=^(I,0) I $D(^DGPT(PTF,"M",I,"P")) S $P(M(I1),U,20)=^("P") "RTN","DGPTFM",5,0) K MT D ORDER^DGPTF K MT D GETVAR^DGPTFM6,CL^SDCO21(DFN,$P(^DGPT(PTF,0),U,2),"",.SDCLY),MOB^DGPTFM2 "RTN","DGPTFM",6,0) S DGPC=I1-1 D WR K M1,M2,^UTILITY($J) S ST=1,M2=0 "RTN","DGPTFM",7,0) DIAG K DGZSER,DGZPRO,DGZSUR S DGZDIAG=1 F J=ST:2:PM S NL=1,L5=0,L6=J D WD2 S L5=1,L6=J+1 D:$D(M(L6)) WD2 D WD G PRO1:$Y>16 D WD3^DGPTFM8 G PRO1:$Y>16 W ! "RTN","DGPTFM",8,0) S ST=1 G SER "RTN","DGPTFM",9,0) WD F J1=1:1:11 I J1'=6 S L=$P(M(J),U,J1+4),L1=0,L3=1 D:+L WD1 S L1=1,L=$S($D(M(J+1)):$P(M(J+1),U,J1+4),1:"") D:+L WD1 "RTN","DGPTFM",10,0) Q "RTN","DGPTFM",11,0) WD1 S N=$$ICDDX^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)),L2=$S(N:$P(N,U,2,99),1:""),M2=M2+1,L4=$P(L2,"^",1),L4=L4_$E(" ",1,3-$L($P(L4,".",2))) "RTN","DGPTFM",12,0) W:L3 ! S:L3 L3=0 W ?L1*40,$J(M2,3)," ",$J(L4,7)," ",$E($P(L2,U,3),1,25) K ^UTILITY($J,"M2",M2) S ^UTILITY($J,"M2",M2)=+M(J+L1)_U_J1 Q "RTN","DGPTFM",13,0) WD2 N Z3 "RTN","DGPTFM",14,0) X:NL "W ! S NL=0" W ?L5*40,"Move #",+L6 S Z=M(L6),Z3=M3(L6) W:+Z=1 " D/C" S Y=$P(Z,U,10)\1 D D^DGPTUTL W " ",Y," ",$S($D(^DIC(42.4,+$P(Z,U,2),0)):$E($P(^(0),U,1),1,10),1:"") "RTN","DGPTFM",15,0) W " <",$S($P(Z3,U,18)=1:"",1:"N"),"SC"_$S($P(Z3,U,26)="Y":",AO",1:"")_$S($P(Z3,U,27)="Y":",IR",1:"")_$S($P(Z3,U,28)="Y":",EC",1:"")_">" "RTN","DGPTFM",16,0) Q "RTN","DGPTFM",17,0) NDG D WR S I=0 K M,M1,M2 S M2=0 F I1=1:1 S I=$O(^DGPT(PTF,"M",I)) Q:I'>0 S M(I1)=^(I,0) "RTN","DGPTFM",18,0) S PM=I1-1 D ORDER^DGPTF K MT G DIAG:$D(ST) G GET S ST=1 "RTN","DGPTFM",19,0) SER K DGZDIAG,DGZPRO,DGZSUR S DGZSER=1 G PRO1:$Y>19 K S1,S2 S S2=0 G SERV:ST G PRO "RTN","DGPTFM",20,0) SERV F J=ST:2:SU S NL=1,L5=0,L6=J D SD2 S L5=1,L6=J+1 D:$D(S(L6)) SD2 D SD G PRO1:$Y>11 D SD3^DGPTFM8 G PRO1:$Y>11 W ! "RTN","DGPTFM",21,0) G PRC^DGPTFM0 "RTN","DGPTFM",22,0) SD F J1=1:1:5 S L=$P(S(J),U,J1+7),L1=0,L3=1 D:+L SD1 S L1=1,L=$S($D(S(J+1)):$P(S(J+1),U,J1+7),1:"") D:+L SD1 "RTN","DGPTFM",23,0) Q "RTN","DGPTFM",24,0) SD1 S N=$$ICDDX^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)),L2=$S(N:$P(N,U,2,99),1:""),S2=S2+1,L4=$P(L2,"^",1),L4=L4_$E(" ",1,3-$L($P(L4,".",2))) "RTN","DGPTFM",25,0) W:L3 ! S:L3 L3=0 W ?L1*40,$J(S2,3)," ",$J(L4,7)," ",$E($P(L2,U,4),1,25) K S2(S2) S S2(S2)=J+L1_U_J1 Q "RTN","DGPTFM",26,0) SD2 S Y=+S(L6) D D^DGPTUTL W:NL ! S:NL NL=0 W ?L5*40,L6,"-Surgery date: ",Y "RTN","DGPTFM",27,0) Q "RTN","DGPTFM",28,0) NSR K S,S1,S2 S I=0 F I1=1:1 S I=$O(^DGPT(PTF,"S",I)) Q:I'>0 S S(I1)=^(I,0),S(I1,1)=I "RTN","DGPTFM",29,0) S S2=0,SU=I1-1 D WR G SERV "RTN","DGPTFM",30,0) ; "RTN","DGPTFM",31,0) WR W @IOF,HEAD,?70 S Z="" D Z Q "RTN","DGPTFM",32,0) PRO K DGZSER,DGZDIAG,DGZSUR S DGZPRO=1 G PRO1:$Y>14 K P1,P2 S ST=1,P2=0 G NPR:'$D(PROC) "RTN","DGPTFM",33,0) PROC D:$Y>14 WR W:PROC]"" !!,"Procedures: ",! "RTN","DGPTFM",34,0) F J1=1:1:5 S L=$P(PROC,"^",J1) I L'="" S P2=P2+1,N=$$ICDDX^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)),L2=$S(N:$P(N,U,2,99),1:""),L4=$P(L2,U,1),L4=L4_$E(" ",1,3-$L($P(L4,".",2))) D "RTN","DGPTFM",35,0) .W:$X>5 ?40 W $J(P2,3)," ",$J(L4,7)," ",$E($P(L2,"^",4),1,25) K P2(P2) S P2(P2)=J1 W:$X>45 ! "RTN","DGPTFM",36,0) K DGZSER,DGZPRO,DGZDIAG,DGZSUR "RTN","DGPTFM",37,0) ENC G PRO1:$Y>7,PRO1:'$P(DGZPRF,U,3) "RTN","DGPTFM",38,0) PF S PS2=0,J=+DGZPRF,Y=+DGZPRF(J),DGSTRT=$S(+$P(DGZPRF,U,4):$P(DGZPRF,U,4),1:4),DGLST=0 "RTN","DGPTFM",39,0) D CL^SDCO21(DFN,+DGZPRF(J),"",.SDCLY),ICDINFO^DGAPI(DFN,PTF),XREF^DGPTFM2 ; load SCI info and DGN's for this service date "RTN","DGPTFM",40,0) D D^DGPTUTL W !,J,"-CPT Capture Date/Time: ",Y W:($P(DGZPRF,U,2)-1!($G(PGBRK))) " (cont.)" "RTN","DGPTFM",41,0) I $P(DGZPRF(J),U,2) W !,?5,"Referring or Ordering Provider: " S L=$P(DGZPRF(J),U,2) D PRV "RTN","DGPTFM",42,0) W !,?5,"Rendering Provider: " S L=$P(DGZPRF(J),U,3) D PRV "RTN","DGPTFM",43,0) I $P(DGZPRF(J),U,5) W !,?5,"Rendering Location: ",$P($G(^SC($P(DGZPRF(J),U,5),0)),U) "RTN","DGPTFM",44,0) S (L1,PGBRK)=0 "RTN","DGPTFM",45,0) F K=$P(DGZPRF,U,2):1 Q:'$D(DGZPRF(J,K)) I '$G(DGZPRF(J,K,9)) S PS2=PS2+1 W !,?2,PS2," " D CPT^DGPTFM2 D Q:$Y+$G(DGZPRF(J,K+1,1))>16!($G(PGBRK)) "RTN","DGPTFM",46,0) . W !,?4 S $P(DS,"-",27)="" W DS," Related Diagnosis ",DS "RTN","DGPTFM",47,0) . F L1=DGSTRT:1:11 S DGLOC=$S(L1<8:L1,1:L1+7),CD=$P(DGZPRF(J,K),U,DGLOC) I CD D I $Y+$G(CKSCI)>16 S PGBRK=1 Q "RTN","DGPTFM",48,0) . . S N=$$ICDDX^ICDCODE(CD,$$GETDATE^ICDGTDRG(PTF)),N=$S(N:$P(N,U,2,99),1:"") "RTN","DGPTFM",49,0) . . S CD=$P(N,U) W !,?8,CD," ",$P(N,U,3) "RTN","DGPTFM",50,0) . . D CKSCI($P(DGZPRF(J,K),U,DGLOC)) "RTN","DGPTFM",51,0) . S PS2(PS2)=J_U_K,CD=1,DGLOC=0,DGSTRT=4 "RTN","DGPTFM",52,0) I L1'=11,$S(L1<8:$P($G(DGZPRF(J,K)),U,L1+1,7),1:"")_$P($G(DGZPRF(J,K)),U,$S(L1<8:15,1:L1+8),18)?."^" S L1=11 "RTN","DGPTFM",53,0) I L1=11 S $P(DGZPRF,U,1,2)=$S($D(DGZPRF(J,K+1)):J_U_(K+1),1:J+1_U_1),$P(DGZPRF,U,4)="",PGBRK=0 "RTN","DGPTFM",54,0) E S $P(DGZPRF,U,1,2)=J_U_K,$P(DGZPRF,U,4)=L1+1 "RTN","DGPTFM",55,0) ;I '$D(DGZPRF(J,K+1)) S $P(DGZPRF,U,1,2)=$S($P($G(DGZPRF(J,K)),U,NXTDGN)'="":J,1:J+1)_U_1,$P(DGZPRF,U,4)=DGLST "RTN","DGPTFM",56,0) ;I $D(DGZPRF(J,K+1)) S $P(DGZPRF,U,1,2)=J_U_(K+1) "RTN","DGPTFM",57,0) K I,K,L,L1,CD,N G PRO1 "RTN","DGPTFM",58,0) ; "RTN","DGPTFM",59,0) CKSCI(IEN) ;print SCI for each Diagnosis code "RTN","DGPTFM",60,0) N DGINFO Q:'$D(XREF(IEN)) "RTN","DGPTFM",61,0) S DGINFO=$G(^DGICD9(46.1,(XREF(IEN)),0)),CKSCI=0 "RTN","DGPTFM",62,0) I 'DGINFO Q "RTN","DGPTFM",63,0) F I=3,7,1,2,4:1:6 I $D(SDCLY(I)) S L=$S(I=3:8,I<4:8+I,1:7+I) D "RTN","DGPTFM",64,0) .W ?45 S M=1,CKSCI=CKSCI+1 "RTN","DGPTFM",65,0) .W $P("Treated for AO Condition^Treated for IR Condition^Treated for SC Condition^Exposed to Envir Contaminants^Treatment for MST^Treatment for Head/Neck CA^Related to Combat",U,I) "RTN","DGPTFM",66,0) .I I'=7 W ":",$S($P(DGINFO,U,($S(I<3:I+2,I=3:2,1:I+1))):"YES",1:"NO"),! "RTN","DGPTFM",67,0) .I I=7 W ":",$S($P(DGINFO,U,8)="Y":"YES",1:"NO"),! "RTN","DGPTFM",68,0) Q ;CKSCI "RTN","DGPTFM",69,0) ; "RTN","DGPTFM",70,0) NPR S ST=1,PROC=$S($D(^DGPT(PTF,"401P")):^("401P"),1:"") D WR G PRO "RTN","DGPTFM",71,0) ; "RTN","DGPTFM",72,0) NPS D WR G PF "RTN","DGPTFM",73,0) ; "RTN","DGPTFM",74,0) DONE G EN1^DGPTF4 "RTN","DGPTFM",75,0) PRO1 ;SET MENU TYPE AND DISPLAY MENU "RTN","DGPTFM",76,0) S DGNUM=$S($D(DGZDIAG)!($D(DGZPRO))!($D(DGZSER))!($D(DGZSUR)!(+DGZPRF-1'=$P(DGZPRF,U,3))):"MAS",1:"701") G MAS^DGPTFJC:DGST F X=$Y:1:(IOSL-8) W ! "RTN","DGPTFM",77,0) W !! S Z="Patient Movements:" W Z S Z=" "_$S(DGPTFE:"M=Add PM X=Delete PM",1:"M=Edit Treat Spec/PM ")_" A=Add Code D=Delete Code V=Edit Mov" W Z "RTN","DGPTFM",78,0) W ! S Z="Surgical Episodes:" W Z S Z=" S=Add SE Z=Delete SE O=Add Code C=Delete Code J=Edit SE" W Z "RTN","DGPTFM",79,0) W ! S Z="Procedure Records:" W Z S Z=" T=Add PR R=Delete PR P=Add Code Q=Delete Code E=Edit PR" W Z "RTN","DGPTFM",80,0) W ! S Z="CPT Records:" W Z S Z=" I=Add CR Y=Delete CR N=Add CPT G=Delete CPT F=Edit CR" W Z K Z "RTN","DGPTFM",81,0) W !," ^=Abort to Continue:<",DGNUM,">// " R ANS:DTIME K DGNUM "RTN","DGPTFM",82,0) A S Z="^C Delete Code^A Add Code^O Add Code^P Add NOP^S Add SE^D Delete Code^M Add PM^X Delete PM^Z Delete SE^J Edit SE^Q Delete NOP^V Edit Move^" "RTN","DGPTFM",83,0) S Z=Z_"T Add PR^R Delete PR^E Edit PR^I Add CR^Y Delete CR^N Add CPT^G Delete CPT^F Edit CR" "RTN","DGPTFM",84,0) I 'DGPTFE S $P(Z,U,8,9)="M Edit treat Spec/PM" "RTN","DGPTFM",85,0) S X=ANS G Q^DGPTF:ANS="^" G ^DGPTFJ:ANS?1"^".E S (A,X)=ANS,X=$E(X,1) D IN^DGHELP "RTN","DGPTFM",86,0) I ANS="" S (ST,ST1)=J+2 D:$D(DGZSUR) WR G @($S($D(DGZDIAG):"NDG",$D(DGZSER):"NSR",$D(DGZPRO):"NPR",$D(DGZSUR):"EN^DGPTFM0",+DGZPRF-1'=$P(DGZPRF,U,3):"NPS",1:"DONE")) "RTN","DGPTFM",87,0) G HELP^DGPTFM1A:%=-1 S Z=$L(A)-1 G @(X_$S(X="X":"",1:"^DGPTFM1")) "RTN","DGPTFM",88,0) PRV I $D(^VA(200,L,0)) W $P(^(0),U) Q "RTN","DGPTFM",89,0) W L Q "RTN","DGPTFM",90,0) X ; "RTN","DGPTFM",91,0) I 'Z S:PM=1 RC=1 G X1:PM=1 W !!,"Delete Patient move <1",$S(PM<3:"",1:"-"_(PM-1)),">: " R RC:DTIME G ^DGPTFM:RC["^"!(RC="") "RTN","DGPTFM",92,0) E S RC=$E(A,2,99) W ! "RTN","DGPTFM",93,0) I +RC'=RC!('$D(M(RC))) W !!,"Enter the record # to delete from the PTF file, 1",$S(PM<3:"",1:"-"_(PM-1)) S Z=0 G X "RTN","DGPTFM",94,0) X1 I +M(RC)=1 W !,*7,"Cannot delete discharge movement",! H 3 G ^DGPTFM "RTN","DGPTFM",95,0) S DIE="^DGPT("_PTF_",""M"",",DP=45.02,DR=".01///@",DA(1)=PTF,DA=+M(RC) D ^DIE K DR W " ",RC,"-DELETED***" H 2 G ^DGPTFM "RTN","DGPTFM",96,0) Z W @DGVI,Z,@DGVO Q "RTN","DGPTFM0") 0^22^B11221145 "RTN","DGPTFM0",1,0) DGPTFM0 ;ALB/MAC/ADL - ROUTINE TO DISPLAY PROCEDURE CODES ON THE MAS SCREEN IN PTF LOAD/EDIT ; AUG 1 1989@1200 "RTN","DGPTFM0",2,0) ;;5.3;Registration;**510,517**;Aug 13, 1993 "RTN","DGPTFM0",3,0) ;;ADL;;Update for CSV Project;;Mar 25, 2003 "RTN","DGPTFM0",4,0) EN S I=0 K P F I1=1:1 S I=$O(^DGPT(PTF,"P",I)) Q:I'>0 S P(I1)=^(I,0),P(I1,1)=I "RTN","DGPTFM0",5,0) S P2=0,(L6,P)=0 F J=ST:2:(I1-1) S NL=1,L5=0,L6=J D PD2 S L5=1,L6=J+1 D:$D(P(L6)) PD2 D PD G PRO1^DGPTFM:$Y>11 W ! "RTN","DGPTFM0",6,0) G PRO^DGPTFM "RTN","DGPTFM0",7,0) PD F J1=1:1:5 S L=$P(P(J),U,J1+4),L1=0,L3=1 D:+L PD1 S L1=1,L=$S($D(P(J+1)):$P(P(J+1),U,J1+4),1:"") D:+L PD1 "RTN","DGPTFM0",8,0) Q "RTN","DGPTFM0",9,0) PD1 S DGPTTMP=$$ICDOP^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)),L2=$S(+DGPTTMP>0:$P(DGPTTMP,U,2,99),1:""),P2=P2+1,L4=$P(L2,"^",1),L4=L4_$E(" ",1,3-$L($P(L4,".",2))) D Q "RTN","DGPTFM0",10,0) . W:L3 ! S:L3 L3=0 W ?L1*40,$J(P2,3)," ",$J(L4,7)," ",$E($P(L2,U,4),1,25) K P2(P2) S P2(P2)=J+L1_U_J1 "RTN","DGPTFM0",11,0) PD2 S Y=+P(L6) D D^DGPTUTL W:NL ! S:NL NL=0 W ?L5*40,L6,"-Procedure date: ",Y "RTN","DGPTFM0",12,0) Q "RTN","DGPTFM0",13,0) PRC K DGZSER,DGZDIAG,DGZPRO S DGZSUR=1,J=-1 G PRO1^DGPTFM:$Y>11 K P1,P2 S ST=1,P2=0 "RTN","DGPTFM0",14,0) S ST=1 G EN "RTN","DGPTFM0",15,0) ; "RTN","DGPTFM0",16,0) C ; -- help for surgery "RTN","DGPTFM0",17,0) W !!,"Enter the item #'s of the operation codes, 1-",S2,", that you wish to delete:" "RTN","DGPTFM0",18,0) F L=1:1:S2 Q:'$D(S2(L)) I $D(S(+S2(L),1)),$D(^DGPT(PTF,"S",+S(+S2(L),1),0)) S DGPTTMP=$$ICDOP^ICDCODE(+$P(^(0),"^",7+$P(S2(L),"^",2)),$$GETDATE^ICDGTDRG(PTF)) I +DGPTTMP>0 D "RTN","DGPTFM0",19,0) . W !?5,$J(L,2),": ",$J($P(DGPTTMP,"^",2),7)," - ",$E($P(DGPTTMP,"^",5),1,40) "RTN","DGPTFM0",20,0) Q "RTN","DGPTFM0",21,0) ; "RTN","DGPTFM0",22,0) DX ; -- help for dx's "RTN","DGPTFM0",23,0) W !!,"Enter the item #'s of the diagnoses, 1-",M2,", that you wish to delete:" "RTN","DGPTFM0",24,0) S UTL="^UTILITY($J,""M2"")" "RTN","DGPTFM0",25,0) F L=1:1:M2 Q:'$D(@UTL@(L)) I $D(^DGPT(PTF,"M",+@UTL@(L),0)) S DGPTTMP=$$ICDDX^ICDCODE(+$P(^(0),"^",4+$P(@UTL@(L),"^",2)),$$GETDATE^ICDGTDRG(PTF)) I +DGPTTMP>0 D "RTN","DGPTFM0",26,0) . W !?5,$J(L,2),": ",$J($P(DGPTTMP,"^",2),7)," - ",$E($P(DGPTTMP,"^",4),1,40) "RTN","DGPTFM0",27,0) K UTL,L Q "RTN","DGPTFM0",28,0) ; "RTN","DGPTFM0",29,0) Q ; -- help for procedure "RTN","DGPTFM0",30,0) W !!,"Type the number of the procedure - not the procedure code -" "RTN","DGPTFM0",31,0) W !,"for the procedure you wish to delete.",! "RTN","DGPTFM0",32,0) W !,"However, this deletion function is not applicable" "RTN","DGPTFM0",33,0) W !,"for procedures listed under 'Procedure date:' displays." "RTN","DGPTFM0",34,0) W !,"Delete these codes using the 601 screen functionality." "RTN","DGPTFM0",35,0) Q "RTN","DGPTFM0",36,0) ; "RTN","DGPTFM0",37,0) D G DEL:Z "RTN","DGPTFM0",38,0) I $D(M2),'M2 W !,"No codes to delete",! H 2 G ^DGPTFM "RTN","DGPTFM0",39,0) D1 R !!,"Enter the item #'s of the ICD Diagnosis codes to delete: ",A1:DTIME "RTN","DGPTFM0",40,0) I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D DX G D1 "RTN","DGPTFM0",41,0) S A=A_A1 "RTN","DGPTFM0",42,0) DEL D EXPL^DGPTUTL "RTN","DGPTFM0",43,0) K X,A1 S DIE="^DGPT("_PTF_",""M"",",DA(1)=PTF W !! "RTN","DGPTFM0",44,0) F J=1:1 S DP=45.02,L=+$P(DGA,",",J) Q:'L S L1=$S($D(^UTILITY($J,"M2",L)):^(L),1:"Undefined, ") W:'L1 " ",L,"-",L1 I L1 S DA=+L1,DR=4+$P(L1,U,2)_"///@",DA(1)=PTF D ^DIE K DR W " ",L,"-Deleted, " W:$X>70 ! "RTN","DGPTFM0",45,0) S DGPTF=PTF,DGMOV=+L1 D CHK501^DGPTSCAN "RTN","DGPTFM0",46,0) H 2 G ^DGPTFM "RTN","DGPTFM0",47,0) ; "RTN","DGPTFM1") 0^17^B19596855 "RTN","DGPTFM1",1,0) DGPTFM1 ;ALB/MTC - MASTER DIAG/OP/PRO CODE ENTER/EDIT ; 11 MAR 91 "RTN","DGPTFM1",2,0) ;;5.3;Registration;**114,517**;Aug 13, 1993 "RTN","DGPTFM1",3,0) ; "RTN","DGPTFM1",4,0) D G D^DGPTFM0 "RTN","DGPTFM1",5,0) ; "RTN","DGPTFM1",6,0) A S L="" F I=1:1:PM S L2=1 F J=5:1:9 I L2&(J'=10)&($P(M(I),U,J)="") S L=L_I_",",L2=0 "RTN","DGPTFM1",7,0) I L="" W !!,"There are no movement records that can be added to.",*7,*7 H 2 G ^DGPTFM "RTN","DGPTFM1",8,0) S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G A2 "RTN","DGPTFM1",9,0) A1 I 'Z W !!,"Add to movement record <",L,"> : " R RC:DTIME G ^DGPTFM:RC[U!('$T)!(RC="") "RTN","DGPTFM1",10,0) E S RC=+$E(A,2,99) "RTN","DGPTFM1",11,0) A2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the movement record number to add ICD diagnosis to: ",L S Z="" G A1 "RTN","DGPTFM1",12,0) S DIE="^DGPT(",(DA,DGPTF)=PTF,DR="[DG501]",DGJUMP="" "RTN","DGPTFM1",13,0) S DGMOV=+M(RC),DGADD=1 D ^DIE K DR,DA,DGADD,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV,DGADD "RTN","DGPTFM1",14,0) G ^DGPTFM "RTN","DGPTFM1",15,0) ; "RTN","DGPTFM1",16,0) M I DGPTFE G ADD^DGPTFM4 "RTN","DGPTFM1",17,0) S X=80 X ^%ZOSF("RM") D MVT K T,AM,M I $L(DGVO_DGVI)>4 S X=132 X ^%ZOSF("RM") "RTN","DGPTFM1",18,0) G ^DGPTFM:'$D(DGPMDA) S DA=$S('$D(^DGPM(DGPMDA,"PTF")):"",1:$P(^("PTF"),"^",3)) G ^DGPTFM:'$D(^DGPT(PTF,"M",+DA,0)) S Y=^(0) "RTN","DGPTFM1",19,0) S X=$S($D(^DIC(42.4,+$P(Y,U,2),0)):$P(^(0),U,1),1:""),Y=$P(Y,U,10) "RTN","DGPTFM1",20,0) D D^DGPTUTL K M W !,"Editing ",$S(DA=1:"Discharge ",1:""),"Movement " W:Y]"" "of ",Y W " Losing Specialty ",X "RTN","DGPTFM1",21,0) S DGMOV=DA,(DA,DGPTF)=PTF,DIE="^DGPT(",DR="[DG501]",DGJUMP="1-2" D ^DIE "RTN","DGPTFM1",22,0) K DA,DR,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV "RTN","DGPTFM1",23,0) ;- update MT indicator after edit movement "RTN","DGPTFM1",24,0) N DGPMCA,DGPMAN D PM^DGPTUTL "RTN","DGPTFM1",25,0) I '$G(DGADM) S DGADM=+^DGPT(PTF,0) "RTN","DGPTFM1",26,0) D MT^DGPTUTL "RTN","DGPTFM1",27,0) G ^DGPTFM "RTN","DGPTFM1",28,0) ; "RTN","DGPTFM1",29,0) Z I 'SU W !,"No surgeries to delete",! H 3 G ^DGPTFM "RTN","DGPTFM1",30,0) S ST=1 I 'Z W !!,"Delete surgery record <1",$S(SU=1:"",1:"-"_SU),">: " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="") "RTN","DGPTFM1",31,0) E S RC=$E(A,2,99) W ! "RTN","DGPTFM1",32,0) I +RC'=RC!('$D(S(RC))) W !!,"Enter the record # to delete from the PTF file, 1",$S(SU=1:"",1:"-"_SU) S Z=0 G Z "RTN","DGPTFM1",33,0) K DA S DIK="^DGPT("_PTF_",""S"",",ST=1,(DGPTF,DA(1))=PTF,(DGSUR,DA)=+S(RC,1) D ^DIK K DA W " ",RC,"-DELETED***" D CHK401^DGPTSCAN K DGPTF,DGSUR H 2 G ^DGPTFM "RTN","DGPTFM1",34,0) ; "RTN","DGPTFM1",35,0) C G CEL:Z "RTN","DGPTFM1",36,0) I '$D(S2) W !,"View codes first",! H 2 G ^DGPTFM "RTN","DGPTFM1",37,0) I 'S2 W !,"No codes to delete",! H 2 G ^DGPTFM "RTN","DGPTFM1",38,0) C1 R !!,"Enter the item #'s of the ICD operation codes to delete: ",A1:DTIME "RTN","DGPTFM1",39,0) S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D C^DGPTFM0 G C1 "RTN","DGPTFM1",40,0) S A=A_A1 "RTN","DGPTFM1",41,0) CEL D EXPL^DGPTUTL "RTN","DGPTFM1",42,0) K X,A1 S DIE="^DGPT("_PTF_",""S"",",DA(1)=PTF W !! "RTN","DGPTFM1",43,0) F J=1:1 S DP=45.01,L=+$P(DGA,",",J) Q:'L S L1=$S($D(S2(L)):S2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1 I L1 S (DA,DGSUR)=+S(+L1,1),(DA(1),DGPTF)=PTF,DR=7+$P(S2(+L),U,2)_"///@" D ^DIE,CEL1 "RTN","DGPTFM1",44,0) H 3 S ST=1 G ^DGPTFM "RTN","DGPTFM1",45,0) ; "RTN","DGPTFM1",46,0) CEL1 ; "RTN","DGPTFM1",47,0) K DR W " ",L,"-Deleted, " W:$X>70 ! D CHK401^DGPTSCAN K DGPTF,DGSUR "RTN","DGPTFM1",48,0) Q "RTN","DGPTFM1",49,0) ; "RTN","DGPTFM1",50,0) O S L="" F I=1:1:SU S L2=1 F J=8:1:12 I L2,$P(S(I),U,J)="" S L=L_I_",",L2=0 "RTN","DGPTFM1",51,0) I L="" W !!,"There are no surgery records that can be added to.",*7 H 2 S ST=1 G ^DGPTFM "RTN","DGPTFM1",52,0) S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G O2 "RTN","DGPTFM1",53,0) O1 I 'Z S ST=1 W !!,"Add to surgery record <",L,"> : " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="") "RTN","DGPTFM1",54,0) E S RC=+$E(A,2,99) "RTN","DGPTFM1",55,0) O2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the surgery record number to add ICD operation codes to: ",L G O1:'Z S Z="" G O1 "RTN","DGPTFM1",56,0) S DIE="^DGPT(",(DGPTF,DA)=PTF,DR="[DG401]" "RTN","DGPTFM1",57,0) S ST=1,DGZS0=RC,DGADD=1,DGSUR=S(DGZS0,1) D ^DIE,CHK401^DGPTSCAN K DR,DGPTF,DGSUR,DGADD G ^DGPTFM "RTN","DGPTFM1",58,0) ; "RTN","DGPTFM1",59,0) S G ADD^DGPTFM5 "RTN","DGPTFM1",60,0) V S DGZM0=0 G ^DGPTFM4 "RTN","DGPTFM1",61,0) J S DGZS0=0 G ^DGPTFM5 "RTN","DGPTFM1",62,0) Q G QEL:Z "RTN","DGPTFM1",63,0) QQ R !!,"Enter the item #'s of the ICD Procedure codes to delete: ",A1:DTIME "RTN","DGPTFM1",64,0) S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D Q^DGPTFM0 G QQ "RTN","DGPTFM1",65,0) S A=A_A1 "RTN","DGPTFM1",66,0) QEL S DGA=$E(A,2,999) K X,A1 S DIE="^DGPT(",DA=PTF W !! "RTN","DGPTFM1",67,0) F J=1:1 S DP=45,L=+$P(DGA,",",J) Q:'L S L1=$S($D(P2(L)):P2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1 I L1 S DR=+P2(+L)/100+45_"///@",DA(1)=PTF D ^DIE K DR W " ",L,"-Deleted, " W:$X>70 ! "RTN","DGPTFM1",68,0) H 2 G ^DGPTFM "RTN","DGPTFM1",69,0) ; "RTN","DGPTFM1",70,0) P G P^DGPTFM6 "RTN","DGPTFM1",71,0) Q1 Q "RTN","DGPTFM1",72,0) T G ^DGPTFM6 "RTN","DGPTFM1",73,0) R G R^DGPTFM4 "RTN","DGPTFM1",74,0) E I $D(^DGPT(PTF,70)),+^(70)>2871000 D MOB^DGPTFM6 G SET^DGPTFM6 "RTN","DGPTFM1",75,0) I DT>2871000 D MOB^DGPTFM6 G SET^DGPTFM6 "RTN","DGPTFM1",76,0) G ^DGPTFM6 "RTN","DGPTFM1",77,0) ; "RTN","DGPTFM1",78,0) MVT ; "RTN","DGPTFM1",79,0) N PTF,DGPMAN "RTN","DGPTFM1",80,0) S DGPMT=6 D CA^DGPMV S DGPMDA=+Y "RTN","DGPTFM1",81,0) K DGPMT Q "RTN","DGPTFM1",82,0) I G ADD^DGPTFM2 "RTN","DGPTFM1",83,0) Y G DEL^DGPTFM2 "RTN","DGPTFM1",84,0) N G N^DGPTFM2 "RTN","DGPTFM1",85,0) G G DC^DGPTFM2 "RTN","DGPTFM1",86,0) F G F^DGPTFM2 "RTN","DGPTFM1A") 0^19^B7332308 "RTN","DGPTFM1A",1,0) DGPTFM1A ;ALB/JDS - MASTER DIAG/OP/PRO CODE HELP ; 09 AUG 8 14:32 "RTN","DGPTFM1A",2,0) ;;5.3;Registration;**517**;Aug 13, 1993 "RTN","DGPTFM1A",3,0) ; "RTN","DGPTFM1A",4,0) HELP W !!,"Enter ",?10,"'D'-To delete an ICD diagnosis",!?10,"'A'-To add an ICD diagnosis",!?10 W:DGPTFE "'M'-To add a new patient movement",!?10,"'X'-To delete a patient movement" "RTN","DGPTFM1A",5,0) W:'DGPTFE "'M'-To edit treating specialty transfers which generate",!,?14,"patient movements" "RTN","DGPTFM1A",6,0) W !?10,"'C'-To delete a ICD op code",!?10,"'O'-To add an ICD op code",!?10,"'S'-To add a new surgery record",!?10,"'Z'-To delete a surgery record" "RTN","DGPTFM1A",7,0) W !?10,"'Q'-To delete a ICD procedure code",!?10,"'P'-To add a new ICD procedure code",!?10,"'T'-To add a new procedure record",!?10,"'R'-To delete a procedure record",!?10,"'E'-To review all procedure segments" "RTN","DGPTFM1A",8,0) W !?10,"'V'-To review all patient movements",!?10,"'J'-To review all surgery segments" "RTN","DGPTFM1A",9,0) W !?10,"'^' to abort",!?10," to continue on to the next screen",! "RTN","DGPTFM1A",10,0) W !,"The delete codes (D,C,Q) may be followed by the numbers that are before the",!,"ICD codes, separated by commas. ('D1,2,8' to delete ICD diagnoses 1,2 and 8",!,"if they were on the screen above)" "RTN","DGPTFM1A",11,0) R !!,"Enter to continue: ",ANS:DTIME K ANS G ^DGPTFM "RTN","DGPTFM2") 0^18^B74512082 "RTN","DGPTFM2",1,0) DGPTFM2 ;DWS - MASTER PROFESSIONAL SERVICE ENTER/EDIT ; 2/26/04 1:15pm "RTN","DGPTFM2",2,0) ;;5.3;Registration;**517**; Aug 13, 1993 "RTN","DGPTFM2",3,0) ADD ;ADD CPT RECORD "RTN","DGPTFM2",4,0) N DGZP S DGZP=0 S:'$D(^DGPT(PTF,"C",0)) ^(0)="^45.06D^^" "RTN","DGPTFM2",5,0) S DIC="^DGPT("_PTF_",""C"",",DIC(0)="AELQMZ",DA(1)=PTF,DLAYGO=45,DIC("S")="D SCR^DGPTFM2" "RTN","DGPTFM2",6,0) D ^DIC K DIC,DLAYGO G ^DGPTFM:Y'>0,^DGPTFM:'$D(^DGPT(PTF,"C",+Y)) "RTN","DGPTFM2",7,0) S DGPSM=+Y D MOB I $P(DGZPRF,U,3) F I=1:1:$P(DGZPRF,U,3) S:DGZPRF(I,0)=DGPSM DGZP=I "RTN","DGPTFM2",8,0) K I G:'DGZP ^DGPTFM S X="1,2" "RTN","DGPTFM2",9,0) ED G HELP:X<1!(X>2) K DA S DGJUMP=X,DGPRD=+DGZPRF(DGZP) "RTN","DGPTFM2",10,0) I X[1 D I FLAG D MOB,REQ^DGPTFM3 H 2 K DGPSM G ^DGPTFM "RTN","DGPTFM2",11,0) .S DA(1)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,REC)=DGZPRF(DGZP,0) "RTN","DGPTFM2",12,0) .S DR=".01;.02;.03;.05" D PTFDIE S FLAG=$D(Y)>9!$D(DTOUT)!'$D(DA) "RTN","DGPTFM2",13,0) .Q:'$D(DA) "RTN","DGPTFM2",14,0) .S DGPRD=+^DGPT(PTF,"C",DGZPRF(DGZP,0),0) Q:+DGZPRF(DGZP)=DGPRD "RTN","DGPTFM2",15,0) .S DGI=0 F S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0 D "RTN","DGPTFM2",16,0) ..Q:+^DGCPT(46,DGI,1)'=+DGZPRF(DGZP) Q:$D(^(9)) "RTN","DGPTFM2",17,0) ..S DR=".14////"_DGPRD,(DA,REC)=DGI,DIE="^DGCPT(46," D FMDIE "RTN","DGPTFM2",18,0) .S $P(DGZPRF(DGZP),U)=DGPRD "RTN","DGPTFM2",19,0) I DGJUMP[2 S DGI=0 D CL^SDCO21(DFN,DGPRD,"",.SDCLY) D "RTN","DGPTFM2",20,0) .F S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0 I +^DGCPT(46,DGI,1)=+DGZPRF(DGZP),'$G(^(9)) S (DA,REC)=DGI,DR=".01;",DIE="^DGCPT(46," D GETINFO "RTN","DGPTFM2",21,0) .F S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELMQZ",DLAYGO=46,DIC("S")="D EN6^DGPTFJC I 'DGER" D ^DIC Q:Y'>0 D SED "RTN","DGPTFM2",22,0) K DR,DIE,DIC,DA,DGI,DGJUMP,DGPRD,DLAYGO,XREF D REQ^DGPTFM3,MOB H:RFL 2 K RFL "RTN","DGPTFM2",23,0) G ^DGPTFM:'$D(DGZPRF(DGZP,0)),^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(DGZP,0))) "RTN","DGPTFM2",24,0) SET D MOB:'$D(DGZPRF) S:'$D(DGZP) DGZP=1 I $G(DGZPRF(DGZP,0))="" K DGZPRF(DGZP) G NEXP "RTN","DGPTFM2",25,0) WRT G ^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(DGZP,0),0)) S J=DGZP W @IOF,HEAD,?68 "RTN","DGPTFM2",26,0) N DGNUM S Z="<801-"_DGZP_">" W @DGVI,Z,@DGVO,!! S Y=+DGZPRF(J),Z=1 D D^DGPTUTL,Z^DGPTFM5 W ?5,"CPT Record Date/Time: ",Y "RTN","DGPTFM2",27,0) I $P(DGZPRF(J),U,2) W !,?5,"Referring or Ordering Provider: " S L=$P(DGZPRF(J),U,2) D PRV "RTN","DGPTFM2",28,0) W !,?5,"Rendering Provider: " S L=$P(DGZPRF(J),U,3) D PRV "RTN","DGPTFM2",29,0) I $P(DGZPRF(J),U,5) W !,?5,"Rendering Location: ",$P($G(^SC($P(DGZPRF(J),U,5),0)),U) "RTN","DGPTFM2",30,0) W !! S Z=2 D Z^DGPTFM5 W " Procedures: " "RTN","DGPTFM2",31,0) F K=$P(DGZPRF,U,2):1 Q:'$D(DGZPRF(J,K)) I '$D(DGZPRF(J,K,9)) W ?5 D CPT W ! Q:$Y>16 "RTN","DGPTFM2",32,0) F I=1:1:(IOSL-$Y-5) W ! "RTN","DGPTFM2",33,0) K I,J,K,L,Z S DGNUM=$S($D(DGZPRF(DGZP+1)):801_"-"_(DGZP+1),1:"MAS") G 801^DGPTFJC:DGST "RTN","DGPTFM2",34,0) S DIR("A")="Enter to continue, 1-2 to edit, 'I' to add a CPT Segment"_$C(10,13)_"'^N' for screen N, or '^' to abort:" "RTN","DGPTFM2",35,0) S DIR(0)="F^OU",DIR("B")=DGNUM D ^DIR "RTN","DGPTFM2",36,0) K DIR G:$D(DIRUT) Q^DGPTF:X="^" "RTN","DGPTFM2",37,0) I X?1"^".E S DGPTSCRN=801 G ^DGPTFJ "RTN","DGPTFM2",38,0) I X="MAS" S DGZP=1 G ^DGPTFM "RTN","DGPTFM2",39,0) G ADD:X="I"!(X="i"),HELP:X["?" "RTN","DGPTFM2",40,0) I X=DGNUM G NEXP "RTN","DGPTFM2",41,0) I X[1!(X[2) G ED "RTN","DGPTFM2",42,0) G HELP "RTN","DGPTFM2",43,0) NEXP S DGZP=DGZP+1 I '$D(DGZPRF(DGZP)) K DGPSM W:DGZP=2 !,"NO PROF. SERVICES TO EDIT." H 2 S DGZP=1 G ^DGPTFM "RTN","DGPTFM2",44,0) G SET "RTN","DGPTFM2",45,0) HELP W !,"Enter '^' to stop display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen as )",!," to continue on to next screen or 1-2 to edit:" "RTN","DGPTFM2",46,0) W !?10,"1-Professional service information",!,?10,"2-Procedure codes",!,"You may also enter any combination of the above, separated by commas (ex:1,2)",! "RTN","DGPTFM2",47,0) R !!,"Enter : ",X:DTIME G WRT "RTN","DGPTFM2",48,0) DEL ;DELETE A CPT RECORD "RTN","DGPTFM2",49,0) I '$P(DGZPRF,U,3) G NOPROC "RTN","DGPTFM2",50,0) ASK S DIR("A")="Select CPT record to Delete <1 - "_$P(DGZPRF,U,3)_">",DIR(0)="NO^^K:X<1!(X>"_$P(DGZPRF,U,3)_") X" "RTN","DGPTFM2",51,0) D ^DIR K DIR G ^DGPTFM:$D(DIRUT),^DGPTFM:'Y,^DGPTFM:'$D(^DGPT(PTF,"C",DGZPRF(Y,0),0)) S DGPROC=Y,Y=+^(0) D D^DGPTUTL "RTN","DGPTFM2",52,0) S DIR("A")="Are you sure you want to delete the entire CR for "_Y "RTN","DGPTFM2",53,0) S DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G ^DGPTFM:'Y S DGI=0 D NOW^%DTC "RTN","DGPTFM2",54,0) F S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0 D:+^DGCPT(46,DGI,1)=+DGZPRF(DGPROC)&'$G(^(9)) "RTN","DGPTFM2",55,0) .S (DA,REC)=DGI,DIE="^DGCPT(46,",DR="1////^S X=%" D FMDIE "RTN","DGPTFM2",56,0) W !!,"CPT Records....Deleted" H 2 "RTN","DGPTFM2",57,0) K DIK,DA,DGI,DGPROC,DGPSM,DGPNUM,Y D MOB G ^DGPTFM "RTN","DGPTFM2",58,0) NOPROC W !!,*7,"No procedures to delete",! H 3 G ^DGPTFM "RTN","DGPTFM2",59,0) N ;ADD CPT CODES TO CPT RECORD "RTN","DGPTFM2",60,0) I '$P(DGZPRF,U,3) W !!,"There are no CPT records that can be added to.",*7 H 2 G ^DGPTFM "RTN","DGPTFM2",61,0) P1 S DIR("A")="Add to CPT record ",DIR(0)="N^1:"_$P(DGZPRF,U,3) D ^DIR K DIR G ^DGPTFM:'Y "RTN","DGPTFM2",62,0) S DGZP=Y,DGI=0,DGPRD=+DGZPRF(DGZP) D CL^SDCO21(DFN,DGPRD,"",.SDCLY) "RTN","DGPTFM2",63,0) S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELQMZ",DLAYGO=46,DIC("S")="D EN6^DGPTFJC I 'DGER" "RTN","DGPTFM2",64,0) D ^DIC K DIC,DLAYGO D:Y>0 SED,MOB,REQ^DGPTFM3 K DGPRD,Y G ^DGPTFM "RTN","DGPTFM2",65,0) DC ;DELETE A CPT PROCEDURE "RTN","DGPTFM2",66,0) I '$D(PS2) W !!,"Must display CPT procedures before choosing delete.",*7 H 2 G ^DGPTFM "RTN","DGPTFM2",67,0) QQ S DIR("A")="Select CPT code to Delete <1 - "_PS2_">",DIR(0)="NO^^K:X<1!(X>"_PS2_") X" D ^DIR K DIR G ^DGPTFM:$D(DIRUT),^DGPTFM:'Y "RTN","DGPTFM2",68,0) S A1=Y,CPT=+DGZPRF(+PS2(A1),$P(PS2(A1),U,2)) "RTN","DGPTFM2",69,0) S DIR("A")="Are you sure you want to delete CPT code '" "RTN","DGPTFM2",70,0) I $D(^ICPT(CPT)) S DIR("A")=DIR("A")_$P(^(CPT,0),U)_" "_$P(^(0),U,2)_"'" "RTN","DGPTFM2",71,0) E S DIR("A")=DIR("A")_CPT_" UNKNOWN" "RTN","DGPTFM2",72,0) S DIR(0)="Y",DIR("B")="No" D ^DIR K DIR G ^DGPTFM:'Y "RTN","DGPTFM2",73,0) QEL D NOW^%DTC S (DA,REC)=DGZPRF(+PS2(A1),$P(PS2(A1),U,2),0),DR="1////^S X=%" "RTN","DGPTFM2",74,0) S DIE="^DGCPT(46," D FMDIE K A1,DR W !!,"CPT Code....Deleted" W:$X>70 ! D MOB H 2 G ^DGPTFM "RTN","DGPTFM2",75,0) F D MOB G SET "RTN","DGPTFM2",76,0) MOB S I=0,N=0 K DGZPRF F M=1:1:6 S:$D(SDCLY(M)) N=N+1 "RTN","DGPTFM2",77,0) F I2=1:1 S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 S DGZPRF(I2)=^(I,0),DGZPRF(I2,0)=I,(K,K1)=0,F=1 D "RTN","DGPTFM2",78,0) .F S K=$O(^DGCPT(46,"C",PTF,K)),L=N+1\2+3 Q:K'>0 I +DGZPRF(I2)=+$G(^DGCPT(46,K,1)),'$G(^DGCPT(46,K,9)) D "RTN","DGPTFM2",79,0) ..S K1=K1+1,DGZPRF(I2,K1)=^(0),DGZPRF(I2,K1,0)=K,F=0 "RTN","DGPTFM2",80,0) ..F M=2,3,5,6,7,15,16,17,18 S:$P(DGZPRF(I2,K1),U,M) L=L+1 "RTN","DGPTFM2",81,0) ..S DGZPRF(I2,K1,1)=L "RTN","DGPTFM2",82,0) .I F,$G(DGPSM)'=DGZPRF(I2,0) K DGZPRF(I2) S I2=I2-1 "RTN","DGPTFM2",83,0) S DGZPRF="1^1^"_(I2-1) K F,I,K,K1,N Q "RTN","DGPTFM2",84,0) PRV I $D(^VA(200,L,0)) W $P(^(0),U) Q "RTN","DGPTFM2",85,0) W L Q "RTN","DGPTFM2",86,0) CPT ;DISPLAY CPT CODES AND MODIFIERS "RTN","DGPTFM2",87,0) S CPT=+DGZPRF(J,K),N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF)),N=$S(N>0:$P(N,U,2,99),1:"") "RTN","DGPTFM2",88,0) W $P(N,U)," ",$P(N,U,2) "RTN","DGPTFM2",89,0) F I=1,2 S MOD=$P(DGZPRF(J,K),U,I+1) D MOD:MOD "RTN","DGPTFM2",90,0) W !,?7,"Quantity: ",$P(DGZPRF(J,K),U,14) K I,MOD,N Q "RTN","DGPTFM2",91,0) MOD S N=$$MOD^ICPTMOD(MOD,"I",$$GETDATE^ICDGTDRG(PTF)) W !,?7,"CPT Modifier ",I,":",$P(N,U,2)," ",$P(N,U,3) "RTN","DGPTFM2",92,0) Q "RTN","DGPTFM2",93,0) PDT I Y<1 K X W !,"Please enter the date and time.",*7 Q "RTN","DGPTFM2",94,0) I $S($D(^DGPT(PTF,0)):Y<$P(^(0),U,2),1:0)!$S($D(^DGPT(PTF,70)):Y>^(70)&^(70),1:0) W !,"The date/time must be between the Admission Date/Time and Discharge Date/Time",*7 K X "RTN","DGPTFM2",95,0) Q "RTN","DGPTFM2",96,0) SDR ;SET DR ARRAY CPT MODIFIERS 1 AND 2 "RTN","DGPTFM2",97,0) S DR=DR_"S:'$$CODM^ICPTCOD($P(^DGCPT(46,D0,0),U),,,+DGZPRF(DGZP)) Y=""@10"";" "RTN","DGPTFM2",98,0) S DR=DR_".02;S:$P(^DGCPT(46,D0,0),U,2,3)?.""^"" Y=""@10"";.03;@10;.2//1;" "RTN","DGPTFM2",99,0) Q ;Exit SDR "RTN","DGPTFM2",100,0) SDR2(DGN) ;Set up DR variable to prompt for DGN Codes "RTN","DGPTFM2",101,0) S DR=DGN/100_";" "RTN","DGPTFM2",102,0) Q ;Exit SDR2 "RTN","DGPTFM2",103,0) CHKDGNS(D0,DGNPC) ;Check to see if there are any more DGN's to edit in a Professional service instance "RTN","DGPTFM2",104,0) S MORE=1 ; Default - more DGN's to process "RTN","DGPTFM2",105,0) I DGNPC=4 S:$P(^DGCPT(46,D0,0),U,4,7)?."^" MORE=0 "RTN","DGPTFM2",106,0) I DGNPC=5 S:$P(^DGCPT(46,D0,0),U,5,7)?."^" MORE=0 "RTN","DGPTFM2",107,0) I DGNPC=6 S:$P(^DGCPT(46,D0,0),U,6,7)?."^" MORE=0 "RTN","DGPTFM2",108,0) I DGNPC=7 S:$P(^DGCPT(46,D0,0),U,7)_$P(^DGCPT(46,D0,0),U,15,18)?."^" MORE=0 "RTN","DGPTFM2",109,0) I DGNPC=21 S:$P(^DGCPT(46,D0,0),U,15,18)?."^" MORE=0 "RTN","DGPTFM2",110,0) I DGNPC=22 S:$P(^DGCPT(46,D0,0),U,16,18)?."^" MORE=0 "RTN","DGPTFM2",111,0) I DGNPC=23 S:$P(^DGCPT(46,D0,0),U,17,18)?."^" MORE=0 "RTN","DGPTFM2",112,0) I DGNPC=24 S:$P(^DGCPT(46,D0,0),U,18)?."^" MORE=0 "RTN","DGPTFM2",113,0) Q MORE ;exit w/flag "RTN","DGPTFM2",114,0) SCI(IEN) Q:'$D(SDCLY) ;Pass the ien of the DGN code being processed "RTN","DGPTFM2",115,0) N NODE,I,SCINUM "RTN","DGPTFM2",116,0) F I=2,8,3:1:7 D ;Go thru the SCI's "RTN","DGPTFM2",117,0) . S SCINUM=$S(I=2:I+1,((I=3)!(I=4)):I-2,1:I-1) "RTN","DGPTFM2",118,0) . I $G(SDCLY(SCINUM,IEN))=1 Q ;If the SCI has already been asked for the DGN (ien) don't ask again "RTN","DGPTFM2",119,0) . S:I=6 DR=DR_"@30;" "RTN","DGPTFM2",120,0) . I $D(SDCLY(SCINUM)) S DR=DR_(I/100)_";",(DA,D)=$G(XREF(IEN)),SDCLY(SCINUM,IEN)=1 D:I=2&$O(SDCLY(1))!$D(SDCLY(1))!$D(SDCLY(2)) ;add prompt for SCI Y/N "RTN","DGPTFM2",121,0) . . I I<6 S DR=DR_"S:$P(^DGICD9(46.1,DA,0),U,2) Y=""@30"";" "RTN","DGPTFM2",122,0) K I "RTN","DGPTFM2",123,0) Q ;SCI "RTN","DGPTFM2",124,0) SED S DR=".14////"_DGPRD_";.16////"_PTF_";",(DA,REC)=+Y,DIE="^DGCPT(46," D GETINFO Q "RTN","DGPTFM2",125,0) FMDIE ;Prompt user for questions and file answers (using DIE) "RTN","DGPTFM2",126,0) L +^DGCPT(46,REC):2 I D ^DIE L -^DGCPT(46,REC) Q "RTN","DGPTFM2",127,0) ERR W !,"CPT Record is being edited by another user" K DIE,REC S ERRFLG=1 H 2 Q "RTN","DGPTFM2",128,0) PTFDIE L +^DGPT(45,REC):2 I D ^DIE L -^DGPT(45,REC) K DIE,REC Q "RTN","DGPTFM2",129,0) K DIE,REC G ERR "RTN","DGPTFM2",130,0) ICDDIE L +^DGICD9(46.1,REC):2 I D ^DIE L -^DGICD9(46.1,REC) Q "RTN","DGPTFM2",131,0) K DIE,REC G ERR "RTN","DGPTFM2",132,0) SCR S F=1,I=0,D=+^(0) F S I=$O(^DGCPT(46,"C",PTF,I)) Q:I'>0 I +^DGCPT(46,I,1)=D S F='$G(^(9)) "RTN","DGPTFM2",133,0) I F "RTN","DGPTFM2",134,0) Q "RTN","DGPTFM2",135,0) GETINFO ;GET PROCEDURE CODE INFORMATION "RTN","DGPTFM2",136,0) N NOKILL,EXITFLAG,DGNIEN "RTN","DGPTFM2",137,0) S NOKILL=1,EXITFLG=0,ERRFLG=0 "RTN","DGPTFM2",138,0) D ICDINFO^DGAPI(DFN,PTF) ;gather all DGN codes for the patient "RTN","DGPTFM2",139,0) D XREF "RTN","DGPTFM2",140,0) D SDR,FMDIE ;prompt for CPT Code and modifiers "RTN","DGPTFM2",141,0) I $G(ERRFLG)=1 Q ;cannot lock REC in DGCPT - exit "RTN","DGPTFM2",142,0) S DR="" F PIECE=4:1:7,21:1:24 S:PIECE=24 NOKILL=0 D Q:EXITFLG ;Go thru all existing DGN's in DGCPT file "RTN","DGPTFM2",143,0) . D SDR2(PIECE),FMDIE I ('$$CHKDGNS(DA,PIECE))!($D(Y)>9)!($D(DTOUT)) S EXITFLG=1 Q ;Promt w/existing DGN cd if it exists "RTN","DGPTFM2",144,0) . S DR="",SAVDA=DA,SAVDIE=DIE,DGNIEN=$P(^DGCPT(46,DA,0),U,$S(PIECE<20:PIECE,1:PIECE-6)) Q:DGNIEN="" "RTN","DGPTFM2",145,0) . I '$D(XREF(DGNIEN)) D ;the IEN to be added has not yet been defined in DGICD9, it must be added before proceeding "RTN","DGPTFM2",146,0) . . K DO S DIC="^DGICD9(46.1,",DIC(0)="LMZ",DLAYGO=46,X=DGNIEN D FILE^DICN I Y<0 S ERRFLG=1 "RTN","DGPTFM2",147,0) . . I 'ERRFLG S XREF(DGNIEN)=+Y ; setup info to build "B" xref in DGICD9 for new entry "RTN","DGPTFM2",148,0) . I ERRFLG S EXITFLG=1 Q ;could not add new DGN ien to DGICD9 - exit loop with error "RTN","DGPTFM2",149,0) . D SCI(DGNIEN):0 S UPDTD=0,(DA,REC)=XREF(DGNIEN) ;determine if any SCI prompts should be done for this DGN "RTN","DGPTFM2",150,0) . K ^TMP("PTF",$J) ;Clean up TMP file to pass info to be filed in 46.1 "RTN","DGPTFM2",151,0) . S DIE="^DGICD9(46.1,",DR="[DG801]" ;SCI flags to be stored in file 46.1 "RTN","DGPTFM2",152,0) . I DR'="" D ICDDIE S DR="",UPDTD=1 ;prompt for SCI y/n and file in 46.1 "RTN","DGPTFM2",153,0) . I 'UPDTD D "RTN","DGPTFM2",154,0) . . S ^TMP("PTF",$J,46.1,1)="^"_DGNIEN "RTN","DGPTFM2",155,0) . . S X=$$DATA2PTF^DGAPI(DFN,PTF,DGPRD) ;If there were no SCI's prompts, stuff DGN into file 46.1 "RTN","DGPTFM2",156,0) . S DIE=SAVDIE,DA=SAVDA "RTN","DGPTFM2",157,0) K DIR,REC "RTN","DGPTFM2",158,0) Q ;GETINFO "RTN","DGPTFM2",159,0) XREF ;create xref for ^TMP global containing DGICD9 info to have access via DGN IEN in local array XREF "RTN","DGPTFM2",160,0) N SEQ,NODE,INFO,IEN "RTN","DGPTFM2",161,0) K XREF "RTN","DGPTFM2",162,0) S SEQ=0 "RTN","DGPTFM2",163,0) F S SEQ=$O(^TMP("PTF",$J,46.1,SEQ)) Q:'SEQ S INFO=^(SEQ),NODE=+INFO,IEN=$P(INFO,U,2),XREF(IEN)=NODE "RTN","DGPTFM2",164,0) Q ;XREF "RTN","DGPTFM3") 0^23^B7367126 "RTN","DGPTFM3",1,0) DGPTFM3 ;ADL - MASTER CPT RECORD ENTER/EDIT PART 2; 29 AUG 03 ; 2/26/04 1:07pm "RTN","DGPTFM3",2,0) ;;5.3;Registration;**517**; Aug 13, 1993 "RTN","DGPTFM3",3,0) REQ ;CHECK FOR REQUIRED FIELDS IN CPT RECORDS. RECORDS MISSING ONE OR MORE REQUIRED FIELDS ARE DELETED. "RTN","DGPTFM3",4,0) S RFL=0 G REQQ:'$D(DGZPRF(DGZP,0)) "RTN","DGPTFM3",5,0) I '$P(^DGPT(PTF,"C",DGZPRF(DGZP,0),0),U,3) S DA(1)=PTF,DA=DGPSM,DIK="^DGPT("_PTF_",""C""," D G REQQ "RTN","DGPTFM3",6,0) .D ^DIK K DA W !!,"No CPT record has been filed because no performing provider was specified." S RFL=1 "RTN","DGPTFM3",7,0) S (I,FCPT)=0 "RTN","DGPTFM3",8,0) F J=1:1 S I=$O(^DGCPT(46,"C",PTF,I)) Q:'I D:+^DGCPT(46,I,1)=+DGZPRF(DGZP)&'$G(^(9)) "RTN","DGPTFM3",9,0) .I $P(^DGCPT(46,I,0),U,4) S FCPT=1 Q "RTN","DGPTFM3",10,0) .S DA=I,DIK="^DGCPT(46,",CPT=+^DGCPT(46,I,0) D ^DIK "RTN","DGPTFM3",11,0) .W !!,"CPT " S N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF)) W $P(N,U,2)," ",$P(N,U,3)," not filed because no diagnosis 1 was entered." "RTN","DGPTFM3",12,0) .S RFL=1 "RTN","DGPTFM3",13,0) I FCPT K FCPT,I,J,N G REQQ "RTN","DGPTFM3",14,0) S DA(1)=PTF,DA=DGZPRF(DGZP,0),DIK="^DGPT("_PTF_",""C""," "RTN","DGPTFM3",15,0) D ^DIK K DA W !!,"No CPT record has been filed because no CPT codes were filed." S RFL=1 K FCPT,I,J,N "RTN","DGPTFM3",16,0) REQQ D RESEQ(PTF) "RTN","DGPTFM3",17,0) Q ;REQ "RTN","DGPTFM3",18,0) RESEQ(PTF) ;A subroutine to check if a DGN in the DGCPT global has been deleted and the other DGN's need "RTN","DGPTFM3",19,0) ;to be moved down in sequence to fill the "gap" in the global "RTN","DGPTFM3",20,0) N REC,CPTINFO,DGNARAY "RTN","DGPTFM3",21,0) S REC=0 "RTN","DGPTFM3",22,0) F S REC=$O(^DGCPT(46,"C",PTF,REC)) Q:REC="" K DGNARAY S CPTINFO=^DGCPT(46,REC,0) D "RTN","DGPTFM3",23,0) . F J=4:1:7,15:1:18 S DGNARAY(J)=$P(CPTINFO,U,J) "RTN","DGPTFM3",24,0) . I $$CHKGAP(.DGNARAY) D RESEQDGN(.CPTINFO,.DGNARAY) S ^DGCPT(46,REC,0)=CPTINFO "RTN","DGPTFM3",25,0) Q ;RESEQ "RTN","DGPTFM3",26,0) CHKGAP(DGNARAY) ;Function call to determine if an inside DGN code has been deleted "RTN","DGPTFM3",27,0) ;Back up in the DGNARAY array until a non-null DGN ien is found, then continuing backwards, "RTN","DGPTFM3",28,0) ;if a null ien is located, that means that an "inside" DGN was deleted "RTN","DGPTFM3",29,0) S SEQ=999,END=1,MISSING=0 "RTN","DGPTFM3",30,0) F S SEQ=$O(DGNARAY(SEQ),-1) Q:SEQ=""!MISSING D "RTN","DGPTFM3",31,0) . I DGNARAY(SEQ)'="" S END=1 Q "RTN","DGPTFM3",32,0) . I DGNARAY(SEQ)="",END=1 S MISSING=1 "RTN","DGPTFM3",33,0) Q MISSING "RTN","DGPTFM3",34,0) ; "RTN","DGPTFM3",35,0) RESEQDGN(CPTINFO,DGNARAY) ;Subroutine to shift down DGN codes to replace any inside DGN's that were deleted by the user "RTN","DGPTFM3",36,0) ; "RTN","DGPTFM3",37,0) S SEQ="" K NOTNULL "RTN","DGPTFM3",38,0) F S SEQ=$O(DGNARAY(SEQ)) Q:SEQ="" I DGNARAY(SEQ)'="" S NOTNULL(SEQ)=DGNARAY(SEQ) "RTN","DGPTFM3",39,0) K DGNARAY S SEQ="" "RTN","DGPTFM3",40,0) F I=4:1:7,15:1:18 S DGNARAY(I)="" "RTN","DGPTFM3",41,0) F I=4:1:7,15:1:18 S SEQ=$O(NOTNULL(SEQ)) Q:SEQ="" S DGNARAY(I)=NOTNULL(SEQ) "RTN","DGPTFM3",42,0) F I=4:1:7,15:1:18 S $P(CPTINFO,U,I)=$G(DGNARAY(I)) "RTN","DGPTFM3",43,0) K NOTNULL "RTN","DGPTFM3",44,0) Q ;RESEQDGN "RTN","DGPTFQWK") 0^14^B15643450 "RTN","DGPTFQWK",1,0) DGPTFQWK ;ALB/AS - QUICK/LOAD PTF DATA ; 1/15/04 8:46am "RTN","DGPTFQWK",2,0) ;;5.3;Registration;**517**;Aug 13, 1993 "RTN","DGPTFQWK",3,0) ; "RTN","DGPTFQWK",4,0) S (DGPTF,DA)=PTF,DIE="^DGPT(",DR="[DGQWK"_$S('DGPTFE:"]",1:"F]") W !,"* editing 101 & 701 transactions" D ^DIE S DR="[DG701]" D ^DIE W !,"* editing 501 transactions" "RTN","DGPTFQWK",5,0) F DGM=0:0 D S501 Q:Y'>0 K DA S (DGPTF,DA)=PTF S DGMOV=+Y,DGJUMP=$S('DGPTFE:"",1:"1-2"),DR=$S('DGPTFE:"[DG501]",1:"[DG501F]"),DIE="^DGPT(" D ^DIE,CHK501^DGPTSCAN K DGMOV "RTN","DGPTFQWK",6,0) K DIC,DA,DR,DIE "RTN","DGPTFQWK",7,0) W !,"* editing 401 transactions" "RTN","DGPTFQWK",8,0) F DGM=0:0 D S401 Q:Y'>0 K DA S DGSUR=+Y,DGJUMP="1-2",DR="[DG401]",DIE="^DGPT(",(DA,DGPTF)=PTF D ^DIE,CHK401^DGPTSCAN K DGSUR "RTN","DGPTFQWK",9,0) W !,"* editing 801 transactions" "RTN","DGPTFQWK",10,0) D S801 "RTN","DGPTFQWK",11,0) W !,"* editing 601 transactions" S DR="60",DR(2,45.05)=".01;2;S:'X Y=4;3;4:8",DIE="^DGPT(",DA=PTF D ^DIE "RTN","DGPTFQWK",12,0) I '$P(^DGPT(PTF,0),"^",4)&('DGST) W !," Updating TRANSFER DRGs" S DGADM=$P(^DGPT(PTF,0),U,2) D SUDO1^DGPTSUDO "RTN","DGPTFQWK",13,0) K DGM,DA,DGMOVENO,DIC,DIE,DR,Y,DGPTF,DGJUMP Q "RTN","DGPTFQWK",14,0) S501 ;-- set up 501 "RTN","DGPTFQWK",15,0) S DA(1)=PTF,DIC("A")="Select 501 MOVEMENT NUMBER: ",DIC(0)="AEQ",DIC="^DGPT("_PTF_",""M""," S:'$D(^DGPT(PTF,"M",0)) ^(0)="^45.02AI^^" D ^DIC "RTN","DGPTFQWK",16,0) K DA,DIC "RTN","DGPTFQWK",17,0) Q "RTN","DGPTFQWK",18,0) ; "RTN","DGPTFQWK",19,0) S401 ;-- set up 401 "RTN","DGPTFQWK",20,0) S DA(1)=PTF,DIC("A")="Select 401 SURGERY DATE: ",DIC(0)="AEQL",DIC="^DGPT("_PTF_",""S""," S:'$D(^DGPT(PTF,"S",0)) ^(0)="^45.01DA^^" D ^DIC "RTN","DGPTFQWK",21,0) K DA,DIC "RTN","DGPTFQWK",22,0) Q "RTN","DGPTFQWK",23,0) ; "RTN","DGPTFQWK",24,0) S801 ;-- set up 801 "RTN","DGPTFQWK",25,0) F S DA(1)=PTF,DIC("A")="Select 801 CPT DATE/TIME: ",DIC(0)="AEQLZ",DIC="^DGPT("_PTF_",""C"",",DIC("S")="D SCR^DGPTFM2" D D REQ:$D(PSIEN) Q:Y'>0 "RTN","DGPTFQWK",26,0) .S:'$D(^DGPT(PTF,"C",0)) ^(0)="^45.06^^" D ^DIC "RTN","DGPTFQWK",27,0) .K DA,DIC,PSIEN Q:Y'>0 S DGPRD=+Y(0),DGPSM=+Y D MOB^DGPTFM2 I $P(DGZPRF,U,3) F I=1:1:$P(DGZPRF,U,3) S:DGZPRF(I,0)=DGPSM DGZP=I "RTN","DGPTFQWK",28,0) .S DA(1)=PTF,DIE="^DGPT("_PTF_",""C"",",(DA,REC,PSIEN)=DGZPRF(DGZP,0),DR=".02;.03;.05" D PTFDIE I $D(Y)>9!$D(DTOUT) S Y=-1 Q "RTN","DGPTFQWK",29,0) .S DGI=0,DR=".01;" D CL^SDCO21(DFN,DGPRD,"",.SDCLY) D S Y=1 "RTN","DGPTFQWK",30,0) ..F S DGI=$O(^DGCPT(46,"C",PTF,DGI)) Q:DGI'>0 I +^DGCPT(46,DGI,1)=+DGZPRF(DGZP)&'$D(^(9)) S (DA,REC)=DGI,DR=".01;",DIE="^DGCPT(46," D GETINFO^DGPTFM2 "RTN","DGPTFQWK",31,0) ..F S DA=PTF,DIC="^DGCPT(46,",DIC(0)="AELQMZ",DLAYGO=46,DIC("S")="D EN6^DGPTFJC I 'DGER" D ^DIC Q:Y'>0 D SED^DGPTFM2 "RTN","DGPTFQWK",32,0) K DR,DIE,DIC,DA,DGI,DGJUMP,DGPRD,DLAYGO,RFL Q "RTN","DGPTFQWK",33,0) REQ ;CHECK FOR REQUIRED FIELDS IN CPT RECORDS. RECORDS MISSING ONE OR MORE REQUIRED FIELDS ARE DELETED. "RTN","DGPTFQWK",34,0) S RFL=0 I '$P(^DGPT(PTF,"C",PSIEN,0),U,3) S DA(1)=PTF,DA=DGPSM,DIK="^DGPT("_PTF_",""C""," D G REQQ "RTN","DGPTFQWK",35,0) .D ^DIK K DA W !!,"No CPT records have been filed because no performing provider was specified." S RFL=1 "RTN","DGPTFQWK",36,0) S (I,FCPT)=0 "RTN","DGPTFQWK",37,0) F J=1:1 S I=$O(^DGCPT(46,"C",PTF,I)) Q:'I D:+^DGCPT(46,I,1)=DGPRD&'$G(^(9)) "RTN","DGPTFQWK",38,0) .I $P(^DGCPT(46,I,0),U,4) S FCPT=1 Q "RTN","DGPTFQWK",39,0) .S DA=I,DIK="^DGCPT(46,",CPT=+^DGCPT(46,I,0) D ^DIK "RTN","DGPTFQWK",40,0) .W !!,"CPT " S N=$$CPT^ICPTCOD(CPT,$$GETDATE^ICDGTDRG(PTF)) W $P(N,U,2)," ",$P(N,U,3)," not filed because no diagnosis 1 was entered." "RTN","DGPTFQWK",41,0) .S RFL=1 "RTN","DGPTFQWK",42,0) I FCPT K FCPT,I,J,N G REQQ "RTN","DGPTFQWK",43,0) S DA(1)=PTF,DA=PSIEN,DIK="^DGPT("_PTF_",""C""," "RTN","DGPTFQWK",44,0) D ^DIK K DA W !!,"No CPT records have been filed because no CPT codes were filed." S RFL=1 K FCPT,I,J,N "RTN","DGPTFQWK",45,0) REQQ D RESEQ^DGPTFM3(PTF) "RTN","DGPTFQWK",46,0) Q "RTN","DGPTFQWK",47,0) SED S DR=".14////"_DGPRD_";.16////"_PTF_";",(DA,REC)=+Y,DIE="^DGCPT(46," D SDR^DGPTFM2,FMDIE Q "RTN","DGPTFQWK",48,0) FMDIE L +^DGCPT(46,REC):2 I D ^DIE L -^DGCPT(46,REC) K DIE,REC Q "RTN","DGPTFQWK",49,0) ERR W !,"CPT record is being edited by another user" K DIE,REC Q "RTN","DGPTFQWK",50,0) PTFDIE L +^DGPT(REC):2 I D ^DIE L -^DGPT(REC) K DIE,REC Q "RTN","DGPTFQWK",51,0) K DIE,REC G ERR "RTN","DGPTUTL1") 0^24^B18314344 "RTN","DGPTUTL1",1,0) DGPTUTL1 ;ALB/MJK - PTF Utility ; 2/19/04 3:13pm "RTN","DGPTUTL1",2,0) ;;5.3;Registration;**33,45,54,517**;Aug 13, 1993 "RTN","DGPTUTL1",3,0) ; "RTN","DGPTUTL1",4,0) FLAG ; -- select PTF rec to update xmit flags "RTN","DGPTUTL1",5,0) S DGMAX=25 "RTN","DGPTUTL1",6,0) W ! S DIC="^DGPT(",DIC(0)="AEMQ",DIC("S")="I '$P(^(0),U,6),$P(^(0),U,11)=1 D CHK^DGPTUTL1 I $D(DGMTY)>9" "RTN","DGPTUTL1",7,0) D ^DIC K DIC G FLAGQ:+Y<0 S (Y,PTF)=+Y D CHK "RTN","DGPTUTL1",8,0) F DGMTY=501,535 I $D(DGMTY(DGMTY)) D UP Q:$D(DGOUT) "RTN","DGPTUTL1",9,0) FLAGQ K DGMAX,DGT,DGADM,DGX,DGA1,DGA,DGMTY,C,DGOUT Q "RTN","DGPTUTL1",10,0) ; "RTN","DGPTUTL1",11,0) UP ; -- select mvt and update xmit flag "RTN","DGPTUTL1",12,0) I DGMTY=501 S DIC="^DGPT("_PTF_",""M"",",DIC("S")="I Y'=1,'$D(^(""P""))" "RTN","DGPTUTL1",13,0) I DGMTY=535 S DIC="^DGPT("_PTF_",535,",DIC("S")="I Y'=1" "RTN","DGPTUTL1",14,0) W ! S DIC(0)="AEMQ" D ^DIC S DIE=DIC K DIC "RTN","DGPTUTL1",15,0) K DGOUT I X["^" S DGOUT="" "RTN","DGPTUTL1",16,0) I +Y<0 G UPQ "RTN","DGPTUTL1",17,0) S DA=+Y,DR=17 D ^DIE K DE,DQ G UP "RTN","DGPTUTL1",18,0) UPQ K DIE,DR Q "RTN","DGPTUTL1",19,0) ; "RTN","DGPTUTL1",20,0) CHK ; "RTN","DGPTUTL1",21,0) N T1,T2,C K DGMTY S T1=0,T2=9999999 "RTN","DGPTUTL1",22,0) F DGMTY=501,535 D @DGMTY^DGPTFVC2 S:C>DGMAX DGMTY(DGMTY)="" "RTN","DGPTUTL1",23,0) Q "RTN","DGPTUTL1",24,0) ; "RTN","DGPTUTL1",25,0) INCOME ;-- load ptf income information "RTN","DGPTUTL1",26,0) ; Use discharge date if available; else use current date/time "RTN","DGPTUTL1",27,0) D NOW^%DTC "RTN","DGPTUTL1",28,0) S X=$S($D(^DGPT(PTF,70)):+^(70),1:%),DGX=$S($D(^DGPT(PTF,101)):^(101),1:"") "RTN","DGPTUTL1",29,0) D INC "RTN","DGPTUTL1",30,0) G INQ:Y=$P(DGX,U,7) "RTN","DGPTUTL1",31,0) S DIE="^DGPT(",DA=PTF,DR="101.07////"_Y "RTN","DGPTUTL1",32,0) D ^DIE "RTN","DGPTUTL1",33,0) INQ ; "RTN","DGPTUTL1",34,0) K DGX,DGINCM,DIE,DA,DR,DGI,DG30,DG362,DGT,% "RTN","DGPTUTL1",35,0) Q "RTN","DGPTUTL1",36,0) ; "RTN","DGPTUTL1",37,0) INC ;-- load income information Input:X date,Output:Y-income "RTN","DGPTUTL1",38,0) N DGINCM,DGI,DG30,DG362,DGT,DGX "RTN","DGPTUTL1",39,0) I '$D(X) S Y="" G INCQ "RTN","DGPTUTL1",40,0) S Y=+$P($$INCOME^VAFMON(DFN,X),".") "RTN","DGPTUTL1",41,0) I Y<0 S Y=0 "RTN","DGPTUTL1",42,0) INCQ Q "RTN","DGPTUTL1",43,0) ; "RTN","DGPTUTL1",44,0) CHQUES ;-- This function will deterime if the patient has any of the following "RTN","DGPTUTL1",45,0) ; indicated : AO, IR and EC. If so the array DGEXQ will contain "RTN","DGPTUTL1",46,0) ; DGEXQ(1)="" - AO "RTN","DGPTUTL1",47,0) ; DGEXQ(2)="" - IR "RTN","DGPTUTL1",48,0) ; DGEXQ(3)="" - EC "RTN","DGPTUTL1",49,0) ; Otherwise they will be undefined. "RTN","DGPTUTL1",50,0) K DGEXQ "RTN","DGPTUTL1",51,0) S DGEXQ(1)="",DGEXQ(2)="",DGEXQ(3)="" "RTN","DGPTUTL1",52,0) Q "RTN","DGPTUTL1",53,0) ; "RTN","DGPTUTL1",54,0) SETTRAN ;-- set transmission if error DGOUT=1, will return XMZ "RTN","DGPTUTL1",55,0) K DGXMZ "RTN","DGPTUTL1",56,0) S DGOUTX=0 "RTN","DGPTUTL1",57,0) S Y=$S($P(DGD,".",2)=99:DGSD,1:DGD) X ^DD("DD") "RTN","DGPTUTL1",58,0) S XMSUB=Y_" "_$P(DGRTY0,U)_" TRANSMISSION ",XMDUZ=.5 "RTN","DGPTUTL1",59,0) D GET^XMA2 "RTN","DGPTUTL1",60,0) I $D(XMZ),XMZ>0 S DGXMZ=XMZ K XMZ G SETQ "RTN","DGPTUTL1",61,0) W !!,"*** ERROR *** Unable to create Mail Message #... Try again later." "RTN","DGPTUTL1",62,0) S DGOUTX=1 "RTN","DGPTUTL1",63,0) SETQ ; "RTN","DGPTUTL1",64,0) Q "RTN","DGPTUTL1",65,0) ; "RTN","DGPTUTL1",66,0) KVAR ; -- clean up for l/e "RTN","DGPTUTL1",67,0) K DA,DFN,A,B,I,ANS,DIE,DR,%,%DT,DGPR,DGREL,DGST,DIC,HEAD,J,K,L,M,MT,NU,PTF,DGPTFE,Y,DGZM0,DGZS0,DOB,L1,PT,SEX,AGE,CC,DAM,DOB,DXLS,EXP,NOR,NO,DRG,DRGCAL,DGZSUR,S1,SUR,M1,MOV,P,P1 "RTN","DGPTUTL1",68,0) K DGDX,DGER,DGI,DGINFO,DGLOS,DGNXD,DGP,DGPAS,DGPSV,DGTLOS,DGTY,DIS2,DGJUMP,DGPRD,DGPC,DGDRGNM,DGMOVM,DR,DGQWK,ST1,DGX,DQ,TY,DGRTY,DGRTY0,DGPTFMT,DG,DGA1,DGDC,DGNEXT,RC,DP,POP,DGICD0,DGPROCD,DGPROCI,DGPROCM,DGVAR,DGAD "RTN","DGPTUTL1",69,0) K TAC,TRS,SD,PD,MDC,NDR,NSD,OR,ORG,T,DGZDIAG,DGZPRO,DGZSER,J1,I1,L2,L3,L4,L5,L6,PM,DGFC,S,M2,PROC,SU,ST,NL,DGDD,SD1,D,DFN,DFN1,DFN2,D0,P2,S2,X,DGNUM,DGN,DGERR,DGVI,DGVO,Z,Z1,DGZ,DGADM,DGNODE,^UTILITY($J),DGCFL "RTN","DGPTUTL1",70,0) K DGPM2X,DGPMDA,DGPMDCD,DGPMVI,DGAMY,VAERR,VAIP,DGPTSCRN,DGREC,DGHOLD,DG300,DG300A,DG300B,DG701,DGBPC,DGPTIT,DGMOV,DGSUR "RTN","DGPTUTL1",71,0) K M3,DGLAST,DGMVT "RTN","DGPTUTL1",72,0) Q "RTN","DGPTUTL1",73,0) ; "RTN","DGPTUTL1",74,0) ELIG ; shows eligibility and disabilities "RTN","DGPTUTL1",75,0) D ELIG^VADPT W !,"Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:"") "RTN","DGPTUTL1",76,0) W !,"Disabilities: " F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1 "RTN","DGPTUTL1",77,0) .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2) "RTN","DGPTUTL1",78,0) .W:$L(PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 !,?15 "RTN","DGPTUTL1",79,0) .W $S($G(PSDIS)]"":PSDIS_"-",1:"")_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), " "RTN","DGPTUTL1",80,0) Q "RTN","DGPTUTL1",81,0) DATE ;EDIT CPT DATE/TIME TO BE AFTER ADMISSION DATE BUT BEFORE DISCHARGE "RTN","DGPTUTL1",82,0) I X<$P(^DGPT(DA(1),0),U,2) W !,"Not before admission" K X Q "RTN","DGPTUTL1",83,0) I $G(^(70)),X>^(70) W !,"Not after discharge" K X Q "RTN","DGPTUTL1",84,0) S I=0 F S I=$O(^DGPT(PTF,"C",I)) Q:I'>0 I X=+^(I,0) W !,"Cannot changed to existing CPT date/time entry" K X Q "RTN","DGPTUTL1",85,0) Q "SEC","^DIC",46.1,46.1,0,"AUDIT") @ "SEC","^DIC",46.1,46.1,0,"DD") @ "SEC","^DIC",46.1,46.1,0,"DEL") @ "SEC","^DIC",46.1,46.1,0,"LAYGO") @ "SEC","^DIC",46.1,46.1,0,"RD") @ "SEC","^DIC",46.1,46.1,0,"WR") @ "UP",45,45.06,-1) 45^C "UP",45,45.06,0) 45.06 "VER") 8.0^22 "^DD",45,45,30,0) CPT RECORD DATE/TIME^45.06D^^C;0 "^DD",45,45,30,"DT") 3040115 "^DD",45,45,79,0) PRINCIPAL DIAGNOSIS^*P80'^ICD9(^70;10^S DIC("S")="S DGI=1 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79,1,0) ^.1 "^DD",45,45,79,1,992,0) 45^ADGRU79^MUMPS "^DD",45,45,79,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79,1,992,"%D",0) ^^1^1^2991006^^^^ "^DD",45,45,79,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79,1,992,"DT") 2991006 "^DD",45,45,79,3) Enter the ICD diagnosis responsible for the patient's greatest length of stay. "^DD",45,45,79,4) Q "^DD",45,45,79,12) For DRG calculation "^DD",45,45,79,12.1) S DIC("S")="S DGI=1 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79,21,0) ^.001^2^2^3040218^^^^ "^DD",45,45,79,21,1,0) This field contains the diagnosis responsible for the patient's "^DD",45,45,79,21,2,0) greatest length of stay. "^DD",45,45,79,"DT") 3040218 "^DD",45,45,79.16,0) SECONDARY DIAGNOSIS 1^*P80'^ICD9(^70;16^S DIC("S")="S DGI=2 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.16,1,0) ^.1 "^DD",45,45,79.16,1,992,0) 45^ADGRU7916^MUMPS "^DD",45,45,79.16,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.16,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.16,1,992,"%D",0) ^^1^1^2991006^^^^ "^DD",45,45,79.16,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.16,1,992,"DT") 2991006 "^DD",45,45,79.16,12) Active Codes "^DD",45,45,79.16,12.1) S DIC("S")="S DGI=2 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.16,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.16,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.16,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.16,"DT") 3040115 "^DD",45,45,79.17,0) SECONDARY DIAGNOSIS 2^*P80'^ICD9(^70;17^S DIC("S")="S DGI=3 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.17,1,0) ^.1 "^DD",45,45,79.17,1,992,0) 45^ADGRU7917^MUMPS "^DD",45,45,79.17,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.17,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.17,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.17,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.17,1,992,"DT") 2991006 "^DD",45,45,79.17,3) "^DD",45,45,79.17,12) Active Codes "^DD",45,45,79.17,12.1) S DIC("S")="S DGI=3 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.17,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.17,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.17,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.17,"DT") 3040115 "^DD",45,45,79.18,0) SECONDARY DIAGNOSIS 3^*P80'^ICD9(^70;18^S DIC("S")="S DGI=4 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.18,1,0) ^.1 "^DD",45,45,79.18,1,992,0) 45^ADGRU7818^MUMPS "^DD",45,45,79.18,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.18,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.18,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.18,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.18,1,992,"DT") 2991006 "^DD",45,45,79.18,3) "^DD",45,45,79.18,12) Active Codes "^DD",45,45,79.18,12.1) S DIC("S")="S DGI=4 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.18,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.18,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.18,21,2,0) care. This diagnosis is used in the caluculation of the DRG. "^DD",45,45,79.18,"DT") 3040115 "^DD",45,45,79.19,0) SECONDARY DIAGNOSIS 4^*P80'^ICD9(^70;19^S DIC("S")="S DGI=5 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.19,1,0) ^.1 "^DD",45,45,79.19,1,992,0) 45^ADGRU7919^MUMPS "^DD",45,45,79.19,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.19,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.19,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.19,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.19,1,992,"DT") 2991006 "^DD",45,45,79.19,3) "^DD",45,45,79.19,12) Active Codes "^DD",45,45,79.19,12.1) S DIC("S")="S DGI=5 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.19,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.19,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.19,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.19,"DT") 3040115 "^DD",45,45,79.201,0) SECONDARY DIAGNOSIS 5^*P80'^ICD9(^70;20^S DIC("S")="S DGI=6 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.201,1,0) ^.1 "^DD",45,45,79.201,1,992,0) 45^ADGRU79201^MUMPS "^DD",45,45,79.201,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.201,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.201,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.201,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.201,1,992,"DT") 2991006 "^DD",45,45,79.201,3) "^DD",45,45,79.201,12) Active Codes "^DD",45,45,79.201,12.1) S DIC("S")="S DGI=6 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.201,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.201,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.201,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.201,"DT") 3040115 "^DD",45,45,79.21,0) SECONDARY DIAGNOSIS 6^*P80'^ICD9(^70;21^S DIC("S")="S DGI=7 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.21,1,0) ^.1 "^DD",45,45,79.21,1,992,0) 45^ADGRU7921^MUMPS "^DD",45,45,79.21,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.21,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.21,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.21,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.21,1,992,"DT") 2991006 "^DD",45,45,79.21,3) "^DD",45,45,79.21,12) Active Codes "^DD",45,45,79.21,12.1) S DIC("S")="S DGI=7 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.21,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.21,21,1,0) This field conatins a diagnosis for the patient during this episode of "^DD",45,45,79.21,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.21,"DT") 3040115 "^DD",45,45,79.22,0) SECONDARY DIAGNOSIS 7^*P80'^ICD9(^70;22^S DIC("S")="S DGI=8 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.22,1,0) ^.1 "^DD",45,45,79.22,1,992,0) 45^ADGRU7922^MUMPS "^DD",45,45,79.22,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.22,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.22,1,992,"%D",0) ^^1^1^2991006^^^^ "^DD",45,45,79.22,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.22,1,992,"DT") 2991006 "^DD",45,45,79.22,3) "^DD",45,45,79.22,12) Active Codes "^DD",45,45,79.22,12.1) S DIC("S")="S DGI=8 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.22,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.22,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.22,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.22,"DT") 3040115 "^DD",45,45,79.23,0) SECONDARY DIAGNOSIS 8^*P80'^ICD9(^70;23^S DIC("S")="S DGI=9 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.23,1,0) ^.1 "^DD",45,45,79.23,1,992,0) 45^ADGRU7923^MUMPS "^DD",45,45,79.23,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.23,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.23,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.23,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.23,1,992,"DT") 2991006 "^DD",45,45,79.23,3) "^DD",45,45,79.23,12) Active Codes "^DD",45,45,79.23,12.1) S DIC("S")="S DGI=9 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.23,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.23,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.23,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.23,"DT") 3040115 "^DD",45,45,79.24,0) SECONDARY DIAGNOSIS 9^*P80'^ICD9(^70;24^S DIC("S")="S DGI=10 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.24,1,0) ^.1 "^DD",45,45,79.24,1,992,0) 45^ADGRU7924^MUMPS "^DD",45,45,79.24,1,992,1) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.24,1,992,2) N DG1 S DG1=$P(^(0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.24,1,992,"%D",0) ^^1^1^2991006^^^ "^DD",45,45,79.24,1,992,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.24,1,992,"DT") 2991006 "^DD",45,45,79.24,3) "^DD",45,45,79.24,12) Active Codes "^DD",45,45,79.24,12.1) S DIC("S")="S DGI=10 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.24,21,0) ^.001^2^2^3040115^^^^ "^DD",45,45,79.24,21,1,0) This field contains a diagnosis for the patient during this episode of "^DD",45,45,79.24,21,2,0) care. This diagnosis is used in the calculation of the DRG. "^DD",45,45,79.24,"DT") 3040115 "^DD",45,45,79.241,0) SECONDARY DIAGNOSIS 10^*P80'^ICD9(^71;1^S DIC("S")="S DGI=11 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.241,12) Valid Code "^DD",45,45,79.241,12.1) S DIC("S")="S DGI=11 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.241,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.241,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.241,"DT") 3040115 "^DD",45,45,79.242,0) SECONDARY DIAGNOSIS 11^*P80'^ICD9(^71;2^S DIC("S")="S DGI=12 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.242,12) Valid Code "^DD",45,45,79.242,12.1) S DIC("S")="S DGI=12 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.242,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.242,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.242,"DT") 3040115 "^DD",45,45,79.243,0) SECONDARY DIAGNOSIS 12^*P80'^ICD9(^71;3^S DIC("S")="S DGI=13 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.243,12) Valid Entries "^DD",45,45,79.243,12.1) S DIC("S")="S DGI=13 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.243,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.243,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.243,"DT") 3040115 "^DD",45,45,79.244,0) SECONDARY DIAGNOSIS 13^P80'^ICD9(^71;4^Q "^DD",45,45,79.244,"DT") 3040115 "^DD",45,45.06,0) CPT RECORD DATE/TIME SUB-FIELD^^.05^5 "^DD",45,45.06,0,"DIK") DGPTXX "^DD",45,45.06,0,"DT") 3040219 "^DD",45,45.06,0,"IX","B",45.06,.01) "^DD",45,45.06,0,"NM","CPT RECORD DATE/TIME") "^DD",45,45.06,0,"UP") 45 "^DD",45,45.06,.01,0) CPT RECORD DATE/TIME^RDX^^0;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X D DATE^DGPTUTL1:$D(X) "^DD",45,45.06,.01,1,0) ^.1 "^DD",45,45.06,.01,1,1,0) 45.06^B "^DD",45,45.06,.01,1,1,1) S ^DGPT(DA(1),"C","B",$E(X,1,30),DA)="" "^DD",45,45.06,.01,1,1,2) K ^DGPT(DA(1),"C","B",$E(X,1,30),DA) "^DD",45,45.06,.01,3) Enter the date and time the professional service was performed. "^DD",45,45.06,.01,"DT") 3040219 "^DD",45,45.06,.02,0) REFERRING OR ORDERING PROVIDER^*P200'^VA(200,^0;2^S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45.06,.02,3) Enter the name of the provider referring or ordering the service or item "^DD",45,45.06,.02,12) Only Allow Active Providers "^DD",45,45.06,.02,12.1) S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DT)" "^DD",45,45.06,.02,"DT") 3030409 "^DD",45,45.06,.03,0) RENDERING PROVIDER^R*P200'^VA(200,^0;3^S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DT)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45.06,.03,3) Enter the name of the provider performing the procedure. "^DD",45,45.06,.03,12) Only Allow Active Providers. "^DD",45,45.06,.03,12.1) S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DT)" "^DD",45,45.06,.03,"DT") 3040205 "^DD",45,45.06,.04,0) PRIMARY DIAGNOSIS^RP80'^ICD9(^0;4^Q "^DD",45,45.06,.04,3) Enter the Primary Diagnosis for this Professional Service. "^DD",45,45.06,.04,21,0) ^^2^2^3030725^ "^DD",45,45.06,.04,21,1,0) Enter the Diagnosis that should appear first in box 21 of the HCFA 1500 "^DD",45,45.06,.04,21,2,0) insurance form. "^DD",45,45.06,.04,"DT") 3030725 "^DD",45,45.06,.05,0) RENDERING LOCATION^P44'^SC(^0;5^Q "^DD",45,45.06,.05,3) Enter the location to be used in box 32 on the HCFA 1500. "^DD",45,45.06,.05,21,0) ^^2^2^3030725^ "^DD",45,45.06,.05,21,1,0) Enter the location in file 44 where services were furnished. The name of "^DD",45,45.06,.05,21,2,0) the facility and address must be entered in file 4 and pointed to by file 44. "^DD",45,45.06,.05,"DT") 3030725 "^DD",46,46,0) FIELDS ^^.131^24 "^DD",46,46,0,"DDA") N "^DD",46,46,0,"DT") 3040224 "^DD",46,46,0,"IX","B",46,.01) "^DD",46,46,0,"IX","C",46,.16) "^DD",46,46,0,"NM","INPATIENT CPT CODE") "^DD",46,46,0,"VRPK") DG "^DD",46,46,.01,0) CPT CODE^R*P81'^ICPT(^0;1^S DIC("S")="D EN6^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.01,1,0) ^.1 "^DD",46,46,.01,1,1,0) 46^B "^DD",46,46,.01,1,1,1) S ^DGCPT(46,"B",$E(X,1,30),DA)="" "^DD",46,46,.01,1,1,2) K ^DGCPT(46,"B",$E(X,1,30),DA) "^DD",46,46,.01,3) Enter the procedure, services or supplies using CPT or HCPCS "^DD",46,46,.01,12) Allow only active CPT procedures "^DD",46,46,.01,12.1) S DIC("S")="D EN6^DGPTFJC I 'DGER" "^DD",46,46,.01,21,0) ^.001^5^5^3040123^^^^ "^DD",46,46,.01,21,1,0) This is the procedure, services, or supplies used for the patient. It is "^DD",46,46,.01,21,2,0) using the HCFA Common Procedure Coding System (HCPCS) or Common Procedure "^DD",46,46,.01,21,3,0) Terminology (CPT) code. This value appears on the HCFA 1500 in box 24d. "^DD",46,46,.01,21,4,0) the values in this field will be provided to the billing package when "^DD",46,46,.01,21,5,0) the record is closed. "^DD",46,46,.01,"DEL",1,0) W *7,!,"USE DELETE OPTION TO DO LOGICAL DELETE" "^DD",46,46,.01,"DT") 3030605 "^DD",46,46,.02,0) CPT MODIFIER 1^*P81.3'^DIC(81.3,^0;2^S DIC("S")="I $D(^TMP(""ICPTM"",$J,$P(^DIC(81.3,Y,0),U)))" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.02,3) Indicates that a service or procedure has been altered, but code unchanged. "^DD",46,46,.02,12) ALLOW ONLY MODIFIERS VALID FOR THIS CPT "^DD",46,46,.02,12.1) S DIC("S")="I $D(^TMP(""ICPTM"",$J,$P(^DIC(81.3,Y,0),U)))" "^DD",46,46,.02,21,0) ^.001^2^2^3040213^^^ "^DD",46,46,.02,21,1,0) Used to indicate that a service or procedure has been altered by some "^DD",46,46,.02,21,2,0) specific circumstance but without changing the definition or code. "^DD",46,46,.02,"DT") 3040213 "^DD",46,46,.03,0) CPT MODIFIER 2^*P81.3'^DIC(81.3,^0;3 ^S DIC("S")="I $D(^TMP(""ICPTM"",$J,$P(^DIC(81.3,Y,0),U)))" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.03,3) Indicates that a service or procedure has been altered, but code UNCHANGED. "^DD",46,46,.03,12) ALLOW ONLY MODIFIERS VALID FOR THIS CPT "^DD",46,46,.03,12.1) S DIC("S")="I $D(^TMP(""ICPTM"",$J,$P(^DIC(81.3,Y,0),U)))" "^DD",46,46,.03,21,0) ^.001^2^2^3040213^^ "^DD",46,46,.03,21,1,0) Used to indicate that a service or procedure has been altered by some "^DD",46,46,.03,21,2,0) specific circumstance but not changed definition or code. "^DD",46,46,.03,"DT") 3040213 "^DD",46,46,.04,0) PRIMARY DIAGNOSIS^R*P80^ICD9(^0;4^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.04,3) The primary diagnosis associated with the procedure performed on the HCFA 1500. "^DD",46,46,.04,12) Allow only active Diagnosis codes. "^DD",46,46,.04,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.04,21,0) ^.001^4^4^3040115^^^^ "^DD",46,46,.04,21,1,0) The diagnosis code most directly related to the procedure code performed for "^DD",46,46,.04,21,2,0) this professional service. This field must be entered for each CPT code "^DD",46,46,.04,21,3,0) entered. It appears in box 21 on the HCFA-1500 and is associated with a "^DD",46,46,.04,21,4,0) procedure in box 24e. "^DD",46,46,.04,"DT") 3040115 "^DD",46,46,.05,0) SECONDARY DIAGNOSIS 1^*P80'^ICD9(^0;5^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.05,3) A secondary diagnosis associated with the procedure performed on the HCFA 1500. "^DD",46,46,.05,12) Allow only active diagnosis codes. "^DD",46,46,.05,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.05,21,0) ^.001^3^3^3040115^^^ "^DD",46,46,.05,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.05,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.05,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.05,"DT") 3040115 "^DD",46,46,.06,0) SECONDARY DIAGNOSIS 2^*P80'^ICD9(^0;6^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.06,3) A secondary diagnosis associated with the procedure performed on the HCFA 1500. "^DD",46,46,.06,12) Allow only active diagnosis codes. "^DD",46,46,.06,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.06,21,0) ^.001^3^3^3040115^^^ "^DD",46,46,.06,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.06,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.06,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.06,"DT") 3040115 "^DD",46,46,.07,0) SECONDARY DIAGNOSIS 3^*P80'^ICD9(^0;7^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.07,3) A secondary diagnosis associated with the procedure performed on the HCFA 1500. "^DD",46,46,.07,12) Allow only active diagnosis codes. "^DD",46,46,.07,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.07,21,0) ^.001^3^3^3040115^^^^ "^DD",46,46,.07,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.07,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.07,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.07,"DT") 3040115 "^DD",46,46,.08,0) TREATED FOR SC CONDITION^RS^1:YES;0:NO;^0;8^Q "^DD",46,46,.08,3) The patient care must be Service Connected. "^DD",46,46,.08,21,0) ^.001^4^4^3031016^^^^ "^DD",46,46,.08,21,1,0) Enter 'Y' if this applicant is service connected and the professional "^DD",46,46,.08,21,2,0) service is related to that service connection. Otherwise enter 'N'. This "^DD",46,46,.08,21,3,0) field can only be entered if the service connection information was entered "^DD",46,46,.08,21,4,0) in registration. See field .301 in file 2. "^DD",46,46,.08,"DT") 3030527 "^DD",46,46,.09,0) TREATED FOR AO CONDITION^RS^1:YES;0:NO;^0;9^Q "^DD",46,46,.09,3) The Patient must have Agent Orange exposure indicated! "^DD",46,46,.09,21,0) ^^4^4^3030605^ "^DD",46,46,.09,21,1,0) The Agent Orange questions must be answered yes in registration "^DD",46,46,.09,21,2,0) before this field can be entered. Enter 'Y' if this procedure is related "^DD",46,46,.09,21,3,0) to Agent Orange exposure based on the related diagnosis. See field .32102 "^DD",46,46,.09,21,4,0) in file 2. "^DD",46,46,.09,"DT") 3030527 "^DD",46,46,.1,0) TREATED FOR IR CONDITION^RS^1:YES;0:NO;^0;10^Q "^DD",46,46,.1,3) The Patient must have Ionizing Radiation exposure indicated! "^DD",46,46,.1,21,0) ^^4^4^3030605^ "^DD",46,46,.1,21,1,0) Enter 'Y' if the procedure performed is related to exposure to ionizing "^DD",46,46,.1,21,2,0) . Enter 'N' if the procedure performed is unrelated to ionizing radiation. "^DD",46,46,.1,21,3,0) The ionizing radiation information must be entered in registration "^DD",46,46,.1,21,4,0) before it can be entered here. See field .32111 in file 2. "^DD",46,46,.1,"DT") 3030527 "^DD",46,46,.11,0) EXPOSED TO ENVIR CONTAMINANTS^RS^1:YES;0:NO;^0;11^Q "^DD",46,46,.11,3) The Patient must have Environment Contaminants exposure! "^DD",46,46,.11,21,0) ^.001^4^4^3030605^^ "^DD",46,46,.11,21,1,0) Enter 'Y' if the procedure performed is related to exposure to environmental "^DD",46,46,.11,21,2,0) contamination. Enter 'N' if the procedure performed is unrelated to "^DD",46,46,.11,21,3,0) environmental contamination. This information must be entered in "^DD",46,46,.11,21,4,0) Registration before it can be entered here. See field .322013 in file 2. "^DD",46,46,.11,"DT") 3030527 "^DD",46,46,.12,0) TREATMENT FOR MST^RS^1:YES;0:NO;^0;12^Q "^DD",46,46,.12,3) Was the treatment related to Military Sexual Trauma. "^DD",46,46,.12,21,0) ^^3^3^3030605^ "^DD",46,46,.12,21,1,0) Enter 'Y' if the procedure performed is related to military sexual trauma. "^DD",46,46,.12,21,2,0) Enter 'N' if the procedure performed is unrelated to military sexual "^DD",46,46,.12,21,3,0) trauma. This information must be entered in registration first. "^DD",46,46,.12,"DT") 3030527 "^DD",46,46,.13,0) TREATMENT FOR HEAD/NECK CA^RS^1:YES;0:NO;^0;13^Q "^DD",46,46,.13,3) Was the treatment related to Head and/or Neck Cancer. "^DD",46,46,.13,21,0) ^.001^3^3^3040218^^ "^DD",46,46,.13,21,1,0) Enter 'Y' if this procedure is related to treatment for head/neck cancer. "^DD",46,46,.13,21,2,0) Enter 'N' is the procedure is unrelated to the patient's head/neck "^DD",46,46,.13,21,3,0) cancer. "^DD",46,46,.13,"DT") 3030527 "^DD",46,46,.131,0) COMBAT VET^S^Y:YES;N:NO;^0;19^Q "^DD",46,46,.131,3) Care is potentially related to military combat. "^DD",46,46,.131,21,0) ^^7^7^3040224^ "^DD",46,46,.131,21,1,0) Indiacte if the inpatient stay at this location is related to military "^DD",46,46,.131,21,2,0) service in combat and not from cause other than military "^DD",46,46,.131,21,3,0) service in combat operations (congenital, developmental, pre-service "^DD",46,46,.131,21,4,0) existing conditions, or conditions having specific and well-established "^DD",46,46,.131,21,5,0) etiology that began after military combat service, i.e., bone "^DD",46,46,.131,21,6,0) fractures occuring after separation date, comon colds, ect). This "^DD",46,46,.131,21,7,0) information can only be entered if the patient has CV status in Registration. "^DD",46,46,.131,"DT") 3040224 "^DD",46,46,.14,0) CPT RECORD DATE/TIME^RD^^1;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",46,46,.14,3) Date and time the professional service occurred. "^DD",46,46,.14,21,0) ^^2^2^3030528^ "^DD",46,46,.14,21,1,0) The date and time the professional service was performed. May not be exact. "^DD",46,46,.14,21,2,0) Must be unique. "^DD",46,46,.14,"DT") 3040122 "^DD",46,46,.16,0) PTF^RP45'^DGPT(^1;3^Q "^DD",46,46,.16,1,0) ^.1 "^DD",46,46,.16,1,1,0) 46^C "^DD",46,46,.16,1,1,1) S ^DGCPT(46,"C",$E(X,1,30),DA)="" "^DD",46,46,.16,1,1,2) K ^DGCPT(46,"C",$E(X,1,30),DA) "^DD",46,46,.16,1,1,"DT") 3030513 "^DD",46,46,.16,3) Enter the inpatient episode to enter professional service for. "^DD",46,46,.16,21,0) ^^1^1^3030528^ "^DD",46,46,.16,21,1,0) Pointer to the inpatient record in the PTF file (45). "^DD",46,46,.16,"DT") 3030513 "^DD",46,46,.17,0) SOURCE^F^^1;4^K:$L(X)>30!($L(X)<3) X "^DD",46,46,.17,3) ENTER THE PACKAGE WHICH PROVIDED THE DATA. "^DD",46,46,.17,21,0) ^^2^2^3030923^ "^DD",46,46,.17,21,1,0) SOURCE is a string of text (3-30 character) identifying the source of the "^DD",46,46,.17,21,2,0) data or Examples of SOURCE are: "LAB DATA". "RADIOLOGY DATA". "^DD",46,46,.17,"DT") 3030917 "^DD",46,46,.18,0) USER^P200'^VA(200,^1;2^Q "^DD",46,46,.18,3) ENTER THE USER WHO LAST EDITED THIS ENTRY. "^DD",46,46,.18,21,0) ^^2^2^3030923^ "^DD",46,46,.18,21,1,0) User who is responsible for add/edit/delete action on the encounter. Pointer "^DD",46,46,.18,21,2,0) to the New Person file (200). "^DD",46,46,.18,"DT") 3030917 "^DD",46,46,.2,0) QUANTITY^NJ2,0^^0;14^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",46,46,.2,3) Enter a number between 1 and 99 indicating how many times this procedure was done. "^DD",46,46,.2,21,0) ^^2^2^3030619^ "^DD",46,46,.2,21,1,0) This is the number of times this procedure was done to the patient for "^DD",46,46,.2,21,2,0) one professional service. "^DD",46,46,.2,"DT") 3030619 "^DD",46,46,.21,0) SECONDARY DIAGNOSIS 4^*P80'^ICD9(^0;15^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.21,3) A secondary diagnosis associated wiht the procedure perfomred on the HCFA 1500. "^DD",46,46,.21,12) Allow only active diagnosis codes. "^DD",46,46,.21,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.21,21,0) ^.001^3^3^3040115^^^ "^DD",46,46,.21,21,1,0) A secondary diagnosis related to the procedure performed ofr this "^DD",46,46,.21,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.21,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.21,"DT") 3040115 "^DD",46,46,.22,0) SECONDARY DIAGNOSIS 5^*P80'^ICD9(^0;16^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.22,3) A secondary diagnosis associated wiht the procedure perfomred on the HCFA 1500. "^DD",46,46,.22,12) Allow only active diagnosis codes. "^DD",46,46,.22,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.22,21,0) ^.001^3^3^3040115^^^^ "^DD",46,46,.22,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.22,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.22,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.22,"DT") 3040115 "^DD",46,46,.23,0) SECONDARY DIAGNOSIS 6^*P80'^ICD9(^0;17^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.23,12) Allow only active diagnosis codes. "^DD",46,46,.23,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.23,21,0) ^.001^3^3^3040115^^^ "^DD",46,46,.23,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.23,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.23,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.23,"DT") 3040115 "^DD",46,46,.24,0) SECONDARY DIAGNOSIS 7^*P80'^ICD9(^0;18^S DIC("S")="D EN5^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",46,46,.24,12) Allow only active diagnosis codes. "^DD",46,46,.24,12.1) S DIC("S")="D EN5^DGPTFJC I 'DGER" "^DD",46,46,.24,21,0) ^.001^3^3^3040115^^^ "^DD",46,46,.24,21,1,0) A secondary diagnosis related to the procedure performed for this "^DD",46,46,.24,21,2,0) professional service. This field is optional. It appears in box 21 on "^DD",46,46,.24,21,3,0) the HCFA-1500 and is associated with a procedure in box 24e. "^DD",46,46,.24,"DT") 3040115 "^DD",46,46,1,0) DELETE DATE^D^^9;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",46,46,1,3) Enter the date that the CPT code was deleted from the professional service. "^DD",46,46,1,"DT") 3030620 "^DD",46.1,46.1,0) FIELD^^9^12 "^DD",46.1,46.1,0,"DT") 3040102 "^DD",46.1,46.1,0,"IX","B",46.1,.01) "^DD",46.1,46.1,0,"IX","C",46.1,1) "^DD",46.1,46.1,0,"NM","INPATIENT POV") "^DD",46.1,46.1,0,"VRPK") DG "^DD",46.1,46.1,.01,0) DIAGNOSIS^RP80'^ICD9(^0;1^Q "^DD",46.1,46.1,.01,1,0) ^.1 "^DD",46.1,46.1,.01,1,1,0) 46.1^B "^DD",46.1,46.1,.01,1,1,1) S ^DGICD9(46.1,"B",$E(X,1,30),DA)="" "^DD",46.1,46.1,.01,1,1,2) K ^DGICD9(46.1,"B",$E(X,1,30),DA) "^DD",46.1,46.1,.01,3) Enter a diagnosis related to this inpatient stay. "^DD",46.1,46.1,.01,21,0) ^^1^1^3030625^ "^DD",46.1,46.1,.01,21,1,0) A diagnosis related to the inpatient stay. "^DD",46.1,46.1,.01,"DT") 3030625 "^DD",46.1,46.1,.02,0) TREATED FOR SC CONDITION^RS^1:YES;0:NO;^0;2^Q "^DD",46.1,46.1,.02,3) The diagnosis must be service related. "^DD",46.1,46.1,.02,21,0) ^.001^4^4^3031016^^^^ "^DD",46.1,46.1,.02,21,1,0) Enter 'Y' if this applicant is service connected and this diagnosis is "^DD",46.1,46.1,.02,21,2,0) related to the service connection. Otherwise enter 'N'. This field "^DD",46.1,46.1,.02,21,3,0) can only be entered if the service connection information was entered "^DD",46.1,46.1,.02,21,4,0) in registration. See field .301 in file 2. "^DD",46.1,46.1,.02,"DT") 3031014 "^DD",46.1,46.1,.03,0) TREATED FOR AO CONDITION^RS^1:YES;0:NO;^0;3^Q "^DD",46.1,46.1,.03,3) The diagnosis must be related to Agent Orange exposure. "^DD",46.1,46.1,.03,21,0) ^.001^3^3^3031014^^ "^DD",46.1,46.1,.03,21,1,0) The Agent Orange questions must be answered yes in registration before this "^DD",46.1,46.1,.03,21,2,0) field can be entered. Enter 'Y' is this diagnosis is related to Agent "^DD",46.1,46.1,.03,21,3,0) Orange exposure. See field .32102 in file 2. "^DD",46.1,46.1,.03,"DT") 3031014 "^DD",46.1,46.1,.04,0) TREATMENT FOR IR CONDITION^RS^1:YES;0:NO;^0;4^Q "^DD",46.1,46.1,.04,3) This diagnosis must be related to Ionizing Radiation. "^DD",46.1,46.1,.04,21,0) ^^4^4^3030625^ "^DD",46.1,46.1,.04,21,1,0) Enter 'Y' if the diagnosis is related to exposure to ionizing radiation. "^DD",46.1,46.1,.04,21,2,0) Enter 'N' if this diagnosis is unrelated to ionizing radiation. "^DD",46.1,46.1,.04,21,3,0) The ionizing radiation must be entered in registration before it can be "^DD",46.1,46.1,.04,21,4,0) entered here. See field .32111 in file 2. "^DD",46.1,46.1,.04,"DT") 3031014 "^DD",46.1,46.1,.05,0) EXPOSURE TO ENVIR CONTAMINANTS^RS^1:YES;0:NO;^0;5^Q "^DD",46.1,46.1,.05,3) This diagnosis must be related to Environmental Contaminates. "^DD",46.1,46.1,.05,21,0) ^^4^4^3030625^ "^DD",46.1,46.1,.05,21,1,0) Enter 'Y' if the diagnosis is related to environmental contamination. "^DD",46.1,46.1,.05,21,2,0) Enter 'N' if the diagnosis is unrelated to environmental contamination. "^DD",46.1,46.1,.05,21,3,0) This information must be entered in Registration before it can be entered "^DD",46.1,46.1,.05,21,4,0) here. See field .322013 in file 2. "^DD",46.1,46.1,.05,"DT") 3031014 "^DD",46.1,46.1,.06,0) TREATMENT FOR MST^RS^1:YES;0:NO;^0;6^Q "^DD",46.1,46.1,.06,3) Was the diagnosis related to Military Sexual Trauma? "^DD",46.1,46.1,.06,21,0) ^^3^3^3030625^ "^DD",46.1,46.1,.06,21,1,0) Enter 'Y' if the diagnosis is related to military sexual trauma. Enter 'N' "^DD",46.1,46.1,.06,21,2,0) if the diagnosis is unrelated to military sexual trauma. This information "^DD",46.1,46.1,.06,21,3,0) must be entered in registration first. "^DD",46.1,46.1,.06,"DT") 3031014 "^DD",46.1,46.1,.07,0) TREATMENT FOR HEAD/NECK CA^RS^1:YES;0:NO;^0;7^Q "^DD",46.1,46.1,.07,3) Was the treatment related to Head and/or Neck Cancer. "^DD",46.1,46.1,.07,21,0) ^^2^2^3030625^ "^DD",46.1,46.1,.07,21,1,0) Enter 'Y' if this diagnosis is related to head/neck cancer. Enter 'N' "^DD",46.1,46.1,.07,21,2,0) if the diagnosis is unrelated to the patient's head/neck cancer. "^DD",46.1,46.1,.07,"DT") 3031014 "^DD",46.1,46.1,.08,0) COMBAT VET^S^Y:YES;N:NO;^0;8^Q "^DD",46.1,46.1,.08,3) Care is potentially related to military combat. "^DD",46.1,46.1,.08,21,0) ^.001^7^7^3040218^^^^ "^DD",46.1,46.1,.08,21,1,0) Indicate if the inpatient stay at this location is related to military "^DD",46.1,46.1,.08,21,2,0) service in combat and not from cause other than military "^DD",46.1,46.1,.08,21,3,0) service in combat operations (congenital, developmental, pre-service "^DD",46.1,46.1,.08,21,4,0) existing conditions, or conditions having specific and well-established "^DD",46.1,46.1,.08,21,5,0) etiology that began after military combat service, i.e., bone "^DD",46.1,46.1,.08,21,6,0) fractures occuring after separation date, common colds, etc). This "^DD",46.1,46.1,.08,21,7,0) information can only be entered if the patient has CV status in Registration. "^DD",46.1,46.1,.08,"DT") 3040204 "^DD",46.1,46.1,1,0) PTF^P45'^DGPT(^1;1^Q "^DD",46.1,46.1,1,1,0) ^.1 "^DD",46.1,46.1,1,1,1,0) 46.1^C "^DD",46.1,46.1,1,1,1,1) S ^DGICD9(46.1,"C",$E(X,1,30),DA)="" "^DD",46.1,46.1,1,1,1,2) K ^DGICD9(46.1,"C",$E(X,1,30),DA) "^DD",46.1,46.1,1,1,1,"%D",0) ^^1^1^3030709^ "^DD",46.1,46.1,1,1,1,"%D",1,0) This crossreference ties the diagnosis file to the PTF file. "^DD",46.1,46.1,1,1,1,"DT") 3030709 "^DD",46.1,46.1,1,3) Enter the inpatient episode that the diagnosis is for. "^DD",46.1,46.1,1,21,0) ^^1^1^3030709^ "^DD",46.1,46.1,1,21,1,0) This connects the file to the PTF file. "^DD",46.1,46.1,1,"DT") 3030709 "^DD",46.1,46.1,1.1,0) SOURCE^F^^1;2^K:$L(X)>30!($L(X)<3) X "^DD",46.1,46.1,1.1,3) ENTER THE PACKAGE WHICH PROVIDED THIS DATA. "^DD",46.1,46.1,1.1,21,0) ^.001^2^2^3031106^^ "^DD",46.1,46.1,1.1,21,1,0) SOURCE is a string of text (3-30 character) identifying the source of the "^DD",46.1,46.1,1.1,21,2,0) data. Examples of SOURCE are: "LAB DATA" or "RADIOLOGY DATA". "^DD",46.1,46.1,1.1,"DT") 3030917 "^DD",46.1,46.1,1.2,0) USER^P200'^VA(200,^1;3^Q "^DD",46.1,46.1,1.2,3) ENTER THE PERSON WHO LAST CHANGED THIS DATA. "^DD",46.1,46.1,1.2,21,0) ^.001^2^2^3031106^^ "^DD",46.1,46.1,1.2,21,1,0) User who is responsible for add/edit/delete action on the encounter. Pointer "^DD",46.1,46.1,1.2,21,2,0) to the New Person file (200). "^DD",46.1,46.1,1.2,"DT") 3030917 "^DD",46.1,46.1,9,0) DELETE DATE^D^^9;1^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X "^DD",46.1,46.1,9,3) Enter the date the diagnosis was deleted. "^DD",46.1,46.1,9,"DT") 3030710 "^DIC",46,46,0) INPATIENT CPT CODE^46 "^DIC",46,46,0,"GL") ^DGCPT(46, "^DIC",46,46,"%D",0) ^^5^5^3030527^ "^DIC",46,46,"%D",1,0) This file is used to capture inpatient professional services for billing. "^DIC",46,46,"%D",2,0) Entries from this file are used on the HCFA 1500. This file can be used "^DIC",46,46,"%D",3,0) to capture billing information for observation visits The date and time "^DIC",46,46,"%D",4,0) of the professional service is used as a unique identifier for the "^DIC",46,46,"%D",5,0) professional service. "^DIC",46,"B","INPATIENT CPT CODE",46) "^DIC",46.1,46.1,0) INPATIENT POV^46.1 "^DIC",46.1,46.1,0,"GL") ^DGICD9(46.1, "^DIC",46.1,"B","INPATIENT POV",46.1) **END** **END**