- ACRFCDIS ;IHS/OIRM/DSD/THL,AEF - CALCULATE STATUS OF FUNDS; [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;;ROUTINE TO CALCULATE THE STATUS OF FUNDS
- EN ;EP;TO CALCULATE THE STATUS OF FUNDS
- D EN1
- EXIT K ACR,ACRX,ACRY,ACRI,ACRJ
- Q
- EN1 D SELECT
- Q:$D(ACRQUIT)!$D(ACROUT)
- D REPORT
- Q:$D(ACRQUIT)!$D(ACROUT)
- S ACRSSDA=0
- F S ACRSSDA=$O(^ACRSS(ACRXREF,ACRDA,ACRSSDA)) Q:'ACRSSDA D
- .N X,Y
- .S X=^ACRSS(ACRSSDA,0)
- .S Y=^ACRSS(ACRSSDA,"DT")
- .S ACRCANDA=$P(X,U,5)
- .S ACROBJDA=$P(X,U,4)
- .S ACRLBDA=$P(X,U,X)
- .S ACR(2)=$P(Y,U,4)
- .S ACR(1)=$P(Y,U,9)
- .S ACRCAN=$P(^AUTTCAN(ACRCANDA,0),U)
- .S ACROBJ=$P(^AUTTOBJC(ACROBJDA,0),U)
- .S ACRFY=$P(^ACRLOCB(ACRLBDA,"DT"),U)
- .S ACRGREF="^TMP(""ACRSOF"","_ACRFY_","_ACRCAN_","_ACROBJ_")"
- .S:'$D(@ACRGREF) @ACRGREF=0
- .F ACR=1,2 S $P(@ACRGREF,U,ACR)=$P(@ACRGREF,U,ACR)+ACR(ACR)
- Q
- SELECT ;SELECT ACCOUNT LEVEL FOR SOF REPORT
- S DIR(0)="SO^1:CAN NO.;2:DEPARTMENT ACCOUNT;3:SUB-ALLOWANCE",DIR("A")="Which summary",DIR("B")="DEPARTMENT ACCOUNT"
- W !
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- S ACRY=+Y
- S ACRXREF=$S(Y=1:"CAN",Y=2:"LB",1:"SA")
- S ACRDA=$S(Y=1:ACRCANDA,1:ACRLBDA)
- Q
- REPORT ;SELECT TYPE OF REPORT
- S DIR(0)="SO^1:SUMMARY;2:DETAIL",DIR("A")="Which report",DIR("B")="SUMMARY"
- W !
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- S ACRSUM=+Y
- Q
- ACRFCDIS ;IHS/OIRM/DSD/THL,AEF - CALCULATE STATUS OF FUNDS; [ 11/01/2001 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- +2 ;;ROUTINE TO CALCULATE THE STATUS OF FUNDS
- EN ;EP;TO CALCULATE THE STATUS OF FUNDS
- +1 DO EN1
- EXIT KILL ACR,ACRX,ACRY,ACRI,ACRJ
- +1 QUIT
- EN1 DO SELECT
- +1 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +2 DO REPORT
- +3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +4 SET ACRSSDA=0
- +5 FOR
- SET ACRSSDA=$ORDER(^ACRSS(ACRXREF,ACRDA,ACRSSDA))
- IF 'ACRSSDA
- QUIT
- Begin DoDot:1
- +6 NEW X,Y
- +7 SET X=^ACRSS(ACRSSDA,0)
- +8 SET Y=^ACRSS(ACRSSDA,"DT")
- +9 SET ACRCANDA=$PIECE(X,U,5)
- +10 SET ACROBJDA=$PIECE(X,U,4)
- +11 SET ACRLBDA=$PIECE(X,U,X)
- +12 SET ACR(2)=$PIECE(Y,U,4)
- +13 SET ACR(1)=$PIECE(Y,U,9)
- +14 SET ACRCAN=$PIECE(^AUTTCAN(ACRCANDA,0),U)
- +15 SET ACROBJ=$PIECE(^AUTTOBJC(ACROBJDA,0),U)
- +16 SET ACRFY=$PIECE(^ACRLOCB(ACRLBDA,"DT"),U)
- +17 SET ACRGREF="^TMP(""ACRSOF"","_ACRFY_","_ACRCAN_","_ACROBJ_")"
- +18 IF '$DATA(@ACRGREF)
- SET @ACRGREF=0
- +19 FOR ACR=1,2
- SET $PIECE(@ACRGREF,U,ACR)=$PIECE(@ACRGREF,U,ACR)+ACR(ACR)
- End DoDot:1
- +20 QUIT
- SELECT ;SELECT ACCOUNT LEVEL FOR SOF REPORT
- +1 SET DIR(0)="SO^1:CAN NO.;2:DEPARTMENT ACCOUNT;3:SUB-ALLOWANCE"
- SET DIR("A")="Which summary"
- SET DIR("B")="DEPARTMENT ACCOUNT"
- +2 WRITE !
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +5 SET ACRY=+Y
- +6 SET ACRXREF=$SELECT(Y=1:"CAN",Y=2:"LB",1:"SA")
- +7 SET ACRDA=$SELECT(Y=1:ACRCANDA,1:ACRLBDA)
- +8 QUIT
- REPORT ;SELECT TYPE OF REPORT
- +1 SET DIR(0)="SO^1:SUMMARY;2:DETAIL"
- SET DIR("A")="Which report"
- SET DIR("B")="SUMMARY"
- +2 WRITE !
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +5 SET ACRSUM=+Y
- +6 QUIT