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

ACRFFDS.m

Go to the documentation of this file. 
  1. ACRFFDS ;IHS/DSD/THL,AEF - FUNDS DISTRIBUTION SUMMARIES; [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  Q
  1. LOCATION ;EP;TO SUMMARIZE SUB ALLOWANCES BY LOCATION
  1.  D LEXIT
  1.  D L1
  1. LEXIT K ^TMP("ACRGLOC",$J),ACR,ACRFY,ACRLOC,ACRQUIT,ACROUT,ACRSSN,ACRSSA,ACRLCOD,ACRJ,ACRRTN,ACRT1,ACRT2,ACRT3,ACRT4,ACRY,ACRZDA,ACR1,ACR2,ACRDC,ACRFUNDS
  1.  Q
  1. L1 D SLOC
  1.  Q:$D(ACRQUIT)
  1.  S (ACRRTN,ZTRTN)="PLOC^ACRFFDS"
  1.  S ZTDESC="SUB-ALLOWANCE DISTRIBUTION SUMMARY"
  1.  D ^ACRFZIS
  1.  Q
  1. SLOC ;SELECT LOCATIONS
  1.  ;
  1.  S DIR(0)="NO^1000:9999"
  1.  S DIR("A")="Fiscal Year"
  1.  S DIR("B")=$S($E(DT,4,5)<10:$E(DT,1,3)+1700,1:($E(DT,1,3)+1)+1700)
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:Y'?4N
  1.  S ACRFY=Y
  1.  S DIR(0)="SO^1:Summarize by LOCATION;2:Summarize by SUB-SUB-ACTIVITY"
  1.  S DIR("A")="Which summary"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:Y<1
  1.  S ACRFUNDS=$S(Y=1:1,1:2)
  1.  I ACRFUNDS=1 D  I 1
  1.  .S DIR(0)="SO^1:ALL Locations;2:Selected Locations"
  1.  .S DIR("A")="ALL or Selected Locations"
  1.  .S DIR("B")="All Locations"
  1.  I ACRFUNDS=2 D
  1.  .S DIR(0)="SO^1:ALL Sub-Sub-Activities;2:Selected Sub-Sub-Activities"
  1.  .S DIR("A")="Which one"
  1.  .S DIR("B")="ALL Sub-Sub-Activities"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:'Y
  1.  I Y=1 S ACRLOC="ALL" Q
  1.  S ACRJ=0
  1.  S ACRLOC=""
  1.  F  D SL1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  Q:$G(ACRLOC)=""
  1.  K ACRQUIT
  1.  Q
  1. SL1 ;SELECT SPECIFIC LOCATIONS
  1.  I ACRFUNDS=1 D  I 1
  1.  .S DIC="^AUTTLCOD("
  1.  .S DIC(0)="AEMQZ"
  1.  .S DIC("A")="Which LOCATION: "
  1.  .S:ACRJ>1 DIC("A")="Next Location: "
  1.  I ACRFUNDS=2 D  I 1
  1.  .S DIC="^AUTTSSA("
  1.  .S DIC(0)="AEMQZ"
  1.  .S DIC("A")="Which Sub-Sub-Activity: "
  1.  .S:ACRJ>1 DIC("A")="Next Sub-Sub-Activity: "
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I Y<1 S ACRQUIT="" Q
  1.  S ACRJ=ACRJ+1
  1.  S ACRLOC=ACRLOC_+Y_","
  1.  Q
  1.  Q
  1. GLOC ;GATHER DATA INTO TEMP GLOBAL
  1.  N ACR ;,X
  1.  S ACR=0
  1.  I ACRLOC'="ALL" D  Q
  1.  .F ACRJ=1:1 S ACR=$P(ACRLOC,",",ACRJ) Q:ACR=""  D GL1
  1.  S ACRZDA=0
  1.  F  S ACRZDA=$O(^ACRALC("FY",ACRFY,ACRZDA)) Q:'ACRZDA  D
  1.  .S X=$G(^ACRALC(ACRZDA,"DT"))
  1.  .I $P(X,U,11),$P(X,U,8),$P(^ACRALC(ACRZDA,0),U,8)="O" D ID
  1.  Q
  1. GL1 S ACRXREF=$S(ACRFUNDS=1:"LCODE",1:"SS")
  1.  S ACRZDA=0
  1.  F  S ACRZDA=$O(^ACRALC(ACRXREF,ACR,ACRZDA)) Q:'ACRZDA  D
  1.  .S X=$G(^ACRALC(ACRZDA,"DT"))
  1.  .I $P(X,U)=ACRFY,$P(X,U,8),$P(^ACRALC(ACRZDA,0),U,8)="O" D ID
  1.  Q
  1. ID ;CALCULATE INCREASES AND DECREASES
  1.  S ACRSSN=$P($G(^AUTTSSA(+$P(X,U,8),0)),U,3)
  1.  S ACRSSA=$P($G(^AUTTSSA(+$P(X,U,8),0)),U,4)
  1.  S ACRLCOD=$P($G(^AUTTLCOD(+$P(X,U,11),0)),U)
  1.  Q:ACRSSA=""!(ACRSSN="")!(ACRLCOD="")
  1.  I ACRFUNDS=1 S ACR1=ACRLCOD,ACR2=ACRSSN
  1.  I ACRFUNDS=2 S ACR1=ACRSSN,ACR2=ACRLCOD
  1.  S ^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)=+^ACRALC(ACRZDA,0),X=^(ACRZDA)
  1.  S ^TMP("ACRGLOC",$J,ACR1)=ACRSSA
  1.  S ^TMP("ACRGLOC",$J,ACR1,ACR2)=ACRSSA
  1.  S ACRX=0
  1.  F  S ACRX=$O(^ACRALC("ORIG",ACRZDA,ACRX)) Q:'ACRX  D
  1.  .S Y=^ACRALC(ACRX,0)
  1.  .S Z=$P(^ACRALC(ACRX,"DT"),U,3)
  1.  .S $P(X,U,$S(Z="R":2,1:3))=$P(X,U,$S(Z="R":2,1:3))+($S($P(Y,U,9)="I":1,1:-1)*+Y)
  1.  S ^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)=X
  1.  Q
  1. PLOC ;EP;TO PRINT SUB-ALLOWANCE DISTRIBUTION SUMMARY
  1.  D PL1
  1.  D LEXIT
  1.  Q
  1. PL1 D GLOC
  1.  Q:'$D(^TMP("ACRGLOC",$J))
  1.  S ACR1=""
  1.  F  S ACR1=$O(^TMP("ACRGLOC",$J,ACR1)) Q:ACR1=""!$D(ACRQUIT)  D
  1.  .D LHEAD
  1.  .S (ACRT1,ACRT2,ACRT3,ACRT4)=0
  1.  .S ACR2=""
  1.  .F  S ACR2=$O(^TMP("ACRGLOC",$J,ACR1,ACR2)) Q:ACR2=""!$D(ACRQUIT)  D
  1.  ..S ACR3=^TMP("ACRGLOC",$J,ACR1,ACR2)
  1.  ..S ACRZDA=""
  1.  ..F  S ACRZDA=$O(^TMP("ACRGLOC",$J,ACR1,ACR2,ACRZDA)) Q:'ACRZDA!$D(ACRQUIT)  S X=^(ACRZDA) D
  1.  ...S ACRT1=ACRT1+$P(X,U)
  1.  ...S ACRT2=ACRT2+$P(X,U,2)
  1.  ...S ACRT3=ACRT3+$P(X,U)+$P(X,U,2)
  1.  ...S ACRT4=ACRT4+$P(X,U,4)
  1.  ...I ACRFUNDS=2 S ACR3=$P($G(^AUTTLCOD(+$O(^AUTTLCOD("B",ACR2,0)),0)),U,2)
  1.  ...W !,$E(ACR3,1,15),?15,"|",$J($FN($P(X,U),"P,"),13),?29,"|",$J($FN($P(X,U,2),"P,"),11),?41,"|",$J($FN($P(X,U)+$P(X,U,2),"P,"),13),?55,"|",$J($FN($P(X,U,3),"P,"),10),?66,"|",$J($FN($P(X,U)+$P(X,U,2)+$P(X,U,3),"P,"),13)
  1.  ...I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D LHEAD
  1.  .D LTAIL
  1.  Q
  1.  W @IOF
  1.  S ACRDC=$G(ACRDC)+1
  1.  W !,"DISTRIBUTION OF FUNDS SUMAMRY"
  1.  W !,"-----------------------------"
  1.  W !,"FISCAL YEAR: ",ACRFY,?55,"PAGE: ",ACRDC
  1.  W !,"REPORT DATE: "
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  W Y
  1.  I ACRFUNDS=1 W !,"LOCATION...: ",ACR1,?$X+3,$P($G(^AUTTLCOD(+$O(^AUTTLCOD("B",ACR1,0)),0)),U,2)
  1.  I ACRFUNDS=2 W !,"SUB-SUB-ACT: ",ACR1,?$X+3,^TMP("ACRGLOC",$J,ACR1)
  1.  W $$DASH^ACRFMENU
  1.  W !?15,"|",?25,"RECURRING",?41,"| TOTAL",?55,"| NON-",?66,"|"
  1.  W !,$S(ACRFUNDS=1:"ACTIVITY",1:"LOCATION")
  1.  W ?15,"| BASE",?29,"| INC/DEC",?41,"| RECURRING",?55,"| RECURRING",?66,"| TOTAL"
  1.  W !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
  1.  Q
  1. LTAIL ;
  1.  W !,"---------------",?15,"|-------------",?29,"|-----------",?41,"|-------------",?55,"|----------",?66,"|------------"
  1.  W !?15,"|",$J($FN(ACRT1,"P,"),13),?29,"|",$J($FN(ACRT2,"P,"),11),?41,"|",$J($FN(ACRT3,"P,"),13),?55,"|",$J($FN(ACRT4,"P,"),10),?66,"|",$J($FN(ACRT3+ACRT4,"P,"),13)
  1.  D PAUSE^ACRFWARN
  1.  Q