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

VDI1P1.m

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