SD5348PT ;ALB/REW - SD*5.3*48 Post-init Checker ; 7 Aug 1996
;;5.3;Scheduling;**48**;AUG 13, 1993
EN ;entry point
;look through patient file's DD for potentially problematic ID nodes
N SCFILE,SCFLG2
D MES^XPDUTL(" Any command that 'talks' in the background will cause problems.")
D MES^XPDUTL(" Using EN^DDIOL is OK.")
D MES^XPDUTL(" Using the WRITE command will cause problems.")
D BMES^XPDUTL(" Please review each of the ID nodes displayed below: ")
F SCFILE=2,44,404.51,200 D
.D IDCHK(SCFILE)
IF $G(SCFLG2) D
.D BMES^XPDUTL(" Please review asterisked nodes closely (they don't contain DDIOL).")
.D MES^XPDUTL(" Replace any WRITE commands with ones that use 'EN^DDIOL'.")
D BMES^XPDUTL("Prior to making any changes to File #200, Contact IRMFO Customer Support.")
Q
;
IDCHK(FILE) ;look through a file's DD for potential ID nodes that 'talk'
N SCSUB,SCND,SCFL,SCFLG3,SCSTAR
S SCSUB=""
D FILE^DID(FILE,"","NAME","SCFL")
D MES^XPDUTL(" ")
D BMES^XPDUTL(">>> WRITE-Type ID nodes in "_SCFL("NAME")_" File (#"_FILE_"):")
F S SCSUB=$O(^DD(FILE,0,"ID",SCSUB)) Q:SCSUB="" S SCND=$G(^(SCSUB)) D
.S SCFLG3=1 ;has one id-write node
.N SCFLG
.Q:(SCSUB=+SCSUB) ;FileMan correctly handles these entries
.IF SCND'["^DDIOL" D
..S SCFLG=1
..S SCFLG2=1
.D MES^XPDUTL($S($G(SCFLG):" ***",1:" ")_" ^DD("_FILE_",0,""ID"","_SCSUB_"):")
.D MES^XPDUTL(" "_SCND)
D:'$G(SCFLG3) MES^XPDUTL(" ...none.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5348PT 1500 printed Oct 16, 2024@18:45:50 Page 2
SD5348PT ;ALB/REW - SD*5.3*48 Post-init Checker ; 7 Aug 1996
+1 ;;5.3;Scheduling;**48**;AUG 13, 1993
EN ;entry point
+1 ;look through patient file's DD for potentially problematic ID nodes
+2 NEW SCFILE,SCFLG2
+3 DO MES^XPDUTL(" Any command that 'talks' in the background will cause problems.")
+4 DO MES^XPDUTL(" Using EN^DDIOL is OK.")
+5 DO MES^XPDUTL(" Using the WRITE command will cause problems.")
+6 DO BMES^XPDUTL(" Please review each of the ID nodes displayed below: ")
+7 FOR SCFILE=2,44,404.51,200
Begin DoDot:1
+8 DO IDCHK(SCFILE)
End DoDot:1
+9 IF $GET(SCFLG2)
Begin DoDot:1
+10 DO BMES^XPDUTL(" Please review asterisked nodes closely (they don't contain DDIOL).")
+11 DO MES^XPDUTL(" Replace any WRITE commands with ones that use 'EN^DDIOL'.")
End DoDot:1
+12 DO BMES^XPDUTL("Prior to making any changes to File #200, Contact IRMFO Customer Support.")
+13 QUIT
+14 ;
IDCHK(FILE) ;look through a file's DD for potential ID nodes that 'talk'
+1 NEW SCSUB,SCND,SCFL,SCFLG3,SCSTAR
+2 SET SCSUB=""
+3 DO FILE^DID(FILE,"","NAME","SCFL")
+4 DO MES^XPDUTL(" ")
+5 DO BMES^XPDUTL(">>> WRITE-Type ID nodes in "_SCFL("NAME")_" File (#"_FILE_"):")
+6 FOR
SET SCSUB=$ORDER(^DD(FILE,0,"ID",SCSUB))
if SCSUB=""
QUIT
SET SCND=$GET(^(SCSUB))
Begin DoDot:1
+7 ;has one id-write node
SET SCFLG3=1
+8 NEW SCFLG
+9 ;FileMan correctly handles these entries
if (SCSUB=+SCSUB)
QUIT
+10 IF SCND'["^DDIOL"
Begin DoDot:2
+11 SET SCFLG=1
+12 SET SCFLG2=1
End DoDot:2
+13 DO MES^XPDUTL($SELECT($GET(SCFLG):" ***",1:" ")_" ^DD("_FILE_",0,""ID"","_SCSUB_"):")
+14 DO MES^XPDUTL(" "_SCND)
End DoDot:1
+15 if '$GET(SCFLG3)
DO MES^XPDUTL(" ...none.")
+16 QUIT
+17 ;
