DVBA23P.m

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 ---DVBA23P   1734     printed  Apr 09, 2024@20:50:04                                                                                                                                                                                                     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