- 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
