ACRFDF ;IHS/OIRM/DSD/THL,AEF - DISTRIBUTE FUNDS; [ 07/23/2002 5:47 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
;;ROUTINE USED TO MANAGE DISTRIBUTION OF FUNDS
EN ;EP;TO DISTRIBUTE FUNDS
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)!$D(@ACRGL@("M",ACRZDA))
EXIT K ACRX,ACRQUIT,ACRY,ACRZ,ACRDM,ACRDGDA,ACRDG,ACRGL,ACRCUM,ACRDFN,ACRGLB,ACRACTPT
Q
EN1 ;SELECT TYPE OF DISTRIBUTION
W @IOF
W !,"Distribute Funds to:"
S DIR(0)="SO^1:Distribution Group;2:Single Distribution^K:X'?1N!(X<1)!(X>2) X"
S DIR("A")=" Option"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I X=1 D GROUP K ACRQUIT Q
S:X=2 ACRQUIT=""
Q
GROUP ;EP;TO DISTRIBUTE FUNDS TO A FUNDS DISTRIBUTION GROUP
W !!,"Distribute Funds by:"
S DIR(0)="SO^1:Percent;2:Standard Percent;3:Fixed Amount^K:X'?1N!(X<1)!(X>3) X"
S DIR("A")=" Option"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S ACRDM=$S(X=1:1,X=2:2,1:3)
S ACRGL=$P($P($T(@ACRENTRY^ACRFCTL1),";;",3),"(")
D GET^ACRFEDG1
Q:'$D(ACRDG)!$D(ACRQUIT)!$D(ACROUT)
D DISPLAY^ACRFEDG
S DIR(0)="YO"
S DIR("A")="Distribute the funds to Group Members listed above"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
S (ACRCUM,ACRX)=0
F S ACRX=$O(^ACRDG(ACRDGDA,"GP",ACRX)) Q:'ACRX D GROUP1 Q:'$D(ACRX) ;ACR*2.1*3.14
Q:'$D(ACRX)
F D ED Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
S DIR(0)="YO"
S DIR("A")="Complete Distribution (Y/N)"
W !
D DIR^ACRFDIC
I "N"[X!'$D(ACRX)!$D(ACRQUIT)!$D(ACROUT) D Q
.W !!,*7,*7,"This distribution was NOT completed."
.W !,"You must begin again to complete the distribution."
.H 2
W !!,"To complete the Distribution you must enter detailed information"
W !,"on each distribution. This data entry process will now begin."
S DIR(0)="YO"
S DIR("A")="Sure you want to continue"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
D DIST^ACRFDF1
Q
GROUP1 N X,Y
S X=$G(^ACRDG(ACRDGDA,"GP",ACRX,0))
S Y=$G(^ACRDG(ACRDGDA,"GP",ACRX,"DT"))
S ACRY=$P(X,U)
S ACRACTPT=$P(X,U,2)
S ACRGLB=$P(Y,U)
S ACRDFN=$P(Y,U,2)
D SARRAY^ACRFDF1
I $D(ACRQUIT)!$D(ACROUT) D GMESS Q
Q
ED ;DISPLAY AND EDIT CURRENT DISTRIBUTION
W @IOF
W !,"Current Distribution:"
W !!,"ID NO."
W ?8,"LOCATION"
W ?40,$S(ACRDM=1:"PERCENT",1:"AMOUNT")
W !,"------"
W ?8,"------------------------------"
W ?40,"------------"
S (ACRZ,ACRX,ACRJ)=0
F S ACRX=$O(ACRX(ACRX)) Q:'ACRX D ED1
W !,"------"
W ?8,"------------------------------"
W ?40,"------------"
W !?20,"TOTAL DISTRIBUTED:"
W ?40,$J($FN(ACRZ,"P",2),10),$S(ACRDM=1:"%",1:"")
I ACRDM=2 S ACRQUIT="" Q
S DIR(0)="YO"
S DIR("A")="Change Distribution (Y/N)"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(X["N")
S DIR(0)="NO^1:"_ACRJ_"^K:'$D(ACRX(X)) X"
S DIR("A")="Which ID NO."
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S ACRX=X
S ACRY=$P(ACRX(X),U)
S ACRCUM=ACRCUM-$P(ACRX(X),U,2)
D SARRAY^ACRFDF1
K ACRQUIT
Q
ED1 ;DISPLAY DISTIBUTION
S ACRJ=ACRJ+1
W !,ACRX
W ?8,$P(ACRX(ACRX),U)
W ?40,$J($FN($P(ACRX(ACRX),U,2),"P",2),10)
S ACRZ=ACRZ+$P(ACRX(ACRX),U,2)
Q
PAUSE K ACRPSE
S DIR(0)="YO"
S DIR("A")=" List more MEMBERS"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y=1
S ACRPSE=""
Q
GMESS K ACRX
W !!,*7,*7,"This distribution was not completed."
W !,"All entries must be redone."
Q
ACRFDF ;IHS/OIRM/DSD/THL,AEF - DISTRIBUTE FUNDS; [ 07/23/2002 5:47 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
+2 ;;ROUTINE USED TO MANAGE DISTRIBUTION OF FUNDS
EN ;EP;TO DISTRIBUTE FUNDS
+1 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)!$DATA(@ACRGL@("M",ACRZDA))
QUIT
EXIT KILL ACRX,ACRQUIT,ACRY,ACRZ,ACRDM,ACRDGDA,ACRDG,ACRGL,ACRCUM,ACRDFN,ACRGLB,ACRACTPT
+1 QUIT
EN1 ;SELECT TYPE OF DISTRIBUTION
+1 WRITE @IOF
+2 WRITE !,"Distribute Funds to:"
+3 SET DIR(0)="SO^1:Distribution Group;2:Single Distribution^K:X'?1N!(X<1)!(X>2) X"
+4 SET DIR("A")=" Option"
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+7 IF X=1
DO GROUP
KILL ACRQUIT
QUIT
+8 IF X=2
SET ACRQUIT=""
+9 QUIT
GROUP ;EP;TO DISTRIBUTE FUNDS TO A FUNDS DISTRIBUTION GROUP
+1 WRITE !!,"Distribute Funds by:"
+2 SET DIR(0)="SO^1:Percent;2:Standard Percent;3:Fixed Amount^K:X'?1N!(X<1)!(X>3) X"
+3 SET DIR("A")=" Option"
+4 DO DIR^ACRFDIC
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 SET ACRDM=$SELECT(X=1:1,X=2:2,1:3)
+7 SET ACRGL=$PIECE($PIECE($TEXT(@ACRENTRY^ACRFCTL1),";;",3),"(")
+8 DO GET^ACRFEDG1
+9 IF '$DATA(ACRDG)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 DO DISPLAY^ACRFEDG
+11 SET DIR(0)="YO"
+12 SET DIR("A")="Distribute the funds to Group Members listed above"
+13 SET DIR("B")="NO"
+14 WRITE !
+15 DO DIR^ACRFDIC
+16 IF Y'=1
QUIT
+17 SET (ACRCUM,ACRX)=0
+18 ;ACR*2.1*3.14
FOR
SET ACRX=$ORDER(^ACRDG(ACRDGDA,"GP",ACRX))
IF 'ACRX
QUIT
DO GROUP1
IF '$DATA(ACRX)
QUIT
+19 IF '$DATA(ACRX)
QUIT
+20 FOR
DO ED
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+21 KILL ACRQUIT
+22 SET DIR(0)="YO"
+23 SET DIR("A")="Complete Distribution (Y/N)"
+24 WRITE !
+25 DO DIR^ACRFDIC
+26 IF "N"[X!'$DATA(ACRX)!$DATA(ACRQUIT)!$DATA(ACROUT)
Begin DoDot:1
+27 WRITE !!,*7,*7,"This distribution was NOT completed."
+28 WRITE !,"You must begin again to complete the distribution."
+29 HANG 2
End DoDot:1
QUIT
+30 WRITE !!,"To complete the Distribution you must enter detailed information"
+31 WRITE !,"on each distribution. This data entry process will now begin."
+32 SET DIR(0)="YO"
+33 SET DIR("A")="Sure you want to continue"
+34 SET DIR("B")="NO"
+35 WRITE !
+36 DO DIR^ACRFDIC
+37 IF Y'=1
QUIT
+38 DO DIST^ACRFDF1
+39 QUIT
GROUP1 NEW X,Y
+1 SET X=$GET(^ACRDG(ACRDGDA,"GP",ACRX,0))
+2 SET Y=$GET(^ACRDG(ACRDGDA,"GP",ACRX,"DT"))
+3 SET ACRY=$PIECE(X,U)
+4 SET ACRACTPT=$PIECE(X,U,2)
+5 SET ACRGLB=$PIECE(Y,U)
+6 SET ACRDFN=$PIECE(Y,U,2)
+7 DO SARRAY^ACRFDF1
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO GMESS
QUIT
+9 QUIT
ED ;DISPLAY AND EDIT CURRENT DISTRIBUTION
+1 WRITE @IOF
+2 WRITE !,"Current Distribution:"
+3 WRITE !!,"ID NO."
+4 WRITE ?8,"LOCATION"
+5 WRITE ?40,$SELECT(ACRDM=1:"PERCENT",1:"AMOUNT")
+6 WRITE !,"------"
+7 WRITE ?8,"------------------------------"
+8 WRITE ?40,"------------"
+9 SET (ACRZ,ACRX,ACRJ)=0
+10 FOR
SET ACRX=$ORDER(ACRX(ACRX))
IF 'ACRX
QUIT
DO ED1
+11 WRITE !,"------"
+12 WRITE ?8,"------------------------------"
+13 WRITE ?40,"------------"
+14 WRITE !?20,"TOTAL DISTRIBUTED:"
+15 WRITE ?40,$JUSTIFY($FNUMBER(ACRZ,"P",2),10),$SELECT(ACRDM=1:"%",1:"")
+16 IF ACRDM=2
SET ACRQUIT=""
QUIT
+17 SET DIR(0)="YO"
+18 SET DIR("A")="Change Distribution (Y/N)"
+19 WRITE !
+20 DO DIR^ACRFDIC
+21 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(X["N")
QUIT
+22 SET DIR(0)="NO^1:"_ACRJ_"^K:'$D(ACRX(X)) X"
+23 SET DIR("A")="Which ID NO."
+24 DO DIR^ACRFDIC
+25 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+26 SET ACRX=X
+27 SET ACRY=$PIECE(ACRX(X),U)
+28 SET ACRCUM=ACRCUM-$PIECE(ACRX(X),U,2)
+29 DO SARRAY^ACRFDF1
+30 KILL ACRQUIT
+31 QUIT
ED1 ;DISPLAY DISTIBUTION
+1 SET ACRJ=ACRJ+1
+2 WRITE !,ACRX
+3 WRITE ?8,$PIECE(ACRX(ACRX),U)
+4 WRITE ?40,$JUSTIFY($FNUMBER($PIECE(ACRX(ACRX),U,2),"P",2),10)
+5 SET ACRZ=ACRZ+$PIECE(ACRX(ACRX),U,2)
+6 QUIT
PAUSE KILL ACRPSE
+1 SET DIR(0)="YO"
+2 SET DIR("A")=" List more MEMBERS"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y=1
QUIT
+7 SET ACRPSE=""
+8 QUIT
GMESS KILL ACRX
+1 WRITE !!,*7,*7,"This distribution was not completed."
+2 WRITE !,"All entries must be redone."
+3 QUIT
