HDI1001A.m

HDI1001A ;BPFO/JRP - PATCH 1 POST INSTALL;5/12/2005

 ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005

 ;

POST ;Main entry point for post-install routine

 ; Input: None

 ;        All variables set by Kernel for KIDS post-installs

 ;Output: None

 N HDIMSG

 S HDIMSG(1)=" "

 S HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"

 S HDIMSG(3)="Post-Installation (POST^HDI1001A) will now be run"

 S HDIMSG(4)=" "

 D MES^XPDUTL(.HDIMSG) K HDIMSG

 D DELETE

 I '$$VUID() D PSTHALT Q

 S HDIMSG(1)=" "

 S HDIMSG(2)="Post-Installation ran to completion"

 S HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"

 S HDIMSG(4)=" "

 D MES^XPDUTL(.HDIMSG) K HDIMSG

 Q

 ;

PSTHALT ;Print post-install halted text

 N HDIMSG

 S HDIMSG(1)=" "

 S HDIMSG(2)="*****"

 S HDIMSG(3)="***** Post-installation has been halted"

 S HDIMSG(4)="***** Please contact Enterprise VistA Support"

 S HDIMSG(5)="*****"

 S HDIMSG(6)=" "

 D MES^XPDUTL(.HDIMSG)

 Q

 ;

VUID() ;Instantiate VUIDs for set of code fields

 ; Input: None

 ;Output: 0 = Stop post-install (error)

 ;        1 = Continue with post-install

 N HDIMSG

 S HDIMSG(1)=" "

 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Allergy data"

 S HDIMSG(3)=" "

 D MES^XPDUTL(.HDIMSG) K HDIMSG

 I '$$VUIDL^HDISVU02("ALLERGY","HDI1001B") Q 0

 S HDIMSG(1)=" "

 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Pharmacy data"

 S HDIMSG(3)=" "

 D MES^XPDUTL(.HDIMSG) K HDIMSG

 I '$$VUIDL^HDISVU02("PHARM","HDI1001C") Q 0

 Q 1

 ;

