DG933PO ;DAL/JCH - PATCH DG*5.3*933 POST INSTALL ;06/18/2017
;;5.3;Registration;**933**;Aug 13, 1993;Build 44
; This routine uses the following IAs:
; #4640 - ^HDISVF01 calls (supported)
; #4639 - ^HDISVCMR calls (supported)
; #4651 - ^HDISVF09 calls (supported)
;
EN ;MAIN ENTRY POINT
N SUCCESS,DEMFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,FIL,DOMPTR,DOMAIN
S DEMFAC=$$KSP^XUPARAM("INST")
S DOMAIN="DEMOGRAPHICS"
S SUCCESS=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
I 'SUCCESS!'+$G(DOMPTR) D Q
.D MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
.D PSTHALT("Seeding for files #10.99, #11.99, and #13.99 was not peformed.")
F FIL=10.99,11.99,13.99 D HDIS(FIL,DOMPTR,DOMAIN)
Q
;
HDIS(FIL,DOMPTR,DOMAIN) ; Do dummy 'seeding'
N TMP,HDIMSG,B,C
;
; New file can't be seeded if there is no data?
I FIL=10.99 D Q
.I '$O(^DGRAM(10.99,0)) D DUMSEED(10.99,"SEEDGRAM")
.D PSEED(10.99,DOMPTR,DOMAIN)
I FIL=11.99 D Q
.I '$O(^DGMMS(11.99,0)) D DUMSEED(11.99,"SEEDGMMS")
.D PSEED(11.99,DOMPTR,DOMAIN)
I FIL=13.99 D Q
.I '$O(^DGMR(13.99,0)) D DUMSEED(13.99,"SEEDGMR")
.D PSEED(13.99,DOMPTR,DOMAIN)
;
Q
;
PSEED(FIL,DOMPTR,DOMAIN) ; Check for previous "seeding"(deployment), quit if already done.
N ASTATUS,TMP,XPROD,DGSITE,XMSUB,XMDUZ,XMY,HDITEXT,FILNAM,MSG,XMTEXT,XMZ
;
S ASTATUS=$P($$GETSTAT^HDISVF01(FIL),U)
I ASTATUS>3 S MSG="File: "_FIL_" Has already been seeded. Status is: "_ASTATUS D PSTHALT(MSG) Q
;
; set the seeding status to complete for data deployments.
D SETSTAT^HDISVF01(FIL,,4)
;
; send message to STS that patch is installed and the current status
D FILE^DID(FIL,"","NAME","FILNAM","ERR")
S FILNAM=$G(FILNAM("NAME"))
S XPROD=$$PROD^XUPROD()
S DGSITE=$$SITE^VASITE()
S XMSUB="Site: "_$P(DGSITE,"^",2)_" File: "_FIL_" in "_($S(XPROD:"PRODUCTION",1:"TEST"))_" ready for ERT Update"
S XMY("G.HDIS ERT NOTIFICATION@DOMAIN.EXT")=""
S XMDUZ="Site: "_$P(DGSITE,"^",3)_" Patch Install DG*5.3*933 is Complete"
S XMY(DUZ)=""
K HDITEXT
S HDITEXT(1)=""
S HDITEXT(2)="Site: "_$P(DGSITE,"^",2)_" - "_$P(DGSITE,"^",3)
S HDITEXT(2)=HDITEXT(2)_" with Domain/IP Address of "_$G(^XMB("NETNAME")) ;facility name
S HDITEXT(3)="Has Installed Patch DG*5.3*933 into their "_$S(XPROD:"PRODUCTION",1:"TEST")_" System Environment"
S HDITEXT(4)="The Patch was Installed on: "
S B=$$NOW^XLFDT N Y S Y=B D DD^%DT S HDITEXT(4)=HDITEXT(4)_Y ;date/time
S HDITEXT(5)=""
S HDITEXT(6)="Patch DG*5.3*933 has standardized file: "_FILNAM_" (#"_FIL_")"
S HDITEXT(7)=""
S HDITEXT(8)="The current HDIS status of file #"_FIL_"is: "_$P($$GETSTAT^HDISVF01(FIL),U)
S HDITEXT(9)=""
S HDITEXT(10)="Site: "_$P(DGSITE,"^",2)_" - "_$P(DGSITE,"^",3)_" needs full file update of the "_FILNAM_" file (#"_FIL_" as soon as possible."
S HDITEXT(11)=""
N DIFROM S XMTEXT="HDITEXT(" D ^XMD K DIFROM
S MSG="File: "_FIL_" Has been 'seeded'. Message Number: "_$G(XMZ) D PSTDONE(MSG)
Q
;
PSTDONE(MSG) ; display FINISHED message
N HDIMSG
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch DG*5.3*933 HDIS 'seeding' "_FILNAM_" file (#"_FIL_") has Completed."
S HDIMSG(4)="***** An update message has been sent to Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
DUMSEED(DGMFILE,DGDTAG) ; New file <#nn.99> contains no data, can't be seeded unless there is at least one entry
; RACE MASTER (#10.99) file initial population data elements from DAT1099 line tag
; MASTER MARITAL STATUS (#11.99) file initial population data elements from DAT1199 line tag;
; MASTER RELIGION (#13.99) file initial population data elements from DAT1399 line tag;
;
; DGDATA ";" PIECE - FIELD # - FIELD NAME
; PIECE #1 - n/a - IEN
; PIECE #2 - .01 - NAME
; PIECE #3 - 1 - CODE
;
N DGMFI,DGDATA,DGDATLN,DGFDA,DGRSLT,XUMF
S XUMF=1
F DGDATLN=1:1 S DGDATA=$P($T(@DGDTAG+DGDATLN),";",3,10) Q:DGDATA="" D
.N DGMFI,DGFDA,DGFDAIEN,DGEFFDT
.S DGMFI=$P(DGDATA,";")
.S DGFDA(DGMFILE,"+1,",.01)=$P(DGDATA,";",2)
.S DGFDA(DGMFILE,"+1,",1)=$P(DGDATA,";",3)
.S DGRSLT=$$INSREC(DGMFILE,DGMFI,.DGFDA)
Q
;
INSREC(DGFILE,DGIEN,DGFDA) ; Insert DGIEN into file DGFILE with data in DGFDA
I ('$G(DGFILE)) Q "0^Invalid parameter"
N DGDERR
D UPDATE^DIE("","DGFDA","","DGDERR")
I $D(DGDERR) Q -1
Q +$G(DGFDA)
;
PSTHALT(MSG) ; display error message
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch DG*5.3*933 HDIS 'seeding' has been halted."
S HDIMSG(4)="***** Please contact Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
SEEDGRAM ; Data to populate the RACE MASTER (#10.99) file.
;;1;American Indian or Alaska Native;1002-5
;;2;Asian;2028-9
;;3;Black or African American;2054-5
;;4;Native Hawaiian or Other Pacific Islander;2076-8
;;5;White;2106-3
Q
;
SEEDGMMS ; Data to populate the MASTER MARITAL STATUS (#11.99) file.
;;1;Annulled;A
;;2;Divorced;D
;;3;Interlocutory;I
;;4;Legally Separated;L
;;5;Married;M
Q
;
SEEDGMR ; Data to populated the MASTER RELIGION (#13.99) file.
;;1;Adventist;1001
;;2;African Religions;1002
;;3;Afro-Caribbean Religions;1003
;;4;Agnosticism;1004
;;5;Anglican;1005
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG933PO 5341 printed Dec 13, 2024@02:40:53 Page 2
DG933PO ;DAL/JCH - PATCH DG*5.3*933 POST INSTALL ;06/18/2017
+1 ;;5.3;Registration;**933**;Aug 13, 1993;Build 44
+2 ; This routine uses the following IAs:
+3 ; #4640 - ^HDISVF01 calls (supported)
+4 ; #4639 - ^HDISVCMR calls (supported)
+5 ; #4651 - ^HDISVF09 calls (supported)
+6 ;
EN ;MAIN ENTRY POINT
+1 NEW SUCCESS,DEMFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,FIL,DOMPTR,DOMAIN
+2 SET DEMFAC=$$KSP^XUPARAM("INST")
+3 SET DOMAIN="DEMOGRAPHICS"
+4 SET SUCCESS=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
+5 IF 'SUCCESS!'+$GET(DOMPTR)
Begin DoDot:1
+6 DO MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
+7 DO PSTHALT("Seeding for files #10.99, #11.99, and #13.99 was not peformed.")
End DoDot:1
QUIT
+8 FOR FIL=10.99,11.99,13.99
DO HDIS(FIL,DOMPTR,DOMAIN)
+9 QUIT
+10 ;
HDIS(FIL,DOMPTR,DOMAIN) ; Do dummy 'seeding'
+1 NEW TMP,HDIMSG,B,C
+2 ;
+3 ; New file can't be seeded if there is no data?
+4 IF FIL=10.99
Begin DoDot:1
+5 IF '$ORDER(^DGRAM(10.99,0))
DO DUMSEED(10.99,"SEEDGRAM")
+6 DO PSEED(10.99,DOMPTR,DOMAIN)
End DoDot:1
QUIT
+7 IF FIL=11.99
Begin DoDot:1
+8 IF '$ORDER(^DGMMS(11.99,0))
DO DUMSEED(11.99,"SEEDGMMS")
+9 DO PSEED(11.99,DOMPTR,DOMAIN)
End DoDot:1
QUIT
+10 IF FIL=13.99
Begin DoDot:1
+11 IF '$ORDER(^DGMR(13.99,0))
DO DUMSEED(13.99,"SEEDGMR")
+12 DO PSEED(13.99,DOMPTR,DOMAIN)
End DoDot:1
QUIT
+13 ;
+14 QUIT
+15 ;
PSEED(FIL,DOMPTR,DOMAIN) ; Check for previous "seeding"(deployment), quit if already done.
+1 NEW ASTATUS,TMP,XPROD,DGSITE,XMSUB,XMDUZ,XMY,HDITEXT,FILNAM,MSG,XMTEXT,XMZ
+2 ;
+3 SET ASTATUS=$PIECE($$GETSTAT^HDISVF01(FIL),U)
+4 IF ASTATUS>3
SET MSG="File: "_FIL_" Has already been seeded. Status is: "_ASTATUS
DO PSTHALT(MSG)
QUIT
+5 ;
+6 ; set the seeding status to complete for data deployments.
+7 DO SETSTAT^HDISVF01(FIL,,4)
+8 ;
+9 ; send message to STS that patch is installed and the current status
+10 DO FILE^DID(FIL,"","NAME","FILNAM","ERR")
+11 SET FILNAM=$GET(FILNAM("NAME"))
+12 SET XPROD=$$PROD^XUPROD()
+13 SET DGSITE=$$SITE^VASITE()
+14 SET XMSUB="Site: "_$PIECE(DGSITE,"^",2)_" File: "_FIL_" in "_($SELECT(XPROD:"PRODUCTION",1:"TEST"))_" ready for ERT Update"
+15 SET XMY("G.HDIS ERT NOTIFICATION@DOMAIN.EXT")=""
+16 SET XMDUZ="Site: "_$PIECE(DGSITE,"^",3)_" Patch Install DG*5.3*933 is Complete"
+17 SET XMY(DUZ)=""
+18 KILL HDITEXT
+19 SET HDITEXT(1)=""
+20 SET HDITEXT(2)="Site: "_$PIECE(DGSITE,"^",2)_" - "_$PIECE(DGSITE,"^",3)
+21 ;facility name
SET HDITEXT(2)=HDITEXT(2)_" with Domain/IP Address of "_$GET(^XMB("NETNAME"))
+22 SET HDITEXT(3)="Has Installed Patch DG*5.3*933 into their "_$SELECT(XPROD:"PRODUCTION",1:"TEST")_" System Environment"
+23 SET HDITEXT(4)="The Patch was Installed on: "
+24 ;date/time
SET B=$$NOW^XLFDT
NEW Y
SET Y=B
DO DD^%DT
SET HDITEXT(4)=HDITEXT(4)_Y
+25 SET HDITEXT(5)=""
+26 SET HDITEXT(6)="Patch DG*5.3*933 has standardized file: "_FILNAM_" (#"_FIL_")"
+27 SET HDITEXT(7)=""
+28 SET HDITEXT(8)="The current HDIS status of file #"_FIL_"is: "_$PIECE($$GETSTAT^HDISVF01(FIL),U)
+29 SET HDITEXT(9)=""
+30 SET HDITEXT(10)="Site: "_$PIECE(DGSITE,"^",2)_" - "_$PIECE(DGSITE,"^",3)_" needs full file update of the "_FILNAM_" file (#"_FIL_" as soon as possible."
+31 SET HDITEXT(11)=""
+32 NEW DIFROM
SET XMTEXT="HDITEXT("
DO ^XMD
KILL DIFROM
+33 SET MSG="File: "_FIL_" Has been 'seeded'. Message Number: "_$GET(XMZ)
DO PSTDONE(MSG)
+34 QUIT
+35 ;
PSTDONE(MSG) ; display FINISHED message
+1 NEW HDIMSG
+2 SET HDIMSG(1)=""
+3 SET HDIMSG(2)=MSG
+4 SET HDIMSG(3)="***** Post-installation of Patch DG*5.3*933 HDIS 'seeding' "_FILNAM_" file (#"_FIL_") has Completed."
+5 SET HDIMSG(4)="***** An update message has been sent to Enterprise VistA Support."
+6 SET HDIMSG(5)=""
+7 DO MES^XPDUTL(.HDIMSG)
+8 QUIT
+9 ;
DUMSEED(DGMFILE,DGDTAG) ; New file <#nn.99> contains no data, can't be seeded unless there is at least one entry
+1 ; RACE MASTER (#10.99) file initial population data elements from DAT1099 line tag
+2 ; MASTER MARITAL STATUS (#11.99) file initial population data elements from DAT1199 line tag;
+3 ; MASTER RELIGION (#13.99) file initial population data elements from DAT1399 line tag;
+4 ;
+5 ; DGDATA ";" PIECE - FIELD # - FIELD NAME
+6 ; PIECE #1 - n/a - IEN
+7 ; PIECE #2 - .01 - NAME
+8 ; PIECE #3 - 1 - CODE
+9 ;
+10 NEW DGMFI,DGDATA,DGDATLN,DGFDA,DGRSLT,XUMF
+11 SET XUMF=1
+12 FOR DGDATLN=1:1
SET DGDATA=$PIECE($TEXT(@DGDTAG+DGDATLN),";",3,10)
if DGDATA=""
QUIT
Begin DoDot:1
+13 NEW DGMFI,DGFDA,DGFDAIEN,DGEFFDT
+14 SET DGMFI=$PIECE(DGDATA,";")
+15 SET DGFDA(DGMFILE,"+1,",.01)=$PIECE(DGDATA,";",2)
+16 SET DGFDA(DGMFILE,"+1,",1)=$PIECE(DGDATA,";",3)
+17 SET DGRSLT=$$INSREC(DGMFILE,DGMFI,.DGFDA)
End DoDot:1
+18 QUIT
+19 ;
INSREC(DGFILE,DGIEN,DGFDA) ; Insert DGIEN into file DGFILE with data in DGFDA
+1 IF ('$GET(DGFILE))
QUIT "0^Invalid parameter"
+2 NEW DGDERR
+3 DO UPDATE^DIE("","DGFDA","","DGDERR")
+4 IF $DATA(DGDERR)
QUIT -1
+5 QUIT +$GET(DGFDA)
+6 ;
PSTHALT(MSG) ; display error message
+1 SET HDIMSG(1)=""
+2 SET HDIMSG(2)=MSG
+3 SET HDIMSG(3)="***** Post-installation of Patch DG*5.3*933 HDIS 'seeding' has been halted."
+4 SET HDIMSG(4)="***** Please contact Enterprise VistA Support."
+5 SET HDIMSG(5)=""
+6 DO MES^XPDUTL(.HDIMSG)
+7 QUIT
+8 ;
SEEDGRAM ; Data to populate the RACE MASTER (#10.99) file.
+1 ;;1;American Indian or Alaska Native;1002-5
+2 ;;2;Asian;2028-9
+3 ;;3;Black or African American;2054-5
+4 ;;4;Native Hawaiian or Other Pacific Islander;2076-8
+5 ;;5;White;2106-3
+6 QUIT
+7 ;
SEEDGMMS ; Data to populate the MASTER MARITAL STATUS (#11.99) file.
+1 ;;1;Annulled;A
+2 ;;2;Divorced;D
+3 ;;3;Interlocutory;I
+4 ;;4;Legally Separated;L
+5 ;;5;Married;M
+6 QUIT
+7 ;
SEEDGMR ; Data to populated the MASTER RELIGION (#13.99) file.
+1 ;;1;Adventist;1001
+2 ;;2;African Religions;1002
+3 ;;3;Afro-Caribbean Religions;1003
+4 ;;4;Agnosticism;1004
+5 ;;5;Anglican;1005
+6 QUIT
