Changeset 623 for WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC

Timestamp:

Dec 4, 2009, 12:11:15 AM (15 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

Location:

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC

Files:

• DVBHCE.m (modified) (3 diffs)
• DVBHCE1.m (modified) (1 diff)
• DVBHCE10.m (modified) (1 diff)
• DVBHCE11.m (modified) (1 diff)
• DVBHCE12.m (modified) (1 diff)
• DVBHCE13.m (modified) (1 diff)
• DVBHCE14.m (modified) (2 diffs)
• DVBHCE15.m (modified) (2 diffs)
• DVBHCE16.m (modified) (1 diff)
• DVBHCE17.m (modified) (2 diffs)
• DVBHCE18.m (modified) (6 diffs)
• DVBHCE19.m (modified) (1 diff)
• DVBHCE2.m (modified) (1 diff)
• DVBHCE20.m (modified) (1 diff)
• DVBHCE21.m (modified) (1 diff)
• DVBHCE22.m (modified) (1 diff)
• DVBHCE23.m (modified) (1 diff)
• DVBHCE24.m (modified) (1 diff)
• DVBHCE25.m (modified) (1 diff)
• DVBHCE26.m (modified) (2 diffs)
• DVBHCE27.m (modified) (1 diff)
• DVBHCE28.m (modified) (1 diff)
• DVBHCE29.m (modified) (1 diff)
• DVBHCE3.m (modified) (1 diff)
• DVBHCE4.m (modified) (1 diff)
• DVBHCE5.m (modified) (1 diff)
• DVBHCE6.m (modified) (1 diff)
• DVBHCE7.m (modified) (1 diff)
• DVBHCE8.m (modified) (2 diffs)
• DVBHCE9.m (modified) (1 diff)
• DVBHCG.m (modified) (1 diff)

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE.m

@@ -1 @@
-DVBHCE ; GENERATED FROM 'DVBHINQ UPDATE' INPUT TEMPLATE(#960), FILE 2;12/13/08
+DVBHCE ; GENERATED FROM 'DVBHINQ UPDATE' INPUT TEMPLATE(#960), FILE 2;12/27/07
  D DE G BEGIN
 DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,4) S:%]"" DE(23)=% S %=$P(%Z,U,5) S:%]"" DE(21)=% S %=$P(%Z,U,6) S:%]"" DE(19)=% S %=$P(%Z,U,7) S:%]"" DE(20)=% S %=$P(%Z,U,8) S:%]"" DE(24)=% S %=$P(%Z,U,11) S:%]"" DE(32)=% S %=$P(%Z,U,19) S:%]"" DE(30)=%
+ I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,4) S:%]"" DE(23)=% S %=$P(%Z,U,5) S:%]"" DE(21)=% S %=$P(%Z,U,6) S:%]"" DE(19)=% S %=$P(%Z,U,7) S:%]"" DE(20)=% S %=$P(%Z,U,8) S:%]"" DE(24)=%
  K %Z Q
  ;
@@ -191 +191 @@
  G RE
 C24 G C24S:$D(DE(24))[0 K DB
- S X=DE(24),DIC=DIE
- D EVENT^IVMPLOG(DA)
+ D ^DVBHCE1
 C24S S X="" G:DG(DQ)=X C24F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
+ D ^DVBHCE2
 C24F1 Q
 X24 S DFN=DA D SV^DGLOCK I $D(X) S:X?1"SS".E L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>15!($L(X)<1)!'(X?.N) X
@@ -214 +212 @@
 X29 S DVBSCR=1 D ^DVBHS4 W !,?34,DVBON,"[NTLAST]",DVBOFF X DVBLIT1
  Q
-30 D:$D(DG)>9 F^DIE17,DE S DQ=30,DW=".32;19",DV="RSX",DU="",DLB="Service NTL Episode",DIFLD=.3285
- S DE(DW)="C30^DVBHCE"
- S DU="Y:YES;N:NO;"
- G RE
-C30 G C30S:$D(DE(30))[0 K DB
- S X=DE(30),DIC=DIE
- ;
- S X=DE(30),DIC=DIE
- ;
- S X=DE(30),DIC=DIE
- X ^DD(2,.3285,1,3,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.32)),DIV=X S $P(^(.32),U,10)=DIV,DIH=2,DIG=.3291 D ^DICR
-C30S S X="" G:DG(DQ)=X C30F1 K DB
- D ^DVBHCE1
-C30F1 Q
-X30 S DFN=DA D SV^DGLOCK
- Q
- ;
-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
-X31 I $P(^DPT(D0,.32),U,19)'="Y" S Y="@31"
- Q
-32 D:$D(DG)>9 F^DIE17,DE S DQ=32,DW=".32;11",DV="RDX",DU="",DLB="NTL-EOD",DIFLD=.3292
- S DE(DW)="C32^DVBHCE",DE(DW,"INDEX")=1
- G RE
-C32 G C32S:$D(DE(32))[0 K DB
- D ^DVBHCE2
-C32S S X="" G:DG(DQ)=X C32F1 K DB
- D ^DVBHCE3
-C32F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
- F DIXR=649 S DIEZRXR(2,DIXR)=""
- Q
-X32 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER1^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,0,"MSNTL") X I $D(X) S DGFRDT=X I $D(^DG(43,1)) S SD1=2 D POS^DGINP
- Q
- ;
-33 D:$D(DG)>9 F^DIE17 G ^DVBHCE4
+30 D:$D(DG)>9 F^DIE17 G ^DVBHCE3

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE1.m

@@ -1 @@
-DVBHCE1 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- X "I X'=""Y"" S DGXRF=.3285 D ^DGDDC Q"
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.3285,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,.3285,1,2,1.4)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$C(59)_$P($G(^DD(2,.3285,0)),U,3) S X=$P($P(Y(1),$C(59)_Y(0)_":",2),$C(59))'="YES" I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" X ^DD(2,.3285,1,3,1.4)
+DVBHCE1 ; ;12/27/07
+ S X=DE(24),DIC=DIE
+ D EVENT^IVMPLOG(DA)

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE10.m

@@ -1 @@
-DVBHCE10 ; ;12/13/08
+DVBHCE10 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
+ X ^DD(2,.301,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,1,1.4)
  S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- S X=DG(DQ),DIC=DIE
- X ^DD(2,1901,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,1901,1,3,1.4)
+ X ^DD(2,.301,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,2,1.4)
  S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VAFCDD01(DA)
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VAFCDD01(DA)
  S X=DG(DQ),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(21))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ I $D(DE(13))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE11.m

@@ -1 @@
-DVBHCE11 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.301,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.301,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X="" X ^DD(2,.301,1,2,1.4)
- S X=DG(DQ),DIC=DIE
+DVBHCE11 ; ;12/27/07
+ S X=DE(16),DIC=DIE
+ ;
+ S X=DE(16),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I DIV(1)>0 S DIK(0)=DA,DIK="^DPT(DIV(0),""E"",",DA(1)=DIV(0),DA=DIV(1) D ^DIK S DA=DIK(0) K DIK
+ S X=DE(16),DIC=DIE
+ X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
+ S X=DE(16),DIC=DIE
+ K ^DPT("AEL",DA,+X)
+ S X=DE(16),DIC=DIE
  D AUTOUPD^DGENA2(DA)
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(22))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ S X=DE(16),DIIX=2_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE12.m

@@ -1 @@
-DVBHCE12 ; ;12/13/08
- S X=DE(25),DIC=DIE
+DVBHCE12 ; ;12/27/07
+ S X=DG(DQ),DIC=DIE
+ X "S DFN=DA D EN^DGMTR K DGREQF"
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4) S Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
  ;
- S X=DE(25),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I DIV(1)>0 S DIK(0)=DA,DIK="^DPT(DIV(0),""E"",",DA(1)=DIV(0),DA=DIV(1) D ^DIK S DA=DIK(0) K DIK
- S X=DE(25),DIC=DIE
- X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
- S X=DE(25),DIC=DIE
- K ^DPT("AEL",DA,+X)
- S X=DE(25),DIC=DIE
+ S X=DG(DQ),DIC=DIE
+ S ^DPT("AEL",DA,+X)=""
+ S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
- S X=DE(25),DIIX=2_U_DIFLD D AUDIT^DIET
+ I $D(DE(16))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE13.m

@@ -1 @@
-DVBHCE13 ; ;12/13/08
+DVBHCE13 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,11) S:%]"" DE(4)=%
+ I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(1)=% S %=$P(%Z,U,13) S:%]"" DE(2)=% S %=$P(%Z,U,14) S:%]"" DE(3)=% S %=$P(%Z,U,20) S:%]"" DE(5)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE13",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
+ S DE(DW)="C1^DVBHCE13"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ G RE
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
+ S X=DE(1),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DE(1),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
+ S X=DE(1),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C1F1 Q
+X1 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
+ S DE(DW)="C2^DVBHCE13"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ G RE
+C2 G C2S:$D(DE(2))[0 K DB
+ S X=DE(2),DIC=DIE
+ X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
+ S X=DE(2),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DE(2),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
+ S X=DE(2),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C2S S X="" G:DG(DQ)=X C2F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C2F1 Q
+X2 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
+ Q
+ ;
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".362;14",DV="SX",DU="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
+ S DE(DW)="C3^DVBHCE13"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ G RE
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
+ X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,2.4)
+ S X=DE(3),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DE(3),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,2.4)
+ S X=DE(3),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C3F1 Q
+X3 S DFN=DA D MV^DGLOCK
+ Q
+ ;
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".3;11",DV="SX",DU="",DLB="RECEIVING VA DISABILITY?",DIFLD=.3025
+ S DE(DW)="C4^DVBHCE13"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ G RE
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
+ X ^DD(2,.3025,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,2.4)
+ S X=DE(4),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,2.4)
+ S X=DE(4),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.3025,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4F1 Q
+X4 S DFN=DA D MV^DGLOCK I $D(X),X="Y" D EC^DGLOCK1
+ Q
+ ;
+5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".362;20",DV="NJ8,2X",DU="",DLB="TOTAL ANNUAL VA CHECK AMOUNT",DIFLD=.36295
+ S DE(DW)="C5^DVBHCE13"
+ G RE
+C5 G C5S:$D(DE(5))[0 K DB
+ S X=DE(5),DIC=DIE
+ X "S DFN=DA D EN^DGMTR K DGREQF"
+ S X=DE(5),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C5S S X="" G:DG(DQ)=X C5F1 K DB
  S X=DG(DQ),DIC=DIE
  X "S DFN=DA D EN^DGMTR K DGREQF"
  S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,89.4) S Y(102)=$S($D(^DPT(D0,"E",D1,0)):^(0),1:"") S X=$S('$D(^DIC(8,+$P(Y(102),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S D1=I(1,0) S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,.361,1,2,1.4)
- S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+C5F1 Q
+X5 D DOL^DGLOCK2 K:+X'=X&(X'?.N1"."2N)!(X>99999)!(X<0) X I $D(X) S DFN=DA D MV^DGLOCK I $D(X),('$$TOTCHK^DGLOCK2(DFN)) D TOTCKMSG^DGLOCK2 K X
+ Q
  ;
- S X=DG(DQ),DIC=DIE
- S ^DPT("AEL",DA,+X)=""
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- I $D(DE(25))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+6 S DQ=7 ;@2062
+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
+X7 S Y="@104"
+ Q
+8 S DQ=9 ;@11
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 S DVBJ2=1
+ Q
+10 D:$D(DG)>9 F^DIE17 G ^DVBHCE14

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE14.m

@@ -1 @@
-DVBHCE14 ; ;12/13/08
+DVBHCE14 ; ;12/27/07
  D DE G BEGIN
 DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,1) S:%]"" DE(10)=% S %=$P(%Z,U,2) S:%]"" DE(11)=%
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,11) S:%]"" DE(4)=%
- I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,12) S:%]"" DE(1)=% S %=$P(%Z,U,13) S:%]"" DE(2)=% S %=$P(%Z,U,14) S:%]"" DE(3)=% S %=$P(%Z,U,20) S:%]"" DE(5)=%
+ I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=% S %=$P(%Z,U,4) S:%]"" DE(4)=%
  K %Z Q
  ;
@@ -52 +50 @@
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="DVBHCE14",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".362;12",DV="SX",DU="",DLB="RECEIVING A&A BENEFITS?",DIFLD=.36205
- S DE(DW)="C1^DVBHCE14"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".11;1",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 1]",DIFLD=.111
+ S DE(DW)="C1^DVBHCE14",DE(DW,"INDEX")=1
  G RE
 C1 G C1S:$D(DE(1))[0 K DB
  S X=DE(1),DIC=DIE
- X ^DD(2,.36205,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,2.4)
- S X=DE(1),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(1),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,2.4)
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA)
+ X "S DGXRF=.111 D ^DGDDC Q"
+ S X=DE(1),DIC=DIE
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DE(1),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(1),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DE(1),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(1),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".111;" D AVAFC^VAFCDD01(DA)
+ S X=DE(1),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
 C1S S X="" G:DG(DQ)=X C1F1 K DB
  S X=DG(DQ),DIC=DIE
- X ^DD(2,.36205,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36205,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C1F1 Q
-X1 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".362;13",DV="SX",DU="",DLB="RECEIVING HOUSEBOUND BENEFITS?",DIFLD=.36215
- S DE(DW)="C2^DVBHCE14"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
+ ;
+ S X=DG(DQ),DIC=DIE
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DG(DQ),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".111;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C1F1 N X,X1,X2 S DIXR=230 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.111,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.111,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C1F2
+C1X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.111,DION),$P($G(^DPT(DA,.11)),U,1))
+ S X=$G(X(1))
+ Q
+C1F2 Q
+X1 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>35!($L(X)<3) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".11;2",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 2]",DIFLD=.112
+ S DE(DW)="C2^DVBHCE14",DE(DW,"INDEX")=1
  G RE
 C2 G C2S:$D(DE(2))[0 K DB
  S X=DE(2),DIC=DIE
- X ^DD(2,.36215,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,2.4)
- S X=DE(2),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(2),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,2.4)
- S X=DE(2),DIC=DIE
- D AUTOUPD^DGENA2(DA)
+ X "S DGXRF=.112 D ^DGDDC Q"
+ S X=DE(2),DIC=DIE
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DE(2),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(2),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DE(2),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(2),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".112;" D AVAFC^VAFCDD01(DA)
+ S X=DE(2),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
 C2S S X="" G:DG(DQ)=X C2F1 K DB
  S X=DG(DQ),DIC=DIE
- X ^DD(2,.36215,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36215,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C2F1 Q
-X2 S DFN=DA D MV^DGLOCK I $D(X) S DFN=DA D EV^DGLOCK
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".362;14",DV="SX",DU="",DLB="RECEIVING A VA PENSION?",DIFLD=.36235
- S DE(DW)="C3^DVBHCE14"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
+ ;
+ S X=DG(DQ),DIC=DIE
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DG(DQ),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".112;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C2F1 N X,X1,X2 S DIXR=232 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.112,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.112,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C2F2
+C2X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.112,DION),$P($G(^DPT(DA,.11)),U,2))
+ S X=$G(X(1))
+ Q
+C2F2 Q
+X2 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X D:$D(X) UP^DGHELP
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".11;3",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 3]",DIFLD=.113
+ S DE(DW)="C3^DVBHCE14",DE(DW,"INDEX")=1
  G RE
 C3 G C3S:$D(DE(3))[0 K DB
  S X=DE(3),DIC=DIE
- X ^DD(2,.36235,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,2.4)
- S X=DE(3),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(3),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,2.4)
- S X=DE(3),DIC=DIE
- D AUTOUPD^DGENA2(DA)
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DE(3),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(3),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DE(3),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(3),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".113;" D AVAFC^VAFCDD01(DA)
+ S X=DE(3),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET
 C3S S X="" G:DG(DQ)=X C3F1 K DB
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.36235,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.36235,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C3F1 Q
-X3 S DFN=DA D MV^DGLOCK
- Q
- ;
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".3;11",DV="SX",DU="",DLB="RECEIVING VA DISABILITY?",DIFLD=.3025
- S DE(DW)="C4^DVBHCE14"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
+ D ^DVBHCE15
+C3F1 N X,X1,X2 S DIXR=233 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.113,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.113,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C3F2
+C3X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.113,DION),$P($G(^DPT(DA,.11)),U,3))
+ S X=$G(X(1))
+ Q
+C3F2 Q
+X3 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".11;4",DV="Fa",DU="",DLB="CITY",DIFLD=.114
+ S DE(DW)="C4^DVBHCE14",DE(DW,"INDEX")=1
  G RE
 C4 G C4S:$D(DE(4))[0 K DB
- S X=DE(4),DIC=DIE
- X ^DD(2,.3025,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,2.4)
- S X=DE(4),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,2.4)
- S X=DE(4),DIC=DIE
- D EVENT^IVMPLOG(DA)
+ D ^DVBHCE16
 C4S S X="" G:DG(DQ)=X C4F1 K DB
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.3025,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$TOTCHK^DGLOCK2(DA) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X="" X ^DD(2,.3025,1,2,1.4)
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C4F1 Q
-X4 S DFN=DA D MV^DGLOCK I $D(X),X="Y" D EC^DGLOCK1
- Q
- ;
-5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".362;20",DV="NJ8,2X",DU="",DLB="TOTAL ANNUAL VA CHECK AMOUNT",DIFLD=.36295
- S DE(DW)="C5^DVBHCE14"
- G RE
-C5 G C5S:$D(DE(5))[0 K DB
- S X=DE(5),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- S X=DE(5),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C5S S X="" G:DG(DQ)=X C5F1 K DB
- S X=DG(DQ),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
-C5F1 Q
-X5 D DOL^DGLOCK2 K:+X'=X&(X'?.N1"."2N)!(X>99999)!(X<0) X I $D(X) S DFN=DA D MV^DGLOCK I $D(X),('$$TOTCHK^DGLOCK2(DFN)) D TOTCKMSG^DGLOCK2 K X
- Q
- ;
-6 S DQ=7 ;@2062
-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
-X7 S Y="@104"
- Q
-8 S DQ=9 ;@11
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 S DVBJ2=1
- Q
-10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW=".11;1",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 1]",DIFLD=.111
- S DE(DW)="C10^DVBHCE14",DE(DW,"INDEX")=1
- G RE
-C10 G C10S:$D(DE(10))[0 K DB
- S X=DE(10),DIC=DIE
- X "S DGXRF=.111 D ^DGDDC Q"
- S X=DE(10),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DE(10),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(10),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(10),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(10),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".111;" D AVAFC^VAFCDD01(DA)
- S X=DE(10),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(10),DIIX=2_U_DIFLD D AUDIT^DIET
-C10S S X="" G:DG(DQ)=X C10F1 K DB
- D ^DVBHCE15
-C10F1 N X,X1,X2 S DIXR=230 D C10X1(U) K X2 M X2=X D C10X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.111,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.111,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C10F2
-C10X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.111,DION),$P($G(^DPT(DA,.11)),U,1))
- S X=$G(X(1))
- Q
-C10F2 Q
-X10 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>35!($L(X)<3) X
- I $D(X),X'?.ANP K X
- Q
- ;
-11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW=".11;2",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 2]",DIFLD=.112
- S DE(DW)="C11^DVBHCE14",DE(DW,"INDEX")=1
- G RE
-C11 G C11S:$D(DE(11))[0 K DB
- D ^DVBHCE16
-C11S S X="" G:DG(DQ)=X C11F1 K DB
  D ^DVBHCE17
-C11F1 N X,X1,X2 S DIXR=232 D C11X1(U) K X2 M X2=X D C11X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.112,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.112,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C11F2
-C11X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.112,DION),$P($G(^DPT(DA,.11)),U,2))
- S X=$G(X(1))
- Q
-C11F2 Q
-X11 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X D:$D(X) UP^DGHELP
- I $D(X),X'?.ANP K X
- Q
- ;
-12 D:$D(DG)>9 F^DIE17 G ^DVBHCE18
+C4F1 N X,X1,X2 S DIXR=234 D C4X1(U) K X2 M X2=X D C4X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.114,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.114,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C4F2
+C4X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.114,DION),$P($G(^DPT(DA,.11)),U,4))
+ S X=$G(X(1))
+ Q
+C4F2 Q
+X4 K:$L(X)>15!($L(X)<2) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+5 D:$D(DG)>9 F^DIE17 G ^DVBHCE18

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE15.m

