- ACRFDIS ;IHS/OIRM/DSD/THL,AEF - ENTER DISTRIBUTION OF DEPARTMENT ACCOUNT; [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;;ROUTINE USED TO ENTER DISTRIBUTION OF DEPARTMENT ACCOUNT
- EN N ACRI,ACRJ
- F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
- EXIT K ACR,ACRX,ACRLBDA,ACRALCDA,ACROBJ,ACROBJDA,ACRQUIT,ACRDA,ACRA,ACRMAX,ACRQUIT,ACRQUIT,ACRCANDA
- Q
- EN1 D DISPLAY
- D ENTER
- Q
- DISPLAY W @IOF
- D:$D(ACRDISP) SUBHEAD^ACRFDTP2
- W !
- K ACR,ACRX
- D HEAD
- D OCDIS
- S ACRJ=0
- F ACRI=1:1 D Q:$D(ACRQUIT)!$D(ACROUT)
- .D LIST
- .D PAUSE:ACRI#10=0
- K ACRQUIT
- Q
- LIST I '$D(ACRX(ACRI)) S ACRQUIT="" Q
- S ACRJ=ACRI
- D W
- Q:'$D(ACRX(ACRJ+1))
- S ACRJ=ACRI+10
- D W:$D(ACRX(ACRJ))
- Q
- W I ACRJ=ACRI D
- .W !,ACRJ
- .W ?4
- I ACRJ'=ACRI D
- .W ?40,"| ",ACRJ
- .W ?46
- W $E($P(ACRX(ACRJ),U,5),1,4)
- W ?$X+1,$J($P($P(ACRX(ACRJ),U),"."),9)
- W ?$X+1,$J($P($P(ACRX(ACRJ),U,2),"."),7)
- W ?$X+1,$J($P($P(ACRX(ACRJ),U,4),"."),7)
- Q
- OC2 S ACRA=$O(ACR(ACRX,0))
- F ACRI=1:1:4 S ACRI(ACRI)=$P(ACR(ACRX,ACRA),U,ACRI)
- Q
- ENTER S DIR(0)="SO^1:Add DISTRIBUTION;2:Change DISTRIBUTION"
- S DIR("A")="Which one"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- N ACRY
- S ACRY=Y
- D:ACRY=1 NEW
- D:ACRY=2 MOD
- Q
- NEW S DIC="^AUTTOBJC("
- S DIC(0)="AEMQZ"
- S DIC("A")="Which OBJECT CODE: "
- W !
- D DIC^ACRFDIC
- I $E(X)[U!(Y<1) S ACRQUIT="" Q
- S ACROBJDA=+Y,ACROBJ=Y(0,0)_" "
- I $D(ACR(ACROBJ)) D W1 Q
- S DIR(0)="YO"
- S DIR("A")="ADD a DISTRIBUTION for OBJECT CODE "_ACROBJ
- W !
- D DIR^ACRFDIC
- Q:Y'=1
- S X=0.00
- S DIC="^ACRFDIS("
- S DIC(0)="L"
- S DIC("DR")="1////0.00;2////0.00;3////0.00;.02////"_DT_";.09////"_ACRFDNFY_";.03////"_ACROBJDA_";.05////"_ACRALCDA_";.06////"_ACRCANDA_";.07////"_ACRSSADA_";.08////"_ACRALWDA_";.04////"_ACRLBDA
- D FILE^ACRFDIC
- S DA=+Y
- S DIE="^ACRFDIS("
- S DR=".01NEW DISTRIBUTION....: ;.02////"_DT
- W !!
- S ACR="!,""AMOUNT AVAILABLE....: "",@ACRON,$J($FN(ACRFDNDD,""P"",2),10),@ACROF"
- W @ACR
- D DIE^ACRFDIC
- Q
- MOD S DIR(0)="NO^1:"_ACRMAX
- S DIR("A")="Which one"
- W !
- D DIR^ACRFDIC
- I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
- S ACRY=Y
- S ACRA=$P(ACRX(ACRY),U,3)
- S ACROBJ=$P(^AUTTOBJC($P(^ACRFDIS(ACRA,0),U,3),0),U)
- W !!?5,"CURRENT DISTRIBUTION FOR THIS OBJECT CODE FOR THIS DEPARTMENT ACCOUNT"
- W !?5,"----------------------------------------------------------------"
- W !?10,"OBJT"
- W !?10,"CLSS"
- W ?16,"DISTRIBTION"
- W !?10,"----"
- W ?16,"-----------"
- W !?10,ACROBJ
- W ?16,$J($P(^ACRFDIS(ACRA,0),U),11)
- S DA=ACRA
- S DIE="^ACRFDIS("
- S DR=".01NEW DISTRIBUTION...."
- S ACR="!,""AMOUNT AVAILABLE....: "",@ACRON,$J($FN(ACRFDNDD,""P"",2),10),@ACROF"
- W !!
- W @ACR
- D DIE^ACRFDIC
- Q
- PAUSE S DIR(0)="YO"
- S DIR("A")=" List more OBJECT CODES"
- S DIR("B")="NO"
- W !
- D DIR^ACRFDIC
- I Y=1 D Q
- .S ACRI=ACRI+10
- .D HEAD
- S ACRQUIT=""
- Q
- OCDIS S ACRA=0
- F ACRJ=1:1 S ACRA=$O(^ACRFDIS("LB",ACRLBDA,ACRA)) Q:'ACRA D OCDIS1
- S ACRMAX=ACRJ-1
- S ACRA=0
- F ACRJ=1:1 S ACRA=$O(ACR(ACRA)) Q:'ACRA S ACRX(ACRJ)=ACR(ACRA)
- S ACRMAX=ACRJ-1
- Q
- OCDIS1 S ACR=$P(^AUTTOBJC($P(^ACRFDIS(ACRA,0),U,3),0),U)_" "
- S:'$D(ACR(ACR)) ACR(ACR)="^^"_ACRA_"^^"_ACR
- D OCDIS2
- Q
- OCDIS2 S $P(ACR(ACR),U)=$P(ACR(ACR),U)+$P(^ACRFDIS(ACRA,0),U)
- F ACRI=2,4 S $P(ACR(ACR),U,ACRI)=$P(ACR(ACR),U,ACRI)+$P($G(^ACRFDIS(ACRA,"BA")),U,ACRI)
- Q
- HEAD W !?4,"OBJT"
- W ?11,"Y-T-D"
- W ?40,"|"
- W ?46,"OBJT"
- W ?53,"Y-T-D"
- W !,"NO."
- W ?4,"CLSS"
- W ?9,"DISTRIBTN"
- W ?19,"PENDNG"
- W ?27,"OBLGTED"
- W ?40,"| NO."
- W ?46,"CLSS"
- W ?51,"DISTRIBTN"
- W ?61,"PENDNG"
- W ?69,"OBLGTED"
- W !,"---"
- W ?4,"----"
- W ?9,"---------"
- W ?19,"-------"
- W ?27,"-------"
- W ?40,"| ---"
- W ?46,"----"
- W ?51,"---------"
- W ?61,"-------"
- W ?69,"-------"
- Q
- W1 W !!,*7,"A distribution for this OBJECT CODE already exists."
- H 2
- Q
- ACRFDIS ;IHS/OIRM/DSD/THL,AEF - ENTER DISTRIBUTION OF DEPARTMENT ACCOUNT; [ 11/01/2001 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- +2 ;;ROUTINE USED TO ENTER DISTRIBUTION OF DEPARTMENT ACCOUNT
- EN NEW ACRI,ACRJ
- +1 FOR
- DO EN1
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- EXIT KILL ACR,ACRX,ACRLBDA,ACRALCDA,ACROBJ,ACROBJDA,ACRQUIT,ACRDA,ACRA,ACRMAX,ACRQUIT,ACRQUIT,ACRCANDA
- +1 QUIT
- EN1 DO DISPLAY
- +1 DO ENTER
- +2 QUIT
- DISPLAY WRITE @IOF
- +1 IF $DATA(ACRDISP)
- DO SUBHEAD^ACRFDTP2
- +2 WRITE !
- +3 KILL ACR,ACRX
- +4 DO HEAD
- +5 DO OCDIS
- +6 SET ACRJ=0
- +7 FOR ACRI=1:1
- Begin DoDot:1
- +8 DO LIST
- +9 IF ACRI#10=0
- DO PAUSE
- End DoDot:1
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +10 KILL ACRQUIT
- +11 QUIT
- LIST IF '$DATA(ACRX(ACRI))
- SET ACRQUIT=""
- QUIT
- +1 SET ACRJ=ACRI
- +2 DO W
- +3 IF '$DATA(ACRX(ACRJ+1))
- QUIT
- +4 SET ACRJ=ACRI+10
- +5 IF $DATA(ACRX(ACRJ))
- DO W
- +6 QUIT
- W IF ACRJ=ACRI
- Begin DoDot:1
- +1 WRITE !,ACRJ
- +2 WRITE ?4
- End DoDot:1
- +3 IF ACRJ'=ACRI
- Begin DoDot:1
- +4 WRITE ?40,"| ",ACRJ
- +5 WRITE ?46
- End DoDot:1
- +6 WRITE $EXTRACT($PIECE(ACRX(ACRJ),U,5),1,4)
- +7 WRITE ?$X+1,$JUSTIFY($PIECE($PIECE(ACRX(ACRJ),U),"."),9)
- +8 WRITE ?$X+1,$JUSTIFY($PIECE($PIECE(ACRX(ACRJ),U,2),"."),7)
- +9 WRITE ?$X+1,$JUSTIFY($PIECE($PIECE(ACRX(ACRJ),U,4),"."),7)
- +10 QUIT
- OC2 SET ACRA=$ORDER(ACR(ACRX,0))
- +1 FOR ACRI=1:1:4
- SET ACRI(ACRI)=$PIECE(ACR(ACRX,ACRA),U,ACRI)
- +2 QUIT
- ENTER SET DIR(0)="SO^1:Add DISTRIBUTION;2:Change DISTRIBUTION"
- +1 SET DIR("A")="Which one"
- +2 DO DIR^ACRFDIC
- +3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +4 NEW ACRY
- +5 SET ACRY=Y
- +6 IF ACRY=1
- DO NEW
- +7 IF ACRY=2
- DO MOD
- +8 QUIT
- NEW SET DIC="^AUTTOBJC("
- +1 SET DIC(0)="AEMQZ"
- +2 SET DIC("A")="Which OBJECT CODE: "
- +3 WRITE !
- +4 DO DIC^ACRFDIC
- +5 IF $EXTRACT(X)[U!(Y<1)
- SET ACRQUIT=""
- QUIT
- +6 SET ACROBJDA=+Y
- SET ACROBJ=Y(0,0)_" "
- +7 IF $DATA(ACR(ACROBJ))
- DO W1
- QUIT
- +8 SET DIR(0)="YO"
- +9 SET DIR("A")="ADD a DISTRIBUTION for OBJECT CODE "_ACROBJ
- +10 WRITE !
- +11 DO DIR^ACRFDIC
- +12 IF Y'=1
- QUIT
- +13 SET X=0.00
- +14 SET DIC="^ACRFDIS("
- +15 SET DIC(0)="L"
- +16 SET DIC("DR")="1////0.00;2////0.00;3////0.00;.02////"_DT_";.09////"_ACRFDNFY_";.03////"_ACROBJDA_";.05////"_ACRALCDA_";.06////"_ACRCANDA_";.07////"_ACRSSADA_";.08////"_ACRALWDA_";.04////"_ACRLBDA
- +17 DO FILE^ACRFDIC
- +18 SET DA=+Y
- +19 SET DIE="^ACRFDIS("
- +20 SET DR=".01NEW DISTRIBUTION....: ;.02////"_DT
- +21 WRITE !!
- +22 SET ACR="!,""AMOUNT AVAILABLE....: "",@ACRON,$J($FN(ACRFDNDD,""P"",2),10),@ACROF"
- +23 WRITE @ACR
- +24 DO DIE^ACRFDIC
- +25 QUIT
- MOD SET DIR(0)="NO^1:"_ACRMAX
- +1 SET DIR("A")="Which one"
- +2 WRITE !
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- KILL ACRQUIT
- QUIT
- +5 SET ACRY=Y
- +6 SET ACRA=$PIECE(ACRX(ACRY),U,3)
- +7 SET ACROBJ=$PIECE(^AUTTOBJC($PIECE(^ACRFDIS(ACRA,0),U,3),0),U)
- +8 WRITE !!?5,"CURRENT DISTRIBUTION FOR THIS OBJECT CODE FOR THIS DEPARTMENT ACCOUNT"
- +9 WRITE !?5,"----------------------------------------------------------------"
- +10 WRITE !?10,"OBJT"
- +11 WRITE !?10,"CLSS"
- +12 WRITE ?16,"DISTRIBTION"
- +13 WRITE !?10,"----"
- +14 WRITE ?16,"-----------"
- +15 WRITE !?10,ACROBJ
- +16 WRITE ?16,$JUSTIFY($PIECE(^ACRFDIS(ACRA,0),U),11)
- +17 SET DA=ACRA
- +18 SET DIE="^ACRFDIS("
- +19 SET DR=".01NEW DISTRIBUTION...."
- +20 SET ACR="!,""AMOUNT AVAILABLE....: "",@ACRON,$J($FN(ACRFDNDD,""P"",2),10),@ACROF"
- +21 WRITE !!
- +22 WRITE @ACR
- +23 DO DIE^ACRFDIC
- +24 QUIT
- PAUSE SET DIR(0)="YO"
- +1 SET DIR("A")=" List more OBJECT CODES"
- +2 SET DIR("B")="NO"
- +3 WRITE !
- +4 DO DIR^ACRFDIC
- +5 IF Y=1
- Begin DoDot:1
- +6 SET ACRI=ACRI+10
- +7 DO HEAD
- End DoDot:1
- QUIT
- +8 SET ACRQUIT=""
- +9 QUIT
- OCDIS SET ACRA=0
- +1 FOR ACRJ=1:1
- SET ACRA=$ORDER(^ACRFDIS("LB",ACRLBDA,ACRA))
- IF 'ACRA
- QUIT
- DO OCDIS1
- +2 SET ACRMAX=ACRJ-1
- +3 SET ACRA=0
- +4 FOR ACRJ=1:1
- SET ACRA=$ORDER(ACR(ACRA))
- IF 'ACRA
- QUIT
- SET ACRX(ACRJ)=ACR(ACRA)
- +5 SET ACRMAX=ACRJ-1
- +6 QUIT
- OCDIS1 SET ACR=$PIECE(^AUTTOBJC($PIECE(^ACRFDIS(ACRA,0),U,3),0),U)_" "
- +1 IF '$DATA(ACR(ACR))
- SET ACR(ACR)="^^"_ACRA_"^^"_ACR
- +2 DO OCDIS2
- +3 QUIT
- OCDIS2 SET $PIECE(ACR(ACR),U)=$PIECE(ACR(ACR),U)+$PIECE(^ACRFDIS(ACRA,0),U)
- +1 FOR ACRI=2,4
- SET $PIECE(ACR(ACR),U,ACRI)=$PIECE(ACR(ACR),U,ACRI)+$PIECE($GET(^ACRFDIS(ACRA,"BA")),U,ACRI)
- +2 QUIT
- HEAD WRITE !?4,"OBJT"
- +1 WRITE ?11,"Y-T-D"
- +2 WRITE ?40,"|"
- +3 WRITE ?46,"OBJT"
- +4 WRITE ?53,"Y-T-D"
- +5 WRITE !,"NO."
- +6 WRITE ?4,"CLSS"
- +7 WRITE ?9,"DISTRIBTN"
- +8 WRITE ?19,"PENDNG"
- +9 WRITE ?27,"OBLGTED"
- +10 WRITE ?40,"| NO."
- +11 WRITE ?46,"CLSS"
- +12 WRITE ?51,"DISTRIBTN"
- +13 WRITE ?61,"PENDNG"
- +14 WRITE ?69,"OBLGTED"
- +15 WRITE !,"---"
- +16 WRITE ?4,"----"
- +17 WRITE ?9,"---------"
- +18 WRITE ?19,"-------"
- +19 WRITE ?27,"-------"
- +20 WRITE ?40,"| ---"
- +21 WRITE ?46,"----"
- +22 WRITE ?51,"---------"
- +23 WRITE ?61,"-------"
- +24 WRITE ?69,"-------"
- +25 QUIT
- W1 WRITE !!,*7,"A distribution for this OBJECT CODE already exists."
- +1 HANG 2
- +2 QUIT
