VDI1P1 ;BP/CMF/GJW - Patch 1 Post-Init ; 3/23/2023
;;1.0;VETERANS DATA INTEGRATION AND FEDERATION;**1**;Dec 30, 1994;Build 19
;
; External Reference DBIA#
; ------------------ -----
; ^VA(200 10060
; XPDUTL 10141
; UPDATE^DIE 2053
; $$SHAHASH^XUSHSH() 6189
; Add new NPE user 7423
;
ENV ;do environment check
S XPDABORT=""
D PROGCHK(.XPDABORT) I XPDABORT=2 Q
D RQIDCHK(.XPDABORT) I XPDABORT=2 Q
I XPDABORT="" K XPDABORT
Q
;
PROGCHK(XPDABORT) ; checks for necessary programmer variables
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.S XPDABORT=2
Q
;
RQIDCHK(XPDABORT) ; checks for additional required identifiers beyond .01 field
; loop through required identifier fields, if a field outside of our filing list, abort, alert user with message
Q:+$G(XPDENV)=0 ; do not execute if run by load a distribution.
N RQIDOUT,RQIDMSG,RQIDENT,RQIDNUM,RQIDNAM,RQIDABRT,RQIDVAL
;S XPDGREF="^XTMP(""VDI1P1"")"
D FILE^DID(200,,"REQUIRED IDENTIFIERS","RQIDOUT","RQIDMSG")
S RQIDENT=0,RQIDABRT=0,XPDABORT=""
F S RQIDENT=$O(RQIDOUT("REQUIRED IDENTIFIERS",RQIDENT)) Q:+RQIDENT=0 D
.S RQIDNUM=$G(RQIDOUT("REQUIRED IDENTIFIERS",RQIDENT,"FIELD"))
.Q:RQIDNUM=""
.Q:"^.01^2^11^7.2^205.1^205.2^205.3^205.4^205.5^"[(U_RQIDNUM_U)
.S RQIDABRT=1
.S RQIDABRT(RQIDNUM)=""
.Q
Q:RQIDABRT=0
D BMES^XPDUTL("This site has required identifier fields for New Person file entries")
D MES^XPDUTL("which are not contained in the new entries being made for this patch.")
D MES^XPDUTL("Please supply the values for these fields at your facility.")
D BMES^XPDUTL("The fields are:")
S RQIDNUM=0
F S RQIDNUM=$O(RQIDABRT(RQIDNUM)) Q:+RQIDNUM=0!(XPDABORT=2) D
.N DIR,X,Y
.S DIR(0)="200,"_RQIDNUM
.D ^DIR
.I $D(DIRUT) S XPDABORT=2 Q
.S RQIDNAM=$$GET1^DID(200,RQIDNUM,"","LABEL","","RQIDMSG")
.S RQIDVAL=$P(Y,U,2)
.I RQIDVAL="" S XPDABORT=2 Q
.M @XPDGREF@("VDI1P1",RQIDNUM)=RQIDVAL
.D MES^XPDUTL(" "_RQIDNUM_" "_RQIDNAM_" "_RQIDVAL_" added to filer array")
.Q
S:XPDABORT'="" XPDABORT=2
Q
;
HELP ; Help for ?? on Installation Question POS1 (use direct writes in env check routine)
W !,"Enter 1 if patch is being installed in a Pre-Production system."
W !,"Enter 2 if patch is being installed in a Software Quality Assurance system."
W !,"Enter 3 if patch is being installed in a Test system."
W !,"Enter 4 if patch is being installed in a Development system."
Q
;
POST ; Post-init for VDI*1*1
N VDIENV,VDITYPE
S VDITYPE=$G(XPDQUES("POS1"))
;VDITYPE will be a value of 1-4 (pre-prod, sqa, test, development) if no value, this is a production system
I 'VDITYPE S VDITYPE=5
S VDIENV=$S(VDITYPE=1:"PPD",VDITYPE=2:"SQA",VDITYPE=3:"TST",VDITYPE=4:"DEV",1:"PRD")
D IZG(VDIENV) ; for IZG
D MHV(VDIENV) ; for MHV
Q
;
IZG(VDIENV) ; Create Non Person Entity (NPE) user
; look for type of VistA instance
; create NPE for type of instance
N VDINPE,VDISECID,VDIUPN,VDIRSLT,VDIRSLT2,VDIERR,VDIERTXT
S VDINPE="OITAUSIZG"_VDIENV
; need SecID for dev
S VDISECID=$S(VDIENV="PRD":1076035779,VDIENV="PPD":1017862488,VDIENV="SQA":1013776211,VDIENV="TST":1013776210,1:"")
S VDIUPN="OITAUSIZG"_VDIENV_"@AAC.DVA.DOMAIN.EXT" ;
S VDIRSLT=$$ADD(VDINPE,VDINPE,VDISECID,VDIUPN,"VDIERR")
I +VDIRSLT>0 D QUIT
. D BMES^XPDUTL(VDINPE_" NPE User created or updated")
. Q
D BMES^XPDUTL(VDINPE_" NPE User not created or updated")
S VDIRSLT2=$P(VDIRSLT,U,2)
D:VDIRSLT2'="" MES^XPDUTL(VDIRSLT2)
S VDIERTXT=$G(VDIERR("DIERR",1,"TEXT",1))
D:VDIERTXT'="" MES^XPDUTL(VDIERTXT)
Q
;
MHV(VDIENV) ; Create NPE user
; create NPE for type of instance
N VDINPE,VDISECID,VDIUPN,VDIRSLT,VDIRSLT2,VDIERR,VDIERTXT
I VDIENV="PRD"!(VDIENV="PPD") D
. S VDINPE="OITSVCMHV"_VDIENV
. S VDIUPN=VDINPE_"@DOMAIN.EXT"
. Q
E D
. S VDINPE="OITAUSMHV"_VDIENV
. S VDIUPN=VDINPE_"@AAC.DVA.DOMAIN.EXT"
. Q
; no names/secids for tst & dev defined
S VDISECID=$S(VDIENV="PRD":1076218582,VDIENV="PPD":1017863107,VDIENV="SQA":1013775925,1:"")
S VDIRSLT=$$ADD(VDINPE,VDINPE,VDISECID,VDIUPN,"VDIERR")
I +VDIRSLT>0 D QUIT
. D BMES^XPDUTL(VDINPE_" NPE User created or updated")
. Q
D BMES^XPDUTL(VDINPE_" NPE User not created")
S VDIRSLT2=$P(VDIRSLT,U,2)
D:VDIRSLT2'="" MES^XPDUTL(VDIRSLT2)
S VDIERTXT=$G(VDIERR("DIERR",1,"TEXT",1))
D:VDIERTXT'="" MES^XPDUTL(VDIERTXT)
Q
;
;
ADD(VDIFIRST,VDILAST,VDISECID,VDIEMAIL,VDIMSG) ;create new non-person user
;
;VDIFIRST - first name
;VDILAST - last name
;VDISECID (optional) - SECID
;VDIEMAIL (optional) - VA email address (UPN)
;VDIMSG (optional) - error message array from UPDATE^DIE
;
;return value: DUZ of user or a value < 0 on error:
;
; -1 - could not obtain lock
; -2 - FileMan signaled an error (see VDIMSG)
; -3 - User does not have DUZ(0)="@"
;
N MYFDA,IROOT,MROOT,DIC,VDINAME,AC,VC,RQIDNUM,RQIDVAL
Q:DUZ(0)'="@" "-3^User must have DUZ(0)=""@"""
H 1 ;ensure that succeive calls do not occur with the same value of $H.
S VDINAME=VDILAST_","_$G(VDIFIRST)
S AC=$$SHAHASH^XUSHSH(256,$J_$H,"B")
S VC=$$SHAHASH^XUSHSH(256,$J_$H_1,"B")
L +^VA(200,0):5 I '$T Q "-1^Could not obtain lock on NEW PERSON file"
S DIC(0)="" ;required to avoid hard error in FileMan
S MYFDA(200,"?+1,",.01)=VDINAME
S MYFDA(200,"?+1,",2)=AC ;ACCESS CODE
S MYFDA(200,"?+1,",11)=VC ;VERIFY CODE
S MYFDA(200,"?+1,",7.2)="Yes" ;VERIFY CODE never expires
S MYFDA(200.07,"?+2,?+1,",.01)="NON-PERSON" ;USER CLASS
S MYFDA(200,"?+1,",205.1)=$G(VDISECID) ;SECID
S MYFDA(200,"?+1,",205.2)="Department of Veterans Affairs" ;SUBJECT ORGANIZATION
S MYFDA(200,"?+1,",205.3)="urn:oid:2.16.840.1.113883.4.349" ;SUBJECT ORGANIZATION ID
S MYFDA(200,"?+1,",205.4)=$G(VDISECID) ;UNIQUE USER ID
S MYFDA(200,"?+1,",205.5)=$G(VDIEMAIL) ;ADUPN
I $G(XPDGREF)'="" D:$D(@XPDGREF)
.S RQIDNUM=0
.F S RQIDNUM=$O(@XPDGREF@("VDI1P1",RQIDNUM)) Q:+RQIDNUM=0 D
..S RQIDVAL=$G(@XPDGREF@("VDI1P1",RQIDNUM))
..Q:RQIDVAL=""
..S MYFDA(200,"?+1,",RQIDNUM)=RQIDVAL
..Q
.Q
D UPDATE^DIE("E","MYFDA","IROOT","MROOT")
L -^VA(200,0)
S VDIIEN=$G(IROOT(1))
M:$D(VDIMSG) @VDIMSG=MROOT
Q $S(VDIIEN="":"-2^FileMan signaled an error",1:VDIIEN)
;
