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

BMXRPC3.m

Go to the documentation of this file. 
  1. BMXRPC3 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ; 23 Jul 2009  3:03 PM
  1.  ;;4.0;BMX;;JUN 28, 2010
  1.  ;
  1.  ;
  1. VARVAL(RESULT,VARIABLE) ;returns value of passed in variable
  1.  S VARIABLE=$TR(VARIABLE,"~","^")
  1.  S RESULT=VARIABLE ;can do this with the REFERENCE type parameter
  1.  Q
  1.  ;See GETV^XWBBRK for how we get the REFERENCE type parameter
  1.  ;
  1. USER(RESULT,D) ;
  1.  ;
  1.  I '+D S RESULT="" Q
  1.  S RESULT=$P($G(^VA(200,D,0)),"^")
  1.  Q
  1.  ;
  1. NTUSER(BMXY,BMXNTUSE)   ;EP
  1.  ;Old code.  Retain for reference
  1.  ;Returns NTDomain^NTUserName^RPMSName for user having DUZ=D
  1.  ;TODO:  Move ANMC NT USERS file
  1.  ;from AZZWNT to BMX namespace and numberspace
  1.  ;
  1.  ;N BMX,BMXNOD,BMXDOM,BMXNAM,BMXCOL,BMXRNAM
  1.  ;S (BMXDOM,BMXNAM,BMXRNAM)=""
  1.  ;S U="^"
  1.  ;I '+D S RESULT="" Q
  1.  ;S BMXRNAM=$G(^VA(200,D,0)),BMXRNAM=$P(BMXRNAM,U)
  1.  ;I '$D(^AZZWNT("DUZ",D)) D NTU1 Q
  1.  ;S BMX=$O(^AZZWNT("DUZ",D,0))
  1.  ;I '+BMX D NTU1 Q
  1.  ;I '$D(^AZZWNT(BMX,0)) D NTU1 Q
  1.  ;S BMXNOD=^AZZWNT(BMX,0)
  1.  ;S BMXDOM=$P(BMXNOD,U,2)
  1.  ;S BMXNAM=$P(BMXNOD,U) ;,4)
  1.  ;D NTU1
  1.  Q
  1.  ;
  1.  ;
  1. NTUGETD(BMXY,BMXNTNAM) ;EP
  1.  ;Entry point for debugging
  1.  ;
  1.  ;D DEBUG^%Serenji("NTUGETD^BMXRPC3(.BMXY,BMXNTNAM)")
  1.  Q
  1.  ;
  1. NTUGET(BMXY,BMXNTNAM) ;EP
  1.  ;
  1.  ;Returns A ENCRYPTED and V ENCRYPTED for NT User BMXNTNM
  1.  ;Called by RPC BMXNetGetCodes
  1.  N BMXI,BMXNTID,BMXNTID,BMXNOD,BMXA,BMXV
  1.  S BMXI=0
  1.  S BMXY="^BMXTMP("_$J_")"
  1.  S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
  1.  S BMXI=BMXI+1
  1.  I BMXNTNM="" S ^BMXTMP($J,BMXI)="^" Q
  1.  S BMXNTID=$O(^BMXUSER("B",BMXNTNAM,0))
  1.  I '+BMXNTID S ^BMXTMP($J,BMXI)="^" Q
  1.  S BMXNOD=$G(^BMXUSER(BMXNTID,0))
  1.  S BMXA=$P(BMXNOD,U,2)
  1.  S BMXV=$P(BMXNOD,U,3)
  1.  S ^BMXTMP($J,BMXI)=BMXA_"^"_BMXV_"^"
  1.  Q
  1.  ;
  1. WINUGET(BMXWINID) ;EP
  1.  ;Returns DUZ for user having Windows Identity BMXWINID
  1.  ;Returns 0 if no Windows user found
  1.  ;
  1.  N BMXIEN,BMXNOD,BMXDUZ
  1.  I BMXWINID="" Q 0
  1.  S BMXIEN=$O(^BMXUSER("B",BMXWINID,0))
  1.  I '+BMXIEN Q 0
  1.  S BMXNOD=$G(^BMXUSER(BMXIEN,0))
  1.  S BMXDUZ=$P(BMXNOD,U,2)
  1.  Q BMXDUZ
  1.  ;
  1. NTUSET(BMXY,BMXNTNAM) ;EP
  1.  ;Sets NEW PERSON map entry for Windows Identity BMXNTNM
  1.  ;Returns ERRORID 0 if all ok
  1.  ;Called by RPC BMXNetSetUser
  1.  ;
  1.  ;
  1.  N BMXI,BMXNTID,BMXFDA,BMXF,BMXIEN,BMXMSG,BMXAPPTD
  1.  S BMXI=0
  1.  S BMXY="^BMXTMP("_$J_")"
  1.  S X="NTUET^BMXRPC3",@^%ZOSF("TRAP")
  1.  S BMXI=BMXI+1
  1.  ; Quit with error if no DUZ exists
  1.  I '+$G(DUZ) D NTUERR(BMXI,500) Q
  1.  ; Create entry or file in existing entry in BMX USER
  1.  I $D(^BMXUSER("B",BMXNTNAM)) S BMXF="?1,"
  1.  E  S BMXF="+1,"
  1.  S BMXFDA(90093.1,BMXF,.01)=BMXNTNAM
  1.  S BMXFDA(90093.1,BMXF,.02)=$G(DUZ)
  1.  K BMXIEN,BMXMSG
  1.  D UPDATE^DIE("","BMXFDA","BMXIEN","BMXMSG")
  1.  S BMXAPPTD=+$G(BMXIEN(1))
  1.  S BMXI=BMXI+1
  1.  S ^BMXTMP($J,BMXI)=BMXAPPTD_"^0"
  1.  Q
  1.  ;
  1. NTUET ;EP
  1.  ;Error trap from REGEVNT
  1.  ;
  1.  I '$D(BMXI) N BMXI S BMXI=999
  1.  S BMXI=BMXI+1
  1.  D NTUERR(BMXI,99)
  1.  Q
  1.  ;
  1. NTUERR(BMXI,BMXERID) ;Error processing
  1.  S BMXI=BMXI+1
  1.  S ^BMXTMP($J,BMXI)="^"_BMXERID
  1.  Q
  1.  ;
  1.  ;
  1. NTU1 ;S BMXCOL="T00030NT_DOMAIN^T00030NT_USERNAME^T00030RPMS_USERNAME"_$C(30)
  1.  ;S RESULT=BMXCOL_BMXDOM_U_BMXNAM_U_BMXRNAM_$C(30)_$C(31)
  1.  Q
  1.  ;
  1. GETFC(BMXFACS,DUZ) ;Gets all facilities for a user
  1.  ; Input DUZ - user IEN from the NEW PERSON FILE
  1.  ; Output - Number of facilities;facility1 name&facility1 IEN;...facilityN&facilityN IEN
  1.  N BMXFN,BMXN
  1.  S BMXFN=0,BMXFACS=""
  1.  F BMXN=1:1 S BMXFN=$O(^VA(200,DUZ,2,BMXFN)) Q:BMXFN=""  D
  1.  . S:BMXN>1 BMXFACS=BMXFACS_";" S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
  1.  I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
  1.  . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"&"_BMXFN
  1.  S BMXFACS=BMXN-(BMXN>1)_";"_BMXFACS
  1.  Q
  1.  ;
  1. GETFCRS(BMXFACS,BMXDUZ) ;Gets all facilities for a user - returns RECORDSET
  1.  ;
  1.  ;TODO: return as global array, add error checking
  1.  N BMXFN,BMXN,BMXSUB,BMXRCNT
  1.  S BMXDUZ=$TR(BMXDUZ,$C(13),"")
  1.  S BMXDUZ=$TR(BMXDUZ,$C(10),"")
  1.  S BMXDUZ=$TR(BMXDUZ,$C(9),"")
  1.  S BMXFN=0
  1.  S BMXSUB="^VA(200,"_BMXDUZ_",2,"
  1.  S BMXFACS="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
  1.  ;F BMXN=1:1 S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:BMXFN=""  D
  1.  S BMXRCNT=0  ;cmi/maw mod 10/17/2006
  1.  F BMXN=1:1 S BMXFN=$O(^VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN  D  ;IHS/ANMC/LJF 8/9/01
  1.  . ;S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN_$C(30)
  1.  . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN
  1.  . ;S BMXRCNT=0  ;cmi/maw orig
  1.  . ;I $D(^DISV(BMXDUZ,BMXSUB)),^DISV(BMXDUZ,BMXSUB)=BMXFN S BMXRCNT=1
  1.  . ;I $G(DUZ(2))=BMXFN S BMXRCNT=1  ;cmi/maw orig
  1.  . S BMXRCNT=BMXRCNT+1  ;cmi/maw mod
  1.  . S BMXFACS=BMXFACS_"^"_BMXRCNT_$C(30)
  1.  I BMXN=1 S BMXFN=$P(^AUTTSITE(1,0),U,1) D
  1.  . S BMXFACS=BMXFACS_$P(^DIC(4,BMXFN,0),U,1)_"^"_BMXFN_"^"_1_$C(30)
  1.  S BMXFACS=BMXFACS_$C(31)
  1.  Q
  1.  ;
  1. SETFCRS(BMXY,BMXFAC)      ;
  1.  ;
  1.  ;Sets DUZ(2) to value in BMXFAC
  1.  ;Fails if BMXFAC is not one of the current user's divisions
  1.  ;Returns Recordset
  1.  ; 
  1.  S X="ERFC^BMXRPC3",@^%ZOSF("TRAP")
  1.  S BMXY="T00030DUZ^T00030FACILITY_IEN^T00030FACILITY_NAME"_$C(30)
  1.  N BMXSUB,BMXFACN
  1.  I '+DUZ S BMXY=BMXY_0_"^"_0_"^"_0_$C(30)_$C(31) Q
  1.  I '+BMXFAC S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q
  1.  ;I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=BMXY_DUZ_"^"_0_"^"_0_$C(30)_$C(31) Q ; GIS/OIT Feb 9, 2010
  1.  S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
  1.  S BMXFACN=$G(^DIC(4,+DUZ(2),0))
  1.  S BMXFACN=$P(BMXFACN,"^")
  1.  S BMXSUB="^VA(200,"_DUZ_",2,"
  1.  S ^DISV(DUZ,BMXSUB)=BMXFAC
  1.  S BMXY=BMXY_DUZ_"^"_BMXFAC_"^"_BMXFACN_$C(30)_$C(31)
  1.  Q
  1.  ;
  1. ERFC ;
  1.  D ^%ZTER
  1.  S BMXY=$G(BMXY)_0_"^"_0_$C(30)_$C(31) Q
  1.  Q
  1.  ;
  1. SETFC(BMXY,BMXFAC) ;
  1.  ;Sets DUZ(2) to value in BMXFAC
  1.  ;Fails if BMXFAC is not one of the current user's divisions
  1.  ;Returns 1 if successful, 0 if failed
  1.  ;
  1.  S BMXY=0
  1.  N BMXSUB
  1.  I '+DUZ S BMXY=0 Q
  1.  I '+BMXFAC S BMXY=0 Q
  1.  I '$D(^VA(200,DUZ,2,+BMXFAC,0)) S BMXY=0 Q
  1.  S DUZ(2)=BMXFAC ;IHS/OIT/HMW SAC Exemption Applied For
  1.  S BMXSUB="^VA(200,"_DUZ_",2,"
  1.  S ^DISV(DUZ,BMXSUB)=BMXFAC
  1.  S BMXY=1
  1.  Q
  1.  ;
  1. APSEC(BMXY,BMXKEY)       ;EP
  1.  ;Return IHSCD_SUCCEEDED (-1) if user has key BMXKEY
  1.  ;OR if user has key XUPROGMODE
  1.  ;Otherwise, returns IHSCD_FAILED (0)
  1.  N BMXIEN,BMXPROG,BMXPKEY
  1.  I '$G(DUZ) S BMXY=0 Q
  1.  I BMXKEY="" S BMXY=0 Q
  1.  ;
  1.  ;Test for programmer mode key
  1.  S BMXPROG=0
  1.  I $D(^DIC(19.1,"B","XUPROGMODE")) D
  1.  . S BMXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
  1.  . I '+BMXPKEY Q
  1.  . I '$D(^VA(200,DUZ,51,BMXPKEY,0)) Q
  1.  . S BMXPROG=1
  1.  I BMXPROG S BMXY=-1 Q
  1.  ;
  1.  I '$D(^DIC(19.1,"B",BMXKEY)) S BMXY=0 Q
  1.  S BMXIEN=$O(^DIC(19.1,"B",BMXKEY,0))
  1.  I '+BMXIEN S BMXY=0 Q
  1.  I '$D(^VA(200,DUZ,51,BMXIEN,0)) S BMXY=0 Q
  1.  S BMXY=-1
  1.  Q
  1.  ;
  1. SIGCHK(BMXY,BMXSIG)         ;EP
  1.  ;Checks BMXSIG against hashed value in NEW PERSON
  1.  ;Return IHSCD_SUCCEEDED (-1) if BMXSIG matches
  1.  ;Otherwise, returns IHSCD_FAILED (0)
  1.  N X
  1.  S BMXY=0
  1.  I '$G(DUZ) Q
  1.  I '$D(^VA(200,DUZ,20)) Q  ;TODO What if no signature?
  1.  S BMXHSH=$P(^VA(200,DUZ,20),U,4)
  1.  S X=$G(BMXSIG)
  1.  D HASH^XUSHSHP
  1.  I X=BMXHSH S BMXY=-1
  1.  Q