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 ---[H[J[2J[HSD5364PT 2572 printed Dec 13, 2024@02:45:21 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
