ACRFDC ;IHS/OIRM/DSD/THL,AEF - UTILITY TO COUNT DOCUMENTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;UTILITY TO DISPLAY COUNTS OF DOCUMENTS FOR A FISCAL YEAR
EN D EN1
EXIT K ACRX,ACR0,ACRAMT,ACRAREA,ACRFY,ACRI,ACRY,ACRZ,ACRQUIT,ACRTOTN,ACRRAMT,ACRSIGS,ACRREC,ACRAPDA,ACRQUIT,ACROUT
Q
EN1 D FY
Q:$D(ACROUT)!$D(ACRQUIT)
D AREA:$O(^ACRSYS(1))
Q:$D(ACROUT)!$D(ACRQUIT)
D ZIS
Q
FY ;EP;
S DIR(0)="SO^1:Specify Fiscal Year;2:All Documents/All Years"
S DIR("A")="Which one"
S DIR("B")="Specify Fiscal Year"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!(Y<1) S ACRQUIT="" Q
I Y=2 S ACRFY="ALL" Q
S ACRFY=$E(DT,4,5)
S ACRFY=$S(ACRFY<10:$E(DT,1,3),1:$E(DT,1,3)+1),ACRFY=ACRFY+1700
S DIR(0)="N0A^1000:9999"
S DIR("A")="Fiscal year: ",DIR("B")=ACRFY
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!(Y'?4N) S ACRQUIT="" Q
S ACRFY=Y
Q
AREA ;SELECT AREA OF REPORT
W !!?10,"NO.",?15,"AREA"
W !?10,"---",?15,"--------------------"
N ACRX,Y,Z
S (ACRX,Z)=0
F S ACRX=$O(^ACRSYS(ACRX)) Q:'ACRX D
.S Y=$P(^ACRSYS(ACRX,0),U)
.S Y=$P(^AUTTAREA(Y,0),U)
.S Z=Z+1
.S Z(Z)=ACRX
.W !?10,Z,?15,Y
S DIR(0)="NO^1:"_Z
S DIR("A")="Report for which Area"
S DIR("A",1)="(Leave blank to report for all Areas)"
W !
D DIR^ACRFDIC
I +Y<1 K ACRQUIT Q
S ACRAREA=Z(Y)
Q
COUNT ;
S (ACRX,ACRSIGS,ACRREC,ACRRAMT)=0
F ACRX=22,33,35,69,133,53,111 S ACRX(ACRX)=0
F S ACRX=$O(^ACRDOC(ACRX)) Q:'ACRX D
.S ACR0=$G(^ACRDOC(ACRX,0))
.I $D(ACRAREA),ACRAREA'=$P($G(^ACRPO(+$P(ACR0,U,8),0)),U,19) Q
.I ACRFY="ALL"!(ACRFY=+$G(^ACRLOCB(+$P(ACR0,U,6),"DT"))) D
..S ACRZ=$P(ACR0,U,13)
..S:$P(ACR0,U,24) ACRZ=111
..I "^22^33^35^69^133^53^111^"[(U_ACRZ_U) D
...D AMT
...S:ACRZ=69 ACRZ=$S($E($G(^ACROBL(ACRX,"APV")))="A":22,1:33)
...S $P(ACRX(ACRZ),U)=$P(ACRX(ACRZ),U)+1
...S $P(ACRX(ACRZ),U,2)=$P(ACRX(ACRZ),U,2)+ACRAMT
...I ACRZ=22!(ACRZ=111) D
....S $P(ACRX(33),U)=$P(ACRX(33),U)+1
....S $P(ACRX(33),U,2)=$P(ACRX(33),U,2)+ACRAMT
...I ACRZ=133 D
....S $P(ACRX(35),U)=$P(ACRX(35),U)+1
....S $P(ACRX(35),U,2)=$P(ACRX(35),U,2)+ACRAMT
...I ACRFY'="ALL" D
....N J
....S (ACRAPDA,J)=0
....F S ACRAPDA=$O(^ACRAPVS("AB",ACRX,ACRAPDA)) Q:'ACRAPDA S J=J+1
....S ACRSIGS=ACRSIGS+J
I ACRFY="ALL" S ACRSIGS=$P(^ACRAPVS(0),U,4)
Q
AMT S (ACRI,ACRAMT)=0
N X
F S ACRI=$O(^ACRSS("C",ACRX,ACRI)) Q:'ACRI D
.S ACRAMT=ACRAMT+$P($G(^ACRSS(ACRI,"DT")),U,4)
.S X=0
.F S X=$O(^ACRRR("B",ACRI,X)) Q:'X D
..S ACRREC=$G(ACRREC)+1
..S Y=$P($G(^ACRSS(ACRI,"DT")),U,3)*$P($G(^ACRRR(X,"DT")),U,3)
..S ACRRAMT=ACRRAMT+Y
Q
PRINT ;
D COUNT
N X
S X=+$G(^ACRSYS(+$G(ACRAREA),0))
I $G(ACRAREA),X,$D(^AUTTAREA(X,0)) N X S X=^(0) D I 1
.W !?10,$P(X,U)
.W:$P(X,U)'["HEAD" " AREA"
E W !
S Y=DT
X ^DD("DD")
W ?33,"REPORT DATE: ",Y
W !?10,"DOCUMENT SUMMARY"
W ?33,"FISCAL YEAR: ",ACRFY
W !?10,"-----------------------------------------------"
W !?40,"DOLLAR VALUE"
W !?32,"TOTAL"
W ?40,"OF DOCUMENTS"
W !?10,"TYPE OF DOCUMENT"
W ?32,"NUMBER"
W ?40,"PROCESSED"
W !?10,"------------------"
W ?32,"------"
W ?40,"-----------------"
N ACRTOTN,ACRTOTD
S (ACRTOTN,ACRTOTD)=0
F ACRZ=33,22,111,35,133,53 D
.W !?10,$S(ACRZ=33:"REQUISITION",ACRZ=22:"PURCHASE ORDER",ACRZ=111:"CONTRACT ACTIONS",ACRZ=35:"TRAVEL ORDER",ACRZ=53:"TRAINING 350",1:"TRAVEL VOUCHER")
.W ?32,$J($P(ACRX(ACRZ),U),6)
.W ?40,$J($FN($P(ACRX(ACRZ),U,2),"P,",2),18)
.S ACRTOTN=ACRTOTN+$P(ACRX(ACRZ),U)
.S ACRTOTD=ACRTOTD+$P(ACRX(ACRZ),U,2)
S ACRTOTN=ACRTOTN+ACRREC
W !?10,"RECEIVING ACTIONS"
W ?32,$J(ACRREC,6)
W ?40,$J($FN(ACRRAMT,"P,",2),18)
W !?10,"ELECTRONIC SIGNATURES"
W ?32,$J(ACRSIGS,6)
W !?32,"------"
W ?40,"-----------------"
W !?32,$J(ACRTOTN,6)
W ?40,$J($FN(ACRTOTD,"P,",2),18)
D PAUSE^ACRFWARN
W @IOF
Q
ZIS N X
W !!?10
F X=1:1:5 W @ACRON,"NOTE",@ACROF,?$X+5
W !!,"This report takes several minutes to compile and print."
W !,"You should QUEUE the report to print offline."
S ACRRTN="PRINT^ACRFDC"
S ZTDESC="FISCAL YEAR DOCUMENT SUMMARY REPORT"
D ^ACRFZIS
K ACRQUIT
Q
REC ;COUNT NUMBER OF RECEIVING ACTIONS
N X,Y,Z
S (Z,X)=0
F S X=$O(^ACRRR("AC",X)) Q:'X D
.S Y=0
.F S Y=$O(^ACRRR("AC",X,Y)) Q:'Y S Z=Z+1
S ACRREC=Z
Q
ACRFDC ;IHS/OIRM/DSD/THL,AEF - UTILITY TO COUNT DOCUMENTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;UTILITY TO DISPLAY COUNTS OF DOCUMENTS FOR A FISCAL YEAR
EN DO EN1
EXIT KILL ACRX,ACR0,ACRAMT,ACRAREA,ACRFY,ACRI,ACRY,ACRZ,ACRQUIT,ACRTOTN,ACRRAMT,ACRSIGS,ACRREC,ACRAPDA,ACRQUIT,ACROUT
+1 QUIT
EN1 DO FY
+1 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+2 IF $ORDER(^ACRSYS(1))
DO AREA
+3 IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+4 DO ZIS
+5 QUIT
FY ;EP;
+1 SET DIR(0)="SO^1:Specify Fiscal Year;2:All Documents/All Years"
+2 SET DIR("A")="Which one"
+3 SET DIR("B")="Specify Fiscal Year"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACRQUIT)!(Y<1)
SET ACRQUIT=""
QUIT
+7 IF Y=2
SET ACRFY="ALL"
QUIT
+8 SET ACRFY=$EXTRACT(DT,4,5)
+9 SET ACRFY=$SELECT(ACRFY<10:$EXTRACT(DT,1,3),1:$EXTRACT(DT,1,3)+1)
SET ACRFY=ACRFY+1700
+10 SET DIR(0)="N0A^1000:9999"
+11 SET DIR("A")="Fiscal year: "
SET DIR("B")=ACRFY
+12 WRITE !
+13 DO DIR^ACRFDIC
+14 IF $DATA(ACRQUIT)!(Y'?4N)
SET ACRQUIT=""
QUIT
+15 SET ACRFY=Y
+16 QUIT
AREA ;SELECT AREA OF REPORT
+1 WRITE !!?10,"NO.",?15,"AREA"
+2 WRITE !?10,"---",?15,"--------------------"
+3 NEW ACRX,Y,Z
+4 SET (ACRX,Z)=0
+5 FOR
SET ACRX=$ORDER(^ACRSYS(ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+6 SET Y=$PIECE(^ACRSYS(ACRX,0),U)
+7 SET Y=$PIECE(^AUTTAREA(Y,0),U)
+8 SET Z=Z+1
+9 SET Z(Z)=ACRX
+10 WRITE !?10,Z,?15,Y
End DoDot:1
+11 SET DIR(0)="NO^1:"_Z
+12 SET DIR("A")="Report for which Area"
+13 SET DIR("A",1)="(Leave blank to report for all Areas)"
+14 WRITE !
+15 DO DIR^ACRFDIC
+16 IF +Y<1
KILL ACRQUIT
QUIT
+17 SET ACRAREA=Z(Y)
+18 QUIT
COUNT ;
+1 SET (ACRX,ACRSIGS,ACRREC,ACRRAMT)=0
+2 FOR ACRX=22,33,35,69,133,53,111
SET ACRX(ACRX)=0
+3 FOR
SET ACRX=$ORDER(^ACRDOC(ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+4 SET ACR0=$GET(^ACRDOC(ACRX,0))
+5 IF $DATA(ACRAREA)
IF ACRAREA'=$PIECE($GET(^ACRPO(+$PIECE(ACR0,U,8),0)),U,19)
QUIT
+6 IF ACRFY="ALL"!(ACRFY=+$GET(^ACRLOCB(+$PIECE(ACR0,U,6),"DT")))
Begin DoDot:2
+7 SET ACRZ=$PIECE(ACR0,U,13)
+8 IF $PIECE(ACR0,U,24)
SET ACRZ=111
+9 IF "^22^33^35^69^133^53^111^"[(U_ACRZ_U)
Begin DoDot:3
+10 DO AMT
+11 IF ACRZ=69
SET ACRZ=$SELECT($EXTRACT($GET(^ACROBL(ACRX,"APV")))="A":22,1:33)
+12 SET $PIECE(ACRX(ACRZ),U)=$PIECE(ACRX(ACRZ),U)+1
+13 SET $PIECE(ACRX(ACRZ),U,2)=$PIECE(ACRX(ACRZ),U,2)+ACRAMT
+14 IF ACRZ=22!(ACRZ=111)
Begin DoDot:4
+15 SET $PIECE(ACRX(33),U)=$PIECE(ACRX(33),U)+1
+16 SET $PIECE(ACRX(33),U,2)=$PIECE(ACRX(33),U,2)+ACRAMT
End DoDot:4
+17 IF ACRZ=133
Begin DoDot:4
+18 SET $PIECE(ACRX(35),U)=$PIECE(ACRX(35),U)+1
+19 SET $PIECE(ACRX(35),U,2)=$PIECE(ACRX(35),U,2)+ACRAMT
End DoDot:4
+20 IF ACRFY'="ALL"
Begin DoDot:4
+21 NEW J
+22 SET (ACRAPDA,J)=0
+23 FOR
SET ACRAPDA=$ORDER(^ACRAPVS("AB",ACRX,ACRAPDA))
IF 'ACRAPDA
QUIT
SET J=J+1
+24 SET ACRSIGS=ACRSIGS+J
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 IF ACRFY="ALL"
SET ACRSIGS=$PIECE(^ACRAPVS(0),U,4)
+26 QUIT
AMT SET (ACRI,ACRAMT)=0
+1 NEW X
+2 FOR
SET ACRI=$ORDER(^ACRSS("C",ACRX,ACRI))
IF 'ACRI
QUIT
Begin DoDot:1
+3 SET ACRAMT=ACRAMT+$PIECE($GET(^ACRSS(ACRI,"DT")),U,4)
+4 SET X=0
+5 FOR
SET X=$ORDER(^ACRRR("B",ACRI,X))
IF 'X
QUIT
Begin DoDot:2
+6 SET ACRREC=$GET(ACRREC)+1
+7 SET Y=$PIECE($GET(^ACRSS(ACRI,"DT")),U,3)*$PIECE($GET(^ACRRR(X,"DT")),U,3)
+8 SET ACRRAMT=ACRRAMT+Y
End DoDot:2
End DoDot:1
+9 QUIT
PRINT ;
+1 DO COUNT
+2 NEW X
+3 SET X=+$GET(^ACRSYS(+$GET(ACRAREA),0))
+4 IF $GET(ACRAREA)
IF X
IF $DATA(^AUTTAREA(X,0))
NEW X
SET X=^(0)
Begin DoDot:1
+5 WRITE !?10,$PIECE(X,U)
+6 IF $PIECE(X,U)'["HEAD"
WRITE " AREA"
End DoDot:1
IF 1
+7 IF '$TEST
WRITE !
+8 SET Y=DT
+9 XECUTE ^DD("DD")
+10 WRITE ?33,"REPORT DATE: ",Y
+11 WRITE !?10,"DOCUMENT SUMMARY"
+12 WRITE ?33,"FISCAL YEAR: ",ACRFY
+13 WRITE !?10,"-----------------------------------------------"
+14 WRITE !?40,"DOLLAR VALUE"
+15 WRITE !?32,"TOTAL"
+16 WRITE ?40,"OF DOCUMENTS"
+17 WRITE !?10,"TYPE OF DOCUMENT"
+18 WRITE ?32,"NUMBER"
+19 WRITE ?40,"PROCESSED"
+20 WRITE !?10,"------------------"
+21 WRITE ?32,"------"
+22 WRITE ?40,"-----------------"
+23 NEW ACRTOTN,ACRTOTD
+24 SET (ACRTOTN,ACRTOTD)=0
+25 FOR ACRZ=33,22,111,35,133,53
Begin DoDot:1
+26 WRITE !?10,$SELECT(ACRZ=33:"REQUISITION",ACRZ=22:"PURCHASE ORDER",ACRZ=111:"CONTRACT ACTIONS",ACRZ=35:"TRAVEL ORDER",ACRZ=53:"TRAINING 350",1:"TRAVEL VOUCHER")
+27 WRITE ?32,$JUSTIFY($PIECE(ACRX(ACRZ),U),6)
+28 WRITE ?40,$JUSTIFY($FNUMBER($PIECE(ACRX(ACRZ),U,2),"P,",2),18)
+29 SET ACRTOTN=ACRTOTN+$PIECE(ACRX(ACRZ),U)
+30 SET ACRTOTD=ACRTOTD+$PIECE(ACRX(ACRZ),U,2)
End DoDot:1
+31 SET ACRTOTN=ACRTOTN+ACRREC
+32 WRITE !?10,"RECEIVING ACTIONS"
+33 WRITE ?32,$JUSTIFY(ACRREC,6)
+34 WRITE ?40,$JUSTIFY($FNUMBER(ACRRAMT,"P,",2),18)
+35 WRITE !?10,"ELECTRONIC SIGNATURES"
+36 WRITE ?32,$JUSTIFY(ACRSIGS,6)
+37 WRITE !?32,"------"
+38 WRITE ?40,"-----------------"
+39 WRITE !?32,$JUSTIFY(ACRTOTN,6)
+40 WRITE ?40,$JUSTIFY($FNUMBER(ACRTOTD,"P,",2),18)
+41 DO PAUSE^ACRFWARN
+42 WRITE @IOF
+43 QUIT
ZIS NEW X
+1 WRITE !!?10
+2 FOR X=1:1:5
WRITE @ACRON,"NOTE",@ACROF,?$X+5
+3 WRITE !!,"This report takes several minutes to compile and print."
+4 WRITE !,"You should QUEUE the report to print offline."
+5 SET ACRRTN="PRINT^ACRFDC"
+6 SET ZTDESC="FISCAL YEAR DOCUMENT SUMMARY REPORT"
+7 DO ^ACRFZIS
+8 KILL ACRQUIT
+9 QUIT
REC ;COUNT NUMBER OF RECEIVING ACTIONS
+1 NEW X,Y,Z
+2 SET (Z,X)=0
+3 FOR
SET X=$ORDER(^ACRRR("AC",X))
IF 'X
QUIT
Begin DoDot:1
+4 SET Y=0
+5 FOR
SET Y=$ORDER(^ACRRR("AC",X,Y))
IF 'Y
QUIT
SET Z=Z+1
End DoDot:1
+6 SET ACRREC=Z
+7 QUIT
