ACHSMAUD ; IHS/ITSC/PMF - TPF MENU OPTION USE AUDIT ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;
;THIS IS CALLED FROM ACHS OPTIONS THAT NEED TO BE AUDITED FOR FREQUENCY
;OF USE
AUDIT(NAMESPAC,LEVEL) ;EP
;
I $G(LEVEL)="" S LEVEL=0
S LEVEL=LEVEL+1
S U="^"
S %H=$H D YX^%DTC S NOW=Y ;NOW INCLUDES SECONDS
S GLOBAL=U_NAMESPAC_"AUD(" ;ADD AUD FOR AUDIT TO NAMESPACE PASSED
;
;XQDIC = INITIAL OPTION KICKED OFF?????
;XQY0 = CURRENT OPTION?????
D NOW^%DTC
S NOW=%
S @(GLOBAL_"""OPTION"","_XQY_")")=$G(@(GLOBAL_"""OPTION"","_XQY_")"))+1
S @(GLOBAL_"""OPTION"","_XQY_","""_XQUSER_""")")=$G(@(GLOBAL_"""OPTION"","_XQY_","""_XQUSER_""")"))+1
S @(GLOBAL_DUZ_","_NOW_","_LEVEL_","_XQY_","""_XQUSER_""")")=XQY0
S @(GLOBAL_DUZ_","""_XQUSER_""","_LEVEL_","_XQY_","_""""_$P(XQY0,U)_""""_")")=$G(@(GLOBAL_DUZ_","""_XQUSER_""","_LEVEL_","_XQY_","_""""_$P(XQY0,U)_""""_")"))+1
;
K GLOBAL,NAMESPAC,NOW,%H
Q
;
;SUB-ROUTINE TO PRINT OUT REPORT FROM AUDIT GLOBAL
REPORT ;
;THREE REPORTS 1) BY DATE/TIM
; 2) BY USER NAME
; 3) BY OPTION USED A) FREQUENCY BY ALL USERS
; B) FREQUENCY USED BY EACH USER
S $P(LINE,"-",81)=""
S U="^"
;
;ASK FOR NAMESPACE
ASKNMSP ;
K DIC
S DIC="^DIC(9.4,"
S DIC("A")="Enter namespace: "
S DIC(0)="MEAQZ"
D ^DIC
I Y=-1 Q
S NAMESPAC=$P(Y(0),U,2)
S NAME=$P(Y(0),U)
W !!,"REPORTING FROM ",NAME
;
;ASK FOR DEVICE
ASKDEV ;
D ^%ZIS
I POP G ASKNMSP
;
;ASK FOR WHICH REPORT
ASKREP ;
K DIR
S DIR(0)="N^1:4^K:X'?.N X"
S DIR("A",1)="Select Option Use Report:"
S DIR("A",2)=" 1. By Date"
S DIR("A",3)=" 2. By User"
S DIR("A",4)=" 3. Frequency of use (All Users)"
S DIR("A",5)=" 4. Frequency of use (By User)"
S DIR("A")="Option: "
S DIR("B")="1"
D ^DIR
Q:X=""!$D(DUOUT)!$D(DTOUT)
S CHOICE=$S(X=1:"BYDATE",X=2:"BYUSER",1:"END")
D @CHOICE
G ASKNMSP
Q
;
;DEPENDING ON SORT CHOICE DO THE SORT
GENERIC ;
;
S ACHSDUZ=""
F S ACHSDUZ=$O(^ACHSAUD(ACHSDUZ)) Q:ACHSDUZ=""!(ACHSDUZ="OPTION") D Q:$G(ACHSQUIT)
.W !!
.S DTTIME=""
.F S DTTIME=$O(^ACHSAUD(ACHSDUZ,DTTIME)) Q:DTTIME=""!(+DTTIME=0) D Q:$G(ACHSQUIT)
..S Y=DTTIME X ^DD("DD") S DATE=Y
..S LEVEL=""
..F S LEVEL=$O(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL)) Q:LEVEL="" D Q:$G(ACHSQUIT)
...S OPTNUM=""
...F S OPTNUM=$O(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL,OPTNUM)) Q:OPTNUM="" D Q:$G(ACHSQUIT)
....S NAME="",OLDNAME=""
....F S NAME=$O(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME)) Q:NAME="" D Q:$G(ACHSQUIT)
....I SORTBY="BY USER" D RPTLINE(ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME) Q
....I SORTBY="BY DATE" S ^TMP($J,"ACHSMAUD",SORTBY,DTTIME,NAME,LEVEL,OPTNUM)=""
....I SORTBY="BY OPTION" S ^TMP($J,"ACHSMAUD",SORTBY,NAME,OPTNUM,ACHSDUZ,DTTIME)=""
D:SORTBY'="BY USER" SORTLOOP(SORTBY)
Q
;GO THROUGH SORTED GLOBAL
SORTLOOP(SORTBY) ;
S SUB3=""
F S SUB3=$O(^TMP($J,"ACHSMAUD",SORTBY,SUB3)) Q:SUB3="" D
.S SUB4=""
.F S SUB4=$O(^TMP($J,"ACHSMAUD",SORTBY,SUB3,SUB4)) Q:SUB4="" D
..S SUB5=""
..F S SUB5=$O(^TMP($J,"ACHSMAUD",SORTBY,SUB3,SUB4,SUB5)) Q:SUB5="" D
...S SUB6=""
...F S SUB6=$O(^TMP($J,"ACHSMAUD",SORTBY,SUB3,SUB4,SUB5,SUB6)) Q:SUB6="" D
....;D RPTLINE()
;
Q
;WRITE THE LINE
RPTLINE(SORTBY,ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME) ;
I SORTBY="BY USER" W !,ACHSDUZ,?25,DTTIME,?35,LEVEL,?45,OPTNUM,?60,NAME
I SORTBY="BY OPTION" W !,OPTNUM
;
Q
;
;LIST BY USER
BYUSER ;
S SORTBY="BY USER"
Q
;LIST BY DATE
BYDATE ;
S SORTBY="BY DATE"
Q
BYOPTION ;
S SORTBY="BY OPTION"
Q
;
PGHDR ;
W @IOF
W $$C^XBFUNC(HEADER)
Q
SETAUD(NAMESPAC) ;EP
Q ;ONE TIME USE BY PROGRAMMER. NEEDS TO BE REWRITTEN
;SET THIS ROUTINE INTO THE ENTRY POINT FIELD OF ALL OPTIONS FOR
;THE PASSED NAMESPACE
S U="^"
S OPTNAME=NAMESPAC_" "
F S OPTNAME=$O(^DIC(19,"B",OPTNAME)) Q:OPTNAME'[(NAMESPAC) D
.S OPTNUM=$O(^DIC(19,"B",OPTNAME,""))
.Q:OPTNUM=""
.W !,OPTNUM,?10,OPTNAME
.S ENTRYACT=$G(^DIC(19,OPTNUM,20))
.W !,ENTRYACT
.I ENTRYACT="" D Q
..W "D "_U_$ZN_"("""_NAMESPAC_""")"
..;S ^DIC(19,OPTNUM,20)="D "_U_$ZN_"("""_NAMESPAC_""")"
.Q:ENTRYACT[($ZN) ;IF THE AUDIT RTN IS ALREADY THERE
. ;DONT DO ANYTHING
.W !,OPTNUM ;W $G(^DIC(19,OPTNUM,20))_" D "_U_$ZN_"("""_NAMESPAC_""")" ;S ^DIC(19,OPTNUM,20)=$G(^DIC(19,OPTNUM,20))_" D "_U_$ZN_"("""_NAMESPAC_""")"
;
;
;FIND THIS AUDIT ROUTINE IN THE ENTRY ACTION FIELD IN THE OPTION FILE
;FOR THE PASSED NAMESPACE. USED BY PROGRAMMER ONLY. NEEDS TO BE
;RE-WRITTEN
FINDAUD(NAMESPAC) ;
Q
S U="^"
S OPTNAME=NAMESPAC_" "
F CNT=1:1 S OPTNAME=$O(^DIC(19,"B",OPTNAME)) Q:OPTNAME'[(NAMESPAC) D
.S OPTNUM=$O(^DIC(19,"B",OPTNAME,""))
.Q:OPTNUM=""
.S ENTRYACT=$G(^DIC(19,OPTNUM,20))
.W !,CNT
.I ENTRYACT[("ACHSMAUD") W ?5,"AUDIT FOUND: ",OPTNAME,!,$G(^DIC(19,OPTNUM,20))
.E W ?15,"AUDIT NOT FOUND: ",OPTNAME
;
Q
;
ACHSMAUD ; IHS/ITSC/PMF - TPF MENU OPTION USE AUDIT ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;
+4 ;THIS IS CALLED FROM ACHS OPTIONS THAT NEED TO BE AUDITED FOR FREQUENCY
+5 ;OF USE
AUDIT(NAMESPAC,LEVEL) ;EP
+1 ;
+2 IF $GET(LEVEL)=""
SET LEVEL=0
+3 SET LEVEL=LEVEL+1
+4 SET U="^"
+5 ;NOW INCLUDES SECONDS
SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+6 ;ADD AUD FOR AUDIT TO NAMESPACE PASSED
SET GLOBAL=U_NAMESPAC_"AUD("
+7 ;
+8 ;XQDIC = INITIAL OPTION KICKED OFF?????
+9 ;XQY0 = CURRENT OPTION?????
+10 DO NOW^%DTC
+11 SET NOW=%
+12 SET @(GLOBAL_"""OPTION"","_XQY_")")=$GET(@(GLOBAL_"""OPTION"","_XQY_")"))+1
+13 SET @(GLOBAL_"""OPTION"","_XQY_","""_XQUSER_""")")=$GET(@(GLOBAL_"""OPTION"","_XQY_","""_XQUSER_""")"))+1
+14 SET @(GLOBAL_DUZ_","_NOW_","_LEVEL_","_XQY_","""_XQUSER_""")")=XQY0
+15 SET @(GLOBAL_DUZ_","""_XQUSER_""","_LEVEL_","_XQY_","_""""_$PIECE(XQY0,U)_""""_")")=$GET(@(GLOBAL_DUZ_","""_XQUSER_""","_LEVEL_","_XQY_","_""""_$PIECE(XQY0,U)_""""_")"))+1
+16 ;
+17 KILL GLOBAL,NAMESPAC,NOW,%H
+18 QUIT
+19 ;
+20 ;SUB-ROUTINE TO PRINT OUT REPORT FROM AUDIT GLOBAL
REPORT ;
+1 ;THREE REPORTS 1) BY DATE/TIM
+2 ; 2) BY USER NAME
+3 ; 3) BY OPTION USED A) FREQUENCY BY ALL USERS
+4 ; B) FREQUENCY USED BY EACH USER
+5 SET $PIECE(LINE,"-",81)=""
+6 SET U="^"
+7 ;
+8 ;ASK FOR NAMESPACE
ASKNMSP ;
+1 KILL DIC
+2 SET DIC="^DIC(9.4,"
+3 SET DIC("A")="Enter namespace: "
+4 SET DIC(0)="MEAQZ"
+5 DO ^DIC
+6 IF Y=-1
QUIT
+7 SET NAMESPAC=$PIECE(Y(0),U,2)
+8 SET NAME=$PIECE(Y(0),U)
+9 WRITE !!,"REPORTING FROM ",NAME
+10 ;
+11 ;ASK FOR DEVICE
ASKDEV ;
+1 DO ^%ZIS
+2 IF POP
GOTO ASKNMSP
+3 ;
+4 ;ASK FOR WHICH REPORT
ASKREP ;
+1 KILL DIR
+2 SET DIR(0)="N^1:4^K:X'?.N X"
+3 SET DIR("A",1)="Select Option Use Report:"
+4 SET DIR("A",2)=" 1. By Date"
+5 SET DIR("A",3)=" 2. By User"
+6 SET DIR("A",4)=" 3. Frequency of use (All Users)"
+7 SET DIR("A",5)=" 4. Frequency of use (By User)"
+8 SET DIR("A")="Option: "
+9 SET DIR("B")="1"
+10 DO ^DIR
+11 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+12 SET CHOICE=$SELECT(X=1:"BYDATE",X=2:"BYUSER",1:"END")
+13 DO @CHOICE
+14 GOTO ASKNMSP
+15 QUIT
+16 ;
+17 ;DEPENDING ON SORT CHOICE DO THE SORT
GENERIC ;
+1 ;
+2 SET ACHSDUZ=""
+3 FOR
SET ACHSDUZ=$ORDER(^ACHSAUD(ACHSDUZ))
IF ACHSDUZ=""!(ACHSDUZ="OPTION")
QUIT
Begin DoDot:1
+4 WRITE !!
+5 SET DTTIME=""
+6 FOR
SET DTTIME=$ORDER(^ACHSAUD(ACHSDUZ,DTTIME))
IF DTTIME=""!(+DTTIME=0)
QUIT
Begin DoDot:2
+7 SET Y=DTTIME
XECUTE ^DD("DD")
SET DATE=Y
+8 SET LEVEL=""
+9 FOR
SET LEVEL=$ORDER(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL))
IF LEVEL=""
QUIT
Begin DoDot:3
+10 SET OPTNUM=""
+11 FOR
SET OPTNUM=$ORDER(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL,OPTNUM))
IF OPTNUM=""
QUIT
Begin DoDot:4
+12 SET NAME=""
SET OLDNAME=""
+13 FOR
SET NAME=$ORDER(^ACHSAUD(ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME))
IF NAME=""
QUIT
Begin DoDot:5
End DoDot:5
IF $GET(ACHSQUIT)
QUIT
+14 IF SORTBY="BY USER"
DO RPTLINE(ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME)
QUIT
+15 IF SORTBY="BY DATE"
SET ^TMP($JOB,"ACHSMAUD",SORTBY,DTTIME,NAME,LEVEL,OPTNUM)=""
+16 IF SORTBY="BY OPTION"
SET ^TMP($JOB,"ACHSMAUD",SORTBY,NAME,OPTNUM,ACHSDUZ,DTTIME)=""
End DoDot:4
IF $GET(ACHSQUIT)
QUIT
End DoDot:3
IF $GET(ACHSQUIT)
QUIT
End DoDot:2
IF $GET(ACHSQUIT)
QUIT
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
+17 IF SORTBY'="BY USER"
DO SORTLOOP(SORTBY)
+18 QUIT
+19 ;GO THROUGH SORTED GLOBAL
SORTLOOP(SORTBY) ;
+1 SET SUB3=""
+2 FOR
SET SUB3=$ORDER(^TMP($JOB,"ACHSMAUD",SORTBY,SUB3))
IF SUB3=""
QUIT
Begin DoDot:1
+3 SET SUB4=""
+4 FOR
SET SUB4=$ORDER(^TMP($JOB,"ACHSMAUD",SORTBY,SUB3,SUB4))
IF SUB4=""
QUIT
Begin DoDot:2
+5 SET SUB5=""
+6 FOR
SET SUB5=$ORDER(^TMP($JOB,"ACHSMAUD",SORTBY,SUB3,SUB4,SUB5))
IF SUB5=""
QUIT
Begin DoDot:3
+7 SET SUB6=""
+8 FOR
SET SUB6=$ORDER(^TMP($JOB,"ACHSMAUD",SORTBY,SUB3,SUB4,SUB5,SUB6))
IF SUB6=""
QUIT
Begin DoDot:4
+9 ;D RPTLINE()
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 QUIT
+12 ;WRITE THE LINE
RPTLINE(SORTBY,ACHSDUZ,DTTIME,LEVEL,OPTNUM,NAME) ;
+1 IF SORTBY="BY USER"
WRITE !,ACHSDUZ,?25,DTTIME,?35,LEVEL,?45,OPTNUM,?60,NAME
+2 IF SORTBY="BY OPTION"
WRITE !,OPTNUM
+3 ;
+4 QUIT
+5 ;
+6 ;LIST BY USER
BYUSER ;
+1 SET SORTBY="BY USER"
+2 QUIT
+3 ;LIST BY DATE
BYDATE ;
+1 SET SORTBY="BY DATE"
+2 QUIT
BYOPTION ;
+1 SET SORTBY="BY OPTION"
+2 QUIT
+3 ;
PGHDR ;
+1 WRITE @IOF
+2 WRITE $$C^XBFUNC(HEADER)
+3 QUIT
SETAUD(NAMESPAC) ;EP
+1 ;ONE TIME USE BY PROGRAMMER. NEEDS TO BE REWRITTEN
QUIT
+2 ;SET THIS ROUTINE INTO THE ENTRY POINT FIELD OF ALL OPTIONS FOR
+3 ;THE PASSED NAMESPACE
+4 SET U="^"
+5 SET OPTNAME=NAMESPAC_" "
+6 FOR
SET OPTNAME=$ORDER(^DIC(19,"B",OPTNAME))
IF OPTNAME'[(NAMESPAC)
QUIT
Begin DoDot:1
+7 SET OPTNUM=$ORDER(^DIC(19,"B",OPTNAME,""))
+8 IF OPTNUM=""
QUIT
+9 WRITE !,OPTNUM,?10,OPTNAME
+10 SET ENTRYACT=$GET(^DIC(19,OPTNUM,20))
+11 WRITE !,ENTRYACT
+12 IF ENTRYACT=""
Begin DoDot:2
+13 WRITE "D "_U_$ZN_"("""_NAMESPAC_""")"
+14 ;S ^DIC(19,OPTNUM,20)="D "_U_$ZN_"("""_NAMESPAC_""")"
End DoDot:2
QUIT
+15 ;IF THE AUDIT RTN IS ALREADY THERE
IF ENTRYACT[($ZN)
QUIT
+16 ;DONT DO ANYTHING
+17 ;W $G(^DIC(19,OPTNUM,20))_" D "_U_$ZN_"("""_NAMESPAC_""")" ;S ^DIC(19,OPTNUM,20)=$G(^DIC(19,OPTNUM,20))_" D "_U_$ZN_"("""_NAMESPAC_""")"
WRITE !,OPTNUM
End DoDot:1
+18 ;
+19 ;
+20 ;FIND THIS AUDIT ROUTINE IN THE ENTRY ACTION FIELD IN THE OPTION FILE
+21 ;FOR THE PASSED NAMESPACE. USED BY PROGRAMMER ONLY. NEEDS TO BE
+22 ;RE-WRITTEN
FINDAUD(NAMESPAC) ;
+1 QUIT
+2 SET U="^"
+3 SET OPTNAME=NAMESPAC_" "
+4 FOR CNT=1:1
SET OPTNAME=$ORDER(^DIC(19,"B",OPTNAME))
IF OPTNAME'[(NAMESPAC)
QUIT
Begin DoDot:1
+5 SET OPTNUM=$ORDER(^DIC(19,"B",OPTNAME,""))
+6 IF OPTNUM=""
QUIT
+7 SET ENTRYACT=$GET(^DIC(19,OPTNUM,20))
+8 WRITE !,CNT
+9 IF ENTRYACT[("ACHSMAUD")
WRITE ?5,"AUDIT FOUND: ",OPTNAME,!,$GET(^DIC(19,OPTNUM,20))
+10 IF '$TEST
WRITE ?15,"AUDIT NOT FOUND: ",OPTNAME
End DoDot:1
+11 ;
+12 QUIT
+13 ;
