- 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 Mar 13, 2025@20:44:14 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
