ABMAUDRP ; IHS/SD/SDR - TM Audit report - 8/19/2005 1:28:34 PM
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;This is to do a report based on fields being audited.
;They are listed below under FILES tag. To add new fields
;to report just list them under FILES and turn the audit on
;using FM.
;
K ABM,ABMY
S ABM("RTYP")=1
S ABM("RTYP","NM")="AUDIT LISTING"
;
SEL D LOOP Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("HD",0)="LISTING of Audited fields "
S ABM("LVL")=0
S ABMQ("RC")="COMPUTE^ABMAUDRP",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
S ABMQ("RP")="OUTPUT^ABMAUDRP"
D ^ABMDRDBQ
Q
;
FILES ;
;;9002274.5;.26;3P Parameters-Printable Name of Payment Site
;;9002274.5;.23;3P Parameters-Facility to Receive Payment
;;9002274.09;2,.05;3P Insurer-Form Locator Override Data Value
;;9999999.06;.14;Location-Mailing address street
;;9999999.06;.15;Location-Mailing address city
;;9999999.06;.16;Location-Mailing address state
;;9999999.06;.17;Location-Mailing address zip
;;END
LOOP ;
; Display current exclusion parameters
S ABMY("X")="W $$SDT^ABMDUTL(X)"
G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
W !!?3,"EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the EXPORT to:",!?3,"======================================================================="
I $D(ABMY("LOC")) W !?3,"- Visit Location.....: ",$P(^DIC(4,ABMY("LOC"),0),"^",1)
I $D(ABMY("DT")) W !?3,"- Edit Date Range....:"
I S X=ABMY("DT",1) X ABMY("X") W " to: " S X=ABMY("DT",2) X ABMY("X")
PARM ;
; Choose additional exclusion parameters
K DIR
S DIR(0)="SO^1:LOCATION;2:DATE RANGE"
S DIR("A")="Select ONE or MORE of the above EXCLUSION PARAMETERS"
S DIR("?")="The report can be restricted to one or more of the listed parameters. A parameter can be removed by reselecting it and making a null entry."
D ^DIR
K DIR
G XIT:$D(DIRUT)!$D(DIROUT)
I Y=1!(Y=2) D @($S(Y=1:"LOC",1:"DT")_"^ABMAUDRP") G LOOP
Q
;
COMPUTE ;
S ABM("SUBR")="ABM-AUDR"
K ^TMP($J,"ABM-AUDR")
F ABMCNT=1:1 S ABMSEL=$P($T(FILES+ABMCNT),";;",2) Q:ABMSEL="END" D
.S ABMFILE=$P(ABMSEL,";")
.S ABMFIELD=$P(ABMSEL,";",2)
.I $G(ABMY("DT",1))'="" S ABMSDT=($G(ABMY("DT",1))-1),ABMEDT=$G(ABMY("DT",2))+1
.E S ABMSDT=0,ABMEDT=9999999
.F S ABMSDT=$O(^DIA(ABMFILE,"C",ABMSDT)) Q:+ABMSDT=0!(ABMSDT>ABMEDT) D
..S ABMAIEN=0
..F S ABMAIEN=$O(^DIA(ABMFILE,"C",ABMSDT,ABMAIEN)) Q:+ABMAIEN=0 D
...Q:$P($G(^DIA(ABMFILE,ABMAIEN,0)),U,3)'=ABMFIELD ;quit if not Printable Name of Payment Site
...S ABMUSER=$P($G(^DIA(ABMFILE,ABMAIEN,0)),U,4)
...S ABMOLD=$P($G(^DIA(ABMFILE,ABMAIEN,2)),U)
...S ABMNEW=$P($G(^DIA(ABMFILE,ABMAIEN,3)),U)
...S ^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)=ABMOLD_"^"_ABMNEW
Q
OUTPUT ;
D HDB
S (ABMADT,ABMUSER,ABMFILE,ABMFIELD,ABMOLD,ABMNEW)=0
F S ABMFILE=$O(^TMP($J,"ABM-AUDR",ABMFILE)) Q:+ABMFILE=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABMFIELD=0,ABMSFLD=0
.F S ABMFIELD=$O(^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD)) Q:+ABMFIELD=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
..S ABMSDT=0
..I ABMFIELD'=ABMSFLD D
...W !!?5,$P($G(^DIC(ABMFILE,0)),U)_" Fld: "_$P($G(^DD(ABMFILE,+ABMFIELD,0)),U)
..S ABMSFLD=ABMFIELD
..F S ABMSDT=$O(^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT)) Q:+ABMSDT=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
...S ABMUSER=0
...F S ABMUSER=$O(^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)) Q:+ABMUSER=0 D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
....I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
....W !,$$CDT^ABMDUTL(ABMSDT) ;date/time
....W ?17,$E($P($G(^VA(200,ABMUSER,0)),U),1,17) ;user
....W ?35,$E($P($G(^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)),U),1,22) ;old value
....W ?58,$E($P($G(^TMP($J,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)),U,2),1,22) ;new value
K ^TMP($J,"ABM-AUDR")
Q
LOC ;EP
W ! K DIC,ABMY("LOC")
S DIC="^BAR(90052.05,DUZ(2),"
S DIC(0)="AEMQ"
S DIC("A")="Select LOCATION: "
D ^DIC K DIC
Q:+Y<1
S ABMY("LOC")=+Y
Q
DT ;EP
K DIR,ABMY("DT")
Q:$D(DIRUT)
S ABMY("DT")="E"
S Y="EDIT DATE"
W !!," ============ Entry of ",Y," Range =============",!
S DIR("A")="Enter STARTING "_Y_" for the Report"
S DIR(0)="DO^::EP"
D ^DIR
G DT:$D(DIRUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
D ^DIR
K DIR
G DT:$D(DIRUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
Q
XIT ;
K ABMY("I"),ABMY("X"),DIR
Q
HDR ;
I $D(ABMY("LOC")) S ABM("TXT")=$P(^DIC(4,ABMY("LOC"),0),U),ABM("CONJ")="at " D CHK
Q:$G(ABMY("DT",1))="" ;no dates
S ABM("CONJ")="with "
S ABM("TXT")="Edit Date" D CHK
S ABM("CONJ")="from ",ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",1)) D CHK
S ABM("CONJ")="to ",ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",2)) D CHK
Q
WHD ;EP for writing Report Header
W $$EN^ABMVDF("IOF"),!
I $D(ABM("PRIVACY")) W ?($S($D(ABM(132)):34,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
K ABM("LINE") S $P(ABM("LINE"),"=",$S($D(ABM(132)):132,1:80))="" W ABM("LINE"),!
W ABM("HD",0),?$S($D(ABM(132)):108,1:57) S Y=DT X ^DD("DD") W Y," Page ",ABM("PG")
W:$G(ABM("HD",1))]"" !,ABM("HD",1)
W:$G(ABM("HD",2))]"" !,ABM("HD",2)
W !,ABM("LINE") K ABM("LINE")
Q
CHK I ($L(ABM("HD",ABM("LVL")))+1+$L(ABM("CONJ"))+$L(ABM("TXT")))<($S($D(ABM(132)):104,1:52)+$S(ABM("LVL")>0:28,1:0)) S ABM("HD",ABM("LVL"))=ABM("HD",ABM("LVL"))_" "_ABM("CONJ")_ABM("TXT")
E S ABM("LVL")=ABM("LVL")+1,ABM("HD",ABM("LVL"))=ABM("CONJ")_ABM("TXT")
Q
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB S ABM("PG")=+$G(ABM("PG"))+1 D WHD
W !,"Date/Time",?17,"User",?35,"Old Value",?58,"New Value"
S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")
Q
ABMAUDRP ; IHS/SD/SDR - TM Audit report - 8/19/2005 1:28:34 PM
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;This is to do a report based on fields being audited.
+4 ;They are listed below under FILES tag. To add new fields
+5 ;to report just list them under FILES and turn the audit on
+6 ;using FM.
+7 ;
+8 KILL ABM,ABMY
+9 SET ABM("RTYP")=1
+10 SET ABM("RTYP","NM")="AUDIT LISTING"
+11 ;
SEL DO LOOP
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+1 SET ABM("HD",0)="LISTING of Audited fields "
+2 SET ABM("LVL")=0
+3 SET ABMQ("RC")="COMPUTE^ABMAUDRP"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
+4 SET ABMQ("RP")="OUTPUT^ABMAUDRP"
+5 DO ^ABMDRDBQ
+6 QUIT
+7 ;
FILES ;
+1 ;;9002274.5;.26;3P Parameters-Printable Name of Payment Site
+2 ;;9002274.5;.23;3P Parameters-Facility to Receive Payment
+3 ;;9002274.09;2,.05;3P Insurer-Form Locator Override Data Value
+4 ;;9999999.06;.14;Location-Mailing address street
+5 ;;9999999.06;.15;Location-Mailing address city
+6 ;;9999999.06;.16;Location-Mailing address state
+7 ;;9999999.06;.17;Location-Mailing address zip
+8 ;;END
LOOP ;
+1 ; Display current exclusion parameters
+2 SET ABMY("X")="W $$SDT^ABMDUTL(X)"
+3 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+4 WRITE !!?3,"EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the EXPORT to:",!?3,"======================================================================="
+5 IF $DATA(ABMY("LOC"))
WRITE !?3,"- Visit Location.....: ",$PIECE(^DIC(4,ABMY("LOC"),0),"^",1)
+6 IF $DATA(ABMY("DT"))
WRITE !?3,"- Edit Date Range....:"
+7 IF $TEST
SET X=ABMY("DT",1)
XECUTE ABMY("X")
WRITE " to: "
SET X=ABMY("DT",2)
XECUTE ABMY("X")
PARM ;
+1 ; Choose additional exclusion parameters
+2 KILL DIR
+3 SET DIR(0)="SO^1:LOCATION;2:DATE RANGE"
+4 SET DIR("A")="Select ONE or MORE of the above EXCLUSION PARAMETERS"
+5 SET DIR("?")="The report can be restricted to one or more of the listed parameters. A parameter can be removed by reselecting it and making a null entry."
+6 DO ^DIR
+7 KILL DIR
+8 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO XIT
+9 IF Y=1!(Y=2)
DO @($SELECT(Y=1:"LOC",1:"DT")_"^ABMAUDRP")
GOTO LOOP
+10 QUIT
+11 ;
COMPUTE ;
+1 SET ABM("SUBR")="ABM-AUDR"
+2 KILL ^TMP($JOB,"ABM-AUDR")
+3 FOR ABMCNT=1:1
SET ABMSEL=$PIECE($TEXT(FILES+ABMCNT),";;",2)
IF ABMSEL="END"
QUIT
Begin DoDot:1
+4 SET ABMFILE=$PIECE(ABMSEL,";")
+5 SET ABMFIELD=$PIECE(ABMSEL,";",2)
+6 IF $GET(ABMY("DT",1))'=""
SET ABMSDT=($GET(ABMY("DT",1))-1)
SET ABMEDT=$GET(ABMY("DT",2))+1
+7 IF '$TEST
SET ABMSDT=0
SET ABMEDT=9999999
+8 FOR
SET ABMSDT=$ORDER(^DIA(ABMFILE,"C",ABMSDT))
IF +ABMSDT=0!(ABMSDT>ABMEDT)
QUIT
Begin DoDot:2
+9 SET ABMAIEN=0
+10 FOR
SET ABMAIEN=$ORDER(^DIA(ABMFILE,"C",ABMSDT,ABMAIEN))
IF +ABMAIEN=0
QUIT
Begin DoDot:3
+11 ;quit if not Printable Name of Payment Site
IF $PIECE($GET(^DIA(ABMFILE,ABMAIEN,0)),U,3)'=ABMFIELD
QUIT
+12 SET ABMUSER=$PIECE($GET(^DIA(ABMFILE,ABMAIEN,0)),U,4)
+13 SET ABMOLD=$PIECE($GET(^DIA(ABMFILE,ABMAIEN,2)),U)
+14 SET ABMNEW=$PIECE($GET(^DIA(ABMFILE,ABMAIEN,3)),U)
+15 SET ^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)=ABMOLD_"^"_ABMNEW
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
OUTPUT ;
+1 DO HDB
+2 SET (ABMADT,ABMUSER,ABMFILE,ABMFIELD,ABMOLD,ABMNEW)=0
+3 FOR
SET ABMFILE=$ORDER(^TMP($JOB,"ABM-AUDR",ABMFILE))
IF +ABMFILE=0
QUIT
Begin DoDot:1
+4 SET ABMFIELD=0
SET ABMSFLD=0
+5 FOR
SET ABMFIELD=$ORDER(^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD))
IF +ABMFIELD=0
QUIT
Begin DoDot:2
+6 SET ABMSDT=0
+7 IF ABMFIELD'=ABMSFLD
Begin DoDot:3
+8 WRITE !!?5,$PIECE($GET(^DIC(ABMFILE,0)),U)_" Fld: "_$PIECE($GET(^DD(ABMFILE,+ABMFIELD,0)),U)
End DoDot:3
+9 SET ABMSFLD=ABMFIELD
+10 FOR
SET ABMSDT=$ORDER(^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT))
IF +ABMSDT=0
QUIT
Begin DoDot:3
+11 SET ABMUSER=0
+12 FOR
SET ABMUSER=$ORDER(^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:4
+13 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
+14 ;date/time
WRITE !,$$CDT^ABMDUTL(ABMSDT)
+15 ;user
WRITE ?17,$EXTRACT($PIECE($GET(^VA(200,ABMUSER,0)),U),1,17)
+16 ;old value
WRITE ?35,$EXTRACT($PIECE($GET(^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)),U),1,22)
+17 ;new value
WRITE ?58,$EXTRACT($PIECE($GET(^TMP($JOB,"ABM-AUDR",ABMFILE,ABMFIELD,ABMSDT,ABMUSER)),U,2),1,22)
End DoDot:4
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:3
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:2
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+18 KILL ^TMP($JOB,"ABM-AUDR")
+19 QUIT
LOC ;EP
+1 WRITE !
KILL DIC,ABMY("LOC")
+2 SET DIC="^BAR(90052.05,DUZ(2),"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select LOCATION: "
+5 DO ^DIC
KILL DIC
+6 IF +Y<1
QUIT
+7 SET ABMY("LOC")=+Y
+8 QUIT
DT ;EP
+1 KILL DIR,ABMY("DT")
+2 IF $DATA(DIRUT)
QUIT
+3 SET ABMY("DT")="E"
+4 SET Y="EDIT DATE"
+5 WRITE !!," ============ Entry of ",Y," Range =============",!
+6 SET DIR("A")="Enter STARTING "_Y_" for the Report"
+7 SET DIR(0)="DO^::EP"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
GOTO DT
+10 SET ABMY("DT",1)=Y
+11 WRITE !
+12 SET DIR("A")="Enter ENDING DATE for the Report"
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DIRUT)
GOTO DT
+16 SET ABMY("DT",2)=Y
+17 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DT
+18 QUIT
XIT ;
+1 KILL ABMY("I"),ABMY("X"),DIR
+2 QUIT
HDR ;
+1 IF $DATA(ABMY("LOC"))
SET ABM("TXT")=$PIECE(^DIC(4,ABMY("LOC"),0),U)
SET ABM("CONJ")="at "
DO CHK
+2 ;no dates
IF $GET(ABMY("DT",1))=""
QUIT
+3 SET ABM("CONJ")="with "
+4 SET ABM("TXT")="Edit Date"
DO CHK
+5 SET ABM("CONJ")="from "
SET ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",1))
DO CHK
+6 SET ABM("CONJ")="to "
SET ABM("TXT")=$$SDT^ABMDUTL(ABMY("DT",2))
DO CHK
+7 QUIT
WHD ;EP for writing Report Header
+1 WRITE $$EN^ABMVDF("IOF"),!
+2 IF $DATA(ABM("PRIVACY"))
WRITE ?($SELECT($DATA(ABM(132)):34,1:8)),"WARNING: Confidential Patient Information, Privacy Act Applies",!
+3 KILL ABM("LINE")
SET $PIECE(ABM("LINE"),"=",$SELECT($DATA(ABM(132)):132,1:80))=""
WRITE ABM("LINE"),!
+4 WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):108,1:57)
SET Y=DT
XECUTE ^DD("DD")
WRITE Y," Page ",ABM("PG")
+5 IF $GET(ABM("HD",1))]""
WRITE !,ABM("HD",1)
+6 IF $GET(ABM("HD",2))]""
WRITE !,ABM("HD",2)
+7 WRITE !,ABM("LINE")
KILL ABM("LINE")
+8 QUIT
CHK IF ($LENGTH(ABM("HD",ABM("LVL")))+1+$LENGTH(ABM("CONJ"))+$LENGTH(ABM("TXT")))<($SELECT($DATA(ABM(132)):104,1:52)+$SELECT(ABM("LVL")>0:28,1:0))
SET ABM("HD",ABM("LVL"))=ABM("HD",ABM("LVL"))_" "_ABM("CONJ")_ABM("TXT")
+1 IF '$TEST
SET ABM("LVL")=ABM("LVL")+1
SET ABM("HD",ABM("LVL"))=ABM("CONJ")_ABM("TXT")
+2 QUIT
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB SET ABM("PG")=+$GET(ABM("PG"))+1
DO WHD
+1 WRITE !,"Date/Time",?17,"User",?35,"Old Value",?58,"New Value"
+2 SET $PIECE(ABM("LINE"),"-",80)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+3 QUIT
