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