@@ -1 @@
-DVBHCE15 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- ;
+DVBHCE15 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
  S A1B2TAG="PAT" D ^A1B2XFR
@@ -11 +9 @@
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".111;" D AVAFC^VAFCDD01(DA)
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".113;" D AVAFC^VAFCDD01(DA)
  S X=DG(DQ),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(10))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE16.m

@@ -1 @@
-DVBHCE16 ; ;12/13/08
- S X=DE(11),DIC=DIE
- X "S DGXRF=.112 D ^DGDDC Q"
- S X=DE(11),DIC=DIE
+DVBHCE16 ; ;12/27/07
+ S X=DE(4),DIC=DIE
  S A1B2TAG="PAT" D ^A1B2XFR
- S X=DE(11),DIC=DIE
+ S X=DE(4),DIC=DIE
  D EVENT^IVMPLOG(DA)
- S X=DE(11),DIC=DIE
+ S X=DE(4),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(11),DIC=DIE
+ S X=DE(4),DIC=DIE
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(11),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".112;" D AVAFC^VAFCDD01(DA)
- S X=DE(11),DIC=DIE
+ S X=DE(4),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA)
+ S X=DE(4),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(11),DIIX=2_U_DIFLD D AUDIT^DIET
+ S X=DE(4),DIIX=2_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE17.m

@@ -1 @@
-DVBHCE17 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- ;
+DVBHCE17 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
  S A1B2TAG="PAT" D ^A1B2XFR
@@ -11 +9 @@
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".112;" D AVAFC^VAFCDD01(DA)
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA)
  S X=DG(DQ),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(11))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ I $D(DE(4))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE18.m

@@ -1 @@
-DVBHCE18 ; ;12/13/08
+DVBHCE18 ; ;12/27/07
  D DE G BEGIN
 DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,3) S:%]"" DE(1)=% S %=$P(%Z,U,4) S:%]"" DE(2)=% S %=$P(%Z,U,5) S:%]"" DE(3)=% S %=$P(%Z,U,7) S:%]"" DE(5)=% S %=$P(%Z,U,12) S:%]"" DE(4)=%
+ I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,5) S:%]"" DE(1)=% S %=$P(%Z,U,7) S:%]"" DE(3)=% S %=$P(%Z,U,12) S:%]"" DE(2)=%
  K %Z Q
  ;
@@ -50 +50 @@
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
 BEGIN S DNM="DVBHCE18",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".11;3",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 3]",DIFLD=.113
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".11;5",DV="P5'a",DU="",DLB="STATE",DIFLD=.115
  S DE(DW)="C1^DVBHCE18",DE(DW,"INDEX")=1
+ S DU="DIC(5,"
  G RE
 C1 G C1S:$D(DE(1))[0 K DB
  S X=DE(1),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:""),Y=$P(Y(1),U,7) X:$D(^DD(2,.117,2)) ^(2) S X=Y S DIU=X K Y S X=DIV S X="" X ^DD(2,.115,1,1,2.4)
+ S X=DE(1),DIC=DIE
  S A1B2TAG="PAT" D ^A1B2XFR
  S X=DE(1),DIC=DIE
  D EVENT^IVMPLOG(DA)
  S X=DE(1),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(1),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(1),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".113;" D AVAFC^VAFCDD01(DA)
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DE(1),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(1),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA)
  S X=DE(1),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
@@ -69 +72 @@
 C1S S X="" G:DG(DQ)=X C1F1 K DB
  S X=DG(DQ),DIC=DIE
+ ;
+ S X=DG(DQ),DIC=DIE
  S A1B2TAG="PAT" D ^A1B2XFR
  S X=DG(DQ),DIC=DIE
@@ -77 +82 @@
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".113;" D AVAFC^VAFCDD01(DA)
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA)
  S X=DG(DQ),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
  I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C1F1 N X,X1,X2 S DIXR=233 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.113,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.113,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C1F2
-C1X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.113,DION),$P($G(^DPT(DA,.11)),U,3))
- S X=$G(X(1))
- Q
-C1F2 Q
-X1 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X
- I $D(X),X'?.ANP K X
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".11;4",DV="Fa",DU="",DLB="CITY",DIFLD=.114
- S DE(DW)="C2^DVBHCE18",DE(DW,"INDEX")=1
- G RE
-C2 G C2S:$D(DE(2))[0 K DB
- S X=DE(2),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DE(2),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(2),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(2),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(2),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA)
- S X=DE(2),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
-C2S S X="" G:DG(DQ)=X C2F1 K DB
- S X=DG(DQ),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DG(DQ),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".114;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C2F1 N X,X1,X2 S DIXR=234 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.114,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.114,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C2F2
-C2X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.114,DION),$P($G(^DPT(DA,.11)),U,4))
- S X=$G(X(1))
- Q
-C2F2 Q
-X2 K:$L(X)>15!($L(X)<2) X
- I $D(X),X'?.ANP K X
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".11;5",DV="P5'a",DU="",DLB="STATE",DIFLD=.115
- S DE(DW)="C3^DVBHCE18",DE(DW,"INDEX")=1
- S DU="DIC(5,"
- G RE
-C3 G C3S:$D(DE(3))[0 K DB
- S X=DE(3),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:""),Y=$P(Y(1),U,7) X:$D(^DD(2,.117,2)) ^(2) S X=Y S DIU=X K Y S X=DIV S X="" X ^DD(2,.115,1,1,2.4)
- S X=DE(3),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DE(3),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(3),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(3),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(3),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA)
- S X=DE(3),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET
-C3S S X="" G:DG(DQ)=X C3F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DG(DQ),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".115;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C3F1 N X,X1,X2 S DIXR=235 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
+C1F1 N X,X1,X2 S DIXR=235 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
  D
  . D FC^DGFCPROT(.DA,2,.115,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
  K X M X=X2 D
  . D FC^DGFCPROT(.DA,2,.115,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C3F2
-C3X1(DION) K X
+ G C1F2
+C1X1(DION) K X
  S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.115,DION),$P($G(^DPT(DA,.11)),U,5))
  S X=$G(X(1))
  Q
-C3F2 Q
-X3 Q
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".11;12",DV="FXOa",DU="",DLB="ZIP+4",DIFLD=.1112
- S DQ(4,2)="S Y(0)=Y D ZIPOUT^VAFADDR"
- S DE(DW)="C4^DVBHCE18",DE(DW,"INDEX")=1
+C1F2 Q
+X1 Q
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".11;12",DV="FXOa",DU="",DLB="ZIP+4",DIFLD=.1112
+ S DQ(2,2)="S Y(0)=Y D ZIPOUT^VAFADDR"
+ S DE(DW)="C2^DVBHCE18",DE(DW,"INDEX")=1
  G RE
-C4 G C4S:$D(DE(4))[0 K DB
- S X=DE(4),DIC=DIE
+C2 G C2S:$D(DE(2))[0 K DB
+ S X=DE(2),DIC=DIE
  D KILL^DGREGDD1(DA,.116,.11,6,$E(X,1,5))
- S X=DE(4),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(4),DIC=DIE
+ S X=DE(2),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(2),DIC=DIE
  K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DE(4),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(4),DIC=DIE
+ S X=DE(2),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(2),DIC=DIE
  I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".1112;" D AVAFC^VAFCDD01(DA)
- S X=DE(4),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(4),DIIX=2_U_DIFLD D AUDIT^DIET
-C4S S X="" G:DG(DQ)=X C4F1 K DB
- D ^DVBHCE19
-C4F1 N X,X1,X2 S DIXR=185 D C4X1(U) K X2 M X2=X D C4X1("O") K X1 M X1=X
+ S X=DE(2),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(2),DIIX=2_U_DIFLD D AUDIT^DIET
+C2S S X="" G:DG(DQ)=X C2F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D SET^DGREGDD1(DA,.116,.11,6,$E(X,1,5))
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
+ S X=DG(DQ),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".1112;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(2))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C2F1 N X,X1,X2 S DIXR=185 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
  D
  . N DIEXARR M DIEXARR=X S DIEZCOND=1
@@ -216 +136 @@
  . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
  . K EASDO2
- G C4F2
-C4X1(DION) K X
+ G C2F2
+C2X1(DION) K X
  S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.1112,DION),$P($G(^DPT(DA,.11)),U,12))
  S:('$G(EASDO2)&($D(EASZIPLK))) X=$$ZIP^DGREGDD1(DA,X(1))
@@ -223 +143 @@
  S X=$G(X(1))
  Q
-C4F2 S DIXR=231 D C4X2(U) K X2 M X2=X D C4X2("O") K X1 M X1=X
+C2F2 S DIXR=231 D C2X2(U) K X2 M X2=X D C2X2("O") K X1 M X1=X
  D
  . D FC^DGFCPROT(.DA,2,.1112,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
  K X M X=X2 D
  . D FC^DGFCPROT(.DA,2,.1112,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C4F3
-C4X2(DION) K X
+ G C2F3
+C2X2(DION) K X
  S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.1112,DION),$P($G(^DPT(DA,.11)),U,12))
  S X=$G(X(1))
  Q
-C4F3 Q
-X4 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR
+C2F3 Q
+X2 K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR
  I $D(X),X'?.ANP K X
  Q
  ;
-5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".11;7",DV="NJ3,0XOa",DU="",DLB="COUNTY",DIFLD=.117
- S DQ(5,2)="S Y(0)=Y Q:Y']""""  S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),""^"",5),1:"""") Q:'Z0  S Y=$P($S($D(^DIC(5,Z0,1,Y,0)):^(0),1:""""),""^"",3)"
- S DE(DW)="C5^DVBHCE18"
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".11;7",DV="NJ3,0XOa",DU="",DLB="COUNTY",DIFLD=.117
+ S DQ(3,2)="S Y(0)=Y Q:Y']""""  S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),""^"",5),1:"""") Q:'Z0  S Y=$P($S($D(^DIC(5,Z0,1,Y,0)):^(0),1:""""),""^"",3)"
+ S DE(DW)="C3^DVBHCE18"
  G RE
-C5 G C5S:$D(DE(5))[0 K DB
- D ^DVBHCE20
-C5S S X="" G:DG(DQ)=X C5F1 K DB
- D ^DVBHCE21
-C5F1 Q
-X5 S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),"^",5),1:0) K:'Z0 X Q:'Z0!'$D(^DIC(5,Z0,1,0))  S DIC="^DIC(5,Z0,1,",DIC(0)="QEM" D ^DIC S X=+Y K:Y'>0 X K Z0,DIC
- Q
- ;
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
+ S A1B2TAG="PAT" D ^A1B2XFR
+ S X=DE(3),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(3),DIC=DIE
+ S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
+ S X=DE(3),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".117;" D AVAFC^VAFCDD01(DA)
+ S X=DE(3),DIIX=2_U_DIFLD D AUDIT^DIET
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ D ^DVBHCE19
+C3F1 Q
+X3 S Z0=$S($D(^DPT(D0,.11)):+$P(^(.11),"^",5),1:0) K:'Z0 X Q:'Z0!'$D(^DIC(5,Z0,1,0))  S DIC="^DIC(5,Z0,1,",DIC(0)="QEM" D ^DIC S X=+Y K:Y'>0 X K Z0,DIC
+ Q
+ ;
+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
+X4 S Y="@1001"
+ Q
+5 S DQ=6 ;@5
 6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 S Y="@1001"
- Q
-7 S DQ=8 ;@5
+X6 D SCRQ^DVBHUTIL
+ Q
+7 S DQ=8 ;@6
 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
-X8 D SCRQ^DVBHUTIL
- Q
-9 S DQ=10 ;@6
+X8 D B^DVBHQEDT R AA:DTIME K AA S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")
+ Q
+9 S DQ=10 ;@8
 10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
-X10 D B^DVBHQEDT R AA:DTIME K AA S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")
- Q
-11 S DQ=12 ;@8
-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
-X12 S Y=$S(ANS="^0":"@101",ANS="^1":"@1001",ANS="^2":"@1",ANS="^3":"@2",ANS="^4":"@3",ANS="^5":"@104",1:Y) I Y["@" W @$S('$D(IOF):"#",IOF="":"#",1:IOF)
- Q
+X10 S Y=$S(ANS="^0":"@101",ANS="^1":"@1001",ANS="^2":"@1",ANS="^3":"@2",ANS="^4":"@3",ANS="^5":"@104",1:Y) I Y["@" W @$S('$D(IOF):"#",IOF="":"#",1:IOF)
+ Q
+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
+X11 D A^DVBHQEDT S Z2=Z I ERROR K ERROR S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")
+ Q
+12 S DQ=13 ;@20
 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
-X13 D A^DVBHQEDT S Z2=Z I ERROR K ERROR S Y=$S(DVBJS=11:"@1001",DVBJS=28:"@1",DVBJS=35:"@2",DVBJS=44:"@3",DVBJS=53:"@104",1:"@10")
- Q
-14 S DQ=15 ;@20
+X13 S JP=1,Y=$S(DVBJS=11:"@11",DVBJS=35:"@40",DVBJS=44:"@30",DVBJS=53:"@204",1:Y)
+ Q
+14 S DQ=15 ;@21
 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
-X15 S JP=1,Y=$S(DVBJS=11:"@11",DVBJS=35:"@40",DVBJS=44:"@30",DVBJS=53:"@204",1:Y)
- Q
-16 S DQ=17 ;@21
+X15 I $P(Z2,U,JP)'=1 S Y="@22"
+ Q
+16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 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
+X16 I '$D(DVBCN) S Y="@22",JP=JP+1
+ Q
 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
-X17 I $P(Z2,U,JP)'=1 S Y="@22"
+X17 I 'DVBCN S Y="@22",JP=JP+1
  Q
 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
-X18 I '$D(DVBCN) S Y="@22",JP=JP+1
+X18 S DVBCN=$TR(DVBCN," ")
  Q
 19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 I 'DVBCN S Y="@22",JP=JP+1
- Q
-20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
-X20 S DVBCN=$TR(DVBCN," ")
- Q
-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
-X21 I $L(DVBCN)=9,(DVBCN?9N),(DVBCN'=$P(^DPT(D0,0),U,9)) W !!,*7,"HINQ claim # is a SSN, does not match patient file SSN  NO UPDATING claim #" R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@22",JP=JP+1
- Q
-22 D:$D(DG)>9 F^DIE17 G ^DVBHCE22
+X19 I $L(DVBCN)=9,(DVBCN?9N),(DVBCN'=$P(^DPT(D0,0),U,9)) W !!,*7,"HINQ claim # is a SSN, does not match patient file SSN  NO UPDATING claim #" R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@22",JP=JP+1
+ Q
+20 D:$D(DG)>9 F^DIE17 G ^DVBHCE20

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE19.m

@@ -1 @@
-DVBHCE19 ; ;12/13/08
+DVBHCE19 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
- D SET^DGREGDD1(DA,.116,.11,6,$E(X,1,5))
+ S A1B2TAG="PAT" D ^A1B2XFR
  S X=DG(DQ),DIC=DIE
  D EVENT^IVMPLOG(DA)
  S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.11)),DIV=X S $P(^(.11),U,13)=DIV,DIH=2,DIG=.118 D ^DICR
- S X=DG(DQ),DIC=DIE
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".1112;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(4))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".117;" D AVAFC^VAFCDD01(DA)
+ I $D(DE(3))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE2.m

@@ -1 @@
-DVBHCE2 ; ;12/13/08
- S X=DE(32),DIC=DIE
- ;
- S X=DE(32),DIC=DIE
+DVBHCE2 ; ;12/27/07
+ S X=DG(DQ),DIC=DIE
  D EVENT^IVMPLOG(DA)

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE20.m

@@ -1 @@
-DVBHCE20 ; ;12/13/08
- S X=DE(5),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DE(5),DIC=DIE
+DVBHCE20 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.31)) S %Z=^(.31) S %=$P(%Z,U,3) S:%]"" DE(1)=%
+ I $D(^(.35)) S %Z=^(.35) S %=$P(%Z,U,1) S:%]"" DE(20)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE20",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".31;3",DV="FXOa",DU="",DLB="CLAIM NUMBER",DIFLD=.313
+ S DQ(1,2)="S Y(0)=Y S Y=$E(Y,1,10)"
+ S DE(DW)="C1^DVBHCE20"
+ S X=DVBCN
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".313;" D AVAFC^VAFCDD01(DA)
+ S X=DE(1),DIC=DIE
  D EVENT^IVMPLOG(DA)
