Routine: VDI1P1

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

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

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

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."

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

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)

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)

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)

VDI1P1.m