Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFDC

ACRFDC.m

Go to the documentation of this file. 
  1. 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
  1.  ;;UTILITY TO DISPLAY COUNTS OF DOCUMENTS FOR A FISCAL YEAR
  1. EN D EN1
  1. EXIT K ACRX,ACR0,ACRAMT,ACRAREA,ACRFY,ACRI,ACRY,ACRZ,ACRQUIT,ACRTOTN,ACRRAMT,ACRSIGS,ACRREC,ACRAPDA,ACRQUIT,ACROUT
  1.  Q
  1. EN1 D FY
  1.  Q:$D(ACROUT)!$D(ACRQUIT)
  1.  D AREA:$O(^ACRSYS(1))
  1.  Q:$D(ACROUT)!$D(ACRQUIT)
  1.  D ZIS
  1.  Q
  1. FY ;EP;
  1.  S DIR(0)="SO^1:Specify Fiscal Year;2:All Documents/All Years"
  1.  S DIR("A")="Which one"
  1.  S DIR("B")="Specify Fiscal Year"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $D(ACRQUIT)!(Y<1) S ACRQUIT="" Q
  1.  I Y=2 S ACRFY="ALL" Q
  1.  S ACRFY=$E(DT,4,5)
  1.  S ACRFY=$S(ACRFY<10:$E(DT,1,3),1:$E(DT,1,3)+1),ACRFY=ACRFY+1700
  1.  S DIR(0)="N0A^1000:9999"
  1.  S DIR("A")="Fiscal year: ",DIR("B")=ACRFY
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $D(ACRQUIT)!(Y'?4N) S ACRQUIT="" Q
  1.  S ACRFY=Y
  1.  Q
  1. AREA ;SELECT AREA OF REPORT
  1.  W !!?10,"NO.",?15,"AREA"
  1.  W !?10,"---",?15,"--------------------"
  1.  N ACRX,Y,Z
  1.  S (ACRX,Z)=0
  1.  F  S ACRX=$O(^ACRSYS(ACRX)) Q:'ACRX  D
  1.  .S Y=$P(^ACRSYS(ACRX,0),U)
  1.  .S Y=$P(^AUTTAREA(Y,0),U)
  1.  .S Z=Z+1
  1.  .S Z(Z)=ACRX
  1.  .W !?10,Z,?15,Y
  1.  S DIR(0)="NO^1:"_Z
  1.  S DIR("A")="Report for which Area"
  1.  S DIR("A",1)="(Leave blank to report for all Areas)"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I +Y<1 K ACRQUIT Q
  1.  S ACRAREA=Z(Y)
  1.  Q
  1. COUNT ;
  1.  S (ACRX,ACRSIGS,ACRREC,ACRRAMT)=0
  1.  F ACRX=22,33,35,69,133,53,111 S ACRX(ACRX)=0
  1.  F  S ACRX=$O(^ACRDOC(ACRX)) Q:'ACRX  D
  1.  .S ACR0=$G(^ACRDOC(ACRX,0))
  1.  .I $D(ACRAREA),ACRAREA'=$P($G(^ACRPO(+$P(ACR0,U,8),0)),U,19) Q
  1.  .I ACRFY="ALL"!(ACRFY=+$G(^ACRLOCB(+$P(ACR0,U,6),"DT"))) D
  1.  ..S ACRZ=$P(ACR0,U,13)
  1.  ..S:$P(ACR0,U,24) ACRZ=111
  1.  ..I "^22^33^35^69^133^53^111^"[(U_ACRZ_U) D
  1.  ...D AMT
  1.  ...S:ACRZ=69 ACRZ=$S($E($G(^ACROBL(ACRX,"APV")))="A":22,1:33)
  1.  ...S $P(ACRX(ACRZ),U)=$P(ACRX(ACRZ),U)+1
  1.  ...S $P(ACRX(ACRZ),U,2)=$P(ACRX(ACRZ),U,2)+ACRAMT
  1.  ...I ACRZ=22!(ACRZ=111) D
  1.  ....S $P(ACRX(33),U)=$P(ACRX(33),U)+1
  1.  ....S $P(ACRX(33),U,2)=$P(ACRX(33),U,2)+ACRAMT
  1.  ...I ACRZ=133 D
  1.  ....S $P(ACRX(35),U)=$P(ACRX(35),U)+1
  1.  ....S $P(ACRX(35),U,2)=$P(ACRX(35),U,2)+ACRAMT
  1.  ...I ACRFY'="ALL" D
  1.  ....N J
  1.  ....S (ACRAPDA,J)=0
  1.  ....F  S ACRAPDA=$O(^ACRAPVS("AB",ACRX,ACRAPDA)) Q:'ACRAPDA  S J=J+1
  1.  ....S ACRSIGS=ACRSIGS+J
  1.  I ACRFY="ALL" S ACRSIGS=$P(^ACRAPVS(0),U,4)
  1.  Q
  1. AMT S (ACRI,ACRAMT)=0
  1.  N X
  1.  F  S ACRI=$O(^ACRSS("C",ACRX,ACRI)) Q:'ACRI  D
  1.  .S ACRAMT=ACRAMT+$P($G(^ACRSS(ACRI,"DT")),U,4)
  1.  .S X=0
  1.  .F  S X=$O(^ACRRR("B",ACRI,X)) Q:'X  D
  1.  ..S ACRREC=$G(ACRREC)+1
  1.  ..S Y=$P($G(^ACRSS(ACRI,"DT")),U,3)*$P($G(^ACRRR(X,"DT")),U,3)
  1.  ..S ACRRAMT=ACRRAMT+Y
  1.  Q
  1. PRINT ;
  1.  D COUNT
  1.  N X
  1.  S X=+$G(^ACRSYS(+$G(ACRAREA),0))
  1.  I $G(ACRAREA),X,$D(^AUTTAREA(X,0)) N X S X=^(0) D  I 1
  1.  .W !?10,$P(X,U)
  1.  .W:$P(X,U)'["HEAD" " AREA"
  1.  E  W !
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W ?33,"REPORT DATE: ",Y
  1.  W !?10,"DOCUMENT SUMMARY"
  1.  W ?33,"FISCAL YEAR:   ",ACRFY
  1.  W !?10,"-----------------------------------------------"
  1.  W !?40,"DOLLAR VALUE"
  1.  W !?32,"TOTAL"
  1.  W ?40,"OF DOCUMENTS"
  1.  W !?10,"TYPE OF DOCUMENT"
  1.  W ?32,"NUMBER"
  1.  W ?40,"PROCESSED"
  1.  W !?10,"------------------"
  1.  W ?32,"------"
  1.  W ?40,"-----------------"
  1.  N ACRTOTN,ACRTOTD
  1.  S (ACRTOTN,ACRTOTD)=0
  1.  F ACRZ=33,22,111,35,133,53 D
  1.  .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")
  1.  .W ?32,$J($P(ACRX(ACRZ),U),6)
  1.  .W ?40,$J($FN($P(ACRX(ACRZ),U,2),"P,",2),18)
  1.  .S ACRTOTN=ACRTOTN+$P(ACRX(ACRZ),U)
  1.  .S ACRTOTD=ACRTOTD+$P(ACRX(ACRZ),U,2)
  1.  S ACRTOTN=ACRTOTN+ACRREC
  1.  W !?10,"RECEIVING ACTIONS"
  1.  W ?32,$J(ACRREC,6)
  1.  W ?40,$J($FN(ACRRAMT,"P,",2),18)
  1.  W !?10,"ELECTRONIC SIGNATURES"
  1.  W ?32,$J(ACRSIGS,6)
  1.  W !?32,"------"
  1.  W ?40,"-----------------"
  1.  W !?32,$J(ACRTOTN,6)
  1.  W ?40,$J($FN(ACRTOTD,"P,",2),18)
  1.  D PAUSE^ACRFWARN
  1.  W @IOF
  1.  Q
  1. ZIS N X
  1.  W !!?10
  1.  F X=1:1:5 W @ACRON,"NOTE",@ACROF,?$X+5
  1.  W !!,"This report takes several minutes to compile and print."
  1.  W !,"You should QUEUE the report to print offline."
  1.  S ACRRTN="PRINT^ACRFDC"
  1.  S ZTDESC="FISCAL YEAR DOCUMENT SUMMARY REPORT"
  1.  D ^ACRFZIS
  1.  K ACRQUIT
  1.  Q
  1. REC ;COUNT NUMBER OF RECEIVING ACTIONS
  1.  N X,Y,Z
  1.  S (Z,X)=0
  1.  F  S X=$O(^ACRRR("AC",X)) Q:'X  D
  1.  .S Y=0
  1.  .F  S Y=$O(^ACRRR("AC",X,Y)) Q:'Y  S Z=Z+1
  1.  S ACRREC=Z
  1.  Q