HDI1000A ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE;2/17/2005
;;1.0;HEALTH DATA & INFORMATICS;;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^HDI1000A) will now be run"
S HDIMSG(4)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$SERVERS^HDI1000B() D PSTHALT Q
I '$$ATTBUL^HDI1000B() D PSTHALT Q
I '$$ATTREM^HDI1000B() D PSTHALT Q
I '$$SYSPAR() D PSTHALT Q
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
;
SYSPAR() ;Initialize HDIS System and HDIS Parameter files
; Input: None
;Output: 0 = Stop post-install (error)
; 1 = Continue with post-install
N FACNUM,DOMAIN,SYSTYPE,X,SYSPTR,HDIMSG,PRAMPTR
;Determine system information
S FACNUM=$$FACNUM^HDISVF01()
S DOMAIN=$G(^XMB("NETNAME"))
S SYSTYPE=$$PROD^XUPROD()
S HDIMSG(1)=" "
S HDIMSG(2)="The following information concerning this system has been"
S HDIMSG(3)="determined and will be used to initialize the HDIS SYSTEM"
S HDIMSG(4)="(#7118.21) and HDIS PARAMETER (#7118.29) files"
S HDIMSG(5)=" "
S HDIMSG(6)=" Facility Number: "_FACNUM
S HDIMSG(7)=" MailMan Domain: "_DOMAIN
S HDIMSG(8)=" System Type: "_$S(SYSTYPE:"Production",1:"Test")
S HDIMSG(9)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
;Create entry in HDIS System file
D BMES^XPDUTL("Creating entry in HDIS SYSTEM file")
I '$$FINDSYS^HDISVF07(DOMAIN,FACNUM,SYSTYPE,1,.SYSPTR) D Q 0
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to create entry"
.S HDIMSG(3)="** Post-installation will be halted"
.S HDIMSG(4)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
D MES^XPDUTL("Entry number "_SYSPTR_" created")
;Create entry in HDIS Parameter file
D BMES^XPDUTL("Creating entry in HDIS PARAMETER file")
S PRAMPTR=$$PARAMINI^HDISVF10(SYSPTR)
I 'PRAMPTR D Q 0
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to create entry"
.S HDIMSG(3)="** Post-installation will be halted"
.S HDIMSG(4)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
D MES^XPDUTL("Entry number "_PRAMPTR_" created")
;Done if this is not FORUM
I DOMAIN'="DOMAIN.EXT" Q 1
;This is FORUM - make it a server
D BMES^XPDUTL("Making FORUM a server")
D SETTYPE^HDISVF02(2,SYSPTR)
I (+$$GETTYPE^HDISVF02(SYSPTR))'=2 D
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to change system type to SERVER"
.S HDIMSG(3)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
;Set Last Non-Standard VUID field
I '$$GETNSVL^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,51,PRAMPTR_",",4536403,1)
I '$$GETNSVL^HDISVF03(SYSPTR) D
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to set LAST NON-STANDARD VUID field to 4536403"
.S HDIMSG(3)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
;Set Ending Non-Standard VUID field
I '$$GETNSVE^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,52,PRAMPTR_",",4636403,1)
I '$$GETNSVE^HDISVF03(SYSPTR) D
.S HDIMSG(1)="**"
.S HDIMSG(2)="** Unable to set ENDING NON-STANDARD VUID field to 4636403"
.S HDIMSG(3)="**"
.D MES^XPDUTL(.HDIMSG) K HDIMSG
;Done
Q 1
;
VUID() ;Instantiate VUIDs for set of code fields in Vitals domain
; 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 Vitals data"
S HDIMSG(3)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$VUIDL("VITALS","HDI1000C") Q 0
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("ALLERGY","HDI1000C") Q 0
S HDIMSG(1)=" "
S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Lab & Pharmacy data"
S HDIMSG(3)=" "
D MES^XPDUTL(.HDIMSG) K HDIMSG
I '$$VUIDL("LABPHAR","HDI1000D") Q 0
I '$$VUIDL("LABPHAR","HDI1000E") Q 0
I '$$VUIDL("LABPHAR","HDI1000F") Q 0
I '$$VUIDL("LABPHAR","HDI1000G") Q 0
Q 1
;
VUIDL(TAG,ROUTINE) ;Instantiate VUIDs for set of code fields
; Input: TAG - Line tag under which VUID data has been placed
; ROUTINE - Routine line tag is in
; Leave blank if in this routine
;Output: 0 = Stop post-install (error)
; 1 = Continue with post-install
; Notes: Data lines must be in the format
; File~Field~Code~VUID~Status~EffectiveDateTime
; (Status and EffectiveDateTime must be in internal format)
; (Default value for Status is 0 - Inactive)
; (Default value for EffectiveDateTime is NOW)
; : Call assumes that all input (TAG & ROUTINE) is valid
; : Call assumes that data lines are valid
; (i.e. no missing/bad data)
N OFFSET,DATA,FILE,FIELD,IREF,VUID,STAT,STDT,DONE,RESULT,HDIMSG
S ROUTINE=$G(ROUTINE)
S RESULT=1
S DONE=0
F OFFSET=1:1 D Q:DONE
.S DATA=$S(ROUTINE="":$T(@TAG+OFFSET),1:$T(@TAG+OFFSET^@ROUTINE))
.S DATA=$P(DATA,";;",2)
.I DATA="" S DONE=1 Q
.S FILE=$P(DATA,"~",1)
.S FIELD=$P(DATA,"~",2)
.S IREF=$P(DATA,"~",3)
.S VUID=$P(DATA,"~",4)
.S STAT=$P(DATA,"~",5)
.I STAT="" S STAT=0
.S STDT=$P(DATA,"~",6)
.I STDT="" S STDT=$$NOW^XLFDT()
.I '$$STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) D
..S HDIMSG(1)="**"
..S HDIMSG(2)="** Unable to store VUID and/or status information for file"
..S HDIMSG(3)="** "_FILE_", field "_FIELD_", and internal value "_IREF
..S HDIMSG(4)="**"
..D MES^XPDUTL(.HDIMSG) K HDIMSG
..S RESULT=0
Q RESULT
;
STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) ;Store VUID info
; Input : FILE - File number
; FIELD - Field number
; IREF - Internal reference
; VUID - VUID
; STAT - Status
; 0 = Inacive (default) 1 = Active
; STDT - Status Date/Time (FileMan)
; (Defaults to NOW)
;Output : 1 = Success
; 0 = Failure
; Notes : Existance/validity of input assumed (internal call)
; : Call will automatically inactivate terms when appropriate
;
N TMP,MASTER
S STAT=+$G(STAT)
S STDT=+$G(STDT)
I 'STDT S STDT=$$NOW^XLFDT()
;Store VUID (also sets master entry flag, if appropriate)
I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) Q 0
;Inactivate non-master entries
I '$$GETMASTR^XTID(FILE,FIELD,IREF) D
.S STAT=0
.S STDT=$$NOW^XLFDT()
;Store status
Q $$SETSTAT^XTID(FILE,FIELD,IREF,STAT,STDT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDI1000A 6850 printed Dec 13, 2024@01:56:05 Page 2
HDI1000A ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE;2/17/2005
+1 ;;1.0;HEALTH DATA & INFORMATICS;;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^HDI1000A) will now be run"
+8 SET HDIMSG(4)=" "
+9 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+10 IF '$$SERVERS^HDI1000B()
DO PSTHALT
QUIT
+11 IF '$$ATTBUL^HDI1000B()
DO PSTHALT
QUIT
+12 IF '$$ATTREM^HDI1000B()
DO PSTHALT
QUIT
+13 IF '$$SYSPAR()
DO PSTHALT
QUIT
+14 IF '$$VUID()
DO PSTHALT
QUIT
+15 SET HDIMSG(1)=" "
+16 SET HDIMSG(2)="Post-Installation ran to completion"
+17 SET HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
+18 SET HDIMSG(4)=" "
+19 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+20 QUIT
+21 ;
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 ;
SYSPAR() ;Initialize HDIS System and HDIS Parameter files
+1 ; Input: None
+2 ;Output: 0 = Stop post-install (error)
+3 ; 1 = Continue with post-install
+4 NEW FACNUM,DOMAIN,SYSTYPE,X,SYSPTR,HDIMSG,PRAMPTR
+5 ;Determine system information
+6 SET FACNUM=$$FACNUM^HDISVF01()
+7 SET DOMAIN=$GET(^XMB("NETNAME"))
+8 SET SYSTYPE=$$PROD^XUPROD()
+9 SET HDIMSG(1)=" "
+10 SET HDIMSG(2)="The following information concerning this system has been"
+11 SET HDIMSG(3)="determined and will be used to initialize the HDIS SYSTEM"
+12 SET HDIMSG(4)="(#7118.21) and HDIS PARAMETER (#7118.29) files"
+13 SET HDIMSG(5)=" "
+14 SET HDIMSG(6)=" Facility Number: "_FACNUM
+15 SET HDIMSG(7)=" MailMan Domain: "_DOMAIN
+16 SET HDIMSG(8)=" System Type: "_$SELECT(SYSTYPE:"Production",1:"Test")
+17 SET HDIMSG(9)=" "
+18 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+19 ;Create entry in HDIS System file
+20 DO BMES^XPDUTL("Creating entry in HDIS SYSTEM file")
+21 IF '$$FINDSYS^HDISVF07(DOMAIN,FACNUM,SYSTYPE,1,.SYSPTR)
Begin DoDot:1
+22 SET HDIMSG(1)="**"
+23 SET HDIMSG(2)="** Unable to create entry"
+24 SET HDIMSG(3)="** Post-installation will be halted"
+25 SET HDIMSG(4)="**"
+26 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+27 DO MES^XPDUTL("Entry number "_SYSPTR_" created")
+28 ;Create entry in HDIS Parameter file
+29 DO BMES^XPDUTL("Creating entry in HDIS PARAMETER file")
+30 SET PRAMPTR=$$PARAMINI^HDISVF10(SYSPTR)
+31 IF 'PRAMPTR
Begin DoDot:1
+32 SET HDIMSG(1)="**"
+33 SET HDIMSG(2)="** Unable to create entry"
+34 SET HDIMSG(3)="** Post-installation will be halted"
+35 SET HDIMSG(4)="**"
+36 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
QUIT 0
+37 DO MES^XPDUTL("Entry number "_PRAMPTR_" created")
+38 ;Done if this is not FORUM
+39 IF DOMAIN'="DOMAIN.EXT"
QUIT 1
+40 ;This is FORUM - make it a server
+41 DO BMES^XPDUTL("Making FORUM a server")
+42 DO SETTYPE^HDISVF02(2,SYSPTR)
+43 IF (+$$GETTYPE^HDISVF02(SYSPTR))'=2
Begin DoDot:1
+44 SET HDIMSG(1)="**"
+45 SET HDIMSG(2)="** Unable to change system type to SERVER"
+46 SET HDIMSG(3)="**"
+47 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
+48 ;Set Last Non-Standard VUID field
+49 IF '$$GETNSVL^HDISVF03(SYSPTR)
SET X=$$SET^HDISVF02(7118.29,51,PRAMPTR_",",4536403,1)
+50 IF '$$GETNSVL^HDISVF03(SYSPTR)
Begin DoDot:1
+51 SET HDIMSG(1)="**"
+52 SET HDIMSG(2)="** Unable to set LAST NON-STANDARD VUID field to 4536403"
+53 SET HDIMSG(3)="**"
+54 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
+55 ;Set Ending Non-Standard VUID field
+56 IF '$$GETNSVE^HDISVF03(SYSPTR)
SET X=$$SET^HDISVF02(7118.29,52,PRAMPTR_",",4636403,1)
+57 IF '$$GETNSVE^HDISVF03(SYSPTR)
Begin DoDot:1
+58 SET HDIMSG(1)="**"
+59 SET HDIMSG(2)="** Unable to set ENDING NON-STANDARD VUID field to 4636403"
+60 SET HDIMSG(3)="**"
+61 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
End DoDot:1
+62 ;Done
+63 QUIT 1
+64 ;
VUID() ;Instantiate VUIDs for set of code fields in Vitals domain
+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 Vitals data"
+7 SET HDIMSG(3)=" "
+8 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+9 IF '$$VUIDL("VITALS","HDI1000C")
QUIT 0
+10 SET HDIMSG(1)=" "
+11 SET HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Allergy data"
+12 SET HDIMSG(3)=" "
+13 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+14 IF '$$VUIDL("ALLERGY","HDI1000C")
QUIT 0
+15 SET HDIMSG(1)=" "
+16 SET HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Lab & Pharmacy data"
+17 SET HDIMSG(3)=" "
+18 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+19 IF '$$VUIDL("LABPHAR","HDI1000D")
QUIT 0
+20 IF '$$VUIDL("LABPHAR","HDI1000E")
QUIT 0
+21 IF '$$VUIDL("LABPHAR","HDI1000F")
QUIT 0
+22 IF '$$VUIDL("LABPHAR","HDI1000G")
QUIT 0
+23 QUIT 1
+24 ;
VUIDL(TAG,ROUTINE) ;Instantiate VUIDs for set of code fields
+1 ; Input: TAG - Line tag under which VUID data has been placed
+2 ; ROUTINE - Routine line tag is in
+3 ; Leave blank if in this routine
+4 ;Output: 0 = Stop post-install (error)
+5 ; 1 = Continue with post-install
+6 ; Notes: Data lines must be in the format
+7 ; File~Field~Code~VUID~Status~EffectiveDateTime
+8 ; (Status and EffectiveDateTime must be in internal format)
+9 ; (Default value for Status is 0 - Inactive)
+10 ; (Default value for EffectiveDateTime is NOW)
+11 ; : Call assumes that all input (TAG & ROUTINE) is valid
+12 ; : Call assumes that data lines are valid
+13 ; (i.e. no missing/bad data)
+14 NEW OFFSET,DATA,FILE,FIELD,IREF,VUID,STAT,STDT,DONE,RESULT,HDIMSG
+15 SET ROUTINE=$GET(ROUTINE)
+16 SET RESULT=1
+17 SET DONE=0
+18 FOR OFFSET=1:1
Begin DoDot:1
+19 SET DATA=$SELECT(ROUTINE="":$TEXT(@TAG+OFFSET),1:$TEXT(@TAG+OFFSET^@ROUTINE))
+20 SET DATA=$PIECE(DATA,";;",2)
+21 IF DATA=""
SET DONE=1
QUIT
+22 SET FILE=$PIECE(DATA,"~",1)
+23 SET FIELD=$PIECE(DATA,"~",2)
+24 SET IREF=$PIECE(DATA,"~",3)
+25 SET VUID=$PIECE(DATA,"~",4)
+26 SET STAT=$PIECE(DATA,"~",5)
+27 IF STAT=""
SET STAT=0
+28 SET STDT=$PIECE(DATA,"~",6)
+29 IF STDT=""
SET STDT=$$NOW^XLFDT()
+30 IF '$$STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT)
Begin DoDot:2
+31 SET HDIMSG(1)="**"
+32 SET HDIMSG(2)="** Unable to store VUID and/or status information for file"
+33 SET HDIMSG(3)="** "_FILE_", field "_FIELD_", and internal value "_IREF
+34 SET HDIMSG(4)="**"
+35 DO MES^XPDUTL(.HDIMSG)
KILL HDIMSG
+36 SET RESULT=0
End DoDot:2
End DoDot:1
if DONE
QUIT
+37 QUIT RESULT
+38 ;
STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) ;Store VUID info
+1 ; Input : FILE - File number
+2 ; FIELD - Field number
+3 ; IREF - Internal reference
+4 ; VUID - VUID
+5 ; STAT - Status
+6 ; 0 = Inacive (default) 1 = Active
+7 ; STDT - Status Date/Time (FileMan)
+8 ; (Defaults to NOW)
+9 ;Output : 1 = Success
+10 ; 0 = Failure
+11 ; Notes : Existance/validity of input assumed (internal call)
+12 ; : Call will automatically inactivate terms when appropriate
+13 ;
+14 NEW TMP,MASTER
+15 SET STAT=+$GET(STAT)
+16 SET STDT=+$GET(STDT)
+17 IF 'STDT
SET STDT=$$NOW^XLFDT()
+18 ;Store VUID (also sets master entry flag, if appropriate)
+19 IF '$$SETVUID^XTID(FILE,FIELD,IREF,VUID)
QUIT 0
+20 ;Inactivate non-master entries
+21 IF '$$GETMASTR^XTID(FILE,FIELD,IREF)
Begin DoDot:1
+22 SET STAT=0
+23 SET STDT=$$NOW^XLFDT()
End DoDot:1
+24 ;Store status
+25 QUIT $$SETSTAT^XTID(FILE,FIELD,IREF,STAT,STDT)
