BUSAMAG1 ;ISI/HS/MLS-SPECIAL CODE FOR VISTA IMAGING AUDITING ; 31 Jan 2013 9:53 AM
;;1.0;IHS USER SECURITY AUDIT;;Nov 05, 2013;Build 65
Q
;
; Find value located inside RPC parameter INPUT list
;
; INPUT: RPARAM = RPC Param
; MATCH = String to look for
; DELIM = If value needs to be parsed, provide delimeter
; PC = If value needs to be parsed, provide $P #
; LEAD = if EQ is null then use "[" contain match, if EQ=1 use leading char match
; OUTPUT: located input value, returned via "OUT" variable
;
; EXAMPLE: S X=$$ARRAY~BUSAMAG1(4,"IDFN",U,3)
ARRAY(RPARAM,MATCH,DELIM,PC,LEAD) ;EP
N $ETRAP,$ESTACK S $ETRAP="D ERR^BUSAMAG1"
N Y,Z,EXIT,OUT,ARRAY,INDIR
K ARRAY S (OUT,EXIT)=0
I $G(RPARAM)="" S OUT=-1 Q OUT
S LEAD=+$G(LEAD)
I $G(XWB(5,"P",RPARAM))="" S OUT=-1 Q OUT
S INDIR=$G(XWB(5,"P",RPARAM)),INDIR=$TR(INDIR,".","")
M ARRAY=@INDIR
I $G(MATCH)="" S OUT=-1 Q OUT
S DELIM=$G(DELIM)
S PC=$G(PC) I +PC="" S PC=1
S Y="" F S Y=$O(ARRAY(Y)) Q:(Y=""!(EXIT)) D
. I ARRAY(Y)[MATCH D
. . I LEAD D Q
. . . N CHECK
. . . S CHECK="1"""_MATCH_""".E"
. . . I $G(ARRAY(Y))'?@CHECK Q ; looks for leading char matches
. . . S Z=$G(ARRAY(Y)) S OUT=Z
. . . I DELIM'="" S OUT=$P(Z,DELIM,PC)
. . . S EXIT=1
. . . Q
. . S Z=$G(ARRAY(Y)) S OUT=Z
. . I DELIM'="" S OUT=$P(Z,DELIM,PC)
. . S EXIT=1
. . Q
. Q
Q OUT
;
; Find value located inside RPC RETURN value list
;
; INPUT: LOC = $P location of match token
; DELIM1 = delimiter used to find match token
; MATCH = value of match token to look for (identifying string)
; DELIM2 = If return value needs to be parsed, provide delimeter
; PC = If return value needs to be parsed, provide $P location (place of value returned)
; OUTPUT: located output value, returned via "OUT" variable
;
; EXAMPLE: S X=$$RLIST~BUSAMAG1(1,"|","STUDY_PAT","|",2)
; Where 1 (LOC) is the "|" (DELIM1) deliminated location to find the id/token string of "STUDY PAT" (MATCH)
; and the value to be returned is stored in the 2nd "|" delimited piece.
;
RLIST(LOC,DELIM1,MATCH,DELIM2,PC) ;EP
N $ETRAP,$ESTACK S $ETRAP="D ERR^BUSAMAG1"
N Y,Z,EXIT,OUT
S (OUT,EXIT)=0
I '$D(XWBY) S OUT=-1 Q OUT
I $G(LOC)="" S LOC=0
I $G(MATCH)="" S OUT=-1 Q OUT
S DELIM1=$G(DELIM1)
S DELIM2=$G(DELIM2)
S PC=$G(PC) I +PC="" S PC=1
S Y="" F S Y=$O(XWBY(Y)) Q:(Y=""!(EXIT)) D
. S Z=$G(XWBY(Y))
. I Z'[MATCH Q
. S OUT=Z
. I LOC D Q ;check return string to see if specific piece matches search string
. . I $P(Z,DELIM1,LOC)=MATCH D
. . . I DELIM2'="" S OUT=$P(Z,DELIM2,PC)
. . . S EXIT=1
. . . Q
. I DELIM2'="" S OUT=$P(Z,DELIM,PC)
. S EXIT=1
. Q
Q OUT
;
; Check for redundant rpc/dfn/act calls
; INPUT: RPC = RPC NAME (#8994)
; DFN = PNT IEN (#2)
; ACT = ACTION value (#9002319.03,.03)
; OUTPUT: 0 - don't record
; 1 - record
; -1 - error
;
; EXAMPLE: S SKIP=$S($$REDUNCHK~BUSAMAG1("MAGG PAT INFO",+$G(XWB(5,"P",0)),"Q")=1:0,1:1)
;
REDUNCHK(RPC,DFN,ACT) ;EP
N OUT,SESSIEN S OUT=0
Q:$G(RPC)="" OUT
Q:$G(ACT)="" OUT
Q:$G(DFN)="" OUT
; Check for MAG Session ID
S SESSIEN=$S($G(MAGSESS):MAGSESS,$D(MAGJOB("SESSION")):MAGJOB("SESSION"),$G(TRKID)'="":$O(^MAG(2006.82,"E",TRKID,""),-1),1:0)
; Check Set top level XTMP node
I '$D(^XTMP("BUSAMAG"_$J,0)) D
. S ^XTMP("BUSAMAG"_$J,0)=(DT+1)_U_DT_U_"REDUNCHK~BUSAMAG1: Prevent redundant logging of RPC calls"
. Q
I $D(^XTMP("BUSAMAG"_$J,RPC,DFN,ACT)) D
. I SESSIEN,$G(^XTMP("BUSAMAG"_$J,RPC,DFN,ACT))'=SESSIEN S ^XTMP("BUSAMAG"_$J,RPC,DFN,ACT)=SESSIEN,OUT=1 Q ;different seession id: Record
. S OUT=0 ;Don't record
. Q
I '$D(^XTMP("BUSAMAG"_$J,RPC,DFN,ACT)) S ^XTMP("BUSAMAG"_$J,RPC,DFN,ACT)=SESSIEN,OUT=1 ;Record
Q OUT
;
ERR ;
S OUT="-1^ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q:$Q 1
Q
BUSAMAG1 ;ISI/HS/MLS-SPECIAL CODE FOR VISTA IMAGING AUDITING ; 31 Jan 2013 9:53 AM
+1 ;;1.0;IHS USER SECURITY AUDIT;;Nov 05, 2013;Build 65
+2 QUIT
+3 ;
+4 ; Find value located inside RPC parameter INPUT list
+5 ;
+6 ; INPUT: RPARAM = RPC Param
+7 ; MATCH = String to look for
+8 ; DELIM = If value needs to be parsed, provide delimeter
+9 ; PC = If value needs to be parsed, provide $P #
+10 ; LEAD = if EQ is null then use "[" contain match, if EQ=1 use leading char match
+11 ; OUTPUT: located input value, returned via "OUT" variable
+12 ;
+13 ; EXAMPLE: S X=$$ARRAY~BUSAMAG1(4,"IDFN",U,3)
ARRAY(RPARAM,MATCH,DELIM,PC,LEAD) ;EP
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^BUSAMAG1"
+2 NEW Y,Z,EXIT,OUT,ARRAY,INDIR
+3 KILL ARRAY
SET (OUT,EXIT)=0
+4 IF $GET(RPARAM)=""
SET OUT=-1
QUIT OUT
+5 SET LEAD=+$GET(LEAD)
+6 IF $GET(XWB(5,"P",RPARAM))=""
SET OUT=-1
QUIT OUT
+7 SET INDIR=$GET(XWB(5,"P",RPARAM))
SET INDIR=$TRANSLATE(INDIR,".","")
+8 MERGE ARRAY=@INDIR
+9 IF $GET(MATCH)=""
SET OUT=-1
QUIT OUT
+10 SET DELIM=$GET(DELIM)
+11 SET PC=$GET(PC)
IF +PC=""
SET PC=1
+12 SET Y=""
FOR
SET Y=$ORDER(ARRAY(Y))
IF (Y=""!(EXIT))
QUIT
Begin DoDot:1
+13 IF ARRAY(Y)[MATCH
Begin DoDot:2
+14 IF LEAD
Begin DoDot:3
+15 NEW CHECK
+16 SET CHECK="1"""_MATCH_""".E"
+17 ; looks for leading char matches
IF $GET(ARRAY(Y))'?@CHECK
QUIT
+18 SET Z=$GET(ARRAY(Y))
SET OUT=Z
+19 IF DELIM'=""
SET OUT=$PIECE(Z,DELIM,PC)
+20 SET EXIT=1
+21 QUIT
End DoDot:3
QUIT
+22 SET Z=$GET(ARRAY(Y))
SET OUT=Z
+23 IF DELIM'=""
SET OUT=$PIECE(Z,DELIM,PC)
+24 SET EXIT=1
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 QUIT OUT
+28 ;
+29 ; Find value located inside RPC RETURN value list
+30 ;
+31 ; INPUT: LOC = $P location of match token
+32 ; DELIM1 = delimiter used to find match token
+33 ; MATCH = value of match token to look for (identifying string)
+34 ; DELIM2 = If return value needs to be parsed, provide delimeter
+35 ; PC = If return value needs to be parsed, provide $P location (place of value returned)
+36 ; OUTPUT: located output value, returned via "OUT" variable
+37 ;
+38 ; EXAMPLE: S X=$$RLIST~BUSAMAG1(1,"|","STUDY_PAT","|",2)
+39 ; Where 1 (LOC) is the "|" (DELIM1) deliminated location to find the id/token string of "STUDY PAT" (MATCH)
+40 ; and the value to be returned is stored in the 2nd "|" delimited piece.
+41 ;
RLIST(LOC,DELIM1,MATCH,DELIM2,PC) ;EP
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^BUSAMAG1"
+2 NEW Y,Z,EXIT,OUT
+3 SET (OUT,EXIT)=0
+4 IF '$DATA(XWBY)
SET OUT=-1
QUIT OUT
+5 IF $GET(LOC)=""
SET LOC=0
+6 IF $GET(MATCH)=""
SET OUT=-1
QUIT OUT
+7 SET DELIM1=$GET(DELIM1)
+8 SET DELIM2=$GET(DELIM2)
+9 SET PC=$GET(PC)
IF +PC=""
SET PC=1
+10 SET Y=""
FOR
SET Y=$ORDER(XWBY(Y))
IF (Y=""!(EXIT))
QUIT
Begin DoDot:1
+11 SET Z=$GET(XWBY(Y))
+12 IF Z'[MATCH
QUIT
+13 SET OUT=Z
+14 ;check return string to see if specific piece matches search string
IF LOC
Begin DoDot:2
+15 IF $PIECE(Z,DELIM1,LOC)=MATCH
Begin DoDot:3
+16 IF DELIM2'=""
SET OUT=$PIECE(Z,DELIM2,PC)
+17 SET EXIT=1
+18 QUIT
End DoDot:3
End DoDot:2
QUIT
+19 IF DELIM2'=""
SET OUT=$PIECE(Z,DELIM,PC)
+20 SET EXIT=1
+21 QUIT
End DoDot:1
+22 QUIT OUT
+23 ;
+24 ; Check for redundant rpc/dfn/act calls
+25 ; INPUT: RPC = RPC NAME (#8994)
+26 ; DFN = PNT IEN (#2)
+27 ; ACT = ACTION value (#9002319.03,.03)
+28 ; OUTPUT: 0 - don't record
+29 ; 1 - record
+30 ; -1 - error
+31 ;
+32 ; EXAMPLE: S SKIP=$S($$REDUNCHK~BUSAMAG1("MAGG PAT INFO",+$G(XWB(5,"P",0)),"Q")=1:0,1:1)
+33 ;
REDUNCHK(RPC,DFN,ACT) ;EP
+1 NEW OUT,SESSIEN
SET OUT=0
+2 IF $GET(RPC)=""
QUIT OUT
+3 IF $GET(ACT)=""
QUIT OUT
+4 IF $GET(DFN)=""
QUIT OUT
+5 ; Check for MAG Session ID
+6 SET SESSIEN=$SELECT($GET(MAGSESS):MAGSESS,$DATA(MAGJOB("SESSION")):MAGJOB("SESSION"),$GET(TRKID)'="":$ORDER(^MAG(2006.82,"E",TRKID,""),-1),1:0)
+7 ; Check Set top level XTMP node
+8 IF '$DATA(^XTMP("BUSAMAG"_$JOB,0))
Begin DoDot:1
+9 SET ^XTMP("BUSAMAG"_$JOB,0)=(DT+1)_U_DT_U_"REDUNCHK~BUSAMAG1: Prevent redundant logging of RPC calls"
+10 QUIT
End DoDot:1
+11 IF $DATA(^XTMP("BUSAMAG"_$JOB,RPC,DFN,ACT))
Begin DoDot:1
+12 ;different seession id: Record
IF SESSIEN
IF $GET(^XTMP("BUSAMAG"_$JOB,RPC,DFN,ACT))'=SESSIEN
SET ^XTMP("BUSAMAG"_$JOB,RPC,DFN,ACT)=SESSIEN
SET OUT=1
QUIT
+13 ;Don't record
SET OUT=0
+14 QUIT
End DoDot:1
+15 ;Record
IF '$DATA(^XTMP("BUSAMAG"_$JOB,RPC,DFN,ACT))
SET ^XTMP("BUSAMAG"_$JOB,RPC,DFN,ACT)=SESSIEN
SET OUT=1
+16 QUIT OUT
+17 ;
ERR ;
+1 SET OUT="-1^ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 IF $QUIT
QUIT 1
+4 QUIT
