ACRFRCA ;IHS/OIRM/DSD/THL,AEF - REQUEST CONTROLLER AUDIT REPORTING; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;UTILITY TO PRINT REQUEST SIGNATURE AUDIT REPORT
EN F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACRDOCDA,ACRAPDA,ACRQUIT,ACROUT,ACRRTN,ACRBEGIN,ACRBEG,ACREND,ACRAP0,ACRDOC,ACRREF,ACRREFDA,ACRDATE,ACRLIST,ACRRCODE,ACRRREF,ACRREQST,ACRDOC2
K ^TMP("ACRRCA",$J)
Q
EN1 D HEAD
W !!,"Select range of dates for documents to include"
W !,"on the FINAL SIGNATURE AUDIT REPORT:"
W !
D DATES^ACRFDATE
Q:$D(ACRQUIT)!$D(ACROUT)
I '$G(ACRBEGIN) S ACRQUIT="" Q
D LIST
Q:$D(ACRQUIT)!$D(ACROUT)
D ZIS
Q
ZIS ;
S (ZTRTN,ACRRTN)="PRINT^ACRFRCA",ZTDESC="FINAL SIGNATURE AUDIT REPORT",ZTDTH=$H
D ^ACRFZIS
Q
PRINT ;EP;TO PRINT AUDIT REPORT
K ^TMP("ACRRCA",$J)
D:ACRLIST="LIST" PHEAD
S ACRBEG=ACRBEGIN-.001,ACREND=ACREND+.999999
F S ACRBEG=$O(^ACRAPVS("F",ACRBEG)) Q:'ACRBEG!(ACRBEG>ACREND)!$D(ACRQUIT)!$D(ACROUT) D
.S ACRAPDA=0
.F S ACRAPDA=$O(^ACRAPVS("F",ACRBEG,ACRAPDA)) Q:'ACRAPDA!(ACRBEG>ACREND)!$D(ACRQUIT)!$D(ACROUT) I $P($G(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y" S ACRAP0=^(0),ACRDATE=$P($P(^("DT"),U,4),".") D:ACRDATE
..Q:'$D(^ACRDOC(+ACRAP0,0))
..S ACRREFDA=$P(ACRAP0,U,6)
..I ACRREFDA S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
..E S ACRREF=999
..S ACRDOC=$S(ACRREF'=103&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210):$P(^ACRDOC(+ACRAP0,0),U),$P(^ACRDOC(+ACRAP0,0),U,2)]"":$P(^(0),U,2),1:$P(^ACRDOC(+ACRAP0,0),U))
..S ^TMP("ACRRCA",$J,ACRDATE,ACRREF,ACRDOC,ACRAPDA)=+ACRAP0
S ACRDATE=0
F S ACRDATE=$O(^TMP("ACRRCA",$J,ACRDATE)) Q:'ACRDATE!$D(ACRQUIT)!$D(ACROUT) D
.S ACRRREF=0
.F S ACRRREF=$O(^TMP("ACRRCA",$J,ACRDATE,ACRRREF)) Q:'ACRRREF!$D(ACRQUIT)!$D(ACROUT) D
..I ACRRCODE'="ALL",ACRRCODE'=ACRRREF Q
..W:ACRLIST="LIST" !!,"REFERENCE CODE: ",ACRRREF
..S ACRDOC2=""
..F S ACRDOC2=$O(^TMP("ACRRCA",$J,ACRDATE,ACRRREF,ACRDOC2)) Q:ACRDOC2=""!$D(ACRQUIT)!$D(ACROUT) D
...S ACRAPDA=0
...F S ACRAPDA=$O(^TMP("ACRRCA",$J,ACRDATE,ACRRREF,ACRDOC2,ACRAPDA)) Q:'ACRAPDA!$D(ACRQUIT)!$D(ACROUT) I $P($G(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y" D
....S D0=$S(ACRLIST="LIST":ACRAPDA,1:+$G(^ACRAPVS(ACRAPDA,0)))
....I ACRLIST="DOCUMENTS" S ACRREQST="",ACRREFX=ACRRREF,ACRDOCDA=D0 D ^ACRFQ Q
....I ACRLIST="LIST" D ^ACRPRCA
....I ACRLIST["^DHR" D
.....S ACRDOCDA=+^ACRAPVS(ACRAPDA,0)
.....Q:$E(^ACROBL(ACRDOCDA,"APV"))'="A"
.....D SETDOC^ACRFEA1
.....S (ACRREF,ACRREFX)=ACRRREF
.....N ACRRCODE
.....D ^ACRFDHR
.....W !!,"NEW DHR CREATED."
....I $G(IOSL)-5<$Y D PAUSE^ACRFWARN,PHEAD:'$D(ACRQUIT)&'$D(ACROUT)
I ACRLIST="LIST",$E($G(IOST),1,2)="C-" W !,"END OF REPORT..." D PAUSE^ACRFWARN
K ACRQUIT
Q
PHEAD ;
D HEAD,H1
W !!,"DOCUMENT NO."
W ?17,"STATUS"
W ?26,"NAME"
W ?48,"DATE"
W ?58,"TYPE OF APPROVAL"
W !,"--------------- ------- -------------------- -------- -----------------"
Q
HEAD ;REPORT HEADER
W @IOF
W !?20,"****************************"
W !?20,"FINAL SIGNATURE 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,"SIGNATURES STARTING: ",Y
S Y=ACREND
X ^DD("DD")
W !?20,"SIGNATURES ENDING..: ",Y
Q
LIST ;DETERMINE IF LIST OF DOCUMENTS OR ALL DOCUMENTS SHOULD BE PRINTED
S DIR(0)="SO^1:Print List of Signed Documents;2:Print a copy of each Signed Document"
S DIR("A")="Which print option"
S DIR("B")=1
W !
D DIR^ACRFDIC
I $G(Y)'=1&($G(Y)'=2) S ACRQUIT="" Q
S ACRLIST=$S(Y=1:"LIST",1:"DOCUMENTS")
S DIR(0)="SO^1:Print "_ACRLIST_" for ALL Reference Codes;2:Print "_ACRLIST_" for one Reference code only"
S DIR("B")=1
W !
D DIR^ACRFDIC
I $G(Y)'=1&($G(Y)'=2) S ACRQUIT="" Q
S ACRRCODE=$S(Y=1:"ALL",1:"")
I $D(ACRDHRZ) S ACRLIST=ACRLIST_"^DHR"
Q:ACRRCODE="ALL"
S DIR(0)="SO^116:REQUISITION;103:PURCHASE ORDER;349:CONTRACT;326:TRIBAL CONTRACT;210:FEDSTRIP/SUPPLY CENTER ORDER;130:TRAVEL ORDER;600:TRAVEL VOUCHER;148:TRAINING REQUEST"
S DIR("A")="Which REFERENCE CODE"
W !
D DIR^ACRFDIC
I $G(Y)'?3N S ACRQUIT="" Q
S ACRRCODE=Y
Q
ACRFRCA ;IHS/OIRM/DSD/THL,AEF - REQUEST CONTROLLER AUDIT REPORTING; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;UTILITY TO PRINT REQUEST SIGNATURE AUDIT REPORT
EN FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACRDOCDA,ACRAPDA,ACRQUIT,ACROUT,ACRRTN,ACRBEGIN,ACRBEG,ACREND,ACRAP0,ACRDOC,ACRREF,ACRREFDA,ACRDATE,ACRLIST,ACRRCODE,ACRRREF,ACRREQST,ACRDOC2
+1 KILL ^TMP("ACRRCA",$JOB)
+2 QUIT
EN1 DO HEAD
+1 WRITE !!,"Select range of dates for documents to include"
+2 WRITE !,"on the FINAL SIGNATURE AUDIT REPORT:"
+3 WRITE !
+4 DO DATES^ACRFDATE
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 IF '$GET(ACRBEGIN)
SET ACRQUIT=""
QUIT
+7 DO LIST
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 DO ZIS
+10 QUIT
ZIS ;
+1 SET (ZTRTN,ACRRTN)="PRINT^ACRFRCA"
SET ZTDESC="FINAL SIGNATURE AUDIT REPORT"
SET ZTDTH=$HOROLOG
+2 DO ^ACRFZIS
+3 QUIT
PRINT ;EP;TO PRINT AUDIT REPORT
+1 KILL ^TMP("ACRRCA",$JOB)
+2 IF ACRLIST="LIST"
DO PHEAD
+3 SET ACRBEG=ACRBEGIN-.001
SET ACREND=ACREND+.999999
+4 FOR
SET ACRBEG=$ORDER(^ACRAPVS("F",ACRBEG))
IF 'ACRBEG!(ACRBEG>ACREND)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+5 SET ACRAPDA=0
+6 FOR
SET ACRAPDA=$ORDER(^ACRAPVS("F",ACRBEG,ACRAPDA))
IF 'ACRAPDA!(ACRBEG>ACREND)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
IF $PIECE($GET(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y"
SET ACRAP0=^(0)
SET ACRDATE=$PIECE($PIECE(^("DT"),U,4),".")
IF ACRDATE
Begin DoDot:2
+7 IF '$DATA(^ACRDOC(+ACRAP0,0))
QUIT
+8 SET ACRREFDA=$PIECE(ACRAP0,U,6)
+9 IF ACRREFDA
SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
+10 IF '$TEST
SET ACRREF=999
+11 SET ACRDOC=$SELECT(ACRREF'=103&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210):$PIECE(^ACRDOC(+ACRAP0,0),U),$PIECE(^ACRDOC(+ACRAP0,0),U,2)]"":$PIECE(^(0),U,2),1:$PIECE(^ACRDOC(+ACRAP0,0),U))
+12 SET ^TMP("ACRRCA",$JOB,ACRDATE,ACRREF,ACRDOC,ACRAPDA)=+ACRAP0
End DoDot:2
End DoDot:1
+13 SET ACRDATE=0
+14 FOR
SET ACRDATE=$ORDER(^TMP("ACRRCA",$JOB,ACRDATE))
IF 'ACRDATE!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+15 SET ACRRREF=0
+16 FOR
SET ACRRREF=$ORDER(^TMP("ACRRCA",$JOB,ACRDATE,ACRRREF))
IF 'ACRRREF!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+17 IF ACRRCODE'="ALL"
IF ACRRCODE'=ACRRREF
QUIT
+18 IF ACRLIST="LIST"
WRITE !!,"REFERENCE CODE: ",ACRRREF
+19 SET ACRDOC2=""
+20 FOR
SET ACRDOC2=$ORDER(^TMP("ACRRCA",$JOB,ACRDATE,ACRRREF,ACRDOC2))
IF ACRDOC2=""!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:3
+21 SET ACRAPDA=0
+22 FOR
SET ACRAPDA=$ORDER(^TMP("ACRRCA",$JOB,ACRDATE,ACRRREF,ACRDOC2,ACRAPDA))
IF 'ACRAPDA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
IF $PIECE($GET(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y"
Begin DoDot:4
+23 SET D0=$SELECT(ACRLIST="LIST":ACRAPDA,1:+$GET(^ACRAPVS(ACRAPDA,0)))
+24 IF ACRLIST="DOCUMENTS"
SET ACRREQST=""
SET ACRREFX=ACRRREF
SET ACRDOCDA=D0
DO ^ACRFQ
QUIT
+25 IF ACRLIST="LIST"
DO ^ACRPRCA
+26 IF ACRLIST["^DHR"
Begin DoDot:5
+27 SET ACRDOCDA=+^ACRAPVS(ACRAPDA,0)
+28 IF $EXTRACT(^ACROBL(ACRDOCDA,"APV"))'="A"
QUIT
+29 DO SETDOC^ACRFEA1
+30 SET (ACRREF,ACRREFX)=ACRRREF
+31 NEW ACRRCODE
+32 DO ^ACRFDHR
+33 WRITE !!,"NEW DHR CREATED."
End DoDot:5
+34 IF $GET(IOSL)-5<$Y
DO PAUSE^ACRFWARN
IF '$DATA(ACRQUIT)&'$DATA(ACROUT)
DO PHEAD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 IF ACRLIST="LIST"
IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE !,"END OF REPORT..."
DO PAUSE^ACRFWARN
+36 KILL ACRQUIT
+37 QUIT
PHEAD ;
+1 DO HEAD
DO H1
+2 WRITE !!,"DOCUMENT NO."
+3 WRITE ?17,"STATUS"
+4 WRITE ?26,"NAME"
+5 WRITE ?48,"DATE"
+6 WRITE ?58,"TYPE OF APPROVAL"
+7 WRITE !,"--------------- ------- -------------------- -------- -----------------"
+8 QUIT
HEAD ;REPORT HEADER
+1 WRITE @IOF
+2 WRITE !?20,"****************************"
+3 WRITE !?20,"FINAL SIGNATURE 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,"SIGNATURES STARTING: ",Y
+6 SET Y=ACREND
+7 XECUTE ^DD("DD")
+8 WRITE !?20,"SIGNATURES ENDING..: ",Y
+9 QUIT
LIST ;DETERMINE IF LIST OF DOCUMENTS OR ALL DOCUMENTS SHOULD BE PRINTED
+1 SET DIR(0)="SO^1:Print List of Signed Documents;2:Print a copy of each Signed Document"
+2 SET DIR("A")="Which print option"
+3 SET DIR("B")=1
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $GET(Y)'=1&($GET(Y)'=2)
SET ACRQUIT=""
QUIT
+7 SET ACRLIST=$SELECT(Y=1:"LIST",1:"DOCUMENTS")
+8 SET DIR(0)="SO^1:Print "_ACRLIST_" for ALL Reference Codes;2:Print "_ACRLIST_" for one Reference code only"
+9 SET DIR("B")=1
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF $GET(Y)'=1&($GET(Y)'=2)
SET ACRQUIT=""
QUIT
+13 SET ACRRCODE=$SELECT(Y=1:"ALL",1:"")
+14 IF $DATA(ACRDHRZ)
SET ACRLIST=ACRLIST_"^DHR"
+15 IF ACRRCODE="ALL"
QUIT
+16 SET DIR(0)="SO^116:REQUISITION;103:PURCHASE ORDER;349:CONTRACT;326:TRIBAL CONTRACT;210:FEDSTRIP/SUPPLY CENTER ORDER;130:TRAVEL ORDER;600:TRAVEL VOUCHER;148:TRAINING REQUEST"
+17 SET DIR("A")="Which REFERENCE CODE"
+18 WRITE !
+19 DO DIR^ACRFDIC
+20 IF $GET(Y)'?3N
SET ACRQUIT=""
QUIT
+21 SET ACRRCODE=Y
+22 QUIT