DELETE ;Delete VUID for ENTERED IN ERROR field (#22) of PATIENT

 ; ALLERGIES file (#120.8)

 ;

 ; Input: None

 ;Output: None

 N HDIFILE,HDIFLD,HDIZERO,HDIARR,HDIERR,DIK,DA,INDX,HDIMSG,VUID

 S HDIMSG(1)=" "

 S HDIMSG(2)="Deleting VUIDs for the ENTERED IN ERROR field (#22)"

 S HDIMSG(3)="of the PATIENT ALLERGIES file (#120.8)"

 S HDIMSG(4)=" "

 D MES^XPDUTL(.HDIMSG) K HDIMSG

 ;Find entry in XTID VUID FOR SET OF CODES file (#8985.1)

 S HDIFILE=120.8

 S HDIFLD=22

 S SCREEN="S HDIZERO=^(0) I $P(HDIZERO,""^"",1)=HDIFILE I $P(HDIZERO,""^"",2)=HDIFLD"

 D FIND^DIC(8985.1,,".01;.02;.03;99.99","Q",120.8,,"B",SCREEN,,"HDIARR","HDIERR")

 ;Delete entries found

 S INDX=0

 F  S INDX=+$O(HDIARR("DILIST",2,INDX)) Q:'INDX  D

 .S VUID=HDIARR("DILIST","ID",INDX,99.99)

 .S HDIMSG(1)=" "

 .S HDIMSG(2)="    Deleting VUID "_VUID_" ..."

 .D MES^XPDUTL(.HDIMSG) K HDIMSG

 .S DA=HDIARR("DILIST",2,INDX)

 .S DIK=$$GET1^DID(8985.1,,,"GLOBAL NAME")

 .D ^DIK

 Q

HDI1001A  ;BPFO/JRP - PATCH 1 POST INSTALL;5/12/2005

 +1       ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005

 +2       ;

POST      ;Main entry point for post-install routine

 +1       ; Input: None

 +2       ;        All variables set by Kernel for KIDS post-installs

 +3       ;Output: None

 +4        NEW HDIMSG

 +5        SET HDIMSG(1)=" "

 +6        SET HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"

 +7        SET HDIMSG(3)="Post-Installation (POST^HDI1001A) will now be run"

 +8        SET HDIMSG(4)=" "

 +9        DO MES^XPDUTL(.HDIMSG)

           KILL HDIMSG

 +10       DO DELETE

 +11       IF '$$VUID()

               DO PSTHALT

               QUIT 

 +12       SET HDIMSG(1)=" "

 +13       SET HDIMSG(2)="Post-Installation ran to completion"

 +14       SET HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"

 +15       SET HDIMSG(4)=" "

 +16       DO MES^XPDUTL(.HDIMSG)

           KILL HDIMSG

 +17       QUIT 

 +18      ;

PSTHALT   ;Print post-install halted text

 +1        NEW HDIMSG

 +2        SET HDIMSG(1)=" "

 +3        SET HDIMSG(2)="*****"

 +4        SET HDIMSG(3)="***** Post-installation has been halted"

 +5        SET HDIMSG(4)="***** Please contact Enterprise VistA Support"

 +6        SET HDIMSG(5)="*****"

 +7        SET HDIMSG(6)=" "

 +8        DO MES^XPDUTL(.HDIMSG)

 +9        QUIT 

 +10      ;

VUID()    ;Instantiate VUIDs for set of code fields

 +1       ; Input: None

 +2       ;Output: 0 = Stop post-install (error)

 +3       ;        1 = Continue with post-install

 +4        NEW HDIMSG

 +5        SET HDIMSG(1)=" "

 +6        SET HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Allergy data"

 +7        SET HDIMSG(3)=" "

 +8        DO MES^XPDUTL(.HDIMSG)

           KILL HDIMSG

 +9        IF '$$VUIDL^HDISVU02("ALLERGY","HDI1001B")

               QUIT 0

 +10       SET HDIMSG(1)=" "

 +11       SET HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Pharmacy data"

 +12       SET HDIMSG(3)=" "

 +13       DO MES^XPDUTL(.HDIMSG)

           KILL HDIMSG

 +14       IF '$$VUIDL^HDISVU02("PHARM","HDI1001C")

               QUIT 0

 +15       QUIT 1

 +16      ;

DELETE    ;Delete VUID for ENTERED IN ERROR field (#22) of PATIENT

 +1       ; ALLERGIES file (#120.8)

 +2       ;

 +3       ; Input: None

 +4       ;Output: None

 +5        NEW HDIFILE,HDIFLD,HDIZERO,HDIARR,HDIERR,DIK,DA,INDX,HDIMSG,VUID

 +6        SET HDIMSG(1)=" "

 +7        SET HDIMSG(2)="Deleting VUIDs for the ENTERED IN ERROR field (#22)"

 +8        SET HDIMSG(3)="of the PATIENT ALLERGIES file (#120.8)"

 +9        SET HDIMSG(4)=" "

 +10       DO MES^XPDUTL(.HDIMSG)

           KILL HDIMSG

 +11      ;Find entry in XTID VUID FOR SET OF CODES file (#8985.1)

 +12       SET HDIFILE=120.8

 +13       SET HDIFLD=22

 +14       SET SCREEN="S HDIZERO=^(0) I $P(HDIZERO,""^"",1)=HDIFILE I $P(HDIZERO,""^"",2)=HDIFLD"

 +15       DO FIND^DIC(8985.1,,".01;.02;.03;99.99","Q",120.8,,"B",SCREEN,,"HDIARR","HDIERR")

 +16      ;Delete entries found

 +17       SET INDX=0

 +18       FOR 

               SET INDX=+$ORDER(HDIARR("DILIST",2,INDX))

               IF 'INDX

                   QUIT 

               Begin DoDot:1

 +19               SET VUID=HDIARR("DILIST","ID",INDX,99.99)

 +20               SET HDIMSG(1)=" "

 +21               SET HDIMSG(2)="    Deleting VUID "_VUID_" ..."

 +22               DO MES^XPDUTL(.HDIMSG)

                   KILL HDIMSG

 +23               SET DA=HDIARR("DILIST",2,INDX)

 +24               SET DIK=$$GET1^DID(8985.1,,,"GLOBAL NAME")

 +25               DO ^DIK

               End DoDot:1

 +26       QUIT