BUSAMAG1.m

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