Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPTX.m

Timestamp:

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

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPTX.m (modified) (8 diffs)

WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPTX.m

@@ -1 @@
-DGRPTX ; GENERATED FROM 'DGRPT 10-10T REGISTRATION' INPUT TEMPLATE(#1476), FILE 2;12/13/08
+DGRPTX ; GENERATED FROM 'DGRPT 10-10T REGISTRATION' INPUT TEMPLATE(#1476), FILE 2;04/21/06
  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(^(0)) S %Z=^(0) S %=$P(%Z,U,2) S:%]"" DE(3)=%
- I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,1) S:%]"" DE(7)=% S %=$P(%Z,U,2) S:%]"" DE(9)=% S %=$P(%Z,U,3) S:%]"" DE(11)=%
+ I $D(^(.11)) S %Z=^(.11) S %=$P(%Z,U,1) S:%]"" DE(7)=% S %=$P(%Z,U,2) S:%]"" DE(9)=%
  I $D(^("TYPE")) S %Z=^("TYPE") S %=$P(%Z,U,1) S:%]"" DE(4)=%
  I $D(^("VET")) S %Z=^("VET") S %=$P(%Z,U,1) S:%]"" DE(5)=%
@@ -94 +94 @@
 C3F1 Q
 X3 Q
-4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="TYPE;1",DV="P391'a",DU="",DLB="TYPE",DIFLD=391
+4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="TYPE;1",DV="RP391'a",DU="",DLB="TYPE",DIFLD=391
  S DE(DW)="C4^DGRPTX",DE(DW,"INDEX")=1
  S DU="DG(391,"
@@ -118 +118 @@
 C4F2 Q
 X4 Q
-5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW="VET;1",DV="SXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
+5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW="VET;1",DV="RSXa",DU="",DLB="VETERAN (Y/N)?",DIFLD=1901
  S DE(DW)="C5^DGRPTX"
  S DU="Y:YES;N:NO;"
@@ -126 +126 @@
  S DFN=DA D EN^DGMTCOR K DGMTCOR
  S X=DE(5),DIC=DIE
- S DFN=DA D EN^DGRP7CC
- S X=DE(5),DIC=DIE
  ;
  S X=DE(5),DIC=DIE
@@ -139 +137 @@
  S X=DG(DQ),DIC=DIE
  S DFN=DA D EN^DGMTCOR K DGMTCOR
- 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)
@@ -175 +171 @@
  S X=DE(7),DIIX=2_U_DIFLD D AUDIT^DIET
 C7S S X="" G:DG(DQ)=X C7F1 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=".111;" D AVAFC^VAFCDD01(DA)
- S X=DG(DQ),DIC=DIE
- D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
- I $D(DE(7))'[0!(^DD(DP,DIFLD,"AUDIT")'="e") S X=DG(DQ),DIIX=3_U_DIFLD D AUDIT^DIET
+ D ^DGRPTX1
 C7F1 N X,X1,X2 S DIXR=230 D C7X1(U) K X2 M X2=X D C7X1("O") K X1 M X1=X
  D
@@ -212 +194 @@
  G RE
 C9 G C9S:$D(DE(9))[0 K DB
- D ^DGRPTX1
+ D ^DGRPTX2
 C9S S X="" G:DG(DQ)=X C9F1 K DB
- D ^DGRPTX2
+ D ^DGRPTX3
 C9F1 N X,X1,X2 S DIXR=232 D C9X1(U) K X2 M X2=X D C9X1("O") K X1 M X1=X
  D
@@ -233 +215 @@
 X10 S:X="" Y="@1112"
  Q
-11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW=".11;3",DV="Fa",DU="",DLB="STREET ADDRESS [LINE 3]",DIFLD=.113
- S DE(DW)="C11^DGRPTX",DE(DW,"INDEX")=1
- G RE
-C11 G C11S:$D(DE(11))[0 K DB
- D ^DGRPTX3
-C11S S X="" G:DG(DQ)=X C11F1 K DB
- D ^DGRPTX4
-C11F1 N X,X1,X2 S DIXR=233 D C11X1(U) K X2 M X2=X D C11X1("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 C11F2
-C11X1(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
-C11F2 Q
-X11 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
- ;
-12 S DQ=13 ;@1112
-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 EASZIPLK=1
- Q
-14 D:$D(DG)>9 F^DIE17 G ^DGRPTX5
+11 D:$D(DG)>9 F^DIE17 G ^DGRPTX4