- S X=DE(5),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(5),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".117;" D AVAFC^VAFCDD01(DA)
- S X=DE(5),DIIX=2_U_DIFLD D AUDIT^DIET
+ S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".313;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C1F1 Q
+X1 S DFN=DA D EV^DGLOCK I $D(X) S L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>9 X Q:'$D(X)  I X'=L K:$L(X)>8!($L(X)<7)!'(X?.N) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+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
+X2 W "." S JP=JP+1,DVBJ2=1
+ Q
+3 S DQ=4 ;@22
+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
+X4 I $P(Z2,U,JP)'=2 S Y="@225"
+ Q
+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
+X5 W !,"Date of Birth cannot be edited with this option."
+ Q
+6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
+X6 H 1
+ Q
+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
+X7 W "." S JP=JP+1,DVBJ2=1
+ Q
+8 S DQ=9 ;@225
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 I $P(Z2,U,JP)'=3 S Y="@23"
+ Q
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
+X10 W !,"Sex cannot be edited with this option."
+ Q
+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
+X11 H 1
+ Q
+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
+X12 W "." S JP=JP+1,DVBJ2=1
+ Q
+13 S DQ=14 ;@23
+14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
+X14 I $P(Z2,U,JP)'=4 S Y="@24"
+ Q
+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
+X15 K Z1 I $D(DVBP(6)),+$P(DVBP(6),U) S Z1=$P(DVBP(6),U),Z1=$E(Z1,1,2)_" "_$E(Z1,3,4)_" "_$E(Z1,5,8)
+ Q
+16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 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
+X16 I $D(DVBVET),$P(DVBVET,U,1)="B",+$P(DVBVET,U,12) S Z1=$P(DVBVET,U,12),Z1=$E(Z1,5,6)_" "_$E(Z1,7,8)_" "_$E(Z1,1,4)
+ Q
+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
+X17 I '$D(Z1) S Y="@24",JP=JP+1
+ Q
+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
+X18 I 'Z1 S Y="@24",JP=JP+1
+ Q
+19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
+X19 I $D(^DPT(D0,.105)) W !!,"Patient is currently in-house." W !,"Discharge patient with a discharge type of DEATH." R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@24",JP=JP+1
+ Q
+20 D:$D(DG)>9 F^DIE17,DE S DQ=20,DW=".35;1",DV="DXa",DU="",DLB="DATE OF DEATH",DIFLD=.351
+ S DE(DW)="C20^DVBHCE20",DE(DW,"INDEX")=1
+ S X=Z1
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C20 G C20S:$D(DE(20))[0 K DB
+ D ^DVBHCE21
+C20S S X="" G:DG(DQ)=X C20F1 K DB
+ D ^DVBHCE22
+C20F1 N X,X1,X2 S DIXR=180 D C20X1(U) K X2 M X2=X D C20X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C20F2
+C20X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.351,DION),$P($G(^DPT(DA,.35)),U,1))
+ S X=$G(X(1))
+ Q
+C20F2 S DIXR=685 D C20X2(U) K X2 M X2=X D C20X2("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C20F3
+C20X2(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.351,DION),$P($G(^DPT(DA,.35)),U,1))
+ S X=$G(X(1))
+ Q
+C20F3 Q
+X20 S %DT="PT" D ^%DT S X=Y K:Y<1 X I $D(X) D H^DGUTL K:X>DGTIME X K DGTIME,DGDATE I $D(X),X<$P(^DPT(DA,0),"^",3) K X
+ Q
+ ;
+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
+X21 W "." S JP=JP+1,DVBJ2=1
+ Q
+22 S DQ=23 ;@24
+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
+X23 I $P(Z2,U,JP)'=5 S Y="@25"
+ Q
+24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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
+X24 K DVBSICK I $D(DVBP(6)) S DVBSICK=$P(DVBP(6),U,7)
+ Q
+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
+X25 I $D(DVBCI) S DVBSICK=DVBCI
+ Q
+26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 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
+X26 I '$D(DVBSICK) S Y="@25",JP=JP+1
+ Q
+27 D:$D(DG)>9 F^DIE17 G ^DVBHCE23

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE21.m

@@ -1 @@
-DVBHCE21 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- S A1B2TAG="PAT" D ^A1B2XFR
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DG(DQ),DIC=DIE
+DVBHCE21 ; ;12/27/07
+ S X=DE(20),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,2.1) X ^DD(2,.351,1,1,2.4)
+ S X=DE(20),DIC=DIE
+ ;
+ S X=DE(20),DIC=DIE
+ D DKBULL^DGDEATH
+ S X=DE(20),DIC=DIE
+ K ^DPT("AEXP1",$E(X,1,30),DA)
+ S X=DE(20),DIC=DIE
+ ;
+ S X=DE(20),DIC=DIE
+ ;
+ S X=DE(20),DIC=DIE
+ S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I  D ERR^RCAMDTH
+ S X=DE(20),DIC=DIE
+ D KILL^DGDEPINA
+ S X=DE(20),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(20),DIC=DIE
+ ;
+ S X=DE(20),DIC=DIE
+ I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOAUTOC(DA)
+ S X=DE(20),DIC=DIE
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".117;" D AVAFC^VAFCDD01(DA)
- I $D(DE(5))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ S X=DE(20),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".351;" D AVAFC^VAFCDD01(DA)
+ S X=DE(20),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(20),DIIX=2_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE22.m

@@ -1 @@
-DVBHCE22 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.29)) S %Z=^(.29) S %=$P(%Z,U,12) S:%]"" DE(27)=%
- I $D(^(.31)) S %Z=^(.31) S %=$P(%Z,U,3) S:%]"" DE(1)=%
- I $D(^(.35)) S %Z=^(.35) S %=$P(%Z,U,1) S:%]"" DE(20)=%
- K %Z Q
- ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE22",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".31;3",DV="FXOa",DU="",DLB="CLAIM NUMBER",DIFLD=.313
- S DQ(1,2)="S Y(0)=Y S Y=$E(Y,1,10)"
- S DE(DW)="C1^DVBHCE22"
- S X=DVBCN
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".313;" D AVAFC^VAFCDD01(DA)
- S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
-C1S S X="" G:DG(DQ)=X C1F1 K DB
+DVBHCE22 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".313;" D AVAFC^VAFCDD01(DA)
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,1.1) X ^DD(2,.351,1,1,1.4)
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C1F1 Q
-X1 S DFN=DA D EV^DGLOCK I $D(X) S L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>9 X Q:'$D(X)  I X'=L K:$L(X)>8!($L(X)<7)!'(X?.N) X
- I $D(X),X'?.ANP K X
- Q
- ;
-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
-X2 W "." S JP=JP+1,DVBJ2=1
- Q
-3 S DQ=4 ;@22
-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
-X4 I $P(Z2,U,JP)'=2 S Y="@225"
- Q
-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
-X5 W !,"Date of Birth cannot be edited with this option."
- Q
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 H 1
- Q
-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
-X7 W "." S JP=JP+1,DVBJ2=1
- Q
-8 S DQ=9 ;@225
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 I $P(Z2,U,JP)'=3 S Y="@23"
- Q
-10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
-X10 W !,"Sex cannot be edited with this option."
- Q
-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
-X11 H 1
- Q
-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
-X12 W "." S JP=JP+1,DVBJ2=1
- Q
-13 S DQ=14 ;@23
-14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
-X14 I $P(Z2,U,JP)'=4 S Y="@24"
- Q
-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
-X15 K Z1 I $D(DVBP(6)),+$P(DVBP(6),U) S Z1=$P(DVBP(6),U),Z1=$E(Z1,1,2)_" "_$E(Z1,3,4)_" "_$E(Z1,5,8)
- Q
-16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 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
-X16 I $D(DVBVET),$P(DVBVET,U,1)="B",+$P(DVBVET,U,12) S Z1=$P(DVBVET,U,12),Z1=$E(Z1,5,6)_" "_$E(Z1,7,8)_" "_$E(Z1,1,4)
- Q
-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
-X17 I '$D(Z1) S Y="@24",JP=JP+1
- Q
-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
-X18 I 'Z1 S Y="@24",JP=JP+1
- Q
-19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 I $D(^DPT(D0,.105)) W !!,"Patient is currently in-house." W !,"Discharge patient with a discharge type of DEATH." R !,?25,"<RET to continue>",DVBQ:DTIME K DVBQ S Y="@24",JP=JP+1
- Q
-20 D:$D(DG)>9 F^DIE17,DE S DQ=20,DW=".35;1",DV="DXa",DU="",DLB="DATE OF DEATH",DIFLD=.351
- S DE(DW)="C20^DVBHCE22",DE(DW,"INDEX")=1
- S X=Z1
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C20 G C20S:$D(DE(20))[0 K DB
- S X=DE(20),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,2.1) X ^DD(2,.351,1,1,2.4)
- S X=DE(20),DIC=DIE
- ;
- S X=DE(20),DIC=DIE
- D DKBULL^DGDEATH
- S X=DE(20),DIC=DIE
- K ^DPT("AEXP1",$E(X,1,30),DA)
- S X=DE(20),DIC=DIE
- ;
- S X=DE(20),DIC=DIE
- ;
- S X=DE(20),DIC=DIE
- S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I  D ERR^RCAMDTH
- S X=DE(20),DIC=DIE
- D KILL^DGDEPINA
- S X=DE(20),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.35)):^(.35),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(2,.351,1,2,1.1) X ^DD(2,.351,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
+ D DSBULL^DGDEATH
+ S X=DG(DQ),DIC=DIE
+ S ^DPT("AEXP1",$E(X,1,30),DA)=""
+ S X=DG(DQ),DIC=DIE
+ D DEATH^DGOERNOT
+ S X=DG(DQ),DIC=DIE
+ S XX=X,X="PSJADT" X ^%ZOSF("TEST") S X=XX K XX I  D END^PSJADT
+ S X=DG(DQ),DIC=DIE
+ S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I  D SET^RCAMDTH
+ S X=DG(DQ),DIC=DIE
+ D SET^DGDEPINA
+ S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
- S X=DE(20),DIC=DIE
- ;
- S X=DE(20),DIC=DIE
- I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOAUTOC(DA)
- S X=DE(20),DIC=DIE
+ S X=DG(DQ),DIC=DIE
+ D START^DGMTDELS(DA)
+ S X=DG(DQ),DIC=DIE
+ I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOCAN3(DA)
+ S X=DG(DQ),DIC=DIE
  S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DE(20),DIC=DIE
+ S X=DG(DQ),DIC=DIE
  I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".351;" D AVAFC^VAFCDD01(DA)
- S X=DE(20),DIC=DIE
+ S X=DG(DQ),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(20),DIIX=2_U_DIFLD D AUDIT^DIET
-C20S S X="" G:DG(DQ)=X C20F1 K DB
- D ^DVBHCE23
-C20F1 N X,X1,X2 S DIXR=180 D C20X1(U) K X2 M X2=X D C20X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C20F2
-C20X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.351,DION),$P($G(^DPT(DA,.35)),U,1))
- S X=$G(X(1))
- Q
-C20F2 S DIXR=685 D C20X2(U) K X2 M X2=X D C20X2("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.351,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.351,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C20F3
-C20X2(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.351,DION),$P($G(^DPT(DA,.35)),U,1))
- S X=$G(X(1))
- Q
-C20F3 Q
-X20 S %DT="PT" D ^%DT S X=Y K:Y<1 X I $D(X) D H^DGUTL K:X>DGTIME X K DGTIME,DGDATE I $D(X),X<$P(^DPT(DA,0),"^",3) K X
- Q
- ;
-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
-X21 W "." S JP=JP+1,DVBJ2=1
- Q
-22 S DQ=23 ;@24
-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
-X23 I $P(Z2,U,JP)'=5 S Y="@25"
- Q
-24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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
-X24 K DVBSICK I $D(DVBP(6)) S DVBSICK=$P(DVBP(6),U,7)
- Q
-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
-X25 I $D(DVBCI) S DVBSICK=DVBCI
- Q
-26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 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
-X26 I '$D(DVBSICK) S Y="@25",JP=JP+1
- Q
-27 D:$D(DG)>9 F^DIE17,DE S DQ=27,DW=".29;12",DV="S",DU="",DLB="RATED INCOMPETENT?",DIFLD=.293
- S DE(DW)="C27^DVBHCE22"
- S DU="0:NO;1:YES;"
- S X=$S((DVBSICK="I")!(DVBSICK="Y"):1,1:0)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C27 G C27S:$D(DE(27))[0 K DB
- S X=DE(27),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C27S S X="" G:DG(DQ)=X C27F1 K DB
- D ^DVBHCE24
-C27F1 Q
-X27 Q
-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
-X28 W "." S JP=JP+1,DVBJ2=1 K DVBSICK
- Q
-29 S DQ=30 ;@25
-30 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=30 D X30 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
-X30 I $P(Z2,U,JP)'=6 S Y="@26"
- Q
-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
-X31 I '$D(DVBPOW),'$D(DVBPOWD) S Y="@26",JP=JP+1
- Q
-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
-X32 I '$D(DVBPOW),$D(DVBPOWD),+DVBPOWD W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
- Q
-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
-X33 I '$D(DVBPOW),'+DVBPOWD S Y="@26",JP=JP+1
- Q
-34 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=34 D X34 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
-X34 I '$D(DVBPOWD),$D(DVBPOW),DVBPOW>0 W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
- Q
-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
-X35 I $D(DVBPOWD),$D(DVBPOW),DVBPOWD=0,DVBPOW>0 W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
- Q
-36 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=36 D X36 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
-X36 I $D(DVBPOWD),$D(DVBPOW),+DVBPOW<1,+DVBPOWD W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
- Q
-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
-X37 D POW^DVBHUTIL
- Q
-38 D:$D(DG)>9 F^DIE17 G ^DVBHCE25
+ I $D(DE(20))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE23.m

@@ -1 @@
-DVBHCE23 ; ;12/13/08
+DVBHCE23 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.29)) S %Z=^(.29) S %=$P(%Z,U,12) S:%]"" DE(1)=%
+ I $D(^(.31)) S %Z=^(.31) S %=$P(%Z,U,4) S:%]"" DE(19)=%
+ I $D(^(.52)) S %Z=^(.52) S %=$P(%Z,U,5) S:%]"" DE(12)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE23",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".29;12",DV="S",DU="",DLB="RATED INCOMPETENT?",DIFLD=.293
+ S DE(DW)="C1^DVBHCE23"
+ S DU="0:NO;1:YES;"
+ S X=$S((DVBSICK="I")!(DVBSICK="Y"):1,1:0)
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C1S S X="" G:DG(DQ)=X C1F1 K DB
  S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y X ^DD(2,.351,1,1,1.1) X ^DD(2,.351,1,1,1.4)
+ D EVENT^IVMPLOG(DA)
+C1F1 Q
+X1 Q
+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
+X2 W "." S JP=JP+1,DVBJ2=1 K DVBSICK
+ Q
+3 S DQ=4 ;@25
+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
+X4 I $P(Z2,U,JP)'=6 S Y="@26"
+ Q
+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
+X5 I '$D(DVBPOW),'$D(DVBPOWD) S Y="@26",JP=JP+1
+ Q
+6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
+X6 I '$D(DVBPOW),$D(DVBPOWD),+DVBPOWD W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
+ Q
+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
+X7 I '$D(DVBPOW),'+DVBPOWD S Y="@26",JP=JP+1
+ Q
+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
+X8 I '$D(DVBPOWD),$D(DVBPOW),DVBPOW>0 W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
+ Q
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 I $D(DVBPOWD),$D(DVBPOW),DVBPOWD=0,DVBPOW>0 W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
+ Q
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
+X10 I $D(DVBPOWD),$D(DVBPOW),+DVBPOW<1,+DVBPOWD W !!,*7,?17,DVBON,"POW Indicator Discrepancy!  <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S JP=JP+1,Y="@26"
+ Q
+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
+X11 D POW^DVBHUTIL
+ Q
+12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".52;5",DV="RSX",DU="",DLB="POW STATUS INDICATED?",DIFLD=.525
+ S DE(DW)="C12^DVBHCE23",DE(DW,"INDEX")=1
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ S X=DVBPOW1
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C12 G C12S:$D(DE(12))[0 K DB
+ S X=DE(12),DIC=DIE
+ ;
+ S X=DE(12),DIC=DIE
+ ;
+ S X=DE(12),DIC=DIE
+ ;
+ S X=DE(12),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(12),DIC=DIE
+ X "S DFN=DA D EN^DGMTR K DGREQF"
+ S X=DE(12),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C12S S X="" G:DG(DQ)=X C12F1 K DB
  S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.35)):^(.35),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(2,.351,1,2,1.1) X ^DD(2,.351,1,2,1.4)
