Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDI1000A

HDI1000A.m

Go to the documentation of this file. 
  1. HDI1000A ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE;2/17/2005
  1.  ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
  1.  ;
  1. POST ;Main entry point for post-install routine
  1.  ; Input: None
  1.  ;        All variables set by Kernel for KIDS post-installs
  1.  ;Output: None
  1.  N HDIMSG
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"
  1.  S HDIMSG(3)="Post-Installation (POST^HDI1000A) will now be run"
  1.  S HDIMSG(4)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$SERVERS^HDI1000B() D PSTHALT Q
  1.  I '$$ATTBUL^HDI1000B() D PSTHALT Q
  1.  I '$$ATTREM^HDI1000B() D PSTHALT Q
  1.  I '$$SYSPAR() D PSTHALT Q
  1.  I '$$VUID() D PSTHALT Q
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Post-Installation ran to completion"
  1.  S HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
  1.  S HDIMSG(4)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  Q
  1.  ;
  1. PSTHALT ;Print post-install halted text
  1.  N HDIMSG
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="*****"
  1.  S HDIMSG(3)="***** Post-installation has been halted"
  1.  S HDIMSG(4)="***** Please contact Enterprise VistA Support"
  1.  S HDIMSG(5)="*****"
  1.  S HDIMSG(6)=" "
  1.  D MES^XPDUTL(.HDIMSG)
  1.  Q
  1.  ;
  1. SYSPAR() ;Initialize HDIS System and HDIS Parameter files
  1.  ; Input: None
  1.  ;Output: 0 = Stop post-install (error)
  1.  ;        1 = Continue with post-install
  1.  N FACNUM,DOMAIN,SYSTYPE,X,SYSPTR,HDIMSG,PRAMPTR
  1.  ;Determine system information
  1.  S FACNUM=$$FACNUM^HDISVF01()
  1.  S DOMAIN=$G(^XMB("NETNAME"))
  1.  S SYSTYPE=$$PROD^XUPROD()
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="The following information concerning this system has been"
  1.  S HDIMSG(3)="determined and will be used to initialize the HDIS SYSTEM"
  1.  S HDIMSG(4)="(#7118.21) and HDIS PARAMETER (#7118.29) files"
  1.  S HDIMSG(5)=" "
  1.  S HDIMSG(6)="  Facility Number: "_FACNUM
  1.  S HDIMSG(7)="   MailMan Domain: "_DOMAIN
  1.  S HDIMSG(8)="      System Type: "_$S(SYSTYPE:"Production",1:"Test")
  1.  S HDIMSG(9)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Create entry in HDIS System file
  1.  D BMES^XPDUTL("Creating entry in HDIS SYSTEM file")
  1.  I '$$FINDSYS^HDISVF07(DOMAIN,FACNUM,SYSTYPE,1,.SYSPTR) D  Q 0
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to create entry"
  1.  .S HDIMSG(3)="** Post-installation will be halted"
  1.  .S HDIMSG(4)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  D MES^XPDUTL("Entry number "_SYSPTR_" created")
  1.  ;Create entry in HDIS Parameter file
  1.  D BMES^XPDUTL("Creating entry in HDIS PARAMETER file")
  1.  S PRAMPTR=$$PARAMINI^HDISVF10(SYSPTR)
  1.  I 'PRAMPTR D  Q 0
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to create entry"
  1.  .S HDIMSG(3)="** Post-installation will be halted"
  1.  .S HDIMSG(4)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  D MES^XPDUTL("Entry number "_PRAMPTR_" created")
  1.  ;Done if this is not FORUM
  1.  I DOMAIN'="FORUM.VA.GOV" Q 1
  1.  ;This is FORUM - make it a server
  1.  D BMES^XPDUTL("Making FORUM a server")
  1.  D SETTYPE^HDISVF02(2,SYSPTR)
  1.  I (+$$GETTYPE^HDISVF02(SYSPTR))'=2 D
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to change system type to SERVER"
  1.  .S HDIMSG(3)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Set Last Non-Standard VUID field
  1.  I '$$GETNSVL^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,51,PRAMPTR_",",4536403,1)
  1.  I '$$GETNSVL^HDISVF03(SYSPTR) D
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to set LAST NON-STANDARD VUID field to 4536403"
  1.  .S HDIMSG(3)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Set Ending Non-Standard VUID field
  1.  I '$$GETNSVE^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,52,PRAMPTR_",",4636403,1)
  1.  I '$$GETNSVE^HDISVF03(SYSPTR) D
  1.  .S HDIMSG(1)="**"
  1.  .S HDIMSG(2)="** Unable to set ENDING NON-STANDARD VUID field to 4636403"
  1.  .S HDIMSG(3)="**"
  1.  .D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ;Done
  1.  Q 1
  1.  ;
  1. VUID() ;Instantiate VUIDs for set of code fields in Vitals domain
  1.  ; Input: None
  1.  ;Output: 0 = Stop post-install (error)
  1.  ;        1 = Continue with post-install
  1.  N HDIMSG
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Vitals data"
  1.  S HDIMSG(3)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$VUIDL("VITALS","HDI1000C") Q 0
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Allergy data"
  1.  S HDIMSG(3)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$VUIDL("ALLERGY","HDI1000C") Q 0
  1.  S HDIMSG(1)=" "
  1.  S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Lab & Pharmacy data"
  1.  S HDIMSG(3)=" "
  1.  D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  I '$$VUIDL("LABPHAR","HDI1000D") Q 0
  1.  I '$$VUIDL("LABPHAR","HDI1000E") Q 0
  1.  I '$$VUIDL("LABPHAR","HDI1000F") Q 0
  1.  I '$$VUIDL("LABPHAR","HDI1000G") Q 0
  1.  Q 1
  1.  ;
  1. VUIDL(TAG,ROUTINE) ;Instantiate VUIDs for set of code fields
  1.  ; Input: TAG - Line tag under which VUID data has been placed
  1.  ;        ROUTINE - Routine line tag is in
  1.  ;                  Leave blank if in this routine
  1.  ;Output: 0 = Stop post-install (error)
  1.  ;        1 = Continue with post-install
  1.  ; Notes: Data lines must be in the format
  1.  ;          File~Field~Code~VUID~Status~EffectiveDateTime
  1.  ;          (Status and EffectiveDateTime must be in internal format)
  1.  ;          (Default value for Status is 0 - Inactive)
  1.  ;          (Default value for EffectiveDateTime is NOW)
  1.  ;      : Call assumes that all input (TAG & ROUTINE) is valid
  1.  ;      : Call assumes that data lines are valid
  1.  ;        (i.e. no missing/bad data)
  1.  N OFFSET,DATA,FILE,FIELD,IREF,VUID,STAT,STDT,DONE,RESULT,HDIMSG
  1.  S ROUTINE=$G(ROUTINE)
  1.  S RESULT=1
  1.  S DONE=0
  1.  F OFFSET=1:1 D  Q:DONE
  1.  .S DATA=$S(ROUTINE="":$T(@TAG+OFFSET),1:$T(@TAG+OFFSET^@ROUTINE))
  1.  .S DATA=$P(DATA,";;",2)
  1.  .I DATA="" S DONE=1 Q
  1.  .S FILE=$P(DATA,"~",1)
  1.  .S FIELD=$P(DATA,"~",2)
  1.  .S IREF=$P(DATA,"~",3)
  1.  .S VUID=$P(DATA,"~",4)
  1.  .S STAT=$P(DATA,"~",5)
  1.  .I STAT="" S STAT=0
  1.  .S STDT=$P(DATA,"~",6)
  1.  .I STDT="" S STDT=$$NOW^XLFDT()
  1.  .I '$$STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) D
  1.  ..S HDIMSG(1)="**"
  1.  ..S HDIMSG(2)="** Unable to store VUID and/or status information for file"
  1.  ..S HDIMSG(3)="** "_FILE_", field "_FIELD_", and internal value "_IREF
  1.  ..S HDIMSG(4)="**"
  1.  ..D MES^XPDUTL(.HDIMSG) K HDIMSG
  1.  ..S RESULT=0
  1.  Q RESULT
  1.  ;
  1. STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) ;Store VUID info
  1.  ; Input : FILE - File number
  1.  ;         FIELD - Field number
  1.  ;         IREF - Internal reference
  1.  ;         VUID - VUID
  1.  ;         STAT - Status
  1.  ;                0 = Inacive (default)     1 = Active
  1.  ;         STDT - Status Date/Time (FileMan)
  1.  ;                (Defaults to NOW)
  1.  ;Output : 1 = Success
  1.  ;         0 = Failure
  1.  ; Notes : Existance/validity of input assumed (internal call)
  1.  ;       : Call will automatically inactivate terms when appropriate
  1.  ;
  1.  N TMP,MASTER
  1.  S STAT=+$G(STAT)
  1.  S STDT=+$G(STDT)
  1.  I 'STDT S STDT=$$NOW^XLFDT()
  1.  ;Store VUID (also sets master entry flag, if appropriate)
  1.  I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) Q 0
  1.  ;Inactivate non-master entries
  1.  I '$$GETMASTR^XTID(FILE,FIELD,IREF) D
  1.  .S STAT=0
  1.  .S STDT=$$NOW^XLFDT()
  1.  ;Store status
  1.  Q $$SETSTAT^XTID(FILE,FIELD,IREF,STAT,STDT)