DVBA23P ;ALB/SEK CLEANUP POST-INS DVBA*2.7*23 ;10/02/98
;;2.7;AMIE;**23**;Apr 10, 1995
;
;This routine will be run as post-installation for patch DVBA*2.7*23.
;This cleanup will delete entries in the IVM PATIENT file (#301.5)
;pointing to non-existing or non-veteran entries in the PATIENT file
;(#2). Corresponding entries in the IVM TRANSMISSION LOG file (#301.6)
;will also be deleted.
;
POST ;entry point for post-install, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DVBIEN","EN^DVBA23P",0)
S %=$$NEWCP^XPDUTL("DVBCTR5")
S %=$$NEWCP^XPDUTL("DVBCTR6")
Q
;
EN ;begin processing
;
;go through the IVM PATIENT file finding entries pointing to non-
;existing or non-veteran entries in the PATIENT file.
N DVBIEN,DVBCTR5,DVBCTR6
;
D BMES^XPDUTL(" >> starting cleanup of IVM PATIENT and IVM TRANSMISSION LOG files")
;
;get value from checkpoints, previous run
S DVBIEN=+$$PARCP^XPDUTL("DVBIEN")
S DVBCTR5=+$$PARCP^XPDUTL("DVBCTR5")
S DVBCTR6=+$$PARCP^XPDUTL("DVBCTR6")
;
D LOOP
D BMES^XPDUTL(" "_DVBCTR5_" entries deleted from IVM PATIENT file")
D MES^XPDUTL(" "_DVBCTR6_" entries deleted from IVM TRANSMISSION LOG file")
D BMES^XPDUTL(" >> cleanup done")
Q
;
LOOP ;
N %,DA,DIK,DVBIVMT,DFN,VAEL,VAERR
F S DVBIEN=$O(^IVM(301.5,DVBIEN)) Q:'DVBIEN D
.S DFN=+$G(^IVM(301.5,DVBIEN,0)) Q:'DFN
.D ELIG^VADPT Q:VAEL(4)
.S DVBIVMT=0
.F S DVBIVMT=$O(^IVM(301.6,"B",DVBIEN,DVBIVMT)) Q:'DVBIVMT D
..S DA=DVBIVMT,DIK="^IVM(301.6," D ^DIK
..S DVBCTR6=DVBCTR6+1
..S %=$$UPCP^XPDUTL("DVBCTR6",DVBCTR6)
.S DA=DVBIEN,DIK="^IVM(301.5," D ^DIK
.S DVBCTR5=DVBCTR5+1
.S %=$$UPCP^XPDUTL("DVBCTR5",DVBCTR5)
.Q
S %=$$UPCP^XPDUTL("DVBIEN",DVBIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA23P 1734 printed Nov 22, 2024@16:49:46 Page 2
DVBA23P ;ALB/SEK CLEANUP POST-INS DVBA*2.7*23 ;10/02/98
+1 ;;2.7;AMIE;**23**;Apr 10, 1995
+2 ;
+3 ;This routine will be run as post-installation for patch DVBA*2.7*23.
+4 ;This cleanup will delete entries in the IVM PATIENT file (#301.5)
+5 ;pointing to non-existing or non-veteran entries in the PATIENT file
+6 ;(#2). Corresponding entries in the IVM TRANSMISSION LOG file (#301.6)
+7 ;will also be deleted.
+8 ;
POST ;entry point for post-install, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DVBIEN","EN^DVBA23P",0)
+3 SET %=$$NEWCP^XPDUTL("DVBCTR5")
+4 SET %=$$NEWCP^XPDUTL("DVBCTR6")
+5 QUIT
+6 ;
EN ;begin processing
+1 ;
+2 ;go through the IVM PATIENT file finding entries pointing to non-
+3 ;existing or non-veteran entries in the PATIENT file.
+4 NEW DVBIEN,DVBCTR5,DVBCTR6
+5 ;
+6 DO BMES^XPDUTL(" >> starting cleanup of IVM PATIENT and IVM TRANSMISSION LOG files")
+7 ;
+8 ;get value from checkpoints, previous run
+9 SET DVBIEN=+$$PARCP^XPDUTL("DVBIEN")
+10 SET DVBCTR5=+$$PARCP^XPDUTL("DVBCTR5")
+11 SET DVBCTR6=+$$PARCP^XPDUTL("DVBCTR6")
+12 ;
+13 DO LOOP
+14 DO BMES^XPDUTL(" "_DVBCTR5_" entries deleted from IVM PATIENT file")
+15 DO MES^XPDUTL(" "_DVBCTR6_" entries deleted from IVM TRANSMISSION LOG file")
+16 DO BMES^XPDUTL(" >> cleanup done")
+17 QUIT
+18 ;
LOOP ;
+1 NEW %,DA,DIK,DVBIVMT,DFN,VAEL,VAERR
+2 FOR
SET DVBIEN=$ORDER(^IVM(301.5,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:1
+3 SET DFN=+$GET(^IVM(301.5,DVBIEN,0))
if 'DFN
QUIT
+4 DO ELIG^VADPT
if VAEL(4)
QUIT
+5 SET DVBIVMT=0
+6 FOR
SET DVBIVMT=$ORDER(^IVM(301.6,"B",DVBIEN,DVBIVMT))
if 'DVBIVMT
QUIT
Begin DoDot:2
+7 SET DA=DVBIVMT
SET DIK="^IVM(301.6,"
DO ^DIK
+8 SET DVBCTR6=DVBCTR6+1
+9 SET %=$$UPCP^XPDUTL("DVBCTR6",DVBCTR6)
End DoDot:2
+10 SET DA=DVBIEN
SET DIK="^IVM(301.5,"
DO ^DIK
+11 SET DVBCTR5=DVBCTR5+1
+12 SET %=$$UPCP^XPDUTL("DVBCTR5",DVBCTR5)
+13 QUIT
End DoDot:1
+14 SET %=$$UPCP^XPDUTL("DVBIEN",DVBIEN)
+15 QUIT