+ X ^DD(2,.525,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$S('$D(^DIC(22,+$P(Y(1),U,6),0)):"",1:$P(^(0),U,1)) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,1,1.4)
  S X=DG(DQ),DIC=DIE
- D DSBULL^DGDEATH
+ X ^DD(2,.525,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,7) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,2,1.4)
  S X=DG(DQ),DIC=DIE
- S ^DPT("AEXP1",$E(X,1,30),DA)=""
- S X=DG(DQ),DIC=DIE
- D DEATH^DGOERNOT
- S X=DG(DQ),DIC=DIE
- S XX=X,X="PSJADT" X ^%ZOSF("TEST") S X=XX K XX I  D END^PSJADT
- S X=DG(DQ),DIC=DIE
- S RCX=X,X="RCAMDTH" X ^%ZOSF("TEST") S X=RCX K RCX I  D SET^RCAMDTH
- S X=DG(DQ),DIC=DIE
- D SET^DGDEPINA
+ X ^DD(2,.525,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,8) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,3,1.4)
  S X=DG(DQ),DIC=DIE
  D AUTOUPD^DGENA2(DA)
  S X=DG(DQ),DIC=DIE
- D START^DGMTDELS(DA)
+ X "S DFN=DA D EN^DGMTR K DGREQF"
  S X=DG(DQ),DIC=DIE
- I $$VERSION^XPDUTL("PSO")>6 D APSOD^PSOCAN3(DA)
- S X=DG(DQ),DIC=DIE
- S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".351;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(20))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ D EVENT^IVMPLOG(DA)
+C12F1 N X,X1,X2 S DIXR=646 D C12X1(U) K X2 M X2=X D C12X1("O") K X1 M X1=X
+ D
+ . D FC^DGFCPROT(.DA,2,.525,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ K X M X=X2 D
+ . D FC^DGFCPROT(.DA,2,.525,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
+ G C12F2
+C12X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.525,DION),$P($G(^DPT(DA,.52)),U,5))
+ S X=$G(X(1))
+ Q
+C12F2 Q
+X12 S DFN=DA D SV^DGLOCK
+ Q
+ ;
+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
+X13 K DVBPOW1 W "." S JP=JP+1,DVBJ2=1
+ Q
+14 S DQ=15 ;@26
+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
+X15 I $P(Z2,U,JP)'=7 S Y="@27"
+ Q
+16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 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
+X16 I '$D(DVBFL) S Y="@27",JP=JP+1
+ Q
+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
+X17 I DVBFL']"" S Y="@27",JP=JP+1
+ Q
+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
+X18 I DVBFL'?3N1" - "1U.E S Y="@27",JP=JP+1
+ Q
+19 D:$D(DG)>9 F^DIE17,DE S DQ=19,DW=".31;4",DV="*P4'X",DU="",DLB="CLAIM FOLDER LOCATION",DIFLD=.314
+ S DE(DW)="C19^DVBHCE23"
+ S DU="DIC(4,"
+ S X=+DVBFL
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C19 G C19S:$D(DE(19))[0 K DB
+ D ^DVBHCE24
+C19S S X="" G:DG(DQ)=X C19F1 K DB
+ D ^DVBHCE25
+C19F1 Q
+X19 S DIC("S")="I $$CFLTF^DGREGDD(Y)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
+ Q
+ ;
+20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
+X20 W "." S JP=JP+1,DVBJ2=1
+ Q
+21 S DQ=22 ;@27
+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
+X22 I $P(Z2,U,JP)'=8 S Y="@50"
+ Q
+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
+X23 I '$D(DVBEI) S Y="@50",JP=JP+1
+ Q
+24 D:$D(DG)>9 F^DIE17 G ^DVBHCE26

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE24.m

@@ -1 @@
-DVBHCE24 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
+DVBHCE24 ; ;12/27/07
+ S X=DE(19),DIC=DIE
+ D KILL^DGREGDD(DA)

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE25.m

@@ -1 @@
-DVBHCE25 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,5) S:%]"" DE(13)=%
- I $D(^(.31)) S %Z=^(.31) S %=$P(%Z,U,4) S:%]"" DE(8)=%
- I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,2) S:%]"" DE(20)=%
- I $D(^(.321)) S %Z=^(.321) S %=$P(%Z,U,1) S:%]"" DE(26)=%
- I $D(^(.52)) S %Z=^(.52) S %=$P(%Z,U,5) S:%]"" DE(1)=%
- K %Z Q
- ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE25",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".52;5",DV="RSX",DU="",DLB="POW STATUS INDICATED?",DIFLD=.525
- S DE(DW)="C1^DVBHCE25",DE(DW,"INDEX")=1
- S DU="Y:YES;N:NO;U:UNKNOWN;"
- S X=DVBPOW1
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- ;
- S X=DE(1),DIC=DIE
- ;
- S X=DE(1),DIC=DIE
- ;
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(1),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C1S S X="" G:DG(DQ)=X C1F1 K DB
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.525,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$S('$D(^DIC(22,+$P(Y(1),U,6),0)):"",1:$P(^(0),U,1)) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.525,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,7) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,2,1.4)
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.525,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.52)):^(.52),1:"") S X=$P(Y(1),U,8) S DIU=X K Y S X=DIV S X="" X ^DD(2,.525,1,3,1.4)
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DG(DQ),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C1F1 N X,X1,X2 S DIXR=646 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
- D
- . D FC^DGFCPROT(.DA,2,.525,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- K X M X=X2 D
- . D FC^DGFCPROT(.DA,2,.525,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q
- G C1F2
-C1X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.525,DION),$P($G(^DPT(DA,.52)),U,5))
- S X=$G(X(1))
- Q
-C1F2 Q
-X1 S DFN=DA D SV^DGLOCK
- Q
- ;
-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
-X2 K DVBPOW1 W "." S JP=JP+1,DVBJ2=1
- Q
-3 S DQ=4 ;@26
-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
-X4 I $P(Z2,U,JP)'=7 S Y="@27"
- Q
-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
-X5 I '$D(DVBFL) S Y="@27",JP=JP+1
- Q
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 I DVBFL']"" S Y="@27",JP=JP+1
- Q
-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
-X7 I DVBFL'?3N1" - "1U.E S Y="@27",JP=JP+1
- Q
-8 D:$D(DG)>9 F^DIE17,DE S DQ=8,DW=".31;4",DV="*P4'X",DU="",DLB="CLAIM FOLDER LOCATION",DIFLD=.314
- S DE(DW)="C8^DVBHCE25"
- S DU="DIC(4,"
- S X=+DVBFL
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C8 G C8S:$D(DE(8))[0 K DB
- S X=DE(8),DIC=DIE
- D KILL^DGREGDD(DA)
-C8S S X="" G:DG(DQ)=X C8F1 K DB
+DVBHCE25 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
  D SET^DGREGDD(DA,X)
-C8F1 Q
-X8 S DIC("S")="I $$CFLTF^DGREGDD(Y)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X
- Q
- ;
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 W "." S JP=JP+1,DVBJ2=1
- Q
-10 S DQ=11 ;@27
-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
-X11 I $P(Z2,U,JP)'=8 S Y="@50"
- Q
-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
-X12 I '$D(DVBEI) S Y="@50",JP=JP+1
- Q
-13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".3;5",DV="S",DU="",DLB="UNEMPLOYABLE",DIFLD=.305
- S DE(DW)="C13^DVBHCE25"
- S DU="Y:YES;N:NO;"
- S X=$S(DVBEI="Y":"Y",1:"N")
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C13 G C13S:$D(DE(13))[0 K DB
- S X=DE(13),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(13),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
-C13S S X="" G:DG(DQ)=X C13F1 K DB
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DG(DQ),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
-C13F1 Q
-X13 Q
-14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
-X14 W "." S JP=JP+1,DVBJ2=1
- Q
-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
-X15 S Y="@50"
- Q
-16 S DQ=17 ;@40
-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
-X17 I $P(Z2,U,JP)'=1 S Y="@42"
- Q
-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
-X18 I '$D(DVBP(6)) S Y="@42",JP=JP+1
- Q
-19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 I $S($P(DVBP(6),U,8)'="Y":1,'$D(^DPT(DFN,.32)):1,+$P(^(0),U,2):1,1:0) S Y="@42",JP=JP+1
- Q
-20 D:$D(DG)>9 F^DIE17,DE S DQ=20,DW=".32;2",DV="DX",DU="",DLB="SERVICE VERIFICATION DATE",DIFLD=.322
- S X="T"
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X20 S %DT="",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
- Q
- ;
-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
-X21 W "." S JP=JP+1,DVBJ2=1
- Q
-22 S DQ=23 ;@42
-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
-X23 I $P(Z2,U,JP)'=2 S Y="@45"
- Q
-24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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
-X24 I '$D(DVBP(6)) S Y="@45",JP=JP+1
- Q
-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
-X25 I $P(DVBP(6),U,4)[" " S Y="@45",JP=JP+1
- Q
-26 S DW=".321;1",DV="RSX",DU="",DLB="VIETNAM SERVICE INDICATED?",DIFLD=.32101
- S DE(DW)="C26^DVBHCE25"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
- S X=$P(DVBP(6),U,4)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C26 G C26S:$D(DE(26))[0 K DB
- S X=DE(26),DIC=DIE
- ;
- S X=DE(26),DIC=DIE
- ;
- S X=DE(26),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C26S S X="" G:DG(DQ)=X C26F1 K DB
- D ^DVBHCE26
-C26F1 Q
-X26 S DFN=DA D SV^DGLOCK
- Q
- ;
-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
-X27 W "." S JP=JP+1,DVBJ2=1
- Q
-28 S DQ=29 ;@45
-29 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=29 D X29 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
-X29 I $P(Z2,U,JP)'=3!('$D(DVBDX(1))) S Y="@50"
- Q
-30 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=30 D X30 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
-X30 S:'$D(DVBFL) DVBFL="UNKNOWN"
- Q
-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
-X31 I $D(DVBCAP),DVBCAP["No C&P",$P(DVBBIR,U,5)'="Y" D CHK^DVBHUTIL
- Q
-32 S DQ=33 ;@47
-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
-X33 S DVB4=$S($D(^DPT(DFN,.3))>0:$P(^(.3),U),1:0),DVB5=$S($D(^DPT(DFN,.36))>0:$P(^(.36),U),1:0),DVB6=$S($D(^DPT(DFN,"VET"))>0:^("VET"),1:0),DVB7=$S($D(^DPT(DFN,"TYPE"))>0:^("TYPE"),1:0)
- Q
-34 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=34 D X34 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
-X34 S DVB8=$O(^DIC(8,"B","SERVICE CONNECTED 50% to 100%",0)),DVB9=$O(^DIC(8,"B","SC LESS THAN 50%",0))
- Q
-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
-X35 I DVBDXNO I ((DVB8'=DVB5&(DVB9'=DVB5))!(DVB4'="Y")!(DVB6'="Y")!(DVB7'=1)) S Y="@70"
- Q
-36 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=36 D X36 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
-X36 W ! K ^DPT(DFN,.372),JP4,JP6 S ^DPT(DFN,.372,0)="^2.04P^^0",JP=0
- Q
-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
-X37 S $P(^DPT(DFN,.3),U,2)="",$P(^DPT(DFN,.3),U,14)=""
- Q
-38 D:$D(DG)>9 F^DIE17 G ^DVBHCE27

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE26.m

@@ -1 @@
-DVBHCE26 ; ;12/13/08
+DVBHCE26 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,2) S:%]"" DE(26)=% S %=$P(%Z,U,5) S:%]"" DE(1)=%
+ I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,2) S:%]"" DE(8)=%
+ I $D(^(.321)) S %Z=^(.321) S %=$P(%Z,U,1) S:%]"" DE(14)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE26",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".3;5",DV="S",DU="",DLB="UNEMPLOYABLE",DIFLD=.305
+ S DE(DW)="C1^DVBHCE26"
+ S DU="Y:YES;N:NO;"
+ S X=$S(DVBEI="Y":"Y",1:"N")
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(1),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DG(DQ),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+C1F1 Q
+X1 Q
+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
+X2 W "." S JP=JP+1,DVBJ2=1
+ Q
+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
+X3 S Y="@50"
+ Q
+4 S DQ=5 ;@40
+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
+X5 I $P(Z2,U,JP)'=1 S Y="@42"
+ Q
+6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
+X6 I '$D(DVBP(6)) S Y="@42",JP=JP+1
+ Q
+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
+X7 I $S($P(DVBP(6),U,8)'="Y":1,'$D(^DPT(DFN,.32)):1,+$P(^(0),U,2):1,1:0) S Y="@42",JP=JP+1
+ Q
+8 D:$D(DG)>9 F^DIE17,DE S DQ=8,DW=".32;2",DV="DX",DU="",DLB="SERVICE VERIFICATION DATE",DIFLD=.322
+ S X="T"
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+X8 S %DT="",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
+ Q
+ ;
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 W "." S JP=JP+1,DVBJ2=1
+ Q
+10 S DQ=11 ;@42
+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
+X11 I $P(Z2,U,JP)'=2 S Y="@45"
+ Q
+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
+X12 I '$D(DVBP(6)) S Y="@45",JP=JP+1
+ Q
+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
+X13 I $P(DVBP(6),U,4)[" " S Y="@45",JP=JP+1
+ Q
+14 S DW=".321;1",DV="RSX",DU="",DLB="VIETNAM SERVICE INDICATED?",DIFLD=.32101
+ S DE(DW)="C14^DVBHCE26"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ S X=$P(DVBP(6),U,4)
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C14 G C14S:$D(DE(14))[0 K DB
+ S X=DE(14),DIC=DIE
+ ;
+ S X=DE(14),DIC=DIE
+ ;
+ S X=DE(14),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C14S S X="" G:DG(DQ)=X C14F1 K DB
  S X=DG(DQ),DIC=DIE
  X ^DD(2,.32101,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.321)):^(.321),1:"") S X=$P(Y(1),U,4) S DIU=X K Y S X=DIV S X="" X ^DD(2,.32101,1,1,1.4)
@@ -6 +129 @@
  S X=DG(DQ),DIC=DIE
  D EVENT^IVMPLOG(DA)
+C14F1 Q
+X14 S DFN=DA D SV^DGLOCK
+ Q
+ ;
+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
+X15 W "." S JP=JP+1,DVBJ2=1
+ Q
+16 S DQ=17 ;@45
+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
+X17 I $P(Z2,U,JP)'=3!('$D(DVBDX(1))) S Y="@50"
+ Q
+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
+X18 S:'$D(DVBFL) DVBFL="UNKNOWN"
+ Q
+19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
+X19 I $D(DVBCAP),DVBCAP["No C&P",$P(DVBBIR,U,5)'="Y" D CHK^DVBHUTIL
+ Q
+20 S DQ=21 ;@47
+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
+X21 S DVB4=$S($D(^DPT(DFN,.3))>0:$P(^(.3),U),1:0),DVB5=$S($D(^DPT(DFN,.36))>0:$P(^(.36),U),1:0),DVB6=$S($D(^DPT(DFN,"VET"))>0:^("VET"),1:0),DVB7=$S($D(^DPT(DFN,"TYPE"))>0:^("TYPE"),1:0)
+ Q
+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
+X22 S DVB8=$O(^DIC(8,"B","SERVICE CONNECTED 50% to 100%",0)),DVB9=$O(^DIC(8,"B","SC LESS THAN 50%",0))
+ Q
+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
+X23 I DVBDXNO I ((DVB8'=DVB5&(DVB9'=DVB5))!(DVB4'="Y")!(DVB6'="Y")!(DVB7'=1)) S Y="@70"
+ Q
+24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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
+X24 W ! K ^DPT(DFN,.372),JP4,JP6 S ^DPT(DFN,.372,0)="^2.04P^^0",JP=0
+ Q
+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
+X25 S $P(^DPT(DFN,.3),U,2)="",$P(^DPT(DFN,.3),U,14)=""
+ Q
+26 D:$D(DG)>9 F^DIE17,DE S DQ=26,DW=".3;2",DV="NJ3,0Xa",DU="",DLB="SERVICE CONNECTED PERCENTAGE",DIFLD=.302
+ S DE(DW)="C26^DVBHCE26"
+ S X=+$G(DVBDXPCT)
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C26 G C26S:$D(DE(26))[0 K DB
+ D ^DVBHCE27
+C26S S X="" G:DG(DQ)=X C26F1 K DB
+ D ^DVBHCE28
+C26F1 Q
+X26 S DFN=DA D EV^DGLOCK Q:'$D(X)  K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X),$D(^DPT(DA,.3)),$P(^(.3),U,1)'="Y" W !?4,*7,"Only applies to service-connected applicants." K X
+ Q
+ ;
+27 D:$D(DG)>9 F^DIE17 G ^DVBHCE29

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE27.m

@@ -1 @@
-DVBHCE27 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,14) S:%]"" DE(2)=%
- I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,8) S:%]"" DE(28)=% S %=$P(%Z,U,9) S:%]"" DE(34)=% S %=$P(%Z,U,15) S:%]"" DE(16)=% S %=$P(%Z,U,18) S:%]"" DE(22)=%
- K %Z Q
+DVBHCE27 ; ;12/27/07
+ S X=DE(26),DIC=DIE
  ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE27",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".3;2",DV="NJ3,0Xa",DU="",DLB="SERVICE CONNECTED PERCENTAGE",DIFLD=.302
