ACRFTVA ;IHS/OIRM/DSD/THL,AEF - TRAVEL VOUCHER AUDIT REPORT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;UTILITY TO PRINT TRAVEL VOUCHER AUDIT LIST
EN D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACRDOCDA,ACRQUIT,ACROUT,ACRRTN,ACRBEGIN,ACRBEG,ACREND,ACRDOC0,ACRDOC,ACRREF,ACRREFX,ACRREFDA,ACRDDATE,ACRLIST,ACRRCODE,ACRRREF,ACRREQST,ACRPERC,ACRMIN,ACRSTART,ACRRDATE,ACRINTRV,ACRLAST,ACRQUIT,ACROUT,ACRTVAI,ACRTVAJ,ACRWATCH
K ^TMP("ACRTVA",$J)
Q
EN1 D HEAD
I '$O(^ACRSYS(1)) S ACRADA=1
E D AREA^ACRFAS
Q:'$G(ACRADA)
W !!,"Select range of dates for documents to include"
W !,"on the TRAVEL VOUCHER AUDIT LIST:"
W !
D DATES^ACRFDATE
Q:$D(ACRQUIT)!$D(ACROUT)
I '$G(ACRBEGIN) S ACRQUIT="" Q
D COUNT
Q:$D(ACRQUIT)!$D(ACROUT)
D LIST
Q:$D(ACRQUIT)!$D(ACROUT)
S ZTDESC="TRAVEL VOUCHER AUDIT LIST"
S ZTDTH=$H
D ^ACRFZIS
Q
PALL ;
F ACRLIST="LIST","DOCUMENTS" D PRINT
D EXIT
Q
PRINT ;EP;TO PRINT AUDIT REPORT
D:ACRLIST="LIST" PHEAD
S ACRLAST=ACRJ
S ACRTVAI=1
F ACRTVAJ=ACRSTART:ACRINTRV:ACRLAST Q:ACRTVAI>ACRMIN!$D(ACRQUIT)!$D(ACROUT) D
.S ACRDDATE=$O(^TMP("ACRTVA",$J,ACRTVAJ,""))
.Q:ACRDDATE=""
.S ACRDOCDA=$O(^TMP("ACRTVA",$J,ACRTVAJ,ACRDDATE,""))
.Q:ACRDOCDA=""
.S D0=ACRDOCDA
.S ACRTVAI=ACRTVAI+1
.I ACRLIST="DOCUMENTS" D Q
..S ACRREQST=""
..S (ACRREFX,ACRREF)=600
..D ^ACRFQ
.I ACRLIST="LIST" D ^ACRPTVA
.I $G(IOSL)-5<$Y D
..D PAUSE^ACRFWARN
..D PHEAD:'$D(ACRQUIT)&'$D(ACROUT)
S ACRWATCH=""
D PAUSE^ACRFWARN
D PHEAD
S ACRTVAJ=""
F S ACRTVAJ=$O(^TMP("ACRTVA",$J,ACRTVAJ)) Q:ACRTVAJ=""!$D(ACROUT)!$D(ACRQUIT) D
.S ACRDATE=0
.F S ACRDDATE=$O(^TMP("ACRTVA",$J,ACRTVAJ,ACRDDATE)) Q:ACRDDATE=""!$D(ACROUT)!$D(ACRQUIT) D
..S ACRDOCDA=0
..F S ACRDOCDA=$O(^TMP("ACRTVA",$J,ACRTVAJ,ACRDDATE,ACRDOCDA)) Q:'ACRDOCDA D
...S D0=ACRDOCDA
...S ACRDUZ=$P($G(^ACRDOC(ACRDOCDA,"TO")),U,9)
...Q:$P($G(^ACRAU(+ACRDUZ,1)),U,12)'=1
...I ACRLIST="DOCUMENTS" D Q
....S ACRREQST=""
....S (ACRREFX,ACRREF)=600
....D ^ACRFQ
...I ACRLIST="LIST" D ^ACRPTVA
...I $G(IOSL)-5<$Y D
....D PAUSE^ACRFWARN
....D PHEAD:'$D(ACRQUIT)&'$D(ACROUT)
I ACRLIST="LIST",$E($G(IOST),1,2)="C-" D
.W !,"END OF REPORT..."
.D PAUSE^ACRFWARN
D:ACRRTN["PRINT" EXIT
W @IOF
Q
PHEAD ;
D HEAD,H1
W:$D(ACRWATCH) !!,"AUDIT WATCH LISTING"
W !!,"DOCUMENT NO."
W ?19,"TRAVELER"
W ?51,"DEPART"
W ?62,"RETURN"
W !,"---------------"
W ?19,"------------------------------"
W ?51,"--------"
W ?62,"--------"
Q
HEAD ;REPORT HEADER
W @IOF
W !?20,"***************************"
W !?20,"TRAVEL VOUCHER AUDIT REPORT"
W !?20,"***************************"
Q
H1 S Y=DT
X ^DD("DD")
W !?20,"REPORT DATE............: ",Y
S Y=ACRBEGIN
X ^DD("DD")
W !?20,"FIRST TRAVEL START DATE: ",Y
S Y=ACREND
X ^DD("DD")
W !?20,"LAST TRAVEL START DATE.: ",Y
Q
LIST ;DETERMINE IF LIST OF DOCUMENTS OR ALL DOCUMENTS SHOULD BE PRINTED
S DIR(0)="SO^1:Print List of Documents;2:Print a copy of each Document;3:Print BOTH the List AND Each Document"
S DIR("A")="Which print option"
S DIR("B")=1
W !
D DIR^ACRFDIC
I '$G(Y) S ACRQUIT="" Q
S ACRLIST=$S(Y=1:"LIST",Y=3:"ALL",1:"DOCUMENTS")
S (ACRRTN,ZTRTN)=$S(Y'=3:"PRINT^ACRFTVA",1:"PALL^ACRFTVA")
Q
COUNT ;COUNT NUMBER OF TV'S
W !!
K ^TMP("ACRTVA",$J)
S ACRBEG=ACRBEGIN-.001
S ACREND=ACREND+.999999
S ACRJ=0
F S ACRBEG=$O(^ACRDOC("DD",ACRBEG)) Q:'ACRBEG!(ACRBEG>ACREND)!$D(ACRQUIT)!$D(ACROUT) D
.S ACRDOCDA=0
.F S ACRDOCDA=$O(^ACRDOC("DD",ACRBEG,ACRDOCDA)) Q:'ACRDOCDA!(ACRBEG>ACREND)!$D(ACRQUIT)!$D(ACROUT) I $P($G(^ACROBL(ACRDOCDA,"APV")),U,8)="A" D
..S ACRDOC0=^ACRDOC(ACRDOCDA,0)
..Q:'$P(ACRDOC0,U,8)
..Q:ACRADA'=$P($G(^ACRPO(+$P(ACRDOC0,U,8),0)),U,19)
..S ACRDDATE=$P($P(^ACRDOC(ACRDOCDA,"TO"),U,14),".")
..S ACRRDATE=$P($P(^ACRDOC(ACRDOCDA,"TO"),U,15),".")
..Q:'ACRDDATE
..Q:$P(ACRDOC0,U,15)
..S ACRJ=ACRJ+1
..S ^TMP("ACRTVA",$J,ACRJ,ACRDDATE,ACRDOCDA)=""
..W "."
W !!,"There are ",$S(ACRJ:ACRJ,1:"NO")," Signed Vouchers within the specified date range"
I ACRJ=0 D Q
.W !
.D PAUSE^ACRFWARN
.S ACRQUIT=""
S DIR(0)="SO^1:10;2:20;3:33;4:50;5:100"
S DIR("A")="Percent of Vouchers to Audit"
S DIR("B")=2
W !
D DIR^ACRFDIC
I '$G(Y) S ACRQUIT="" Q
S ACRPERC=Y(0)
S ACRMIN=$P(ACRJ*ACRPERC/100,".")
W !!,ACRMIN," documents will be selected for this audit list."
RANDOM I ACRPERC=100 S (ACRSTART,ACRINTRV)=1 Q
S ACRSTART=$R($S(ACRPERC=10:10,ACRPERC=20:5,ACRPERC=33:3,ACRPERC=50:2,1:1))
G:'ACRSTART RANDOM
S ACRINTRV=$S(ACRPERC=10:10,ACRPERC=20:5,ACRPERC=33:3,ACRPERC=50:2,1:1)
Q
ACRFTVA ;IHS/OIRM/DSD/THL,AEF - TRAVEL VOUCHER AUDIT REPORT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;UTILITY TO PRINT TRAVEL VOUCHER AUDIT LIST
EN DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACRDOCDA,ACRQUIT,ACROUT,ACRRTN,ACRBEGIN,ACRBEG,ACREND,ACRDOC0,ACRDOC,ACRREF,ACRREFX,ACRREFDA,ACRDDATE,ACRLIST,ACRRCODE,ACRRREF,ACRREQST,ACRPERC,ACRMIN,ACRSTART,ACRRDATE,ACRINTRV,ACRLAST,ACRQUIT,ACROUT,ACRTVAI,ACRTVAJ,ACRWATCH
+1 KILL ^TMP("ACRTVA",$JOB)
+2 QUIT
EN1 DO HEAD
+1 IF '$ORDER(^ACRSYS(1))
SET ACRADA=1
+2 IF '$TEST
DO AREA^ACRFAS
+3 IF '$GET(ACRADA)
QUIT
+4 WRITE !!,"Select range of dates for documents to include"
+5 WRITE !,"on the TRAVEL VOUCHER AUDIT LIST:"
+6 WRITE !
+7 DO DATES^ACRFDATE
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 IF '$GET(ACRBEGIN)
SET ACRQUIT=""
QUIT
+10 DO COUNT
+11 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 DO LIST
+13 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+14 SET ZTDESC="TRAVEL VOUCHER AUDIT LIST"
+15 SET ZTDTH=$HOROLOG
+16 DO ^ACRFZIS
+17 QUIT
PALL ;
+1 FOR ACRLIST="LIST","DOCUMENTS"
DO PRINT
+2 DO EXIT
+3 QUIT
PRINT ;EP;TO PRINT AUDIT REPORT
+1 IF ACRLIST="LIST"
DO PHEAD
+2 SET ACRLAST=ACRJ
+3 SET ACRTVAI=1
+4 FOR ACRTVAJ=ACRSTART:ACRINTRV:ACRLAST
IF ACRTVAI>ACRMIN!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+5 SET ACRDDATE=$ORDER(^TMP("ACRTVA",$JOB,ACRTVAJ,""))
+6 IF ACRDDATE=""
QUIT
+7 SET ACRDOCDA=$ORDER(^TMP("ACRTVA",$JOB,ACRTVAJ,ACRDDATE,""))
+8 IF ACRDOCDA=""
QUIT
+9 SET D0=ACRDOCDA
+10 SET ACRTVAI=ACRTVAI+1
+11 IF ACRLIST="DOCUMENTS"
Begin DoDot:2
+12 SET ACRREQST=""
+13 SET (ACRREFX,ACRREF)=600
+14 DO ^ACRFQ
End DoDot:2
QUIT
+15 IF ACRLIST="LIST"
DO ^ACRPTVA
+16 IF $GET(IOSL)-5<$Y
Begin DoDot:2
+17 DO PAUSE^ACRFWARN
+18 IF '$DATA(ACRQUIT)&'$DATA(ACROUT)
DO PHEAD
End DoDot:2
End DoDot:1
+19 SET ACRWATCH=""
+20 DO PAUSE^ACRFWARN
+21 DO PHEAD
+22 SET ACRTVAJ=""
+23 FOR
SET ACRTVAJ=$ORDER(^TMP("ACRTVA",$JOB,ACRTVAJ))
IF ACRTVAJ=""!$DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+24 SET ACRDATE=0
+25 FOR
SET ACRDDATE=$ORDER(^TMP("ACRTVA",$JOB,ACRTVAJ,ACRDDATE))
IF ACRDDATE=""!$DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+26 SET ACRDOCDA=0
+27 FOR
SET ACRDOCDA=$ORDER(^TMP("ACRTVA",$JOB,ACRTVAJ,ACRDDATE,ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:3
+28 SET D0=ACRDOCDA
+29 SET ACRDUZ=$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,9)
+30 IF $PIECE($GET(^ACRAU(+ACRDUZ,1)),U,12)'=1
QUIT
+31 IF ACRLIST="DOCUMENTS"
Begin DoDot:4
+32 SET ACRREQST=""
+33 SET (ACRREFX,ACRREF)=600
+34 DO ^ACRFQ
End DoDot:4
QUIT
+35 IF ACRLIST="LIST"
DO ^ACRPTVA
+36 IF $GET(IOSL)-5<$Y
Begin DoDot:4
+37 DO PAUSE^ACRFWARN
+38 IF '$DATA(ACRQUIT)&'$DATA(ACROUT)
DO PHEAD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 IF ACRLIST="LIST"
IF $EXTRACT($GET(IOST),1,2)="C-"
Begin DoDot:1
+40 WRITE !,"END OF REPORT..."
+41 DO PAUSE^ACRFWARN
End DoDot:1
+42 IF ACRRTN["PRINT"
DO EXIT
+43 WRITE @IOF
+44 QUIT
PHEAD ;
+1 DO HEAD
DO H1
+2 IF $DATA(ACRWATCH)
WRITE !!,"AUDIT WATCH LISTING"
+3 WRITE !!,"DOCUMENT NO."
+4 WRITE ?19,"TRAVELER"
+5 WRITE ?51,"DEPART"
+6 WRITE ?62,"RETURN"
+7 WRITE !,"---------------"
+8 WRITE ?19,"------------------------------"
+9 WRITE ?51,"--------"
+10 WRITE ?62,"--------"
+11 QUIT
HEAD ;REPORT HEADER
+1 WRITE @IOF
+2 WRITE !?20,"***************************"
+3 WRITE !?20,"TRAVEL VOUCHER AUDIT REPORT"
+4 WRITE !?20,"***************************"
+5 QUIT
H1 SET Y=DT
+1 XECUTE ^DD("DD")
+2 WRITE !?20,"REPORT DATE............: ",Y
+3 SET Y=ACRBEGIN
+4 XECUTE ^DD("DD")
+5 WRITE !?20,"FIRST TRAVEL START DATE: ",Y
+6 SET Y=ACREND
+7 XECUTE ^DD("DD")
+8 WRITE !?20,"LAST TRAVEL START DATE.: ",Y
+9 QUIT
LIST ;DETERMINE IF LIST OF DOCUMENTS OR ALL DOCUMENTS SHOULD BE PRINTED
+1 SET DIR(0)="SO^1:Print List of Documents;2:Print a copy of each Document;3:Print BOTH the List AND Each Document"
+2 SET DIR("A")="Which print option"
+3 SET DIR("B")=1
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF '$GET(Y)
SET ACRQUIT=""
QUIT
+7 SET ACRLIST=$SELECT(Y=1:"LIST",Y=3:"ALL",1:"DOCUMENTS")
+8 SET (ACRRTN,ZTRTN)=$SELECT(Y'=3:"PRINT^ACRFTVA",1:"PALL^ACRFTVA")
+9 QUIT
COUNT ;COUNT NUMBER OF TV'S
+1 WRITE !!
+2 KILL ^TMP("ACRTVA",$JOB)
+3 SET ACRBEG=ACRBEGIN-.001
+4 SET ACREND=ACREND+.999999
+5 SET ACRJ=0
+6 FOR
SET ACRBEG=$ORDER(^ACRDOC("DD",ACRBEG))
IF 'ACRBEG!(ACRBEG>ACREND)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+7 SET ACRDOCDA=0
+8 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("DD",ACRBEG,ACRDOCDA))
IF 'ACRDOCDA!(ACRBEG>ACREND)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U,8)="A"
Begin DoDot:2
+9 SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
+10 IF '$PIECE(ACRDOC0,U,8)
QUIT
+11 IF ACRADA'=$PIECE($GET(^ACRPO(+$PIECE(ACRDOC0,U,8),0)),U,19)
QUIT
+12 SET ACRDDATE=$PIECE($PIECE(^ACRDOC(ACRDOCDA,"TO"),U,14),".")
+13 SET ACRRDATE=$PIECE($PIECE(^ACRDOC(ACRDOCDA,"TO"),U,15),".")
+14 IF 'ACRDDATE
QUIT
+15 IF $PIECE(ACRDOC0,U,15)
QUIT
+16 SET ACRJ=ACRJ+1
+17 SET ^TMP("ACRTVA",$JOB,ACRJ,ACRDDATE,ACRDOCDA)=""
+18 WRITE "."
End DoDot:2
End DoDot:1
+19 WRITE !!,"There are ",$SELECT(ACRJ:ACRJ,1:"NO")," Signed Vouchers within the specified date range"
+20 IF ACRJ=0
Begin DoDot:1
+21 WRITE !
+22 DO PAUSE^ACRFWARN
+23 SET ACRQUIT=""
End DoDot:1
QUIT
+24 SET DIR(0)="SO^1:10;2:20;3:33;4:50;5:100"
+25 SET DIR("A")="Percent of Vouchers to Audit"
+26 SET DIR("B")=2
+27 WRITE !
+28 DO DIR^ACRFDIC
+29 IF '$GET(Y)
SET ACRQUIT=""
QUIT
+30 SET ACRPERC=Y(0)
+31 SET ACRMIN=$PIECE(ACRJ*ACRPERC/100,".")
+32 WRITE !!,ACRMIN," documents will be selected for this audit list."
RANDOM IF ACRPERC=100
SET (ACRSTART,ACRINTRV)=1
QUIT
+1 SET ACRSTART=$RANDOM($SELECT(ACRPERC=10:10,ACRPERC=20:5,ACRPERC=33:3,ACRPERC=50:2,1:1))
+2 IF 'ACRSTART
GOTO RANDOM
+3 SET ACRINTRV=$SELECT(ACRPERC=10:10,ACRPERC=20:5,ACRPERC=33:3,ACRPERC=50:2,1:1)
+4 QUIT
