BUSARPC ;GDIT/HS/BEE-IHS USER SECURITY AUDIT Utility Program ; 31 Jan 2013 9:53 AM
;;1.0;IHS USER SECURITY AUDIT;;Nov 05, 2013;Build 65
;
Q
;
BMX(BUSAP) ;PEP - Log audit entry from BMXNet
;
NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
;
S SKIP=""
;
;Make sure logging switch is on
I '+$$STATUS^BUSAOPT("B") S STS="0^BMX audit logging switch is off" G XBMX
;
;Define Application Variables
S BUSABKR="B" ;Set Broker to BMX
S BUSARPC=$G(BUSAP(2,"CAPI")) ;Get the RPC
I BUSARPC="" S STS="0^Missing RPC" G XBMX
;
;Find RPC IEN and skip if not defined
S RPCIEN=$O(^XWB(8994,"B",BUSARPC,0)) I RPCIEN="" S STS="0^Invalid RPC" G XBMX
;
;See if RPC is set up to be audited
S BUSAIEN=$O(^BUSA(9002319.03,"B",BUSARPC,"")) I BUSAIEN="" S STS="0^RPC not set to be tracked" G XBMX
;
;Check for inactive
I $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I") S STS="0^RPC call is inactive" G XBMX
;
;Pull definition
S STS=$$DEF(BUSAIEN,.BUSAD) I 'STS G XBMX
;
;Assemble Summary Information
;
;Define Type as RPC
S TYPE="R"
;
;Pull the CATEGORY
S CAT=$G(BUSAD(.02)) I CAT="" S STS="0^Invalid definition category" G XBMX
;
;Pull the ACTION
S ACT=$G(BUSAD(.03))
;
;Determine the Entry Description
S X="",XDESC=$G(BUSAD(.06)) X:XDESC]"" XDESC
S DESC=$G(X)
;
;Assemble Detail Information
;
;Retrieve DFN definition
S DFNLOC=$G(BUSAD(1.01))
S DFNEXE=$G(BUSAD(1.02))
;
;Retrieve VIEN definition
S VSTLOC=$G(BUSAD(2.01))
S VSTEXE=$G(BUSAD(2.02))
;
;Retrieve Multiple input info
S MINP=0
S MINPL=$G(BUSAD(2.03))
S MINPD=$G(BUSAD(2.04))
I MINPL]"",MINPD]"" S MINP=1
;
;Look for multiple results
S MULT=0 I $P(DFNLOC,"^")="R"!($P(VSTLOC,"^")="R") S MULT=1
I MINP,MULT S STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results" G XBMX
;
;Stuff the DFN
I $P(DFNLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(DFNLOC,U),$P(DFNLOC,U,2),"B",BUSARPC,.DVAL) I 'STS G XBMX
I MINP=1,MINPL="D" D MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL) ;Multiple Input DFNs
I MINP=0 D BFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP) ;Single DFN or Result DFNs
;
;Stuff the VIEN (and possibly the DFN)
I $P(VSTLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(VSTLOC,U),$P(VSTLOC,U,2),"B",BUSARPC,.VVAL) I 'STS G XBMX
I MINP=1,MINPL="V" D MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL) ;Multiple Input VIENs
I MINP=0 D BFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP) ;Single VIEN or Result VIENs
;
;Stuff the detail description
S DETEXE=$G(BUSAD(3))
I DETEXE]"" D BFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
;
;Stuff the new value
S NEWEXE=$G(BUSAD(4))
I NEWEXE]"" D BFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
;
;Stuff the original value
S ORGEXE=$G(BUSAD(5))
I ORGEXE]"" D BFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
;
;Advance definition executable
S ADVEXE=$G(BUSAD(6))
I ADVEXE]"" X ADVEXE
;
;Look for SKIP
I +$G(SKIP) S STS="0^Skipped log entry" G XBMX
;
;Make API call
S STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
;
XBMX Q STS
;
CIA(XWBPTYPE,RTN,BUSAARY) ;PEP - Log audit entry from CIA Broker
;
;Make sure logging switch is on
I '+$$STATUS^BUSAOPT("C") S STS="0^CIA Broker audit logging switch is off" G XCIA
;
NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
;
;Define Application Variables
S BUSABKR="C" ;Set Broker to CIA
S BUSARPC=$G(BUSAARY) ;Get the RPC
I BUSARPC="" S STS="0^Missing RPC" G XCIA
S SKIP=""
;
;Find RPC IEN and skip if not defined
S RPCIEN=$O(^XWB(8994,"B",BUSARPC,0)) I RPCIEN="" S STS="0^Invalid RPC" G XCIA
;
;See if RPC is set up to be audited
S BUSAIEN=$O(^BUSA(9002319.03,"B",BUSARPC,"")) I BUSAIEN="" S STS="0^RPC not set to be tracked" G XCIA
;
;Check for inactive
I $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I") S STS="0^RPC call is inactive" G XCIA
;
;Pull definition
S STS=$$DEF(BUSAIEN,.BUSAD) I 'STS G XCIA
;
;Assemble Summary Information
;
;Define Type as RPC
S TYPE="R"
;
;Pull the CATEGORY
S CAT=$G(BUSAD(.02)) I CAT="" S STS="0^Invalid definition category" G XCIA
;
;Pull the ACTION
S ACT=$G(BUSAD(.03))
;
;Determine the Entry Description
S X="",XDESC=$G(BUSAD(.06)),XDESC=$TR(XDESC,"~","^") X:XDESC]"" XDESC
S DESC=$G(X)
;
;Assemble Detail Information
;
;Retrieve DFN definition
S DFNLOC=$G(BUSAD(1.01))
S DFNEXE=$G(BUSAD(1.02))
;
;Retrieve VIEN definition
S VSTLOC=$G(BUSAD(2.01))
S VSTEXE=$G(BUSAD(2.02))
;
;Retrieve Multiple input info
S MINP=0
S MINPL=$G(BUSAD(2.03))
S MINPD=$G(BUSAD(2.04))
I MINPL]"",MINPD]"" S MINP=1
;
;Look for multiple results
S MULT=0 I $P(DFNLOC,"^")="R"!($P(VSTLOC,"^")="R") S MULT=1
I MINP,MULT S STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results" G XCIA
;
;Stuff the DFN
I $P(DFNLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(DFNLOC,U),$P(DFNLOC,U,2),"C",BUSARPC,.DVAL) I 'STS G XCIA
I MINP=1,MINPL="D" D MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL) ;Multiple Input DFNs
I MINP=0 D CFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP) ;Single DFN or Result DFNs
;
;Stuff the VIEN
I $P(VSTLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(VSTLOC,U),$P(VSTLOC,U,2),"C",BUSARPC,.VVAL) I 'STS G XCIA
I MINP=1,MINPL="V" D MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL) ;Multiple Input VIENs
I MINP=0 D CFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP) ;Single VIEN or Result VIENs
;
;Stuff the detail description
S DETEXE=$G(BUSAD(3))
I DETEXE]"" D CFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
;
;Stuff the new value
S NEWEXE=$G(BUSAD(4))
I NEWEXE]"" D CFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
;
;Stuff the original value
S ORGEXE=$G(BUSAD(5))
I ORGEXE]"" D CFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
;
;Advance definition executable
S ADVEXE=$G(BUSAD(6))
I ADVEXE]"" X ADVEXE
;
;Look for SKIP
I +$G(SKIP) S STS="0^Skipped log entry" G XCIA
;
;Create the log entry
S STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
;
XCIA Q STS
;
XWB(BUSAP) ;PEP - Log audit entry from XWB Broker
;
NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
;
S SKIP=""
;
;Make sure logging switch is on
I '+$$STATUS^BUSAOPT("B") S STS="0^BMX audit logging switch is off" G XXWB
;
;Define Application Variables
S BUSABKR="W" ;Set Broker to XWB Broker
;
;Get the RPC
S BUSARPC=$G(BUSAP(2,"RPC")) S:BUSARPC="" BUSARPC=$G(BUSAP(2,"CAPI"))
I BUSARPC="" S STS="0^Missing RPC" G XXWB
;
;Find RPC IEN and skip if not defined
S RPCIEN=$O(^XWB(8994,"B",BUSARPC,0)) I RPCIEN="" S STS="0^Invalid RPC" G XXWB
;
;See if RPC is set up to be audited
S BUSAIEN=$O(^BUSA(9002319.03,"B",BUSARPC,"")) I BUSAIEN="" S STS="0^RPC not set to be tracked" G XXWB
;
;Check for inactive
I $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I") S STS="0^RPC call is inactive" G XXWB
;
;Pull definition
S STS=$$DEF(BUSAIEN,.BUSAD) I 'STS G XXWB
;
;Assemble Summary Information
;
;Define Type as RPC
S TYPE="R"
;
;Pull the CATEGORY
S CAT=$G(BUSAD(.02)) I CAT="" S STS="0^Invalid definition category" G XXWB
;
;Pull the ACTION
S ACT=$G(BUSAD(.03))
;
;Determine the Entry Description
S X="",XDESC=$G(BUSAD(.06)) X:XDESC]"" XDESC
S DESC=$G(X)
;
;Assemble Detail Information
;
;Retrieve DFN definition
S DFNLOC=$G(BUSAD(1.01))
S DFNEXE=$G(BUSAD(1.02))
;
;Retrieve VIEN definition
S VSTLOC=$G(BUSAD(2.01))
S VSTEXE=$G(BUSAD(2.02))
;
;Retrieve Multiple input info
S MINP=0
S MINPL=$G(BUSAD(2.03))
S MINPD=$G(BUSAD(2.04))
I MINPL]"",MINPD]"" S MINP=1
;
;Look for multiple results
S MULT=0 I $P(DFNLOC,"^")="R"!($P(VSTLOC,"^")="R") S MULT=1
I MINP,MULT S STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results" G XXWB
;
;Stuff the DFN
I $P(DFNLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(DFNLOC,U),$P(DFNLOC,U,2),"W",BUSARPC,.DVAL) I 'STS G XXWB
I MINP=1,MINPL="D" D MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL) ;Multiple Input DFNs
I MINP=0 D WFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP) ;Single DFN or Result DFNs
;
;Stuff the VIEN (and possibly the DFN)
I $P(VSTLOC,U,2)]"" S STS=$$VAL^BUSAUTIL($P(VSTLOC,U),$P(VSTLOC,U,2),"W",BUSARPC,.VVAL) I 'STS G XXWB
I MINP=1,MINPL="V" D MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL) ;Multiple Input VIENs
I MINP=0 D WFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP) ;Single VIEN or Result VIENs
;
;Stuff the detail description
S DETEXE=$G(BUSAD(3))
I DETEXE]"" D WFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
;
;Stuff the new value
S NEWEXE=$G(BUSAD(4))
I NEWEXE]"" D WFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
;
;Stuff the original value
S ORGEXE=$G(BUSAD(5))
I ORGEXE]"" D WFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
;
;Advance definition executable
S ADVEXE=$G(BUSAD(6))
I ADVEXE]"" X ADVEXE
;
;Look for SKIP
I +$G(SKIP) S STS="0^Skipped log entry" G XXWB
;
;Make API call
S STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
;
XXWB Q STS
;
DEF(BUSAIEN,BUSAD) ;EP - Set up entry definition array
;
NEW FLD
F FLD=".01",".02",".03",".06",1.01,1.02,2.01,2.02,2.03,2.04,3,4,5,6 S BUSAD(FLD)=$TR($$GET1^DIQ(9002319.03,BUSAIEN_",",FLD,"I"),"~","^")
Q $S($D(BUSAD)>1:1,1:"0^Invalid Definition")
;
RPC(DATA,INPUT) ;EP - BUSA LOG SECURITY AUDIT ENTRY
;
; Required variable:
; DUZ - Pointer to NEW PERSON (#200) file
;
;Input Parameters:
;
; INPUT
;
; Piece ("|" delimiter)
;
; 1 - CAT (Required) - The category of the event to log (S:System Event;
; P:Patient Related;D:Definition Change;O:Other Event)
; 2 - ACTION (Required for CAT="P") - The action for the event to log
; (A:Additions;D:Deletions;Q:Queries;P:Print;
; E:Changes;C:Copy)
; 3 - CALL - (Required) - Free text entry describing the call which
; originated the audit event (Maximum length
; 200 characters)
; Examples could be an RPC value or calling
; routine
; 4 - DESC - (Required) - Free text entry describing the call action
; (Maximum length 250 characters)
; Examples could be 'Patient demographic update',
; 'Copied iCare panel to clipboard' or 'POV Entry'
; 5 - DETAIL (Required for CAT="P") - Delimited list of patient/visit records
; to log. Required for patient related events.
; Optional for other event types
;
; Format: DETAIL = DFN1_$C(29)_VIEN1_$C(29)_EVENT DESCRIPTION1_$C(29)_NEW VALUE1 ...
; ... _$C(29)_ORIGINAL VALUE1_$C(28)_DFN2_$C(29)_VIEN2_$C(29) ...
; ... _EVENT DESCRIPTION2_$C(29)_NEW VALUE2_$C(29)_ORIGINAL VALUE2 ...
; ... $C(28)_DFN3 ...
;
; Where:
; DFN# - (Optional for non-patient related calls) - Pointer to VA PATIENT file (#2)
; VIEN# - (Optional for non-visit related calls) - Pointer to VISIT file (#9000010)
; EVENT DESCRIPTION# -(Optional) - Additional detail to log for this entry
; NEW VALUE# - (Optional) - New value after call completion, if applicable
; ORIGINAL VALUE# - (Optional) - Original value prior to call execution, if applicable
;
NEW CAT,ACTION,CALL,DESC,DETAIL,DCNT,I,DET,BUSAII,UID,RES,ENTRY
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BUSARPC",UID))
K @DATA
;
S BUSAII=0
;
;Create header
S @DATA@(0)="I00001RESULT^T00250ERROR_MESSAGE"_$C(30)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BUSARPC D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Check for DUZ
I $G(DUZ)="" S RES="0^DUZ is not defined" G XBRPC
;
;Move input to local variables
S INPUT=$G(INPUT,"")
S CAT=$P(INPUT,"|")
S ACTION=$P(INPUT,"|",2)
S CALL=$P(INPUT,"|",3)
S DESC=$P(INPUT,"|",4)
S DETAIL=$P(INPUT,"|",5)
;
;Format DETAIL
S DCNT=0
F I=1:1:$L(DETAIL,$C(28)) S ENTRY=$P(DETAIL,$C(28),I) I $TR(ENTRY,$C(29))]"" D
. NEW DFN,VIEN,EDESC,NVAL,OVAL
. S DFN=$P(ENTRY,$C(29))
. S VIEN=$P(ENTRY,$C(29),2)
. S EDESC=$P(ENTRY,$C(29),3)
. S NVAL=$P(ENTRY,$C(29),4)
. S OVAL=$P(ENTRY,$C(29),5)
. S DCNT=DCNT+1
. S DET(DCNT)=DFN_U_VIEN_U_EDESC_U_NVAL_U_OVAL
;
;Perform the call
S RES=$$LOG^BUSAAPI("R",CAT,ACTION,CALL,DESC,"DET")
;
XBRPC S BUSAII=BUSAII+1,@DATA@(BUSAII)=RES_$C(30)
S BUSAII=BUSAII+1,@DATA@(BUSAII)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(BUSAII),$D(DATA) S BUSAII=BUSAII+1,@DATA@(BUSAII)=$C(31)
Q
BUSARPC ;GDIT/HS/BEE-IHS USER SECURITY AUDIT Utility Program ; 31 Jan 2013 9:53 AM
+1 ;;1.0;IHS USER SECURITY AUDIT;;Nov 05, 2013;Build 65
+2 ;
+3 QUIT
+4 ;
BMX(BUSAP) ;PEP - Log audit entry from BMXNet
+1 ;
+2 NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
+3 NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
+4 NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
+5 ;
+6 SET SKIP=""
+7 ;
+8 ;Make sure logging switch is on
+9 IF '+$$STATUS^BUSAOPT("B")
SET STS="0^BMX audit logging switch is off"
GOTO XBMX
+10 ;
+11 ;Define Application Variables
+12 ;Set Broker to BMX
SET BUSABKR="B"
+13 ;Get the RPC
SET BUSARPC=$GET(BUSAP(2,"CAPI"))
+14 IF BUSARPC=""
SET STS="0^Missing RPC"
GOTO XBMX
+15 ;
+16 ;Find RPC IEN and skip if not defined
+17 SET RPCIEN=$ORDER(^XWB(8994,"B",BUSARPC,0))
IF RPCIEN=""
SET STS="0^Invalid RPC"
GOTO XBMX
+18 ;
+19 ;See if RPC is set up to be audited
+20 SET BUSAIEN=$ORDER(^BUSA(9002319.03,"B",BUSARPC,""))
IF BUSAIEN=""
SET STS="0^RPC not set to be tracked"
GOTO XBMX
+21 ;
+22 ;Check for inactive
+23 IF $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I")
SET STS="0^RPC call is inactive"
GOTO XBMX
+24 ;
+25 ;Pull definition
+26 SET STS=$$DEF(BUSAIEN,.BUSAD)
IF 'STS
GOTO XBMX
+27 ;
+28 ;Assemble Summary Information
+29 ;
+30 ;Define Type as RPC
+31 SET TYPE="R"
+32 ;
+33 ;Pull the CATEGORY
+34 SET CAT=$GET(BUSAD(.02))
IF CAT=""
SET STS="0^Invalid definition category"
GOTO XBMX
+35 ;
+36 ;Pull the ACTION
+37 SET ACT=$GET(BUSAD(.03))
+38 ;
+39 ;Determine the Entry Description
+40 SET X=""
SET XDESC=$GET(BUSAD(.06))
IF XDESC]""
XECUTE XDESC
+41 SET DESC=$GET(X)
+42 ;
+43 ;Assemble Detail Information
+44 ;
+45 ;Retrieve DFN definition
+46 SET DFNLOC=$GET(BUSAD(1.01))
+47 SET DFNEXE=$GET(BUSAD(1.02))
+48 ;
+49 ;Retrieve VIEN definition
+50 SET VSTLOC=$GET(BUSAD(2.01))
+51 SET VSTEXE=$GET(BUSAD(2.02))
+52 ;
+53 ;Retrieve Multiple input info
+54 SET MINP=0
+55 SET MINPL=$GET(BUSAD(2.03))
+56 SET MINPD=$GET(BUSAD(2.04))
+57 IF MINPL]""
IF MINPD]""
SET MINP=1
+58 ;
+59 ;Look for multiple results
+60 SET MULT=0
IF $PIECE(DFNLOC,"^")="R"!($PIECE(VSTLOC,"^")="R")
SET MULT=1
+61 IF MINP
IF MULT
SET STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results"
GOTO XBMX
+62 ;
+63 ;Stuff the DFN
+64 IF $PIECE(DFNLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(DFNLOC,U),$PIECE(DFNLOC,U,2),"B",BUSARPC,.DVAL)
IF 'STS
GOTO XBMX
+65 ;Multiple Input DFNs
IF MINP=1
IF MINPL="D"
DO MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL)
+66 ;Single DFN or Result DFNs
IF MINP=0
DO BFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP)
+67 ;
+68 ;Stuff the VIEN (and possibly the DFN)
+69 IF $PIECE(VSTLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(VSTLOC,U),$PIECE(VSTLOC,U,2),"B",BUSARPC,.VVAL)
IF 'STS
GOTO XBMX
+70 ;Multiple Input VIENs
IF MINP=1
IF MINPL="V"
DO MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL)
+71 ;Single VIEN or Result VIENs
IF MINP=0
DO BFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP)
+72 ;
+73 ;Stuff the detail description
+74 SET DETEXE=$GET(BUSAD(3))
+75 IF DETEXE]""
DO BFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
+76 ;
+77 ;Stuff the new value
+78 SET NEWEXE=$GET(BUSAD(4))
+79 IF NEWEXE]""
DO BFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
+80 ;
+81 ;Stuff the original value
+82 SET ORGEXE=$GET(BUSAD(5))
+83 IF ORGEXE]""
DO BFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
+84 ;
+85 ;Advance definition executable
+86 SET ADVEXE=$GET(BUSAD(6))
+87 IF ADVEXE]""
XECUTE ADVEXE
+88 ;
+89 ;Look for SKIP
+90 IF +$GET(SKIP)
SET STS="0^Skipped log entry"
GOTO XBMX
+91 ;
+92 ;Make API call
+93 SET STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
+94 ;
XBMX QUIT STS
+1 ;
CIA(XWBPTYPE,RTN,BUSAARY) ;PEP - Log audit entry from CIA Broker
+1 ;
+2 ;Make sure logging switch is on
+3 IF '+$$STATUS^BUSAOPT("C")
SET STS="0^CIA Broker audit logging switch is off"
GOTO XCIA
+4 ;
+5 NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
+6 NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
+7 NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
+8 ;
+9 ;Define Application Variables
+10 ;Set Broker to CIA
SET BUSABKR="C"
+11 ;Get the RPC
SET BUSARPC=$GET(BUSAARY)
+12 IF BUSARPC=""
SET STS="0^Missing RPC"
GOTO XCIA
+13 SET SKIP=""
+14 ;
+15 ;Find RPC IEN and skip if not defined
+16 SET RPCIEN=$ORDER(^XWB(8994,"B",BUSARPC,0))
IF RPCIEN=""
SET STS="0^Invalid RPC"
GOTO XCIA
+17 ;
+18 ;See if RPC is set up to be audited
+19 SET BUSAIEN=$ORDER(^BUSA(9002319.03,"B",BUSARPC,""))
IF BUSAIEN=""
SET STS="0^RPC not set to be tracked"
GOTO XCIA
+20 ;
+21 ;Check for inactive
+22 IF $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I")
SET STS="0^RPC call is inactive"
GOTO XCIA
+23 ;
+24 ;Pull definition
+25 SET STS=$$DEF(BUSAIEN,.BUSAD)
IF 'STS
GOTO XCIA
+26 ;
+27 ;Assemble Summary Information
+28 ;
+29 ;Define Type as RPC
+30 SET TYPE="R"
+31 ;
+32 ;Pull the CATEGORY
+33 SET CAT=$GET(BUSAD(.02))
IF CAT=""
SET STS="0^Invalid definition category"
GOTO XCIA
+34 ;
+35 ;Pull the ACTION
+36 SET ACT=$GET(BUSAD(.03))
+37 ;
+38 ;Determine the Entry Description
+39 SET X=""
SET XDESC=$GET(BUSAD(.06))
SET XDESC=$TRANSLATE(XDESC,"~","^")
IF XDESC]""
XECUTE XDESC
+40 SET DESC=$GET(X)
+41 ;
+42 ;Assemble Detail Information
+43 ;
+44 ;Retrieve DFN definition
+45 SET DFNLOC=$GET(BUSAD(1.01))
+46 SET DFNEXE=$GET(BUSAD(1.02))
+47 ;
+48 ;Retrieve VIEN definition
+49 SET VSTLOC=$GET(BUSAD(2.01))
+50 SET VSTEXE=$GET(BUSAD(2.02))
+51 ;
+52 ;Retrieve Multiple input info
+53 SET MINP=0
+54 SET MINPL=$GET(BUSAD(2.03))
+55 SET MINPD=$GET(BUSAD(2.04))
+56 IF MINPL]""
IF MINPD]""
SET MINP=1
+57 ;
+58 ;Look for multiple results
+59 SET MULT=0
IF $PIECE(DFNLOC,"^")="R"!($PIECE(VSTLOC,"^")="R")
SET MULT=1
+60 IF MINP
IF MULT
SET STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results"
GOTO XCIA
+61 ;
+62 ;Stuff the DFN
+63 IF $PIECE(DFNLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(DFNLOC,U),$PIECE(DFNLOC,U,2),"C",BUSARPC,.DVAL)
IF 'STS
GOTO XCIA
+64 ;Multiple Input DFNs
IF MINP=1
IF MINPL="D"
DO MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL)
+65 ;Single DFN or Result DFNs
IF MINP=0
DO CFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP)
+66 ;
+67 ;Stuff the VIEN
+68 IF $PIECE(VSTLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(VSTLOC,U),$PIECE(VSTLOC,U,2),"C",BUSARPC,.VVAL)
IF 'STS
GOTO XCIA
+69 ;Multiple Input VIENs
IF MINP=1
IF MINPL="V"
DO MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL)
+70 ;Single VIEN or Result VIENs
IF MINP=0
DO CFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP)
+71 ;
+72 ;Stuff the detail description
+73 SET DETEXE=$GET(BUSAD(3))
+74 IF DETEXE]""
DO CFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
+75 ;
+76 ;Stuff the new value
+77 SET NEWEXE=$GET(BUSAD(4))
+78 IF NEWEXE]""
DO CFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
+79 ;
+80 ;Stuff the original value
+81 SET ORGEXE=$GET(BUSAD(5))
+82 IF ORGEXE]""
DO CFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
+83 ;
+84 ;Advance definition executable
+85 SET ADVEXE=$GET(BUSAD(6))
+86 IF ADVEXE]""
XECUTE ADVEXE
+87 ;
+88 ;Look for SKIP
+89 IF +$GET(SKIP)
SET STS="0^Skipped log entry"
GOTO XCIA
+90 ;
+91 ;Create the log entry
+92 SET STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
+93 ;
XCIA QUIT STS
+1 ;
XWB(BUSAP) ;PEP - Log audit entry from XWB Broker
+1 ;
+2 NEW BUSABKR,BUSARPC,RPCIEN,BUSAIEN,BUSADVAL,BUSAOVAL,STS,MINP
+3 NEW TYPE,CAT,ACT,X,DESC,XDESC,DFNLOC,DFNEXE,VSTLOC,VSTEXE
+4 NEW MULT,BUSADVAL,DVAL,VVAL,DETEXE,NEWEXE,ORGEXE,SKIP,ADVEXE,MINPD,MINPL
+5 ;
+6 SET SKIP=""
+7 ;
+8 ;Make sure logging switch is on
+9 IF '+$$STATUS^BUSAOPT("B")
SET STS="0^BMX audit logging switch is off"
GOTO XXWB
+10 ;
+11 ;Define Application Variables
+12 ;Set Broker to XWB Broker
SET BUSABKR="W"
+13 ;
+14 ;Get the RPC
+15 SET BUSARPC=$GET(BUSAP(2,"RPC"))
IF BUSARPC=""
SET BUSARPC=$GET(BUSAP(2,"CAPI"))
+16 IF BUSARPC=""
SET STS="0^Missing RPC"
GOTO XXWB
+17 ;
+18 ;Find RPC IEN and skip if not defined
+19 SET RPCIEN=$ORDER(^XWB(8994,"B",BUSARPC,0))
IF RPCIEN=""
SET STS="0^Invalid RPC"
GOTO XXWB
+20 ;
+21 ;See if RPC is set up to be audited
+22 SET BUSAIEN=$ORDER(^BUSA(9002319.03,"B",BUSARPC,""))
IF BUSAIEN=""
SET STS="0^RPC not set to be tracked"
GOTO XXWB
+23 ;
+24 ;Check for inactive
+25 IF $$GET1^DIQ(9002319.03,BUSAIEN_",",.07,"I")
SET STS="0^RPC call is inactive"
GOTO XXWB
+26 ;
+27 ;Pull definition
+28 SET STS=$$DEF(BUSAIEN,.BUSAD)
IF 'STS
GOTO XXWB
+29 ;
+30 ;Assemble Summary Information
+31 ;
+32 ;Define Type as RPC
+33 SET TYPE="R"
+34 ;
+35 ;Pull the CATEGORY
+36 SET CAT=$GET(BUSAD(.02))
IF CAT=""
SET STS="0^Invalid definition category"
GOTO XXWB
+37 ;
+38 ;Pull the ACTION
+39 SET ACT=$GET(BUSAD(.03))
+40 ;
+41 ;Determine the Entry Description
+42 SET X=""
SET XDESC=$GET(BUSAD(.06))
IF XDESC]""
XECUTE XDESC
+43 SET DESC=$GET(X)
+44 ;
+45 ;Assemble Detail Information
+46 ;
+47 ;Retrieve DFN definition
+48 SET DFNLOC=$GET(BUSAD(1.01))
+49 SET DFNEXE=$GET(BUSAD(1.02))
+50 ;
+51 ;Retrieve VIEN definition
+52 SET VSTLOC=$GET(BUSAD(2.01))
+53 SET VSTEXE=$GET(BUSAD(2.02))
+54 ;
+55 ;Retrieve Multiple input info
+56 SET MINP=0
+57 SET MINPL=$GET(BUSAD(2.03))
+58 SET MINPD=$GET(BUSAD(2.04))
+59 IF MINPL]""
IF MINPD]""
SET MINP=1
+60 ;
+61 ;Look for multiple results
+62 SET MULT=0
IF $PIECE(DFNLOC,"^")="R"!($PIECE(VSTLOC,"^")="R")
SET MULT=1
+63 IF MINP
IF MULT
SET STS="0^DFN/VIEN cannot be pulled from both multiple inputs and results"
GOTO XXWB
+64 ;
+65 ;Stuff the DFN
+66 IF $PIECE(DFNLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(DFNLOC,U),$PIECE(DFNLOC,U,2),"W",BUSARPC,.DVAL)
IF 'STS
GOTO XXWB
+67 ;Multiple Input DFNs
IF MINP=1
IF MINPL="D"
DO MINP^BUSAUTIL(.DVAL,MINPD,MINPL,DFNEXE,.BUSADVAL)
+68 ;Single DFN or Result DFNs
IF MINP=0
DO WFILE^BUSAUTIL(.DVAL,.BUSADVAL,1,DFNEXE,MULT,MINP)
+69 ;
+70 ;Stuff the VIEN (and possibly the DFN)
+71 IF $PIECE(VSTLOC,U,2)]""
SET STS=$$VAL^BUSAUTIL($PIECE(VSTLOC,U),$PIECE(VSTLOC,U,2),"W",BUSARPC,.VVAL)
IF 'STS
GOTO XXWB
+72 ;Multiple Input VIENs
IF MINP=1
IF MINPL="V"
DO MINP^BUSAUTIL(.VVAL,MINPD,MINPL,VSTEXE,.BUSADVAL)
+73 ;Single VIEN or Result VIENs
IF MINP=0
DO WFILE^BUSAUTIL(.VVAL,.BUSADVAL,2,VSTEXE,MULT,MINP)
+74 ;
+75 ;Stuff the detail description
+76 SET DETEXE=$GET(BUSAD(3))
+77 IF DETEXE]""
DO WFILE^BUSAUTIL("",.BUSADVAL,3,DETEXE,MULT,MINP)
+78 ;
+79 ;Stuff the new value
+80 SET NEWEXE=$GET(BUSAD(4))
+81 IF NEWEXE]""
DO WFILE^BUSAUTIL("",.BUSADVAL,4,NEWEXE,MULT,MINP)
+82 ;
+83 ;Stuff the original value
+84 SET ORGEXE=$GET(BUSAD(5))
+85 IF ORGEXE]""
DO WFILE^BUSAUTIL("",.BUSADVAL,5,ORGEXE,MULT,MINP)
+86 ;
+87 ;Advance definition executable
+88 SET ADVEXE=$GET(BUSAD(6))
+89 IF ADVEXE]""
XECUTE ADVEXE
+90 ;
+91 ;Look for SKIP
+92 IF +$GET(SKIP)
SET STS="0^Skipped log entry"
GOTO XXWB
+93 ;
+94 ;Make API call
+95 SET STS=$$LOG^BUSAAPI(TYPE,CAT,ACT,BUSARPC,DESC,"BUSADVAL")
+96 ;
XXWB QUIT STS
+1 ;
DEF(BUSAIEN,BUSAD) ;EP - Set up entry definition array
+1 ;
+2 NEW FLD
+3 FOR FLD=".01",".02",".03",".06",1.01,1.02,2.01,2.02,2.03,2.04,3,4,5,6
SET BUSAD(FLD)=$TRANSLATE($$GET1^DIQ(9002319.03,BUSAIEN_",",FLD,"I"),"~","^")
+4 QUIT $SELECT($DATA(BUSAD)>1:1,1:"0^Invalid Definition")
+5 ;
RPC(DATA,INPUT) ;EP - BUSA LOG SECURITY AUDIT ENTRY
+1 ;
+2 ; Required variable:
+3 ; DUZ - Pointer to NEW PERSON (#200) file
+4 ;
+5 ;Input Parameters:
+6 ;
+7 ; INPUT
+8 ;
+9 ; Piece ("|" delimiter)
+10 ;
+11 ; 1 - CAT (Required) - The category of the event to log (S:System Event;
+12 ; P:Patient Related;D:Definition Change;O:Other Event)
+13 ; 2 - ACTION (Required for CAT="P") - The action for the event to log
+14 ; (A:Additions;D:Deletions;Q:Queries;P:Print;
+15 ; E:Changes;C:Copy)
+16 ; 3 - CALL - (Required) - Free text entry describing the call which
+17 ; originated the audit event (Maximum length
+18 ; 200 characters)
+19 ; Examples could be an RPC value or calling
+20 ; routine
+21 ; 4 - DESC - (Required) - Free text entry describing the call action
+22 ; (Maximum length 250 characters)
+23 ; Examples could be 'Patient demographic update',
+24 ; 'Copied iCare panel to clipboard' or 'POV Entry'
+25 ; 5 - DETAIL (Required for CAT="P") - Delimited list of patient/visit records
+26 ; to log. Required for patient related events.
+27 ; Optional for other event types
+28 ;
+29 ; Format: DETAIL = DFN1_$C(29)_VIEN1_$C(29)_EVENT DESCRIPTION1_$C(29)_NEW VALUE1 ...
+30 ; ... _$C(29)_ORIGINAL VALUE1_$C(28)_DFN2_$C(29)_VIEN2_$C(29) ...
+31 ; ... _EVENT DESCRIPTION2_$C(29)_NEW VALUE2_$C(29)_ORIGINAL VALUE2 ...
+32 ; ... $C(28)_DFN3 ...
+33 ;
+34 ; Where:
+35 ; DFN# - (Optional for non-patient related calls) - Pointer to VA PATIENT file (#2)
+36 ; VIEN# - (Optional for non-visit related calls) - Pointer to VISIT file (#9000010)
+37 ; EVENT DESCRIPTION# -(Optional) - Additional detail to log for this entry
+38 ; NEW VALUE# - (Optional) - New value after call completion, if applicable
+39 ; ORIGINAL VALUE# - (Optional) - Original value prior to call execution, if applicable
+40 ;
+41 NEW CAT,ACTION,CALL,DESC,DETAIL,DCNT,I,DET,BUSAII,UID,RES,ENTRY
+42 ;
+43 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+44 SET DATA=$NAME(^TMP("BUSARPC",UID))
+45 KILL @DATA
+46 ;
+47 SET BUSAII=0
+48 ;
+49 ;Create header
+50 SET @DATA@(0)="I00001RESULT^T00250ERROR_MESSAGE"_$CHAR(30)
+51 ;
+52 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BUSARPC D UNWIND^%ZTER"
+53 ;
+54 ;Check for DUZ
+55 IF $GET(DUZ)=""
SET RES="0^DUZ is not defined"
GOTO XBRPC
+56 ;
+57 ;Move input to local variables
+58 SET INPUT=$GET(INPUT,"")
+59 SET CAT=$PIECE(INPUT,"|")
+60 SET ACTION=$PIECE(INPUT,"|",2)
+61 SET CALL=$PIECE(INPUT,"|",3)
+62 SET DESC=$PIECE(INPUT,"|",4)
+63 SET DETAIL=$PIECE(INPUT,"|",5)
+64 ;
+65 ;Format DETAIL
+66 SET DCNT=0
+67 FOR I=1:1:$LENGTH(DETAIL,$CHAR(28))
SET ENTRY=$PIECE(DETAIL,$CHAR(28),I)
IF $TRANSLATE(ENTRY,$CHAR(29))]""
Begin DoDot:1
+68 NEW DFN,VIEN,EDESC,NVAL,OVAL
+69 SET DFN=$PIECE(ENTRY,$CHAR(29))
+70 SET VIEN=$PIECE(ENTRY,$CHAR(29),2)
+71 SET EDESC=$PIECE(ENTRY,$CHAR(29),3)
+72 SET NVAL=$PIECE(ENTRY,$CHAR(29),4)
+73 SET OVAL=$PIECE(ENTRY,$CHAR(29),5)
+74 SET DCNT=DCNT+1
+75 SET DET(DCNT)=DFN_U_VIEN_U_EDESC_U_NVAL_U_OVAL
End DoDot:1
+76 ;
+77 ;Perform the call
+78 SET RES=$$LOG^BUSAAPI("R",CAT,ACTION,CALL,DESC,"DET")
+79 ;
XBRPC SET BUSAII=BUSAII+1
SET @DATA@(BUSAII)=RES_$CHAR(30)
+1 SET BUSAII=BUSAII+1
SET @DATA@(BUSAII)=$CHAR(31)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(BUSAII)
IF $DATA(DATA)
SET BUSAII=BUSAII+1
SET @DATA@(BUSAII)=$CHAR(31)
+6 QUIT