- S DE(DW)="C1^DVBHCE27"
- S X=+$G(DVBDXPCT)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
+ S X=DE(26),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(26),DIC=DIE
  ;
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(1),DIC=DIE
- ;
- S X=DE(1),DIC=DIE
+ S X=DE(26),DIC=DIE
  I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".302;" D AVAFC^VAFCDD01(DA)
- S X=DE(1),DIC=DIE
+ S X=DE(26),DIC=DIE
  D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
-C1S S X="" G:DG(DQ)=X C1F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DG(DQ),DIC=DIE
- X "S DFN=DA D EN^DGMTR K DGREQF"
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".302;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C1F1 Q
-X1 S DFN=DA D EV^DGLOCK Q:'$D(X)  K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X),$D(^DPT(DA,.3)),$P(^(.3),U,1)'="Y" W !?4,*7,"Only applies to service-connected applicants." K X
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".3;14",DV="DX",DU="",DLB="EFF. DATE COMBINED SC% EVAL.",DIFLD=.3014
- S X=$G(DVBEFF)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X2 S %DT="P" D ^%DT S X=Y K:Y<1!(Y>DT) X
- Q
- ;
-3 S DQ=4 ;@46
-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
-X4 S JP=$O(DVBDX(JP)) I 'JP S Y="@50"
- Q
-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
-X5 S JPP=+$P(DVBDX(JP),U,2) I JPP'>0 S Y="@46"
- Q
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 I '$D(^DIC(31,JPP)) D CHKDIS^DVBHS3 S Y="@46"
- Q
-7 S D=0 K DE(1) ;.3721
- S DIFLD=.3721,DGO="^DVBHCE28",DC="6^2.04P^.372^",DV="2.04MP31'X",DW="0;1",DOW="RATED DISABILITIES (VA)",DLB="Select "_DOW S:D DC=DC_D
- S DU="DIC(31,"
- G RE:D I $D(DSC(2.04))#2,$P(DSC(2.04),"I $D(^UTILITY(",1)="" X DSC(2.04) S D=$O(^(0)) S:D="" D=-1 G M7
- S D=$S($D(^DPT(DA,.372,0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M7 I D>0 S DC=DC_D I $D(^DPT(DA,.372,+D,0)) S DE(7)=$P(^(0),U,1)
- S X="""`"_$P(DVBDX(JP),U,2)_""""
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-R7 D DE
- G A
- ;
-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
-X8 W "." S DVBJ2=1
- Q
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 S Y="@46"
- Q
-10 S DQ=11 ;@61
-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
-X11 S Y="@4"
- Q
-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
-X12 I Z2'[1 S Y="@62"
- Q
-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
-X13 I '$D(DVBSSA) S Y="@62",JP=JP+1
- Q
-14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
-X14 I DVBSSA S DVBYN="Y",DVBXYN=DVBSSA
- Q
-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
-X15 I 'DVBSSA S DVBYN="N",DVBXYN=""
- Q
-16 S DW=".362;15",DV="SX",DU="",DLB="RECEIVING SOCIAL SECURITY?",DIFLD=.36225
- S DE(DW)="C16^DVBHCE27"
- S DU="Y:YES;N:NO;U:UNKNOWN;"
- S X=DVBYN
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C16 G C16S:$D(DE(16))[0 K DB
- S X=DE(16),DIC=DIE
- X ^DD(2,.36225,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.36225,1,1,2.4)
-C16S S X="" G:DG(DQ)=X C16F1 K DB
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.36225,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.36225,1,1,1.4)
-C16F1 Q
-X16 S DFN=DA D MV^DGLOCK Q
- Q
- ;
-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
-X17 W "." S JP=JP+1,DVBJ2=1 K DVBYN,DVBXYN
- Q
-18 S DQ=19 ;@62
-19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 I Z2'[2 S Y="@63"
- Q
-20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
-X20 I '$D(DVBRETT) S Y="@63",JP=JP+1
- Q
-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
-X21 I DVBRETT=""!("BMCROX"'[DVBRETT) S Y="@63",JP=JP+1
- Q
-22 D:$D(DG)>9 F^DIE17,DE S DQ=22,DW=".362;18",DV="SX",DU="",DLB="TYPE OF OTHER RETIREMENT",DIFLD=.36285
- S DU="B:BLACK LUNG;M:MILITARY;C:CIVIL;R:RAILROAD;O:OTHER;X:COMBINATIONS OF TYPES;"
- S X=DVBRETT
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X22 S DFN=DA D MV^DGLOCK Q
- Q
- ;
-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
-X23 W "." S JP=JP+1,DVBJ2=1
- Q
-24 S DQ=25 ;@63
-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
-X25 I Z2'[3 S Y="@64"
- Q
-26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 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
-X26 I '$D(DVBRETO) S Y="@64",JP=JP+1
- Q
-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
-X27 S X=DVBRETO I X=""!(X=0) S X="@"
- Q
-28 S DW=".362;8",DV="NJ8,2X",DU="",DLB="AMOUNT OF OTHER RETIREMENT",DIFLD=.3628
- S X=X
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X28 D DOL^DGLOCK2 K:+X'=X&(X'?.N1"."2N)!(X>99999)!(X<1) X I $D(X) S DFN=DA D MV^DGLOCK
- Q
- ;
-29 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=29 D X29 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
-X29 W "." S JP=JP+1,DVBJ2=1
- Q
-30 S DQ=31 ;@64
-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
-X31 I Z2'[4 S Y="@1006"
- Q
-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
-X32 I '$D(DVBOINC) S Y="@1006",JP=JP+1
- Q
-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
-X33 S X=DVBOINC I X=""!(X=0) S X="@"
- Q
-34 S DW=".362;9",DV="NJ8,2X",DU="",DLB="AMOUNT OF OTHER INCOME",DIFLD=.3629
- S X=X
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X34 D DOL^DGLOCK2 K:+X'=X&(X'?.N1"."2N)!(X>999999)!(X<1) X
- Q
- ;
-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
-X35 W "." S JP=JP+1,DVBJ2=1,Y="@1006"
- Q
-36 S DQ=37 ;@4
-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
-X37 S Y=$S(DVBJS=11:"@1",DVBJS=28:"@2",DVBJS=35:"@3",DVBJS=44:"@104",1:"@10")
- Q
-38 S DQ=39 ;@70
-39 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=39 D X39 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
-X39 W !!,*7,"HINQ contains SC disabilities, Patient is NSC no updating allowed.  Check       patient's SERVICE CONNECTION, ELIGIBILITY CODE, VET STATUS, or PATIENT TYPE.     Screen 5 contains this."
- Q
-40 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=40 D X40 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
-X40 R !!,?25,"<RET> to continue.",ZZ:DTIME K ZZ,JP3,JP4
- Q
-41 S DQ=42 ;@50
-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
-X42 K DVBJX,JP,JPP S Y=$S(DVBJS=28:"@1",DVBJS=35:"@2",1:"@10")
- Q
-43 S DQ=44 ;@10
-44 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=44 D X44 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
-X44 I $G(DVBRADL)]"" D DX^DVBHQEDT(DVBRADL)
- Q
-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
-X45 K DVBRADL
- Q
-46 G 0^DIE17
+ S X=DE(26),DIIX=2_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE28.m

@@ -1 @@
-DVBHCE28 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(D0,.372,",DIC=DIE,DP=2.04,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DPT(D0,.372,DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(1)=% S %=$P(%Z,U,3) S:%]"" DE(2)=% S %=$P(%Z,U,4) S:%]"" DE(3)=% S %=$P(%Z,U,5) S:%]"" DE(4)=% S %=$P(%Z,U,6) S:%]"" DE(5)=%
- K %Z Q
+DVBHCE28 ; ;12/27/07
+ S X=DG(DQ),DIC=DIE
  ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE28",DQ=1
-1 S DW="0;2",DV="RNJ3,0X",DU="",DLB="DISABILITY %",DIFLD=2
- S DE(DW)="C1^DVBHCE28",DE(DW,"INDEX")=1
- S X=$S($P(DVBDX(JP),U,3)="X0":100,1:+$P(DVBDX(JP),U,3))
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C1S S X="" G:DG(DQ)=X C1F1 K DB
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C1F1 N X,X1,X2 S DIXR=411 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- K X M X=X2 D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- G C1F2
-C1X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
- S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
- S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
- S X=$G(X(1))
- Q
-C1F2 Q
-X1 K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X I $D(X) D EK^DGLOCK
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;3",DV="SX",DU="",DLB="SERVICE CONNECTED",DIFLD=3
- S DE(DW)="C2^DVBHCE28",DE(DW,"INDEX")=1
- S DU="0:NO;1:YES;"
- S X=1
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-C2 G C2S:$D(DE(2))[0 K DB
- S X=DE(2),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C2S S X="" G:DG(DQ)=X C2F1 K DB
+ D AUTOUPD^DGENA2(DA)
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG($G(DA(1)))
-C2F1 N X,X1,X2 S DIXR=411 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- K X M X=X2 D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . I (X1(1)'=X2(1))!(X1(2)'=X2(2))!(X1(3)'=X2(3))
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . S DGRDCHG=1
- G C2F2
-C2X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2.04,DIIENS,.01,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,1))
- S X(2)=$G(@DIEZTMP@("V",2.04,DIIENS,2,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,2))
- S X(3)=$G(@DIEZTMP@("V",2.04,DIIENS,3,DION),$P($G(^DPT(DA(1),.372,DA,0)),U,3))
- S X=$G(X(1))
- Q
-C2F2 Q
-X2 S DFN=DA(1) D:X SC^DGLOCK1 I $D(X) D EK^DGLOCK 
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;4",DV="S",DU="",DLB="EXTREMITY AFFECTED",DIFLD=4
- S DU="BL:BOTH LOWER;BU:BOTH UPPER;RL:RIGHT LOWER;RU:RIGHT UPPER;LL:LEFT LOWER;LU:LEFT UPPER;"
- S X=$P($G(DVBDX(JP)),U,4)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X3 Q
-4 S DW="0;5",DV="DX",DU="",DLB="ORIGINAL EFFECTIVE DATE",DIFLD=5
- S X=$P($G(DVBDX(JP)),U,5)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X4 S %DT="" D ^%DT S X=Y K:Y<1!(Y>DT) X
- Q
- ;
-5 S DW="0;6",DV="DX",DU="",DLB="CURRENT EFFECTIVE DATE",DIFLD=6
- S X=$P($G(DVBDX(JP)),U,6)
- S Y=X
- S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
- G RD
-X5 S %DT="" D ^%DT S X=Y K:Y<1!(Y>DT) X
- Q
- ;
-6 G 1^DIE17
+ X "S DFN=DA D EN^DGMTR K DGREQF"
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".302;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(26))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE29.m

@@ -1 @@
-DVBHCE29 ; ;12/13/08
- ;;
-1 N X,X1,X2 S DIXR=303 D X1(U) K X2 M X2=X D X1("F") K X1 M X1=X
- K X M X=X2 D
- . N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1
- . I '$P($G(^DPT(DA,.52)),"^",15) S X=$$CVELIG^DGCV(DA)
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . D SETCV^DGCV(DA,X2(1))
+DVBHCE29 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,14) S:%]"" DE(1)=%
+ I $D(^(.362)) S %Z=^(.362) S %=$P(%Z,U,8) S:%]"" DE(27)=% S %=$P(%Z,U,15) S:%]"" DE(15)=% S %=$P(%Z,U,18) S:%]"" DE(21)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
  Q
-X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.327,DION),$P($G(^DPT(DA,.32)),U,7))
- S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.5294,DION),$P($G(^DPT(DA,.52)),U,14))
- S X(3)=$G(@DIEZTMP@("V",2,DIIENS,.322021,DION),$P($G(^DPT(DA,.322)),U,21))
- S X(4)=$G(@DIEZTMP@("V",2,DIIENS,.322018,DION),$P($G(^DPT(DA,.322)),U,18))
- S X(5)=$G(@DIEZTMP@("V",2,DIIENS,.322012,DION),$P($G(^DPT(DA,.322)),U,12))
- S X(6)=$G(@DIEZTMP@("V",2,DIIENS,.5291,DION),$P($G(^DPT(DA,.52)),U,11))
- S X(7)=$G(@DIEZTMP@("V",2,DIIENS,.322019,DION),$P($G(^DPT(DA,.322)),U,19))
- S X(8)=$G(@DIEZTMP@("V",2,DIIENS,.322016,DION),$P($G(^DPT(DA,.322)),U,16))
- S X(9)=$G(@DIEZTMP@("V",2,DIIENS,.32201,DION),$P($G(^DPT(DA,.322)),U,10))
- S X=$G(X(1))
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
  Q
-2 N X,X1,X2 S DIXR=648 D X2(U) K X2 M X2=X D X2("F") K X1 M X1=X
- D
- . D KSERV^DGSRVICE(.X,.DA,"LAST")
- K X M X=X2 D
- . D SSERV^DGSRVICE(.X,.DA,"LAST")
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
  Q
-X2(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.326,DION),$P($G(^DPT(DA,.32)),U,6))
- S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.327,DION),$P($G(^DPT(DA,.32)),U,7))
- S X=$G(X(1))
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
  Q
-3 N X,X1,X2 S DIXR=649 D X3(U) K X2 M X2=X D X3("F") K X1 M X1=X
- D
- . D KSERV^DGSRVICE(.X,.DA,"NTL")
- K X M X=X2 D
- . D SSERV^DGSRVICE(.X,.DA,"NTL")
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
  Q
-X3(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3292,DION),$P($G(^DPT(DA,.32)),U,11))
- S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.3293,DION),$P($G(^DPT(DA,.32)),U,12))
- S X=$G(X(1))
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE29",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".3;14",DV="DX",DU="",DLB="EFF. DATE COMBINED SC% EVAL.",DIFLD=.3014
+ S X=$G(DVBEFF)
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+X1 S %DT="P" D ^%DT S X=Y K:Y<1!(Y>DT) X
  Q
-4 N X,X1,X2 S DIXR=663 D X4(U) K X2 M X2=X D X4("F") K X1 M X1=X
- D
- . D KSERV^DGSRVICE(.X,.DA,"NNTL")
- K X M X=X2 D
- . D SSERV^DGSRVICE(.X,.DA,"NNTL")
+ ;
+2 S DQ=3 ;@46
+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
+X3 S JP=$O(DVBDX(JP)) I 'JP S Y="@50"
  Q
