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.
Q
;
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
Q
;
ATADDQ D MES^XPDUTL(.SDA) K SDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P496 1366 printed Nov 22, 2024@17:56:18 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
