- 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
