- 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
