DG687PRE.m

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 ---DG687PRE   1063     printed  Mar 13, 2025@21:45:08                                                                                                                                                                                                    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