SD5364PT.m

SD5364PT ;ALB/REW - SD*5.3*64 Post-installation ; 5 OCT 1996

 ;;5.3;Scheduling;**64**;SEP 25, 1993

EN ;entry point

 ;look through TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73) to find

 ;encounters without an encounter that occured prior to 10/1/96

 ;delete all such entries that are awaiting transmittal

 ;

 D INTRO

 D SEARCH

 D EXIT

 Q

 ;

INTRO ;header info for output

 D MES^XPDUTL("     The TRANSMITTED OUTPATIENT ENCOUNTER File (#409.73)")

 D MES^XPDUTL("     should only contain records for visits after 10/1/96.")

 D BMES^XPDUTL("     This deletes records in this file for all visits prior to 10/1/96")

 Q

SEARCH ;look for erroneous OUTPATIENT ENCOUNTER ENTRIES

 ;   SCE  = ien of OUTPATIENT ENCOUNTER (#409.68)

 ;   SCD  = ien of DELETED OUTPATIENT ENCOUNTER (#409.74)

 ;   SCCNT = Count of actually deleted records

 ;   SCNODE = Zero Node of Associated File (409.68 or 409.74)

 ;   SCTEST = Testing parameter to prevent deletion & list records

 ;

 N SCE,SC40973,SCCNT,SCNODE,SCD

 D:$G(SCTEST) BMES^XPDUTL("*** Warning !!! with SCTEST flag, no records are deleted!!")

 D:$G(SCTEST) MES^XPDUTL("    Clear the SCTEST variable to delete records and avoid listing records")

 D BMES^XPDUTL(">>>OUTPATIENT ENCOUNTER File (#409.68) related entries...")

 S SCCNT=0

 S SCE=0 F  S SCE=$O(^SD(409.73,"AENC",SCE)) Q:'SCE  D

 .S SCNODE=$G(^SCE(SCE,0))

 .Q:+SCNODE'<2961001

 .S SC40973=+$O(^SD(409.73,"AENC",SCE,""))

 .D:$G(SCTEST) MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.68 IEN:  "_SCE_"   Enc Date: "_+SCNODE)

 .IF '$G(SCTEST) IF $$DELXMIT^SCDXFU03(SC40973,0) D

 ..D MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.68 IEN:  "_SCE_"   Enc Date: "_+SCNODE)

 ..D MES^XPDUTL("   ***Entry could not be deleted. Please check.")

 .S SCCNT=SCCNT+1

 D BMES^XPDUTL("        "_SCCNT_" records deleted related to File #409.68")

 S SCCNT=0

 D BMES^XPDUTL(">>>DELETED OUTPATIENT ENCOUNTER File (#409.74) related entries...")

 S SCD=0 F  S SCD=$O(^SD(409.73,"ADEL",SCD)) Q:'SCD  D

 .S SCNODE=$G(^SD(409.74,SCD,0))

 .Q:+SCNODE'<2961001

 .S SCCNT=SCCNT+1

 .S SC40973=+$O(^SD(409.73,"ADEL",SCD,""))

 .D MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.74 IEN:  "_SCD_"   Enc Date: "_+SCNODE)

 .IF '$G(SCTEST) IF $$DELXMIT^SCDXFU03(SC40973,0) D

 ..D MES^XPDUTL("   ***Entry could not be deleted. Please check.")

 D BMES^XPDUTL("        "_SCCNT_" records deleted related to File #409.74")

 Q

PRINT ;

 Q

EXIT ;final cleanup

 D BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")

 D MES^XPDUTL("under 'SD*5.3*64'")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD5364PT   2572     printed  Apr 23, 2025@18:59:51                                                                                                                                                                                                    Page 2

SD5364PT  ;ALB/REW - SD*5.3*64 Post-installation ; 5 OCT 1996

 +1       ;;5.3;Scheduling;**64**;SEP 25, 1993

EN        ;entry point

 +1       ;look through TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73) to find

 +2       ;encounters without an encounter that occured prior to 10/1/96

 +3       ;delete all such entries that are awaiting transmittal

 +4       ;

 +5        DO INTRO

 +6        DO SEARCH

 +7        DO EXIT

 +8        QUIT 

 +9       ;

INTRO     ;header info for output

 +1        DO MES^XPDUTL("     The TRANSMITTED OUTPATIENT ENCOUNTER File (#409.73)")

 +2        DO MES^XPDUTL("     should only contain records for visits after 10/1/96.")

 +3        DO BMES^XPDUTL("     This deletes records in this file for all visits prior to 10/1/96")

 +4        QUIT 

SEARCH    ;look for erroneous OUTPATIENT ENCOUNTER ENTRIES

 +1       ;   SCE  = ien of OUTPATIENT ENCOUNTER (#409.68)

 +2       ;   SCD  = ien of DELETED OUTPATIENT ENCOUNTER (#409.74)

 +3       ;   SCCNT = Count of actually deleted records

 +4       ;   SCNODE = Zero Node of Associated File (409.68 or 409.74)

 +5       ;   SCTEST = Testing parameter to prevent deletion & list records

 +6       ;

 +7        NEW SCE,SC40973,SCCNT,SCNODE,SCD

 +8        if $GET(SCTEST)

               DO BMES^XPDUTL("*** Warning !!! with SCTEST flag, no records are deleted!!")

 +9        if $GET(SCTEST)

               DO MES^XPDUTL("    Clear the SCTEST variable to delete records and avoid listing records")

 +10       DO BMES^XPDUTL(">>>OUTPATIENT ENCOUNTER File (#409.68) related entries...")

 +11       SET SCCNT=0

 +12       SET SCE=0

           FOR 

               SET SCE=$ORDER(^SD(409.73,"AENC",SCE))

               if 'SCE

                   QUIT 

               Begin DoDot:1

 +13               SET SCNODE=$GET(^SCE(SCE,0))

 +14               if +SCNODE'<2961001

                       QUIT 

 +15               SET SC40973=+$ORDER(^SD(409.73,"AENC",SCE,""))

 +16               if $GET(SCTEST)

                       DO MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.68 IEN:  "_SCE_"   Enc Date: "_+SCNODE)

 +17               IF '$GET(SCTEST)

                       IF $$DELXMIT^SCDXFU03(SC40973,0)

                           Begin DoDot:2

 +18                           DO MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.68 IEN:  "_SCE_"   Enc Date: "_+SCNODE)

 +19                           DO MES^XPDUTL("   ***Entry could not be deleted. Please check.")

                           End DoDot:2

 +20               SET SCCNT=SCCNT+1

               End DoDot:1

 +21       DO BMES^XPDUTL("        "_SCCNT_" records deleted related to File #409.68")

 +22       SET SCCNT=0

 +23       DO BMES^XPDUTL(">>>DELETED OUTPATIENT ENCOUNTER File (#409.74) related entries...")

 +24       SET SCD=0

           FOR 

               SET SCD=$ORDER(^SD(409.73,"ADEL",SCD))

               if 'SCD

                   QUIT 

               Begin DoDot:1

 +25               SET SCNODE=$GET(^SD(409.74,SCD,0))

 +26               if +SCNODE'<2961001

                       QUIT 

 +27               SET SCCNT=SCCNT+1

 +28               SET SC40973=+$ORDER(^SD(409.73,"ADEL",SCD,""))

 +29               DO MES^XPDUTL("   409.73 IEN: "_SC40973_"   409.74 IEN:  "_SCD_"   Enc Date: "_+SCNODE)

 +30               IF '$GET(SCTEST)

                       IF $$DELXMIT^SCDXFU03(SC40973,0)

                           Begin DoDot:2

 +31                           DO MES^XPDUTL("   ***Entry could not be deleted. Please check.")

                           End DoDot:2

               End DoDot:1

 +32       DO BMES^XPDUTL("        "_SCCNT_" records deleted related to File #409.74")

 +33       QUIT 

PRINT     ;

 +1        QUIT 

EXIT      ;final cleanup

 +1        DO BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")

 +2        DO MES^XPDUTL("under 'SD*5.3*64'")

 +3        QUIT