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

ACRFSOF.m

Go to the documentation of this file. 
  1. ACRFSOF ;IHS/OIRM/DSD/THL,AEF - STATUS OF FUNDS REPORT;  [ 02/02/2005  10:23 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
  1.  ;;ROUTINE TO PRINT THE STATUS OF FUNDS REPORT
  1. EN F  D SELECT Q:$D(ACRQUIT)!$D(ACROUT)
  1. EXIT K ACR,ACR1,ACR2,ACR3,ACR4,ACR5,ACR6,ACR0,ACROBJ,ACROBJ0,ACRDTAIL,ACRDOC,ACRDOC0,ACRREQ2,ACRSOFT,ACRDTL1,ACRBOTH,ACRZZDA,ACRZDA,ACRBUD,ACRSUBO,ACRQUIT,ACROUT,ACRXX,ACRYY,ACROCG,ACR11,ACR21,ACR22,ACR25,ACRDOCDA,ACRDT,ACRFY,ACRGLB,ACRGREF
  1.  K ACRI,ACRLCDA,ACROBL,ACRPURP,ACRREF,ACRREQ,ACRSPT,ACRTO,ACRTOT,ACRX
  1.  F X="ACRSOF","ACRXX","ACRYY" K ^TMP(X,$J)
  1.  Q
  1. SELECT D EXIT
  1.  D HOME^ACRFMENU
  1.  K ACRSOFT,ACRDTAIL,ACRDTL1
  1.  W @IOF
  1.  W !?10,"Status of Funds Report"
  1.  S DIR(0)="SO^1:Department Account;2:Common Accounting Number;3:Sub-Allowance;4:Allowance;5:Location Code;6:Area Office;7:Funds Distribution Summaries"
  1.  S DIR("A")="Which type of report"
  1.  D DIR^ACRFDIC
  1.  I $D(ACRQUIT)!$D(ACROUT)!("1234567"'[+Y) Q
  1.  I Y=7 D LOCATION^ACRFFDS Q
  1.  S ACRSOFT=$S(Y=1:"F",Y=2:"CAN",Y=3:"G",Y=4:"H",Y=5:"LCOD",Y=6:"AREA",1:"")
  1.  Q:ACRSOFT=""
  1.  D DETAIL
  1.  I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
  1.  I ACRSOFT="CAN" D CAN^ACRFSOF1 Q:$D(ACRQUIT)!$D(ACROUT)  G ZIS
  1.  I ACRSOFT="AREA" D  Q:$D(ACRQUIT)!$D(ACROUT)  G ZIS
  1.  .D AREA^ACRFTV
  1.  .Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S ACRZDA=ACRADA
  1.  .D FY^ACRFSOF1
  1.  I ACRSOFT="LCOD" D  Q:$D(ACRQUIT)!$D(ACROUT)  G ZIS
  1.  .D LCOD^ACRFSOF1
  1.  .Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S (ACRZDA,ACRLCDA)=+Y
  1.  .D FY^ACRFSOF1
  1.  S ACRENTR1=$S(ACRSOFT="F":"LOCBAMT",ACRSOFT="G":"ALCAMT",ACRSOFT="H":"ALLAMT")
  1.  S ACRENTRY=$S(ACRSOFT="F":"ALCAMT",ACRSOFT="G":"ALLAMT",ACRSOFT="H":"APPAMT")
  1.  K ACRZDA
  1.  D ENTRY^ACRFDTP
  1.  I '$D(ACRZDA) K ACRQUIT Q
  1.  I ACRSOFT'="CAN" D BUDGET
  1.  I ACRSOFT="F" D C1^ACRFSOF1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. ZIS S ACRGLB=$S(ACRSOFT="F":"^ACRLOCB",ACRSOFT="H":"^ACRALW",ACRSOFT="G":"^ACRALC",1:"")
  1.  S ACRRTN="SS^ACRFSOF"
  1.  S ZTDESC="STATUS OF FUNDS REPORT"
  1.  D ^ACRFZIS
  1.  K ACRQUIT
  1.  Q
  1. DETAIL ;EP;
  1.  K ACRDTAIL,ACRBOTH,ACRDTL1,ACROCG
  1.  S DIR(0)="SO^1:Summary;2:Sub-Object Code Summary;3:Detailed Report;4:Summary and Detailed REport"
  1.  S DIR("A")="Which one"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I $D(ACRQUIT)!$D(ACROUT) Q
  1.  I ACRY=1 K ACRDTAIL Q
  1.  I ACRY=2 K ACRDTAIL S ACRSUBO="" D OCG Q
  1.  I ACRY=3 S ACRDTAIL="" W ! D OC Q
  1.  I Y=4 S ACRBOTH="" D OCG
  1.  Q
  1. SS ;EP;TO PRINT STATUS OF FUNDS REPORT
  1.  I '$D(ACRDTAIL)!$D(ACRBOTH),$G(ACRGLB)]"" D P2^ACRFEA43
  1.  I $D(ACRBOTH) D  Q
  1.  .K ACRDTAIL,ACRDTL1
  1.  .D SS0
  1.  .S ACRDTAIL=""
  1.  .D SS0
  1.  .S ACRDTL1=""
  1.  .D SS0
  1.  .K ACRDTL1,^TMP("ACRSOF",$J),^TMP("ACRXX",$J),^TMP("ACRYY",$J)
  1. SS0 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  U IO
  1.  K ^TMP("ACRSOF",$J),^TMP("ACRXX",$J),^TMP("ACRYY",$J)
  1.  S (ACR,ACR4,ACR9,ACR21,ACR25,ACRREQ,ACROBL,ACRSPT,ACRTOT)=0
  1.  F  S ACR=$O(^ACRSS(ACRSOFT,ACRZDA,ACR)) Q:'ACR  D
  1.  .S ACR0=$G(^ACRSS(ACR,0))
  1.  .S ACRDT=$G(^ACRSS(ACR,"DT"))
  1.  .S ACRDOCDA=$P(ACR0,U,2)
  1.  .Q:'ACRDOCDA
  1.  .Q:'$D(^ACRDOC(ACRDOCDA))                    ;ACR*2.1*16.05 IM11519
  1.  .Q:'$P(ACR0,U,6)
  1.  .Q:'$D(^ACRLOCB($P(ACR0,U,6),"DT"))
  1.  .I ACRSOFT["CAN",$P(ACR0,U,5)'=ACRZDA Q
  1.  .I "^CAN^AREA^LCOD^"[(U_ACRSOFT_U),+^ACRLOCB($P(ACR0,U,6),"DT")'=ACRFY Q
  1.  .S ACROBJ0=$P(ACR0,U,4)
  1.  .Q:'$D(^AUTTOBJC(+ACROBJ0,0))
  1.  .S ACROBJ0=$P(^AUTTOBJC(ACROBJ0,0),U)
  1.  .S ACROBJ=$E(ACROBJ0,1,2)_"00"
  1.  .I $D(ACROCG)#2 Q:$E(ACROBJ,1,2)'=$E(ACROCG,1,2)
  1.  .I $D(ACROCG)#2,$E(ACROCG,3,4)'="00",$E(ACROBJ0,3,4)'=$E(ACROCG,3,4) Q
  1.  .I $D(ACROCG)#2,$E(ACROCG,3,4)'="00",$E(ACROBJ0,3,4)=$E(ACROCG,3,4) S ACROBJ=ACROCG
  1.  .S:$D(ACRDTL1) ACROBJ="ALL"
  1.  .I '$D(ACRSUBO) S:'$D(^TMP("ACRSOF",$J,ACROBJ)) ^TMP("ACRSOF",$J,ACROBJ)=""
  1.  .E  S:'$D(^TMP("ACRSOF",$J,"SUB",ACROBJ0)) ^TMP("ACRSOF",$J,"SUB",ACROBJ0)=""
  1.  .F ACRI=4,9,21 S @("ACR"_ACRI)=$P(ACRDT,U,ACRI)
  1.  .N X
  1.  .I '$D(ACRSUBO) S X=^TMP("ACRSOF",$J,ACROBJ)
  1.  .E  S X=^TMP("ACRSOF",$J,"SUB",ACROBJ0)
  1.  .S $P(X,U)=$P(X,U)+ACR4
  1.  .S $P(X,U,2)=$P(X,U,2)+ACR9
  1.  .I '$D(^TMP("ACRXX",$J,ACRDOCDA)) D
  1.  ..S $P(X,U,25)=$P(X,U,25)+1
  1.  ..S ^TMP("ACRXX",$J,ACRDOCDA)=""
  1.  .S $P(X,U,4)=$P(X,U,4)+ACR21
  1.  .I '$D(ACRSUBO) S ^TMP("ACRSOF",$J,ACROBJ)=X
  1.  .E  S ^TMP("ACRSOF",$J,"SUB",ACROBJ0)=X
  1.  .I $D(ACRDTAIL) D
  1.  ..S ACRDOC=$P(ACR0,U,3)
  1.  ..Q:'ACRDOC
  1.  ..S ACRPURP=$E($P($G(^ACROBL(ACRDOC,"JST")),U),1,28)
  1.  ..S ACRTO=$G(^ACRDOC(ACRDOC,"TO"))
  1.  ..S ACRREQ2=$G(^ACRDOC(ACRDOC,"REQ2"))
  1.  ..S ACRDOC=^ACRDOC(ACRDOC,0)
  1.  ..S ACRREF=$P(ACRDOC,U,13)
  1.  ..S ACRREF=$P(^AUTTDOCR(ACRREF,0),U)
  1.  ..I "^130^600^"[(U_ACRREF_U) D
  1.  ...S $P(ACRDOC,U,14)=ACRPURP
  1.  ...S $P(ACRDOC,U,3)=$P(ACRTO,U,14)
  1.  ...S $P(ACRDOC,U,11)=$P(ACRTO,U,15)
  1.  ..I "^103^349^326^210^"'[(U_ACRREF_U) D  I 1
  1.  ...S ACRDOC0=$P(ACRDOC,U)
  1.  ...S ACRDOC2=""
  1.  ..E  D
  1.  ...S ACRDOC2=$P(ACRDOC,U)
  1.  ...S ACRDOC0=$S($L($P(ACRDOC,U,2))>3&($P(ACRDOC,U,2)'["PEND"):$P(ACRDOC,U,2),1:$P(ACRDOC,U))
  1.  ..I '$D(^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)) D  I 1
  1.  ...S X=$P(ACRDOC,U,3)_U_ACRDOC0_U_$P(ACRDOC,U,14)_U_$P(ACRREQ2,U,8)
  1.  ...S:ACRDOC0'=ACRDOC2 $P(X,U,10)=ACRDOC2
  1.  ..E  S X=^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)
  1.  ..S $P(X,U,5)=$P(X,U,5)+ACR4
  1.  ..S $P(X,U,6)=$P(X,U,6)+ACR9
  1.  ..S $P(X,U,21)=$P(X,U,21)+ACR21
  1.  ..I '$D(^TMP("ACRYY",$J,ACRDOCDA)) D
  1.  ...S $P(X,U,25)=$P(X,U,25)+1
  1.  ...S ^TMP("ACRYY",$J,ACRDOCDA)=""
  1.  ..S $P(X,U,11)=$P(ACRTO,U,15)
  1.  ..S ^TMP("ACRSOF",$J,ACROBJ,ACRDOC0)=X
  1.  ..K ACR4,ACR21,ACR9,ACRDOC2
  1.  I '$D(ACRQUIT),$D(^TMP("ACRSOF",$J)) D SS1^ACRFSOF1
  1.  I '$D(ACRQUIT),$E(IOST,1,2)="C-" D PAUSE^ACRFWARN
  1.  W @IOF
  1.  K ^TMP("ACRSOF",$J)
  1.  Q
  1. OC ;EP;SORT BY OBJECT CLASS
  1.  S DIR(0)="YO"
  1.  S DIR("A")="By Object Code"
  1.  S DIR("B")="NO"
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACROUT)!$D(ACRQUIT)
  1.  I Y=0 S ACRDTL1="" Q
  1. OCG ;SELECT OBJECT CLASS GROUP
  1.  W !!?7,"If you want to print the report for one OBJECT CLASS group,"
  1.  W !?7,"select the group below.  If no group is selected the report"
  1.  W !?7,"will include all OBJECT CLASS groups."
  1.  S DIR(0)="SO^1100:Personnel Costs;2100:Travel;2200:Transportation;2300:Rent;2400:Printing;2500:Services;2600:Supplies;3100:Equipment;3200:Land and Structures;4100:Grants"
  1.  S DIR("A")="Which OBJECT CLASS Group"
  1.  D DIR^ACRFDIC
  1.  I '+Y K ACRQUIT Q
  1.  S ACROCG=Y
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Report for one specific"
  1.  S DIR("A")=$S(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Granst")_" Sub-Object Code ONLY"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I 'Y K ACRQUIT Q
  1.  S DIC="^AUTTOBJC("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("S")="I $E($P(^(0),U),1,2)=$E($G(ACROCG),1,2)"
  1.  S Y=ACROCG
  1.  S DIC("A")="Which "_$S(Y=1100:"Personnel",Y=2100:"Travel",Y=2200:"Transportation",Y=2300:"Rent",Y=2400:"Printing",Y=2500:"Services",Y=2600:"Supplies",Y=3100:"Equipment",Y=3200:"Land and Structures",Y=4100:"Grants")_" Sub-Object Code: "
  1.  W !
  1.  D DIC^ACRFDIC
  1.  I +Y<1 S ACRQUIT="" Q
  1.  S ACROCG=$P(^AUTTOBJC(+Y,0),U)
  1.  Q
  1. BUDGET ;DETERMINE DOLLARS IN ACCOUNT
  1.  K ACRBUD
  1.  N ACRAMT,X,ACRX
  1.  S X=U_"ACR"_$P(ACRENTR1,"AMT")
  1.  S:X["ACRALL" X="^ACRALW"
  1.  S ACRBUD=+@X@(ACRZDA,0) S:X["ACRLOCB" ACRBUD=ACRBUD+$P(^(0),U,11)
  1.  S ACRX=0
  1.  F  S ACRX=$O(@X@("ORIG",ACRZDA,ACRX)) Q:'ACRX  S ACRAMT=$S($P(@X@(ACRX,0),U,8)'="D":1,1:-1),ACRBUD=ACRBUD+(+@X@(ACRX,0)*ACRAMT)
  1.  Q