Routine: SD53P496

SD53P496 ;ALB/ESW - SD*5.3*496 POST INIT; Oct 04, 2006 ; 10/23/06 5:40pm  ; 4/16/07 5:27pm

 ;;5.3;SCHEDULING;**496**;AUG 13, 1993;Build 11

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;Clean ^GMR(123,"F"  cross-reference, used to search by patient to

 ;get REQUEST/CONSULTATION ien, through verification that each cross-

 ;reference entry has its corresponding REQUEST/CONSULTATION entry pointed to.

POST ;

 N SDA

 S SDA(1)="",SDA(2)="    SD*5.3*496 Post-Install .....",SDA(3)="" D ATADDQ

 S SDA(1)="  >> Verifying if )'^GMR(123,""F"",SDPT,SDIN)' have corresponding"

 S SDA(2)="     '0' entries in the REQUEST/CONSULTATION file (# 123), and remove them if not."

 N SDPT,SDIN,DA,SDREF,CNT S CNT=0

 S SDPT="" F  S SDPT=$O(^GMR(123,"F",SDPT)) Q:SDPT'>0  D

 .S SDIN="" F  S SDIN=$O(^GMR(123,"F",SDPT,SDIN)) Q:SDIN=""  D

 ..I $G(^GMR(123,SDIN,0))="" S CNT=CNT+1 D  S SDREF=^GMR(123,"F",SDPT,SDIN) K ^(SDIN),SDREF

 ...N SDA

 ...S SDA(1)="Entry "_SDIN_" - Patient DFN= "_SDPT_" does not have '0' node"

 ...S SDA(2)="      ""F"" - cross-reference deleted."

 ...D ATADDQ

 I 'CNT N SDA S SDA(1)=" No bad ""F"" cross-references identified"

 E  N SDA S SDA(1)="  "_CNT_" 'hanging' ""F"""_" cross-references identified"

 S SDA(2)="  SD*5.3*496 Post-Install finished."

 D ATADDQ

ATADDQ D MES^XPDUTL(.SDA) K SDA

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P496   1366     printed  Apr 09, 2024@21:40:11                                                                                                                                                                                                    Page 2

SD53P496  ;ALB/ESW - SD*5.3*496 POST INIT; Oct 04, 2006 ; 10/23/06 5:40pm  ; 4/16/07 5:27pm

 +1       ;;5.3;SCHEDULING;**496**;AUG 13, 1993;Build 11

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;Clean ^GMR(123,"F"  cross-reference, used to search by patient to

 +4       ;get REQUEST/CONSULTATION ien, through verification that each cross-

 +5       ;reference entry has its corresponding REQUEST/CONSULTATION entry pointed to.

 +6        QUIT

 +7       ;

POST      ;

 +1        NEW SDA

 +2        SET SDA(1)=""

           SET SDA(2)="    SD*5.3*496 Post-Install ....."

           SET SDA(3)=""

           DO ATADDQ

 +3        SET SDA(1)="  >> Verifying if )'^GMR(123,""F"",SDPT,SDIN)' have corresponding"

 +4        SET SDA(2)="     '0' entries in the REQUEST/CONSULTATION file (# 123), and remove them if not."

 +5        NEW SDPT,SDIN,DA,SDREF,CNT

           SET CNT=0

 +6        SET SDPT=""

FOR

               SET SDPT=$ORDER(^GMR(123,"F",SDPT))

               if SDPT'>0

                   QUIT

               Begin DoDot:1

 +7                SET SDIN=""

FOR

                       SET SDIN=$ORDER(^GMR(123,"F",SDPT,SDIN))

                       if SDIN=""

                           QUIT

                       Begin DoDot:2

 +8                        IF $GET(^GMR(123,SDIN,0))=""

                               SET CNT=CNT+1

                               Begin DoDot:3

 +9                                NEW SDA

 +10                               SET SDA(1)="Entry "_SDIN_" - Patient DFN= "_SDPT_" does not have '0' node"

 +11                               SET SDA(2)="      ""F"" - cross-reference deleted."

 +12                               DO ATADDQ

                               End DoDot:3

                               SET SDREF=^GMR(123,"F",SDPT,SDIN)

                               KILL ^(SDIN),SDREF

                       End DoDot:2

               End DoDot:1

 +13       IF 'CNT

               NEW SDA

               SET SDA(1)=" No bad ""F"" cross-references identified"

 +14      IF '$TEST

               NEW SDA

               SET SDA(1)="  "_CNT_" 'hanging' ""F"""_" cross-references identified"

 +15       SET SDA(2)="  SD*5.3*496 Post-Install finished."

 +16       DO ATADDQ

 +17       QUIT

 +18      ;

ATADDQ     DO MES^XPDUTL(.SDA)

           KILL SDA

 +1        QUIT

SD53P496.m