HDI1007A ;HRN/ART - PATCH 7 POST INSTALL;6/13/2008
;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
;
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^HDI1007A) will now be run"
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
D DELETE
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
;
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,HDIMSG,VUID,SCREEN
N INDX1,INDX2,HDIDATA,CODE
S HDIMSG(1)=" "
S HDIMSG(2)="Deleting invalid VUIDs entered for Lab set of code fields."
S HDIMSG(3)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
;Find entry in XTID VUID FOR SET OF CODES file (#8985.1)
F INDX1=1:1 Q:$P($T(LAB+INDX1^HDI1007B),";;",2)="" D
.S HDIDATA=$P($T(LAB+INDX1^HDI1007B),";;",2)
.S HDIFILE=$P(HDIDATA,"~",1)
.S HDIFLD=$P(HDIDATA,"~",2)
.S HDIMSG(1)=" "
.S HDIMSG(2)=" File: "_HDIFILE_" Field: "_HDIFLD
.D MES^XPDUTL(.HDIMSG) K HDIMSG
.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",HDIFILE,,"B",SCREEN,,"HDIARR","HDIERR")
.;Delete entries found
.S INDX2=0
.F S INDX2=+$O(HDIARR("DILIST",2,INDX2)) Q:'INDX2 D
..S VUID=HDIARR("DILIST","ID",INDX2,99.99)
..S CODE=HDIARR("DILIST","ID",INDX2,.03)
..S HDIMSG(1)=" "
..S HDIMSG(2)=" Deleting CODE "_CODE_" VUID "_VUID_" ..."
..;S HDIMSG(2)=" Deleting VUID "_VUID_" ..."
..D MES^XPDUTL(.HDIMSG) K HDIMSG
..S DA=HDIARR("DILIST",2,INDX2)
..S DIK=$$GET1^DID(8985.1,,,"GLOBAL NAME")
..D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDI1007A 2219 printed Oct 16, 2024@17:57:07 Page 2
HDI1007A ;HRN/ART - PATCH 7 POST INSTALL;6/13/2008
+1 ;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
+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^HDI1007A) will now be run"
+8 SET HDIMSG(4)=" "
+9 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+10 DO DELETE
+11 SET HDIMSG(1)=" "
+12 SET HDIMSG(2)="Post-Installation ran to completion"
+13 SET HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
+14 SET HDIMSG(4)=" "
+15 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+16 QUIT
+17 ;
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 ;
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,HDIMSG,VUID,SCREEN
+6 NEW INDX1,INDX2,HDIDATA,CODE
+7 SET HDIMSG(1)=" "
+8 SET HDIMSG(2)="Deleting invalid VUIDs entered for Lab set of code fields."
+9 SET HDIMSG(3)=" "
+10 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+11 ;Find entry in XTID VUID FOR SET OF CODES file (#8985.1)
+12 FOR INDX1=1:1
if $PIECE($TEXT(LAB+INDX1^HDI1007B),";;",2)=""
QUIT
Begin DoDot:1
+13 SET HDIDATA=$PIECE($TEXT(LAB+INDX1^HDI1007B),";;",2)
+14 SET HDIFILE=$PIECE(HDIDATA,"~",1)
+15 SET HDIFLD=$PIECE(HDIDATA,"~",2)
+16 SET HDIMSG(1)=" "
+17 SET HDIMSG(2)=" File: "_HDIFILE_" Field: "_HDIFLD
+18 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+19 SET SCREEN="S HDIZERO=^(0) I $P(HDIZERO,""^"",1)=HDIFILE I $P(HDIZERO,""^"",2)=HDIFLD"
+20 DO FIND^DIC(8985.1,,".01;.02;.03;99.99","Q",HDIFILE,,"B",SCREEN,,"HDIARR","HDIERR")
+21 ;Delete entries found
+22 SET INDX2=0
+23 FOR
SET INDX2=+$ORDER(HDIARR("DILIST",2,INDX2))
if 'INDX2
QUIT
Begin DoDot:2
+24 SET VUID=HDIARR("DILIST","ID",INDX2,99.99)
+25 SET CODE=HDIARR("DILIST","ID",INDX2,.03)
+26 SET HDIMSG(1)=" "
+27 SET HDIMSG(2)=" Deleting CODE "_CODE_" VUID "_VUID_" ..."
+28 ;S HDIMSG(2)=" Deleting VUID "_VUID_" ..."
+29 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+30 SET DA=HDIARR("DILIST",2,INDX2)
+31 SET DIK=$$GET1^DID(8985.1,,,"GLOBAL NAME")
+32 DO ^DIK
End DoDot:2
End DoDot:1
+33 QUIT