-X4(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3297,DION),$P($G(^DPT(DA,.32)),U,16))
- S X(2)=$G(@DIEZTMP@("V",2,DIIENS,.3298,DION),$P($G(^DPT(DA,.32)),U,17))
- S X=$G(X(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
+X4 S JPP=+$P(DVBDX(JP),U,2) I JPP'>0 S Y="@46"
  Q
+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
+X5 I '$D(^DIC(31,JPP)) D CHKDIS^DVBHS3 S Y="@46"
+ Q
+6 S D=0 K DE(1) ;.3721
+ S DIFLD=.3721,DGO="^DVBHCE30",DC="6^2.04P^.372^",DV="2.04MP31'X",DW="0;1",DOW="RATED DISABILITIES (VA)",DLB="Select "_DOW S:D DC=DC_D
+ S DU="DIC(31,"
+ G RE:D I $D(DSC(2.04))#2,$P(DSC(2.04),"I $D(^UTILITY(",1)="" X DSC(2.04) S D=$O(^(0)) S:D="" D=-1 G M6
+ S D=$S($D(^DPT(DA,.372,0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
+M6 I D>0 S DC=DC_D I $D(^DPT(DA,.372,+D,0)) S DE(6)=$P(^(0),U,1)
+ S X="""`"_$P(DVBDX(JP),U,2)_""""
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+R6 D DE
+ G A
+ ;
+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
+X7 W "." S DVBJ2=1
+ Q
+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
+X8 S Y="@46"
+ Q
+9 S DQ=10 ;@61
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
+X10 S Y="@4"
+ Q
+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
+X11 I Z2'[1 S Y="@62"
+ Q
+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
+X12 I '$D(DVBSSA) S Y="@62",JP=JP+1
+ Q
+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
+X13 I DVBSSA S DVBYN="Y",DVBXYN=DVBSSA
+ Q
+14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
+X14 I 'DVBSSA S DVBYN="N",DVBXYN=""
+ Q
+15 S DW=".362;15",DV="SX",DU="",DLB="RECEIVING SOCIAL SECURITY?",DIFLD=.36225
+ S DE(DW)="C15^DVBHCE29"
+ S DU="Y:YES;N:NO;U:UNKNOWN;"
+ S X=DVBYN
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+C15 G C15S:$D(DE(15))[0 K DB
+ S X=DE(15),DIC=DIE
+ X ^DD(2,.36225,1,1,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.36225,1,1,2.4)
+C15S S X="" G:DG(DQ)=X C15F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.36225,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.362)):^(.362),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.36225,1,1,1.4)
+C15F1 Q
+X15 S DFN=DA D MV^DGLOCK Q
+ Q
+ ;
+16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 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
+X16 W "." S JP=JP+1,DVBJ2=1 K DVBYN,DVBXYN
+ Q
+17 S DQ=18 ;@62
+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
+X18 I Z2'[2 S Y="@63"
+ Q
+19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
+X19 I '$D(DVBRETT) S Y="@63",JP=JP+1
+ Q
+20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
+X20 I DVBRETT=""!("BMCROX"'[DVBRETT) S Y="@63",JP=JP+1
+ Q
+21 D:$D(DG)>9 F^DIE17,DE S DQ=21,DW=".362;18",DV="SX",DU="",DLB="TYPE OF OTHER RETIREMENT",DIFLD=.36285
+ S DU="B:BLACK LUNG;M:MILITARY;C:CIVIL;R:RAILROAD;O:OTHER;X:COMBINATIONS OF TYPES;"
+ S X=DVBRETT
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+X21 S DFN=DA D MV^DGLOCK Q
+ Q
+ ;
+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
+X22 W "." S JP=JP+1,DVBJ2=1
+ Q
+23 S DQ=24 ;@63
+24 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=24 D X24 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
+X24 I Z2'[3 S Y="@64"
+ Q
+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
+X25 I '$D(DVBRETO) S Y="@64",JP=JP+1
+ Q
+26 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=26 D X26 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
+X26 S X=DVBRETO I X=""!(X=0) S X="@"
+ Q
+27 S DW=".362;8",DV="NJ8,2X",DU="",DLB="AMOUNT OF OTHER RETIREMENT",DIFLD=.3628
+ S X=X
+ S Y=X
+ S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X)
+ G RD
+X27 D DOL^DGLOCK2 K:+X'=X&(X'?.N1"."2N)!(X>99999)!(X<1) X I $D(X) S DFN=DA D MV^DGLOCK
+ Q
+ ;
+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
+X28 W "." S JP=JP+1,DVBJ2=1
+ Q
+29 S DQ=30 ;@64
+30 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=30 D X30 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
+X30 I Z2'[4 S Y="@1006"
+ Q
+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
+X31 I '$D(DVBOINC) S Y="@1006",JP=JP+1
+ Q
+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
+X32 S X=DVBOINC I X=""!(X=0) S X="@"
+ Q
+33 D:$D(DG)>9 F^DIE17 G ^DVBHCE31

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE3.m

@@ -1 @@
-DVBHCE3 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
+DVBHCE3 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,9) S:%]"" DE(6)=% S %=$P(%Z,U,10) S:%]"" DE(5)=% S %=$P(%Z,U,11) S:%]"" DE(3)=% S %=$P(%Z,U,12) S:%]"" DE(4)=% S %=$P(%Z,U,13) S:%]"" DE(7)=% S %=$P(%Z,U,19) S:%]"" DE(1)=% S %=$P(%Z,U,20) S:%]"" DE(13)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE3",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".32;19",DV="RSX",DU="",DLB="Service NTL Episode",DIFLD=.3285
+ S DE(DW)="C1^DVBHCE3"
+ S DU="Y:YES;N:NO;"
+ G RE
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ ;
+ S X=DE(1),DIC=DIE
+ ;
+ S X=DE(1),DIC=DIE
+ X ^DD(2,.3285,1,3,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.32)),DIV=X S $P(^(.32),U,10)=DIV,DIH=2,DIG=.3291 D ^DICR
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ X "I X'=""Y"" S DGXRF=.3285 D ^DGDDC Q"
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.3285,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,20),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,.3285,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$C(59)_$P($G(^DD(2,.3285,0)),U,3) S X=$P($P(Y(1),$C(59)_Y(0)_":",2),$C(59))'="YES" I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X="" X ^DD(2,.3285,1,3,1.4)
+C1F1 Q
+X1 S DFN=DA D SV^DGLOCK
+ Q
+ ;
+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
+X2 I $P(^DPT(D0,.32),U,19)'="Y" S Y="@31"
+ Q
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".32;11",DV="RDX",DU="",DLB="NTL-EOD",DIFLD=.3292
+ S DE(DW)="C3^DVBHCE3",DE(DW,"INDEX")=1
+ G RE
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
+ ;
+ S X=DE(3),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C3F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
+ F DIXR=649 S DIEZRXR(2,DIXR)=""
+ Q
+X3 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER1^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,0,"MSNTL") X I $D(X) S DGFRDT=X I $D(^DG(43,1)) S SD1=2 D POS^DGINP
+ Q
+ ;
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".32;12",DV="RDX",DU="",DLB="NTL-RAD",DIFLD=.3293
+ S DE(DW)="C4^DVBHCE3",DE(DW,"INDEX")=1
+ G RE
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
+ F DIXR=649 S DIEZRXR(2,DIXR)=""
+ Q
+X4 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER1^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,1,"MSNTL") X I $D(X),$D(^DG(43,1)) S SD1=2 D PS^DGINP
+ Q
+ ;
+5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".32;10",DV="P23'X",DU="",DLB="NTL-Bran. Ser.",DIFLD=.3291
+ S DE(DW)="C5^DVBHCE3",DE(DW,"INDEX")=1
+ S DU="DIC(23,"
+ G RE
+C5 G C5S:$D(DE(5))[0 K DB
+ S X=DE(5),DIC=DIE
+ I $P($G(^DPT(DA,.321)),U,14)]"" D FVP^DGRPMS
+ S X=DE(5),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(5),DIC=DIE
+ X "S DGXRF=.3291 D ^DGDDC Q"
+C5S S X="" G:DG(DQ)=X C5F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DG(DQ),DIC=DIE
+ ;
+C5F1 N X,X1,X2 S DIXR=409 D C5X1(U) K X2 M X2=X D C5X1("O") K X1 M X1=X
+ D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . S X=X2(1)=""
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . D DELMSE^DGRPMS(DA,2)
+ G C5F2
+C5X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3291,DION),$P($G(^DPT(DA,.32)),U,10))
+ S X=$G(X(1))
+ Q
+C5F2 Q
+X5 S DFN=DA K:X=$O(^DIC(23,"B","B.E.C.","")) X I $D(X) D SER1^DGLOCK S DGCOMBR=$G(Y) Q
+ Q
+ ;
+6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW=".32;9",DV="RP25'X",DU="",DLB="NTL-Char. Ser.",DIFLD=.329
+ S DE(DW)="C6^DVBHCE3"
+ S DU="DIC(25,"
+ G RE
+C6 G C6S:$D(DE(6))[0 K DB
+ S X=DE(6),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C6S S X="" G:DG(DQ)=X C6F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C6F1 Q
+X6 S DFN=DA D SER1^DGLOCK
+ Q
+ ;
+7 D:$D(DG)>9 F^DIE17,DE S DQ=7,DW=".32;13",DV="FX",DU="",DLB="NTL-Ser. Num.",DIFLD=.3294
+ S DE(DW)="C7^DVBHCE3"
+ G RE
+C7 G C7S:$D(DE(7))[0 K DB
+ S X=DE(7),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C7S S X="" G:DG(DQ)=X C7F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C7F1 Q
+X7 S DFN=DA D SER1^DGLOCK I $D(X) S:X?1"SS".E L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>15!($L(X)<1)!'(X?.N) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+8 S DQ=9 ;@31
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 I Z2'[3 S Y="@33"
+ Q
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
+X10 I '$D(^DPT(D0,.32)) W !!,*7,?17,DVBON,"No NTLast episode can't edit NNTLast   <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S Y="@33"
+ Q
+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
+X11 I $P(^DPT(D0,.32),U,19)'="Y" W !!,*7,?17,DVBON,"No NTLast episode can't edit NNTLast   <RET>.",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S Y="@33"
+ Q
+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
+X12 S DVBSCR=1 D ^DVBHS4 W !,?34,DVBON,"[NNTLAST]",DVBOFF X DVBLIT1
+ Q
+13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".32;20",DV="RSX",DU="",DLB="Service NNTL Episode",DIFLD=.32945
+ S DE(DW)="C13^DVBHCE3"
+ S DU="Y:YES;N:NO;"
+ G RE
+C13 G C13S:$D(DE(13))[0 K DB
+ D ^DVBHCE4
+C13S S X="" G:DG(DQ)=X C13F1 K DB
+ D ^DVBHCE5
+C13F1 Q
+X13 S DFN=DA D SV^DGLOCK I "N"'[$G(X),$D(^DPT(DFN,.32)),$P(^(.32),U,19)'="Y" W !?4,*7,"Other Periods of service are not indicated...NO EDITING!" K X
+ Q
+ ;
+14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
+X14 I $P(^DPT(D0,.32),U,20)'="Y" S Y="@33"
+ Q
+15 D:$D(DG)>9 F^DIE17 G ^DVBHCE6

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE4.m

@@ -1 @@
-DVBHCE4 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,9) S:%]"" DE(3)=% S %=$P(%Z,U,10) S:%]"" DE(2)=% S %=$P(%Z,U,12) S:%]"" DE(1)=% S %=$P(%Z,U,13) S:%]"" DE(4)=% S %=$P(%Z,U,14) S:%]"" DE(15)=% S %=$P(%Z,U,15) S:%]"" DE(14)=% S %=$P(%Z,U,16) S:%]"" DE(12)=%
- I  S %=$P(%Z,U,17) S:%]"" DE(13)=% S %=$P(%Z,U,18) S:%]"" DE(16)=% S %=$P(%Z,U,20) S:%]"" DE(10)=%
- K %Z Q
+DVBHCE4 ; ;12/27/07
+ S X=DE(13),DIC=DIE
  ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE4",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".32;12",DV="RDX",DU="",DLB="NTL-RAD",DIFLD=.3293
- S DE(DW)="C1^DVBHCE4",DE(DW,"INDEX")=1
- G RE
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C1S S X="" G:DG(DQ)=X C1F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C1F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
- F DIXR=649 S DIEZRXR(2,DIXR)=""
- Q
-X1 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER1^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,1,"MSNTL") X I $D(X),$D(^DG(43,1)) S SD1=2 D PS^DGINP
- Q
- ;
-2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".32;10",DV="P23'X",DU="",DLB="NTL-Bran. Ser.",DIFLD=.3291
- S DE(DW)="C2^DVBHCE4",DE(DW,"INDEX")=1
- S DU="DIC(23,"
- G RE
-C2 G C2S:$D(DE(2))[0 K DB
- S X=DE(2),DIC=DIE
- I $P($G(^DPT(DA,.321)),U,14)]"" D FVP^DGRPMS
- S X=DE(2),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(2),DIC=DIE
- X "S DGXRF=.3291 D ^DGDDC Q"
-C2S S X="" G:DG(DQ)=X C2F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DG(DQ),DIC=DIE
- ;
-C2F1 N X,X1,X2 S DIXR=409 D C2X1(U) K X2 M X2=X D C2X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . S X=X2(1)=""
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . D DELMSE^DGRPMS(DA,2)
- G C2F2
-C2X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3291,DION),$P($G(^DPT(DA,.32)),U,10))
- S X=$G(X(1))
- Q
-C2F2 Q
-X2 S DFN=DA K:X=$O(^DIC(23,"B","B.E.C.","")) X I $D(X) D SER1^DGLOCK S DGCOMBR=$G(Y) Q
- Q
- ;
-3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".32;9",DV="RP25'X",DU="",DLB="NTL-Char. Ser.",DIFLD=.329
- S DE(DW)="C3^DVBHCE4"
- S DU="DIC(25,"
- G RE
-C3 G C3S:$D(DE(3))[0 K DB
- S X=DE(3),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C3S S X="" G:DG(DQ)=X C3F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C3F1 Q
-X3 S DFN=DA D SER1^DGLOCK
- Q
- ;
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".32;13",DV="FX",DU="",DLB="NTL-Ser. Num.",DIFLD=.3294
- S DE(DW)="C4^DVBHCE4"
- G RE
-C4 G C4S:$D(DE(4))[0 K DB
- S X=DE(4),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C4S S X="" G:DG(DQ)=X C4F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C4F1 Q
-X4 S DFN=DA D SER1^DGLOCK I $D(X) S:X?1"SS".E L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>15!($L(X)<1)!'(X?.N) X
- I $D(X),X'?.ANP K X
- Q
- ;
-5 S DQ=6 ;@31
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 I Z2'[3 S Y="@33"
- Q
-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
-X7 I '$D(^DPT(D0,.32)) W !!,*7,?17,DVBON,"No NTLast episode can't edit NNTLast   <RET>",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S Y="@33"
- Q
-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
-X8 I $P(^DPT(D0,.32),U,19)'="Y" W !!,*7,?17,DVBON,"No NTLast episode can't edit NNTLast   <RET>.",DVBOFF X DVBLIT1 R DVBZ:DTIME K DVBZ S Y="@33"
- Q
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 S DVBSCR=1 D ^DVBHS4 W !,?34,DVBON,"[NNTLAST]",DVBOFF X DVBLIT1
- Q
-10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW=".32;20",DV="RSX",DU="",DLB="Service NNTL Episode",DIFLD=.32945
- S DE(DW)="C10^DVBHCE4"
- S DU="Y:YES;N:NO;"
- G RE
-C10 G C10S:$D(DE(10))[0 K DB
- S X=DE(10),DIC=DIE
- ;
- S X=DE(10),DIC=DIE
+ S X=DE(13),DIC=DIE
  X ^DD(2,.32945,1,2,2.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.32)),DIV=X S $P(^(.32),U,15)=DIV,DIH=2,DIG=.3296 D ^DICR
-C10S S X="" G:DG(DQ)=X C10F1 K DB
- S X=DG(DQ),DIC=DIE
- X "I X'=""Y"" S DGXRF=.32945 D ^DGDDC Q"
- S X=DG(DQ),DIC=DIE
- X ^DD(2,.32945,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.32)),DIV=X S $P(^(.32),U,15)=DIV,DIH=2,DIG=.3296 D ^DICR
-C10F1 Q
-X10 S DFN=DA D SV^DGLOCK I "N"'[$G(X),$D(^DPT(DFN,.32)),$P(^(.32),U,19)'="Y" W !?4,*7,"Other Periods of service are not indicated...NO EDITING!" K X
- Q
- ;
-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
-X11 I $P(^DPT(D0,.32),U,20)'="Y" S Y="@33"
- Q
-12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".32;16",DV="RDX",DU="",DLB="NNTL-EOD",DIFLD=.3297
- S DE(DW)="C12^DVBHCE4",DE(DW,"INDEX")=1
- G RE
-C12 G C12S:$D(DE(12))[0 K DB
- S X=DE(12),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C12S S X="" G:DG(DQ)=X C12F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C12F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
- F DIXR=663 S DIEZRXR(2,DIXR)=""
- Q
-X12 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER2^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,0,"MSNNTL") X I $D(X) S DGFRDT=X I $D(^DG(43,1)) S SD1=3 D POS^DGINP
- Q
- ;
-13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".32;17",DV="RDX",DU="",DLB="NNTL-RAD",DIFLD=.3298
- S DE(DW)="C13^DVBHCE4",DE(DW,"INDEX")=1
- G RE
-C13 G C13S:$D(DE(13))[0 K DB
- S X=DE(13),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C13S S X="" G:DG(DQ)=X C13F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C13F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
- F DIXR=663 S DIEZRXR(2,DIXR)=""
- Q
-X13 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER2^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,1,"MSNNTL") X I $D(X),$D(^DG(43,1)) S SD1=3 D PS^DGINP
- Q
- ;
-14 D:$D(DG)>9 F^DIE17,DE S DQ=14,DW=".32;15",DV="P23'X",DU="",DLB="NNTL-Bran. Ser.",DIFLD=.3296
- S DE(DW)="C14^DVBHCE4",DE(DW,"INDEX")=1
- S DU="DIC(23,"
- G RE
-C14 G C14S:$D(DE(14))[0 K DB
- S X=DE(14),DIC=DIE
- I $P($G(^DPT(DA,.321)),U,14)]"" D FVP^DGRPMS
- S X=DE(14),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(14),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.3291)):^(.3291),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.3291)),DIV=X S $P(^(.3291),U,3)=DIV,DIH=2,DIG=.32913 D ^DICR
- S X=DE(14),DIC=DIE
- X "S DGXRF=.3296 D ^DGDDC Q"
-C14S S X="" G:DG(DQ)=X C14F1 K DB
- S X=DG(DQ),DIC=DIE
- ;
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.3291)):^(.3291),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.3291)),DIV=X S $P(^(.3291),U,3)=DIV,DIH=2,DIG=.32913 D ^DICR
- S X=DG(DQ),DIC=DIE
- ;
-C14F1 N X,X1,X2 S DIXR=410 D C14X1(U) K X2 M X2=X D C14X1("O") K X1 M X1=X
- D
- . N DIEXARR M DIEXARR=X S DIEZCOND=1
- . S X=X2(1)=""
- . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
- . D DELMSE^DGRPMS(DA,3)
- G C14F2
-C14X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3296,DION),$P($G(^DPT(DA,.32)),U,15))
- S X=$G(X(1))
- Q
-C14F2 Q
-X14 S DFN=DA K:X=$O(^DIC(23,"B","B.E.C.","")) X I $D(X) D SER2^DGLOCK S DGCOMBR=$G(Y) Q
- Q
- ;
-15 D:$D(DG)>9 F^DIE17,DE S DQ=15,DW=".32;14",DV="RP25'X",DU="",DLB="NNTL-Char. Ser.",DIFLD=.3295
- S DE(DW)="C15^DVBHCE4"
- S DU="DIC(25,"
- G RE
-C15 G C15S:$D(DE(15))[0 K DB
- S X=DE(15),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C15S S X="" G:DG(DQ)=X C15F1 K DB
- D ^DVBHCE5
-C15F1 Q
-X15 S DFN=DA D SER2^DGLOCK
- Q
- ;
-16 D:$D(DG)>9 F^DIE17,DE S DQ=16,DW=".32;18",DV="FX",DU="",DLB="NNTL-Ser. Num.",DIFLD=.3299
- S DE(DW)="C16^DVBHCE4"
- G RE
-C16 G C16S:$D(DE(16))[0 K DB
- D ^DVBHCE6
-C16S S X="" G:DG(DQ)=X C16F1 K DB
- D ^DVBHCE7
-C16F1 Q
-X16 S DFN=DA D SER2^DGLOCK I $D(X) S:X?1"SS".E L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>15!($L(X)<1)!'(X?.N) X
- I $D(X),X'?.ANP K X
- Q
- ;
-17 S DQ=18 ;@33
-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
-X18 I Z2'[4 S Y="@3"
- Q
-19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 S DVBSCR=1 D ^DVBHS4
- Q
-20 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=20 D X20 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
-X20 S DVBJC2=$S($D(^DPT(D0,.32)):$P(^(.32),U,3),1:"")
- Q
-21 D:$D(DG)>9 F^DIE17 G ^DVBHCE8

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE5.m

@@ -1 @@
-DVBHCE5 ; ;12/13/08
+DVBHCE5 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
+ X "I X'=""Y"" S DGXRF=.32945 D ^DGDDC Q"
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.32945,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.32)):^(.32),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.32)),DIV=X S $P(^(.32),U,15)=DIV,DIH=2,DIG=.3296 D ^DICR

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE6.m

