ABMAUDRP.m

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