BUSARPC.m

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))