DG687PRE ;BAY/JAT;reset kill nodes of "AC" and "AADA1" on file 45
;;5.3;Registration;**687*;Aug 13,1993
;
; This is a pre-init routine for DG*5.3*687
; The purpose is to reset kill nodes on the "AC" and "AADA1"
; crossreferences of the discharge date (field #70) on
; the Patient Treatment file (#45)
;
EN ;
N DGI
D BMES^XPDUTL("Updating the ""AC"" cross reference...")
S DGI=0 F S DGI=$O(^DD(45,70,1,DGI)) Q:'DGI D
.Q:$P($G(^DD(45,70,1,DGI,0)),U,2)'="AC"
.S ^DD(45,70,1,DGI,2)="S %=$S($D(^DGPT(DA,""M"",1,0)):^(0),1:""""),%D=+$P(%,U,10),^(0)=$P(%_""^^^^^^^^^^"",U,1,9)_U_X_U_$P(%,U,11,99) K ^DGPT(DA,""M"",""AM"",%D,1),%,%D"
D BMES^XPDUTL("Updating the ""AADA1"" cross reference...")
S DGI=0 F S DGI=$O(^DD(45,70,1,DGI)) Q:'DGI D
.Q:$P($G(^DD(45,70,1,DGI,0)),U,2)'="AADA1"
.S ^DD(45,70,1,DGI,2)="S L=$P(^DGPT(DA,0),""^"",2) I L?7N.E,$G(DIK)'=""^DGPT("" S ^DGPT(""AADA"",L,DA)="""""
I $D(^DD(45,0,"DIK")) N X,Y,DMAX S X=^DD(45,0,"DIK"),Y=45,DMAX=$$ROUSIZE^DILF D EN^DIKZ Q ;Trigger xref re-compile if already compiled
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG687PRE 1063 printed Nov 22, 2024@17:50:33 Page 2
DG687PRE ;BAY/JAT;reset kill nodes of "AC" and "AADA1" on file 45
+1 ;;5.3;Registration;**687*;Aug 13,1993
+2 ;
+3 ; This is a pre-init routine for DG*5.3*687
+4 ; The purpose is to reset kill nodes on the "AC" and "AADA1"
+5 ; crossreferences of the discharge date (field #70) on
+6 ; the Patient Treatment file (#45)
+7 ;
EN ;
+1 NEW DGI
+2 DO BMES^XPDUTL("Updating the ""AC"" cross reference...")
+3 SET DGI=0
FOR
SET DGI=$ORDER(^DD(45,70,1,DGI))
if 'DGI
QUIT
Begin DoDot:1
+4 if $PIECE($GET(^DD(45,70,1,DGI,0)),U,2)'="AC"
QUIT
+5 SET ^DD(45,70,1,DGI,2)="S %=$S($D(^DGPT(DA,""M"",1,0)):^(0),1:""""),%D=+$P(%,U,10),^(0)=$P(%_""^^^^^^^^^^"",U,1,9)_U_X_U_$P(%,U,11,99) K ^DGPT(DA,""M"",""AM"",%D,1),%,%D"
End DoDot:1
+6 DO BMES^XPDUTL("Updating the ""AADA1"" cross reference...")
+7 SET DGI=0
FOR
SET DGI=$ORDER(^DD(45,70,1,DGI))
if 'DGI
QUIT
Begin DoDot:1
+8 if $PIECE($GET(^DD(45,70,1,DGI,0)),U,2)'="AADA1"
QUIT
+9 SET ^DD(45,70,1,DGI,2)="S L=$P(^DGPT(DA,0),""^"",2) I L?7N.E,$G(DIK)'=""^DGPT("" S ^DGPT(""AADA"",L,DA)="""""
End DoDot:1
+10 ;Trigger xref re-compile if already compiled
IF $DATA(^DD(45,0,"DIK"))
NEW X,Y,DMAX
SET X=^DD(45,0,"DIK")
SET Y=45
SET DMAX=$$ROUSIZE^DILF
DO EN^DIKZ
QUIT
+11 QUIT