@@ -1 @@
-DVBHCE6 ; ;12/13/08
- S X=DE(16),DIC=DIE
- D EVENT^IVMPLOG(DA)
+DVBHCE6 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,3) S:%]"" DE(10)=% S %=$P(%Z,U,14) S:%]"" DE(4)=% S %=$P(%Z,U,15) S:%]"" DE(3)=% S %=$P(%Z,U,16) S:%]"" DE(1)=% S %=$P(%Z,U,17) S:%]"" DE(2)=% S %=$P(%Z,U,18) S:%]"" DE(5)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE6",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".32;16",DV="RDX",DU="",DLB="NNTL-EOD",DIFLD=.3297
+ S DE(DW)="C1^DVBHCE6",DE(DW,"INDEX")=1
+ G RE
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C1F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
+ F DIXR=663 S DIEZRXR(2,DIXR)=""
+ Q
+X1 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER2^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,0,"MSNNTL") X I $D(X) S DGFRDT=X I $D(^DG(43,1)) S SD1=3 D POS^DGINP
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW=".32;17",DV="RDX",DU="",DLB="NNTL-RAD",DIFLD=.3298
+ S DE(DW)="C2^DVBHCE6",DE(DW,"INDEX")=1
+ G RE
+C2 G C2S:$D(DE(2))[0 K DB
+ S X=DE(2),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C2S S X="" G:DG(DQ)=X C2F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C2F1 S DIEZRXR(2,DIIENS)=$$OREF^DILF($NA(@$$CREF^DILF(DIE)))
+ F DIXR=663 S DIEZRXR(2,DIXR)=""
+ Q
+X2 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) S DFN=DA D SER2^DGLOCK I $D(X) K:'$$VALMSE^DGRPMS(DFN,X,1,"MSNNTL") X I $D(X),$D(^DG(43,1)) S SD1=3 D PS^DGINP
+ Q
+ ;
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".32;15",DV="P23'X",DU="",DLB="NNTL-Bran. Ser.",DIFLD=.3296
+ S DE(DW)="C3^DVBHCE6",DE(DW,"INDEX")=1
+ S DU="DIC(23,"
+ G RE
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
+ I $P($G(^DPT(DA,.321)),U,14)]"" D FVP^DGRPMS
+ S X=DE(3),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(3),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.3291)):^(.3291),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.3291)),DIV=X S $P(^(.3291),U,3)=DIV,DIH=2,DIG=.32913 D ^DICR
+ S X=DE(3),DIC=DIE
+ X "S DGXRF=.3296 D ^DGDDC Q"
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
+ ;
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.3291)):^(.3291),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" S DIH=$G(^DPT(DIV(0),.3291)),DIV=X S $P(^(.3291),U,3)=DIV,DIH=2,DIG=.32913 D ^DICR
+ S X=DG(DQ),DIC=DIE
+ ;
+C3F1 N X,X1,X2 S DIXR=410 D C3X1(U) K X2 M X2=X D C3X1("O") K X1 M X1=X
+ D
+ . N DIEXARR M DIEXARR=X S DIEZCOND=1
+ . S X=X2(1)=""
+ . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND
+ . D DELMSE^DGRPMS(DA,3)
+ G C3F2
+C3X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,.3296,DION),$P($G(^DPT(DA,.32)),U,15))
+ S X=$G(X(1))
+ Q
+C3F2 Q
+X3 S DFN=DA K:X=$O(^DIC(23,"B","B.E.C.","")) X I $D(X) D SER2^DGLOCK S DGCOMBR=$G(Y) Q
+ Q
+ ;
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".32;14",DV="RP25'X",DU="",DLB="NNTL-Char. Ser.",DIFLD=.3295
+ S DE(DW)="C4^DVBHCE6"
+ S DU="DIC(25,"
+ G RE
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4F1 Q
+X4 S DFN=DA D SER2^DGLOCK
+ Q
+ ;
+5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW=".32;18",DV="FX",DU="",DLB="NNTL-Ser. Num.",DIFLD=.3299
+ S DE(DW)="C5^DVBHCE6"
+ G RE
+C5 G C5S:$D(DE(5))[0 K DB
+ S X=DE(5),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C5S S X="" G:DG(DQ)=X C5F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C5F1 Q
+X5 S DFN=DA D SER2^DGLOCK I $D(X) S:X?1"SS".E L=$S($D(^DPT(DA,0)):$P(^(0),U,9),1:X) W:X?1"SS".E "  ",L S:X?1"SS".E X=L K:$L(X)>15!($L(X)<1)!'(X?.N) X
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+6 S DQ=7 ;@33
+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
+X7 I Z2'[4 S Y="@3"
+ Q
+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
+X8 S DVBSCR=1 D ^DVBHS4
+ Q
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 S DVBJC2=$S($D(^DPT(D0,.32)):$P(^(.32),U,3),1:"")
+ Q
+10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW=".32;3",DV="*P21'Xa",DU="",DLB="PERIOD OF SERVICE",DIFLD=.323
+ S DE(DW)="C10^DVBHCE6"
+ S DU="DIC(21,"
+ G RE
+C10 G C10S:$D(DE(10))[0 K DB
+ S X=DE(10),DIC=DIE
+ K ^DPT("APOS",$E(X,1,30),DA)
+ S X=DE(10),DIC=DIE
+ ;
+ S X=DE(10),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".323;" D AVAFC^VAFCDD01(DA)
+ S X=DE(10),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ S X=DE(10),DIIX=2_U_DIFLD D AUDIT^DIET
+C10S S X="" G:DG(DQ)=X C10F1 K DB
+ S X=DG(DQ),DIC=DIE
+ S ^DPT("APOS",$E(X,1,30),DA)=""
+ S X=DG(DQ),DIC=DIE
+ X ^DD(2,.323,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,"ODS")):^("ODS"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(2,.323,1,2,1.1) X ^DD(2,.323,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".323;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+ I $D(DE(10))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C10F1 Q
+X10 S DFN=DA D POS^DGLOCK1
+ Q
+ ;
+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
+X11 I X'=DVBJC2 S DVBJ2=1
+ Q
+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
+X12 K DVBJC2
+ Q
+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
+X13 S Y="@3"
+ Q
+14 S DQ=15 ;@104
+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
+X15 D ^DVBHS5 S Y="@5" K DXS
+ Q
+16 S DQ=17 ;@204
+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
+X17 I Z2'[1 S Y="@205"
+ Q
+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
+X18 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
+ Q
+19 D:$D(DG)>9 F^DIE17 G ^DVBHCE7

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE7.m

@@ -1 @@
-DVBHCE7 ; ;12/13/08
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
+DVBHCE7 ; ;12/27/07
+ D DE G BEGIN
+DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
+ I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(13)=% S %=$P(%Z,U,6) S:%]"" DE(6)=%
+ I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(16)=%
+ I $D(^(.361)) S %Z=^(.361) S %=$P(%Z,U,1) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(3)=% S %=$P(%Z,U,5) S:%]"" DE(4)=%
+ I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(11)=%
+ I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(12)=%
+ K %Z Q
+ ;
+W W !?DL+DL-2,DLB_": "
+ Q
+O D W W Y W:$X>45 !?9
+ I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
+ W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
+TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
+ Q
+A K DQ(DQ) S DQ=DQ+1
+B G @DQ
+RE G PR:$D(DE(DQ)) D W,TR
+N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
+RD G QS:X?."?" I X["^" D D G ^DIE17
+ I X="@" D D G Z^DIE2
+ I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
+T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
+ K DDER G X
+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
+ G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
+ I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
+V D @("X"_DQ) K YS
+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
+X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
+ S X="?BAD"
+QS S DZ=X D D,QQ^DIEQ G B
+D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
+Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
+PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
+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
+ 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
+ X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
+RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
+I I DV'["I",DV'["#" G RD
+ D E^DIE0 G RD:$D(X),PR
+ Q
+SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
+ I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
+ D ^DIR I 'DDER S %=Y(0),X=Y
+ Q
+SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
+ I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
+ E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
+ Q
+NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
+KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
+BEGIN S DNM="DVBHCE7",DQ=1
+1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".361;1",DV="SX",DU="",DLB="ELIGIBILITY STATUS",DIFLD=.3611
+ S DE(DW)="C1^DVBHCE7"
+ S DU="P:PENDING VERIFICATION;R:PENDING RE-VERIFICATION;V:VERIFIED;"
+ G RE
+C1 G C1S:$D(DE(1))[0 K DB
+ S X=DE(1),DIC=DIE
+ ;
+ S X=DE(1),DIC=DIE
+ ;
+ S X=DE(1),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C1S S X="" G:DG(DQ)=X C1F1 K DB
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(2,.3611,1,1,1.1) X ^DD(2,.3611,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(2,.3611,1,2,1.4)
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C1F1 Q
+X1 D EK^DGLOCK Q:'$D(X)
+ Q
+ ;
+2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 G A
+3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW=".361;2",DV="DX",DU="",DLB="ELIGIBILITY STATUS DATE",DIFLD=.3612
+ S DE(DW)="C3^DVBHCE7"
+ S X="TODAY"
+ S Y=X
+ G Y
+C3 G C3S:$D(DE(3))[0 K DB
+ S X=DE(3),DIC=DIE
+ ;
+ S X=DE(3),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C3S S X="" G:DG(DQ)=X C3F1 K DB
+ S X=DG(DQ),DIC=DIE
+ K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=$S(($D(DUZ)#2):DUZ,1:"") X ^DD(2,.3612,1,1,1.4)
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C3F1 Q
+X3 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
+ Q
+ ;
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW=".361;5",DV="FX",DU="",DLB="ELIGIBILITY VERIF. METHOD",DIFLD=.3615
+ S DE(DW)="C4^DVBHCE7"
+ S X="HINQ"
+ S Y=X
+ G Y
+C4 G C4S:$D(DE(4))[0 K DB
+ S X=DE(4),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4S S X="" G:DG(DQ)=X C4F1 K DB
+ S X=DG(DQ),DIC=DIE
+ D EVENT^IVMPLOG(DA)
+C4F1 Q
+X4 K:$L(X)>50!($L(X)<2) X I $D(X) D EK^DGLOCK
+ I $D(X),X'?.ANP K X
+ Q
+ ;
+5 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=5 G A
+6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW=".3;6",DV="DX",DU="",DLB="MONETARY BEN. VERIFY DATE",DIFLD=.306
+ S X="TODAY"
+ S Y=X
+ G Y
+X6 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
+ Q
+ ;
+7 S D=0 K DE(1) ;361
+ S DIFLD=361,DGO="^DVBHCE8",DC="3^2.0361IP^E^",DV="2.0361M*P8'X",DW="0;1",DOW="ELIGIBILITY",DLB="Select "_DOW S:D DC=DC_D
+ S DU="DIC(8,"
+ G RE:D I $D(DSC(2.0361))#2,$P(DSC(2.0361),"I $D(^UTILITY(",1)="" X DSC(2.0361) S D=$O(^(0)) S:D="" D=-1 G M7
+ S D=$S($D(^DPT(DA,"E",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
+M7 I D>0 S DC=DC_D I $D(^DPT(DA,"E",+D,0)) S DE(7)=$P(^(0),U,1)
+ G RE
+R7 D DE
+ S D=$S($D(^DPT(DA,"E",0)):$P(^(0),U,3,4),1:1) G 7+1
+ ;
+8 S DQ=9 ;@205
+9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
+X9 I Z2'[2 S Y="@206"
+ Q
+10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 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
+X10 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
+ Q
+11 S DW="TYPE;1",DV="RP391'a",DU="",DLB="TYPE",DIFLD=391
+ S DE(DW)="C11^DVBHCE7",DE(DW,"INDEX")=1
+ S DU="DG(391,"
+ G RE
+C11 G C11S:$D(DE(11))[0 K DB
+ S X=DE(11),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
+ S X=DE(11),DIIX=2_U_DIFLD D AUDIT^DIET
+C11S S X="" G:DG(DQ)=X C11F1 K DB
+ S X=DG(DQ),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
+ I $D(DE(11))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+C11F1 N X,X1,X2 S DIXR=664 D C11X1(U) K X2 M X2=X D C11X1("O") K X1 M X1=X
+ I $G(X(1))]"" D
+ . K ^DPT("APTYPE",X,DA)
+ K X M X=X2 I $G(X(1))]"" D
+ . S ^DPT("APTYPE",X,DA)=""
+ G C11F2
+C11X1(DION) K X
+ S X(1)=$G(@DIEZTMP@("V",2,DIIENS,391,DION),$P($G(^DPT(DA,"TYPE")),U,1))
+ S X=$G(X(1))
+ Q
+C11F2 Q
+X11 Q
+12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="VET;1",DV="RSXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
+ S DE(DW)="C12^DVBHCE7"
+ S DU="Y:YES;N:NO;"
+ G RE
+C12 G C12S:$D(DE(12))[0 K DB
+ S X=DE(12),DIC=DIE
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
+ S X=DE(12),DIC=DIE
+ S DFN=DA D EN^DGRP7CC
+ S X=DE(12),DIC=DIE
+ ;
+ S X=DE(12),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(12),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VAFCDD01(DA)
+ S X=DE(12),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(12),DIIX=2_U_DIFLD D AUDIT^DIET
+C12S S X="" G:DG(DQ)=X C12F1 K DB
+ D ^DVBHCE9
+C12F1 Q
+X12 I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILITY",DUZ)) VAGE^DGLOCK:X="Y" I $D(X) D:$D(DFN) EV^DGLOCK
+ Q
+ ;
+13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".3;1",DV="RSXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
+ S DE(DW)="C13^DVBHCE7"
+ S DU="Y:YES;N:NO;"
+ G RE
+C13 G C13S:$D(DE(13))[0 K DB
+ S X=DE(13),DIC=DIE
+ ;
+ S X=DE(13),DIC=DIE
+ ;
+ S X=DE(13),DIC=DIE
+ D AUTOUPD^DGENA2(DA)
+ S X=DE(13),DIC=DIE
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VAFCDD01(DA)
+ S X=DE(13),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ S X=DE(13),DIIX=2_U_DIFLD D AUDIT^DIET
+C13S S X="" G:DG(DQ)=X C13F1 K DB
+ D ^DVBHCE10
+C13F1 Q
+X13 S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK
+ Q
+ ;
+14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 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
+X14 I X="N" S Y="@2063"
+ Q
+15 S DQ=16 ;@2063
+16 D:$D(DG)>9 F^DIE17,DE S DQ=16,DW=".36;1",DV="*P8'Xa",DU="",DLB="PRIMARY ELIGIBILITY CODE",DIFLD=.361
+ S DE(DW)="C16^DVBHCE7"
+ S DU="DIC(8,"
+ G RE
+C16 G C16S:$D(DE(16))[0 K DB
+ D ^DVBHCE11
+C16S S X="" G:DG(DQ)=X C16F1 K DB
+ D ^DVBHCE12
+C16F1 Q
+X16 S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
+ Q
+ ;
+17 S DQ=18 ;@206
+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
+X18 I Z2'[3 S Y="@104"
+ Q
+19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
+X19 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
+ Q
+20 D:$D(DG)>9 F^DIE17 G ^DVBHCE13

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE8.m

@@ -1 @@
-DVBHCE8 ; ;12/13/08
+DVBHCE8 ; ;12/27/07
  D DE G BEGIN
-DE S DIE="^DPT(",DIC=DIE,DP=2,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DPT(DA,""))=""
- I $D(^(.3)) S %Z=^(.3) S %=$P(%Z,U,1) S:%]"" DE(22)=% S %=$P(%Z,U,6) S:%]"" DE(15)=%
- I $D(^(.32)) S %Z=^(.32) S %=$P(%Z,U,3) S:%]"" DE(1)=%
- I $D(^(.36)) S %Z=^(.36) S %=$P(%Z,U,1) S:%]"" DE(25)=%
- I $D(^(.361)) S %Z=^(.361) S %=$P(%Z,U,1) S:%]"" DE(10)=% S %=$P(%Z,U,2) S:%]"" DE(12)=% S %=$P(%Z,U,5) S:%]"" DE(13)=%
- I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(20)=%
- I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(21)=%
+DE S DIE="^DPT(D0,""E"",",DIC=DIE,DP=2.0361,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DPT(D0,"E",DA,""))=""
+ I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=%
  K %Z Q
  ;
@@ -54 +49 @@
 NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE8",DQ=1
-1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW=".32;3",DV="*P21'Xa",DU="",DLB="PERIOD OF SERVICE",DIFLD=.323
+BEGIN S DNM="DVBHCE8",DQ=1+D G B
+1 S DW="0;1",DV="M*P8'X#",DU="",DLB="ELIGIBILITY",DIFLD=.01
  S DE(DW)="C1^DVBHCE8"
- S DU="DIC(21,"
- G RE
+ S DU="DIC(8,"
+ G RE:'D S DQ=2 G 2
 C1 G C1S:$D(DE(1))[0 K DB
  S X=DE(1),DIC=DIE
- K ^DPT("APOS",$E(X,1,30),DA)
+ K ^DPT(DA(1),"E","B",$E(X,1,30),DA)
  S X=DE(1),DIC=DIE
- ;
+ K ^DPT("AEL",DA(1),+X)
  S X=DE(1),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".323;" D AVAFC^VAFCDD01(DA)
+ D E32^VADPT62
  S X=DE(1),DIC=DIE
- D EVENT^IVMPLOG(DA)
- S X=DE(1),DIIX=2_U_DIFLD D AUDIT^DIET
+ X "S DFN=DA(1) D EN^DGMTR K DGREQF"
+ S X=DE(1),DIC=DIE
+ D AUTOUPD^DGENA2(DA(1))
 C1S S X="" G:DG(DQ)=X C1F1 K DB
  S X=DG(DQ),DIC=DIE
- S ^DPT("APOS",$E(X,1,30),DA)=""
+ S ^DPT(DA(1),"E","B",$E(X,1,30),DA)=""
  S X=DG(DQ),DIC=DIE
- X ^DD(2,.323,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,"ODS")):^("ODS"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(2,.323,1,2,1.1) X ^DD(2,.323,1,2,1.4)
+ S ^DPT("AEL",DA(1),+X)=""
  S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".323;" D AVAFC^VAFCDD01(DA)
+ D E31^VADPT62
  S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
- I $D(DE(1))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ X "S DFN=DA(1) D EN^DGMTR K DGREQF"
+ S X=DG(DQ),DIC=DIE
+ D AUTOUPD^DGENA2(DA(1))
 C1F1 Q
-X1 S DFN=DA D POS^DGLOCK1
+X1 S DIC("S")="I '$P(^(0),U,7),$S($P(^(0),U,8):1,'$D(^DPT(D0,.36)):0,1:Y=+^(.36)),$$ELGCHK^DGRPTU(D0)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X I $D(X) S DINUM=X
  Q
  ;
-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
-X2 I X'=DVBJC2 S DVBJ2=1
- Q
-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
-X3 K DVBJC2
- Q
-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
-X4 S Y="@3"
- Q
-5 S DQ=6 ;@104
-6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 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
-X6 D ^DVBHS5 S Y="@5" K DXS
- Q
-7 S DQ=8 ;@204
-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
-X8 I Z2'[1 S Y="@205"
- Q
-9 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=9 D X9 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
-X9 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
- Q
-10 D:$D(DG)>9 F^DIE17,DE S DQ=10,DW=".361;1",DV="SX",DU="",DLB="ELIGIBILITY STATUS",DIFLD=.3611
- S DE(DW)="C10^DVBHCE8"
- S DU="P:PENDING VERIFICATION;R:PENDING RE-VERIFICATION;V:VERIFIED;"
- G RE
-C10 G C10S:$D(DE(10))[0 K DB
- S X=DE(10),DIC=DIE
- ;
- S X=DE(10),DIC=DIE
- ;
- S X=DE(10),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C10S S X="" G:DG(DQ)=X C10F1 K DB
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y X ^DD(2,.3611,1,1,1.1) X ^DD(2,.3611,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(2,.3611,1,2,1.4)
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C10F1 Q
-X10 D EK^DGLOCK Q:'$D(X)
- Q
- ;
-11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 G A
-12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW=".361;2",DV="DX",DU="",DLB="ELIGIBILITY STATUS DATE",DIFLD=.3612
- S DE(DW)="C12^DVBHCE8"
- S X="TODAY"
- S Y=X
- G Y
-C12 G C12S:$D(DE(12))[0 K DB
- S X=DE(12),DIC=DIE
- ;
- S X=DE(12),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C12S S X="" G:DG(DQ)=X C12F1 K DB
- S X=DG(DQ),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.361)):^(.361),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=$S(($D(DUZ)#2):DUZ,1:"") X ^DD(2,.3612,1,1,1.4)
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C12F1 Q
-X12 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
- Q
- ;
-13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW=".361;5",DV="FX",DU="",DLB="ELIGIBILITY VERIF. METHOD",DIFLD=.3615
- S DE(DW)="C13^DVBHCE8"
- S X="HINQ"
- S Y=X
- G Y
-C13 G C13S:$D(DE(13))[0 K DB
- S X=DE(13),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C13S S X="" G:DG(DQ)=X C13F1 K DB
- S X=DG(DQ),DIC=DIE
- D EVENT^IVMPLOG(DA)
-C13F1 Q
-X13 K:$L(X)>50!($L(X)<2) X I $D(X) D EK^DGLOCK
- I $D(X),X'?.ANP K X
- Q
- ;
-14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 G A
-15 D:$D(DG)>9 F^DIE17,DE S DQ=15,DW=".3;6",DV="DX",DU="",DLB="MONETARY BEN. VERIFY DATE",DIFLD=.306
- S X="TODAY"
- S Y=X
- G Y
-X15 S %DT="E",%DT(0)=-DT D ^%DT K %DT S X=Y K:Y<1 X I $D(X) D EK^DGLOCK
- Q
- ;
-16 S D=0 K DE(1) ;361
- S DIFLD=361,DGO="^DVBHCE9",DC="3^2.0361IP^E^",DV="2.0361M*P8'X",DW="0;1",DOW="ELIGIBILITY",DLB="Select "_DOW S:D DC=DC_D
- S DU="DIC(8,"
- G RE:D I $D(DSC(2.0361))#2,$P(DSC(2.0361),"I $D(^UTILITY(",1)="" X DSC(2.0361) S D=$O(^(0)) S:D="" D=-1 G M16
- S D=$S($D(^DPT(DA,"E",0)):$P(^(0),U,3,4),$O(^(0))'="":$O(^(0)),1:-1)
-M16 I D>0 S DC=DC_D I $D(^DPT(DA,"E",+D,0)) S DE(16)=$P(^(0),U,1)
- G RE
-R16 D DE
- S D=$S($D(^DPT(DA,"E",0)):$P(^(0),U,3,4),1:1) G 16+1
- ;
-17 S DQ=18 ;@205
-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
-X18 I Z2'[2 S Y="@206"
- Q
-19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 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
-X19 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
- Q
-20 S DW="TYPE;1",DV="P391'a",DU="",DLB="TYPE",DIFLD=391
- S DE(DW)="C20^DVBHCE8",DE(DW,"INDEX")=1
- S DU="DG(391,"
- G RE
-C20 G C20S:$D(DE(20))[0 K DB
- S X=DE(20),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
- S X=DE(20),DIIX=2_U_DIFLD D AUDIT^DIET
-C20S S X="" G:DG(DQ)=X C20F1 K DB
- S X=DG(DQ),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="391;" D AVAFC^VAFCDD01(DA)
- I $D(DE(20))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
-C20F1 N X,X1,X2 S DIXR=664 D C20X1(U) K X2 M X2=X D C20X1("O") K X1 M X1=X
- I $G(X(1))]"" D
- . K ^DPT("APTYPE",X,DA)
- K X M X=X2 I $G(X(1))]"" D
- . S ^DPT("APTYPE",X,DA)=""
- G C20F2
-C20X1(DION) K X
- S X(1)=$G(@DIEZTMP@("V",2,DIIENS,391,DION),$P($G(^DPT(DA,"TYPE")),U,1))
- S X=$G(X(1))
- Q
-C20F2 Q
-X20 Q
-21 D:$D(DG)>9 F^DIE17,DE S DQ=21,DW="VET;1",DV="SXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
- S DE(DW)="C21^DVBHCE8"
- S DU="Y:YES;N:NO;"
- G RE
-C21 G C21S:$D(DE(21))[0 K DB
- S X=DE(21),DIC=DIE
- S DFN=DA D EN^DGMTCOR K DGMTCOR
- S X=DE(21),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- S X=DE(21),DIC=DIE
- ;
- S X=DE(21),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(21),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VAFCDD01(DA)
- S X=DE(21),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(21),DIIX=2_U_DIFLD D AUDIT^DIET
-C21S S X="" G:DG(DQ)=X C21F1 K DB
- D ^DVBHCE10
-C21F1 Q
-X21 I $D(X) S:'$D(DPTX) DFN=DA D:'$D(^XUSEC("DG ELIGIBILITY",DUZ)) VAGE^DGLOCK:X="Y" I $D(X) D:$D(DFN) EV^DGLOCK
- Q
- ;
-22 D:$D(DG)>9 F^DIE17,DE S DQ=22,DW=".3;1",DV="SXa",DU="",DLB="SERVICE CONNECTED?",DIFLD=.301
- S DE(DW)="C22^DVBHCE8"
- S DU="Y:YES;N:NO;"
- G RE
-C22 G C22S:$D(DE(22))[0 K DB
- S X=DE(22),DIC=DIE
- ;
- S X=DE(22),DIC=DIE
- ;
- S X=DE(22),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(22),DIC=DIE
- I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".301;" D AVAFC^VAFCDD01(DA)
- S X=DE(22),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- S X=DE(22),DIIX=2_U_DIFLD D AUDIT^DIET
-C22S S X="" G:DG(DQ)=X C22F1 K DB
- D ^DVBHCE11
-C22F1 Q
-X22 S DFN=DA D EV^DGLOCK I $D(X),X="Y" D VET^DGLOCK
- Q
- ;
-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
-X23 I X="N" S Y="@2063"
- Q
-24 S DQ=25 ;@2063
-25 D:$D(DG)>9 F^DIE17,DE S DQ=25,DW=".36;1",DV="*P8'Xa",DU="",DLB="PRIMARY ELIGIBILITY CODE",DIFLD=.361
- S DE(DW)="C25^DVBHCE8"
- S DU="DIC(8,"
- G RE
-C25 G C25S:$D(DE(25))[0 K DB
- D ^DVBHCE12
-C25S S X="" G:DG(DQ)=X C25F1 K DB
- D ^DVBHCE13
-C25F1 Q
-X25 S DFN=DA D EV^DGLOCK I $D(X) D ECD^DGLOCK1
- Q
- ;
-26 S DQ=27 ;@206
-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
-X27 I Z2'[3 S Y="@104"
- Q
-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
-X28 S DVBSCR=1 D ^DVBHS5 S DVBJ2=1
- Q
-29 D:$D(DG)>9 F^DIE17 G ^DVBHCE14
+2 G 1^DIE17

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCE9.m

@@ -1 @@
-DVBHCE9 ; ;12/13/08
- D DE G BEGIN
-DE S DIE="^DPT(D0,""E"",",DIC=DIE,DP=2.0361,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DPT(D0,"E",DA,""))=""
- I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1) S:%]"" DE(1)=%
- K %Z Q
- ;
-W W !?DL+DL-2,DLB_": "
- Q
-O D W W Y W:$X>45 !?9
- I $L(Y)>19,'DV,DV'["I",(DV["F"!(DV["K")) G RW^DIR2
- W:Y]"" "// " I 'DV,DV["I",$D(DE(DQ))#2 S X="" W "  (No Editing)" Q
-TR R X:DTIME E  S (DTOUT,X)=U W $C(7)
- Q
-A K DQ(DQ) S DQ=DQ+1
-B G @DQ
-RE G PR:$D(DE(DQ)) D W,TR
-N I X="" G NKEY:$D(^DD("KEY","F",DP,DIFLD)),A:DV'["R",X:'DV,X:D'>0,A
-RD G QS:X?."?" I X["^" D D G ^DIE17
- I X="@" D D G Z^DIE2
- I X=" ",DV["d",DV'["P",$D(^DISV(DUZ,"DIE",DLB)) S X=^(DLB) I DV'["D",DV'["S" W "  "_X
-T G M^DIE17:DV,^DIE3:DV["V",P:DV'["S" X:$D(^DD(DP,DIFLD,12.1)) ^(12.1) I X?.ANP D SET I 'DDER X:$D(DIC("S")) DIC("S") I  W:'$D(DB(DQ)) "  "_% G V
- K DDER G X
-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
- G V:DV'["N" D D I $L($P(X,"."))>24 K X G Z
- I $P(DQ(DQ),U,5)'["$",X?.1"-".N.1".".N,$P(DQ(DQ),U,5,99)["+X'=X" S X=+X
-V D @("X"_DQ) K YS
-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
-X W:'$D(ZTQUEUED) $C(7),"??" I $D(DB(DQ)) G Z^DIE17
- S X="?BAD"
-QS S DZ=X D D,QQ^DIEQ G B
-D S D=DIFLD,DQ(DQ)=DLB_U_DV_U_DU_U_DW_U_$P($T(@("X"_DQ))," ",2,99) Q
-Y I '$D(DE(DQ)) D O G RD:"@"'[X,A:DV'["R"&(X="@"),X:X="@" S X=Y G N
-PR S DG=DV,Y=DE(DQ),X=DU I $D(DQ(DQ,2)) X DQ(DQ,2) G RP
-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
- 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
- X:DG["D" ^DD("DD") I DG["S" S %=$P($P(";"_X,";"_Y_":",2),";") S:%]"" Y=%
-RP D O I X="" S X=DE(DQ) G A:'DV,A:DC<2,N^DIE17
-I I DV'["I",DV'["#" G RD
- D E^DIE0 G RD:$D(X),PR
- Q
-SET N DIR S DIR(0)="SV"_$E("o",$D(DB(DQ)))_U_DU,DIR("V")=1
- I $D(DB(DQ)),'$D(DIQUIET) N DIQUIET S DIQUIET=1
- D ^DIR I 'DDER S %=Y(0),X=Y
- Q
-SAVEVALS S @DIEZTMP@("V",DP,DIIENS,DIFLD,"O")=$G(DE(DQ)) S:$D(^("F"))[0 ^("F")=$G(DE(DQ))
- I $D(DE(DW,"4/")) S @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")=""
- E  K @DIEZTMP@("V",DP,DIIENS,DIFLD,"4/")
- Q
-NKEY W:'$D(ZTQUEUED) "??  Required key field" S X="?BAD" G QS
-KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY")
-BEGIN S DNM="DVBHCE9",DQ=1+D G B
-1 S DW="0;1",DV="M*P8'X#",DU="",DLB="ELIGIBILITY",DIFLD=.01
- S DE(DW)="C1^DVBHCE9"
- S DU="DIC(8,"
- G RE:'D S DQ=2 G 2
-C1 G C1S:$D(DE(1))[0 K DB
- S X=DE(1),DIC=DIE
- K ^DPT(DA(1),"E","B",$E(X,1,30),DA)
- S X=DE(1),DIC=DIE
- K ^DPT("AEL",DA(1),+X)
- S X=DE(1),DIC=DIE
- D E32^VADPT62
- S X=DE(1),DIC=DIE
- X "S DFN=DA(1) D EN^DGMTR K DGREQF"
- S X=DE(1),DIC=DIE
- D AUTOUPD^DGENA2(DA(1))
-C1S S X="" G:DG(DQ)=X C1F1 K DB
+DVBHCE9 ; ;12/27/07
  S X=DG(DQ),DIC=DIE
- S ^DPT(DA(1),"E","B",$E(X,1,30),DA)=""
+ S DFN=DA D EN^DGMTCOR K DGMTCOR
  S X=DG(DQ),DIC=DIE
- S ^DPT("AEL",DA(1),+X)=""
+ S DFN=DA D EN^DGRP7CC
  S X=DG(DQ),DIC=DIE
- D E31^VADPT62
+ X ^DD(2,1901,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,.3)):^(.3),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X="N" X ^DD(2,1901,1,3,1.4)
  S X=DG(DQ),DIC=DIE
- X "S DFN=DA(1) D EN^DGMTR K DGREQF"
+ D AUTOUPD^DGENA2(DA)
  S X=DG(DQ),DIC=DIE
- D AUTOUPD^DGENA2(DA(1))
-C1F1 Q
-X1 S DIC("S")="I '$P(^(0),U,7),$S($P(^(0),U,8):1,'$D(^DPT(D0,.36)):0,1:Y=+^(.36)),$$ELGCHK^DGRPTU(D0)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X I $D(X) S DINUM=X
- Q
- ;
-2 G 1^DIE17
+ I ($T(AVAFC^VAFCDD01)'="") S VAFCF="1901;" D AVAFC^VAFCDD01(DA)
+ S X=DG(DQ),DIC=DIE
+ D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
+ I $D(DE(12))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET

WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHCG.m

@@ -1 @@
-DVBHCG ; GENERATED FROM 'DVBHINQ PAT-HINQ COMP' PRINT TEMPLATE (#513) ; 12/13/08 ; (FILE 2, MARGIN=80)
+DVBHCG ; GENERATED FROM 'DVBHINQ PAT-HINQ COMP' PRINT TEMPLATE (#513) ; 04/03/06 ; (FILE 2, MARGIN=80)
  G BEGIN
 N W !