Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTX7

DGPTX7.m

Go to the documentation of this file. 
  1. DGPTX7 ; GENERATED FROM 'DG701' INPUT TEMPLATE(#432), FILE 45;12/08/20
  1.  D DE G BEGIN
  1. DE S DIE="^DGPT(",DIC=DIE,DP=45,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DGPT(DA,""))=""
  1.  I $D(^(70)) S %Z=^(70) S %=$P(%Z,U,10) S:%]"" DE(6)=% S %=$P(%Z,U,16) S:%]"" DE(16)=% S %=$P(%Z,U,17) S:%]"" DE(26)=% S %=$P(%Z,U,18) S:%]"" DE(36)=% S %=$P(%Z,U,19) S:%]"" DE(46)=% S %=$P(%Z,U,20) S:%]"" DE(56)=% S %=$P(%Z,U,21) S:%]"" DE(66)=%
  1.  I $D(^(82)) S %Z=^(82) S %=$P(%Z,U,1) S:%]"" DE(9)=% S %=$P(%Z,U,2) S:%]"" DE(19)=% S %=$P(%Z,U,3) S:%]"" DE(29)=% S %=$P(%Z,U,4) S:%]"" DE(39)=% S %=$P(%Z,U,5) S:%]"" DE(49)=% S %=$P(%Z,U,6) S:%]"" DE(59)=%
  1.  K %Z Q
  1.  ;
  1. W W !?DL+DL-2,DLB_": "
  1.  Q
  1. O D W W Y W:$X>45 !?9
  1.  I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
  1.  W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 K X S X("FIELD")=DIFLD,X("FILE")=DP W "  ("_$$EZBLD^DIALOG(710,.X)_")" K X S X="" Q  ;**
  1. TR Q:DV["K"&(DUZ(0)'="@")  R X:DTIME E  S (DTOUT,X)=U W $C(7)
  1.  Q
  1. A K DQ(DQ) S DQ=DQ+1
  1. B G @DQ
  1. RE G A:DV["K"&(DUZ(0)'["@"),PR:$D(DE(DQ)) D W,TR
  1. N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
  1. RD G QS:X?."?" I X["^" D D G ^DIE17
  1.  I X="@" D D G Z^DIE2
  1.  I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
  1. T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" I X?.ANP D SET^DIED I 'DDER G V
  1.  K DDER G X
  1. P I DV["P" S DIC=U_DU,DIC(0)=$E("EN",$D(DB(DQ))+1)_"M"_$E("L",DV'["'") S:DIC(0)["L" DLAYGO=+$P(DV,"P",2) G:DV["*" AST^DIED D NOSCR^DIED S X=+Y,DIC=DIE G X:X<0
  1.  G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
  1.  I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
  1. V D @("X"_DQ) K YS
  1. UNIQ I DV["U",$D(X),DIFLD=.01 K % M %=@(DIE_"""B"",X)") K %(DA) K:$O(%(0)) X
  1. Z K DIC("S"),DLAYGO I $D(X),X'=U D:$G(DE(DW,"INDEX")) SAVEVALS G:'$$KEYCHK UNIQFERR^DIE17 S DG(DW)=X S:DV["d" ^DISV(DUZ,"DIE",DLB)=X G A
  1. X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
  1.  S X="?BAD"
  1. QS S DZ=X D D,QQ^DIEQ G B
  1. D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
  1. Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
  1. PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
  1. R I DG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DG=$P(^(0),U,2) G R
  1.  I DG["V",+Y,$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)")) S X=+$P(^(0),U,2) G RP:'$D(^(+Y,0)) S Y=$P(^(0),U) I $D(^DD(+X,.01,0)) S DG=$P(^(0),U,2),X=$P(^(0),U,3) G R
  1.  X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") I %]"" S Y=$S($G(DUZ("LANG"))'>1:%,'DIFLD:%,1:$$SET^DIQ(DP,DIFLD,Y))
  1. RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
  1. I I DV'["I",DV'["#" G RD
  1.  D E^DIE0 G RD:$D(X),PR
  1.  Q
  1. SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
  1.  I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
  1.  E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
  1.  Q
  1. NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
  1. KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
  1. BEGIN S DNM="DGPTX7",DQ=1
  1.  N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
  1.  M DIEZAR=^DIE(432,"AR") S DICRREC="TRIG^DIE17"
  1.  S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_",",DIEZ=432,U="^"
  1. 1 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=1 D X1 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X1 F X=2:1:7 S DGDUP(X)=0
  1.  Q
  1. 2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X2 K DGPTIT D FLAGCHK^DGPTSCAN
  1.  Q
  1. 3 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X3 S DGNFLD="@10"
  1.  Q
  1. 4 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=4 D X4 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X4 S DGXX="",DGTYPE=$P(^DGPT(D0,0),U,11),DGCODSYS=$$CODESYS^DGPTIC10(D0)
  1.  Q
  1. 5 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 D X5 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X5 D CENSUS^DGPTIC10(DA)
  1.  Q
  1. 6 S DW="70;10",DV="*P80'X",DU="",DIFLD=79,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C6^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C6 G C6S:$D(DE(6))[0 K DB
  1.  S X=DE(6),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,1)=DIV,DIH=45,DIG=82.01 D ^DICR
  1.  S X=DE(6),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C6S S X="" G:DG(DQ)=X C6F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,1)=DIV,DIH=45,DIG=82.01 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C6F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1176 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X6 N DGI S DGI=1 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 7 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=7 D X7 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X7 S DGXX=X
  1.  Q
  1. 8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X8 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@1"
  1.  Q
  1. 9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW="82;1",DV="SX",DU="",DIFLD=82.01,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X9 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,10) X
  1.  Q
  1.  ;
  1. 10 S DQ=11 ;@1
  1. 11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X11 S X=DGXX
  1.  Q
  1. 12 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X12 I X K DGPTIT S DGNFLD="@10",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 13 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=13 D X13 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X13 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"
  1.  Q
  1. 14 S DQ=15 ;@10
  1. 15 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=15 D X15 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X15 S DGNFLD="@20"
  1.  Q
  1. 16 S DW="70;16",DV="*P80`X",DU="",DIFLD=79.16,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C16^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C16 G C16S:$D(DE(16))[0 K DB
  1.  S X=DE(16),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,2)=DIV,DIH=45,DIG=82.02 D ^DICR
  1.  S X=DE(16),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C16S S X="" G:DG(DQ)=X C16F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,2)=DIV,DIH=45,DIG=82.02 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C16F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1187 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X16 N DGI S DGI=2 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 17 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=17 D X17 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X17 S DGXX=X
  1.  Q
  1. 18 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=18 D X18 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X18 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@11"
  1.  Q
  1. 19 D:$D(DG)>9 F^DIE17,DE S DQ=19,DW="82;2",DV="SX",DU="",DIFLD=82.02,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X19 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,16) X
  1.  Q
  1.  ;
  1. 20 S DQ=21 ;@11
  1. 21 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=21 D X21 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X21 S X=DGXX
  1.  Q
  1. 22 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=22 D X22 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X22 I X K DGPTIT S DGNFLD="@20",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 23 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=23 D X23 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X23 S:$P($G(^DGPT(D0,70)),U,16,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"
  1.  Q
  1. 24 S DQ=25 ;@20
  1. 25 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=25 D X25 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X25 S DGNFLD="@30"
  1.  Q
  1. 26 S DW="70;17",DV="*P80'X",DU="",DIFLD=79.17,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C26^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C26 G C26S:$D(DE(26))[0 K DB
  1.  S X=DE(26),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,3)=DIV,DIH=45,DIG=82.03 D ^DICR
  1.  S X=DE(26),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C26S S X="" G:DG(DQ)=X C26F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,3)=DIV,DIH=45,DIG=82.03 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C26F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1192 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X26 N DGI S DGI=3 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 27 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=27 D X27 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X27 S DGXX=X
  1.  Q
  1. 28 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=28 D X28 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X28 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@21"
  1.  Q
  1. 29 D:$D(DG)>9 F^DIE17,DE S DQ=29,DW="82;3",DV="SX",DU="",DIFLD=82.03,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X29 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,17) X
  1.  Q
  1.  ;
  1. 30 S DQ=31 ;@21
  1. 31 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=31 D X31 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X31 S X=DGXX
  1.  Q
  1. 32 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=32 D X32 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X32 I X K DGPTIT S DGNFLD="@30",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 33 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=33 D X33 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X33 S:$P($G(^DGPT(D0,70)),U,17,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"
  1.  Q
  1. 34 S DQ=35 ;@30
  1. 35 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=35 D X35 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X35 S DGNFLD="@40"
  1.  Q
  1. 36 S DW="70;18",DV="*P80'X",DU="",DIFLD=79.18,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C36^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C36 G C36S:$D(DE(36))[0 K DB
  1.  S X=DE(36),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,4)=DIV,DIH=45,DIG=82.04 D ^DICR
  1.  S X=DE(36),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C36S S X="" G:DG(DQ)=X C36F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,4)=DIV,DIH=45,DIG=82.04 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C36F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1193 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X36 N DGI S DGI=4 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 37 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=37 D X37 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X37 S DGXX=X
  1.  Q
  1. 38 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=38 D X38 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X38 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@31"
  1.  Q
  1. 39 D:$D(DG)>9 F^DIE17,DE S DQ=39,DW="82;4",DV="SX",DU="",DIFLD=82.04,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X39 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,18) X
  1.  Q
  1.  ;
  1. 40 S DQ=41 ;@31
  1. 41 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=41 D X41 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X41 S X=DGXX
  1.  Q
  1. 42 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=42 D X42 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X42 I X K DGPTIT S DGNFLD="@40",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 43 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=43 D X43 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X43 S:$P($G(^DGPT(D0,70)),U,18,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"
  1.  Q
  1. 44 S DQ=45 ;@40
  1. 45 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=45 D X45 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X45 S DGNFLD="@50"
  1.  Q
  1. 46 S DW="70;19",DV="*P80'X",DU="",DIFLD=79.19,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C46^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C46 G C46S:$D(DE(46))[0 K DB
  1.  S X=DE(46),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,5)=DIV,DIH=45,DIG=82.05 D ^DICR
  1.  S X=DE(46),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C46S S X="" G:DG(DQ)=X C46F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,5)=DIV,DIH=45,DIG=82.05 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C46F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1194 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X46 N DGI S DGI=5 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 47 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=47 D X47 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X47 S DGXX=X
  1.  Q
  1. 48 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=48 D X48 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X48 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@41"
  1.  Q
  1. 49 D:$D(DG)>9 F^DIE17,DE S DQ=49,DW="82;5",DV="SX",DU="",DIFLD=82.05,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X49 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,19) X
  1.  Q
  1.  ;
  1. 50 S DQ=51 ;@41
  1. 51 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=51 D X51 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X51 S X=DGXX
  1.  Q
  1. 52 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=52 D X52 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X52 I X K DGPTIT S DGNFLD="@50",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 53 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=53 D X53 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X53 S:$P($G(^DGPT(D0,70)),U,19,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"
  1.  Q
  1. 54 S DQ=55 ;@50
  1. 55 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=55 D X55 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X55 S DGNFLD="@55"
  1.  Q
  1. 56 S DW="70;20",DV="*P80'X",DU="",DIFLD=79.201,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C56^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C56 G C56S:$D(DE(56))[0 K DB
  1.  S X=DE(56),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,6)=DIV,DIH=45,DIG=82.06 D ^DICR
  1.  S X=DE(56),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C56S S X="" G:DG(DQ)=X C56F1 K DB
  1.  S X=DG(DQ),DIC=DIE
  1.  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGPT(D0,82)):^(82),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X="" S DIH=$G(^DGPT(DIV(0),82)),DIV=X S $P(^(82),U,6)=DIV,DIH=45,DIG=82.06 D ^DICR
  1.  S X=DG(DQ),DIC=DIE
  1.  X "N DG1 S DG1=$P(^DGPT(DA,0),""^"",1) N X S X=""DGRUDD01"" X ^%ZOSF(""TEST"") Q:'$T  D:(+DG1>0) ADGRU^DGRUDD01(DG1)"
  1. C56F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1195 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X56 N DGI S DGI=6 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 57 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=57 D X57 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X57 S DGXX=X
  1.  Q
  1. 58 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=58 D X58 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X58 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@51"
  1.  Q
  1. 59 D:$D(DG)>9 F^DIE17,DE S DQ=59,DW="82;6",DV="SX",DU="",DIFLD=82.06,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DU="Y:Present on Admission;N:Not Present on Admission;U:Insufficient Docum to Present on Admission;W:Can't Determine if Present on Admission;"
  1.  G RE
  1. X59 I X]"",$G(DA) K:'$$POA701^DGPTFUT1(X,DA,70,20) X
  1.  Q
  1.  ;
  1. 60 S DQ=61 ;@51
  1. 61 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=61 D X61 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X61 S X=DGXX
  1.  Q
  1. 62 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=62 D X62 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X62 I X K DGPTIT S DGNFLD="@55",Y="@800",DGPTIT(X_$C(59)_"ICD9(")=""
  1.  Q
  1. 63 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=63 D X63 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X63 S:$P($G(^DGPT(D0,70)),U,20,24)_$P($G(^DGPT(D0,71)),U,1,3)?."^" Y="@120"
  1.  Q
  1. 64 S DQ=65 ;@55
  1. 65 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=65 D X65 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X65 S DGNFLD="@60"
  1.  Q
  1. 66 S DW="70;21",DV="*P80'X",DU="",DIFLD=79.21,DLB=$$LABEL^DIALOGZ(DP,DIFLD)
  1.  S DE(DW)="C66^DGPTX7",DE(DW,"INDEX")=1
  1.  S DU="ICD9("
  1.  G RE
  1. C66 G C66S:$D(DE(66))[0 K DB
  1.  D ^DGPTX71
  1. C66S S X="" G:DG(DQ)=X C66F1 K DB
  1.  D ^DGPTX72
  1. C66F1 S DIEZRXR(45,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
  1.  F DIXR=833,1196 S DIEZRXR(45,DIXR)=""
  1.  Q
  1. X66 N DGI S DGI=7 D GETAPI^DGICDGT("DG PTF","DIAG",$G(DA),"EN3")
  1.  Q
  1.  ;
  1. 67 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=67 D X67 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X67 S DGXX=X
  1.  Q
  1. 68 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=68 D X68 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17
  1. X68 I DGCODSYS="ICD9"!(DGXX="")!(DGTYPE=2) S Y="@56"
  1.  Q
  1. 69 D:$D(DG)>9 F^DIE17 G ^DGPTX73