SD5348PT.m

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 ---SD5348PT   1500     printed  Apr 09, 2024@21:49:47                                                                                                                                                                                                    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      ;