- ACRFEA2 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 09/23/2005 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- ;;CONTINUATION OF ACRFEA
- EDIE ;EP;TO EDIT DOCUMENT
- I '$D(ACRNEW)&'$D(ACRNEWOB) D Q:$D(ACRQUIT)!$D(ACROUT)
- .S:'$D(DIR("A")) DIR("A")=" Edit this data? "
- .D OUT
- I $G(ACRY)=1 D EDIE1
- Q
- EDIE1 ;EP;
- S DA=ACRZDA
- S DIE=ACRDIE
- S DR=ACRDR
- S DIE("NO^")="NO"
- I ACRENTRY["OBLAMT" D
- .K DIE("NO^")
- .S ACRCAN=$P(^ACROBL(ACRDOCDA,0),U,4)
- .S DA=ACRDOCDA
- .S DIE="^ACROBL("
- .S DR=$P(ACRENTRY,";;",5)
- .S:ACRREF=130!(ACRREF=600) DR="[ACR TRAVEL INFO]"
- W !
- D DDS^ACRFDIC
- G:'$D(ACRSCREN) EDIEOUT
- K ACRSCREN
- D DIE^ACRFDIC
- EDIEOUT S:ACRENTRY["OBLAMT" ACRCAN=$P(^AUTTCAN(ACRCAN,0),U)
- Q
- OUT ;EP;FOR FAST OUT CHOICE
- S DIR(0)="SOA^1:YES;2:NO;3:OUT"
- S:'$D(DIR("B")) DIR("B")="NO"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- S ACRY=+Y
- I ACRY=3 S (ACRQUIT,ACROUT)=""
- I ACRY=2 S ACRQUIT=""
- Q
- DIC1 ;EP;
- K ACRNEW
- D ADD
- Q:$D(ACRQUIT)
- S DIC=ACRDIC
- S DIC(0)=ACRDIC(0)
- S DIC("A")=ACRDIC("A")
- S D=ACRD
- W !
- I $D(ACRNEW),$G(ACRZDA) S Y=ACRZDA,$P(ACRYY,U,3)=1,X=ACRZDA,Y(0,0)=@(ACRDIC_ACRZDA_",0)")
- E D
- .I ACRDIC["ACRLOCB",ACRDIC(0)["L" W !,"(NON-Personnel Amount ONLY)"
- .D DIC^ACRFDIC
- .S ACRYY=Y
- .Q:+Y<1
- .Q:$P(Y,U,3)'=1
- .S DA=+Y
- .N Y
- .S DIE=ACRDIC
- .S DR=".8////O"
- .D DIE^ACRFDIC
- I U[$E(X)!(X="")!(+Y<1) S ACRQUIT="" Q
- I $P($G(ACRYY),U,3)=1,ACRENTRY'["APPAMT",$G(ACRORIG)'="D",(ACRFTOT+Y(0,0))>ACRFDNAM D Q
- .S DA=+Y
- .S DIK=ACRDIC
- .S:DIK'["(" DIK=DIK_"("
- .D EXCTOT^ACRFWARN
- .S ACRQUIT=""
- S:$P(ACRYY,U,3)=1 ACRNEW=""
- S ACRZDA=+Y
- S ACRZY=Y
- I $P(ACRYY,U,3)=1 D
- .S ACRNEW=""
- .Q:ACRDIC["OBL"
- .S (DA(1),DA)=+Y
- .S DIC=ACRDIC_DA_",""SC"","
- .S DIC(0)="L"
- .S:'$D(@(DIC_"0)")) @(DIC_"0)")="^"_$S(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
- .D NOW^%DTC
- .S DIC("DR")=".17////"_%_";.18////"_DUZ
- .S X=DUZ
- .D FILE^ACRFDIC
- Q
- ACRDIE ;EP;
- S (ACRDOCDA,DA)=+ACROBLDT
- S ACRLBDA=$P(ACROBL0,U,3)
- S ACRDOC=$S($P(ACRDOC0,U,2)]""&'$D(ACRREQST):$P(ACRDOC0,U,2),1:$P(ACRDOC0,U))
- S ACRREFDA=$P(ACRDOC0,U,13)
- S ACRREF=$P(^AUTTDOCR(ACRREFDA,0),U)
- I "^103^349^326^210^"[(U_ACRREF_U)&($D(ACRREQST)!$D(ACRCOMP)) D I 1
- .S ACRREFX=116
- .S ACRREFDA=$O(^AUTTDOCR("B",116,0))
- E I ACRREF=600&($D(ACRREQST)!$D(ACRCOMP)) D I 1
- .S ACRREFX=130
- .S ACRREFDA=$O(^AUTTDOCR("B",130,0))
- E S ACRREFX=$S(ACRREF=210:103,1:ACRREF)
- S ACRDATA=$T(@ACRREFX^ACRFCTL1)
- S ACRRTN2="^"_$P(ACRDATA,";;",3)
- S ACRDIE="^ACRDOC("
- S ACRDR="[ACR "_$P(ACRDATA,";;",2)_"]"
- D ^ACRFCHK:ACRREF'=103&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210)&'$D(ACRREV)
- I ACRREFX=349!(ACRREFX=326) D
- .N X
- .S X=$P(^ACRDOC(ACRDOCDA,0),U,24)
- .I X=1 S ACRDR="[ACR CONTRACT ACTION-26]"
- .I X=2 S ACRDR="[ACR CONTRACT ACTION-33]"
- .I X=3 S ACRDR="[ACR CONTRACT ACTION-1449]"
- .I X=4 S ACRDR="[ACR CONTRACT ACTION-TRIBAL]"
- S DA=ACRDOCDA
- S DIE=ACRDIE
- S DR=ACRDR
- I $D(ACRREV) S ACRSCREN=""
- E D DDS^ACRFDIC
- I '$D(ACRSCREN) S ACRQUIT="" Q
- K ACRSCREN
- D DISP
- I $D(ACRREV) D PAUSE^ACRFWARN Q
- K ACRQUIT
- D ^ACRFEA3
- D ^ACRFCHK:'$D(ACRQUIT)
- Q
- DRAFT ;EP;UTILITY TO FLAG DOCUMENT FOR DRAFT CHECK PAYMENT
- S DA=ACRDOCDA
- S DIE="^ACRDOC("
- S DR=".12 Draft Payment"
- D DIE^ACRFDIC
- Q
- APPROVE1 ;EP;
- W !
- D WAIT^DICD:$E($G(IOST),1,2)="C-"
- D ^ACRFAPVS
- Q
- TRANS ;EP;FOR ELECTRONIC TRANSMISSION OF FUNDS DISTRIBUTION
- W !
- S DIR(0)="YO"
- S DIR("A")="Transmit this "_ACRY_" now"
- S DIR("B")="NO"
- D DIR^ACRFDIC
- Q:ACRY'=1
- D ^%ZIS
- Q:$D(DUOUT)!$D(DTOUT)!(POP'=0)
- D ^ACRFCAA,^%ZISC
- Q
- DISP W @IOF
- S ACRTXDA=$P(^ACRDOC(ACRDOCDA,0),U,4)
- ;S ACREB=$P(^VA(200,$P(^ACROBL(ACRDOCDA,0),U,5),0),U) ;ACR*2.1*19.02 IM16848
- S ACREB=$$NAME2^ACRFUTL1($P(^ACROBL(ACRDOCDA,0),U,5)) ;ACR*2.1*19.02 IM16848
- W !,"DOCUMENT NO: ",@ACRON,ACRDOC,@ACROF," ",$P(^ACRTXTYP(ACRTXDA,0),U)
- W !,"PREPARED BY: ",$P($P(ACREB,",",2)," ")," ",$P(ACREB,",")
- K ACREB
- I $D(ACRPRCS),$D(ACRAPDA) D
- .;W ?$X+1,"REVIEW FOR: ",$P(^VA(200,$P(^ACRAPVS(ACRAPDA,0),U,3),0),U) ;ACR*2.1*19.02 IM16848
- .W ?$X+1,"REVIEW FOR: ",$$NAME2^ACRFUTL1($P(^ACRAPVS(ACRAPDA,0),U,3)) ;ACR*2.1*19.02 IM16848
- N ACRI
- W $$DASH^ACRFMENU
- N DXS,DIP,DC,DN,D0
- S D0=ACRDOCDA
- D @ACRRTN2
- I $D(ACRDOCDT),$P(ACRDOCDT,U,5)]"" D
- .W !,"JUSTIFY PRIORITY:"
- .N ACR
- .F ACR=5:1:9 I $P(ACRDOCDT,U,ACR)]"" D
- ..W:ACR'=5 !
- ..W ?19,$P(ACRDOCDT,U,ACR)
- W $$DASH^ACRFMENU
- Q
- ADD ;ADD OR EDIT ACCOUNT
- S DIR(0)="SO^1:ADD New Account;2:INCREASE Existing Account;3:DECREASE Existing Account;4:EDIT Existing Account"
- S DIR("A")="Which one"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)
- I "1234"'[+Y S ACRQUIT="" Q
- I Y=1 D Q
- .K ACRQUIT,ACRNEW
- .S ACRDIC(0)="AELQZ"
- .S ACRDIC("A")="New ACCOUNT DOLLAR AMOUNT: "
- I Y=2!(Y=3) D Q
- .D ORIG
- I Y=4 D Q
- .S ACRDIC(0)=$TR(ACRDIC(0),"L","")
- Q
- ORIG ;ID INCREASES AND DECREASES
- K ACRORIG
- N ACRXX,ACRAMT,ACR0,ACRDT
- S ACRORIG=$S(Y=2:"I",Y=3:"D",1:"")
- I ACRORIG="" S ACRQUIT="" Q
- D AMT
- Q:$D(ACRQUIT)
- S DIC=ACRDIC
- S DIC(0)="AENQZ"
- S DIC("A")="ID NO. of Account to be Increased or Decreased: "
- S DIC("S")="I $P(^(0),U,8)=""O"""
- W !
- D DIC^ACRFDIC
- I +Y<1 S ACRQUIT="" Q
- S ACRXX=+Y
- S X=ACRAMT
- S DIC=ACRDIC
- S DIC(0)="L"
- S ACR0=@(ACRDIC_ACRXX_",0)"),ACRDT=@(ACRDIC_ACRXX_","_"""DT"""_")")
- S DIC("DR")=".02////"_$P(ACR0,U,2)_";.03////"_$P(ACR0,U,3)_";.04////"_$P(ACR0,U,4)_";.05////"_$P(ACR0,U,5)_";.16////N;.17////"_DT_";.18////"_DUZ_";.2////"_$P(ACR0,U,12)_";.21////"_$P(ACR0,U,21)_";.3////"_$P(ACR0,U,13)
- S DIC("DR")=DIC("DR")_";.8////"_ACRORIG_";.9////"_ACRXX
- D FILE^ACRFDIC
- S (ACRZDA,DA)=+Y
- S ACRYY=Y
- S DIE=ACRDIC
- S DR="10////"_$P(ACRDT,U)_";20////"_$P(ACRDT,U,2)_";30////"_$P(ACRDT,U,3)_";40////"_$P(ACRDT,U,4)_";50////"_$P(ACRDT,U,5)_";60////"_$P(ACRDT,U,6)_";70////"_$P(ACRDT,U,7)_";80////"_$P(ACRDT,U,8)_";90////"_$P(ACRDT,U,9)
- S DR=DR_";110////"_$P(ACRDT,U,11)_";130////"_$P(ACRDT,U,13)_";150////"_$P(ACRDT,U,15)
- D DIE^ACRFDIC
- S (ACRQUIT,ACRNEW)=""
- S X=DUZ
- S DA(1)=ACRZDA
- S DIC=ACRDIC_ACRZDA_",""SC"","
- S DIC(0)="L"
- S:'$D(@(ACRDIC_ACRZDA_",""SC"",0)")) $P(^(0),U,2)=$S(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
- D FILE^ACRFDIC
- Q
- AMT ;ENTER ACCOUNT AMOUNT
- S DIR(0)="NOA^0:9999999"
- I $G(ACRDIC)["ACRLOCB",$G(ACRDIC(0))["L" S DIR("A",1)="(NON-Personnel Amount ONLY)"
- S DIR("A")="Amount of Increase/Decrease: "
- W !
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)
- S ACRAMT=Y
- Q
- ACRFEA2 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 09/23/2005 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- +2 ;;CONTINUATION OF ACRFEA
- EDIE ;EP;TO EDIT DOCUMENT
- +1 IF '$DATA(ACRNEW)&'$DATA(ACRNEWOB)
- Begin DoDot:1
- +2 IF '$DATA(DIR("A"))
- SET DIR("A")=" Edit this data? "
- +3 DO OUT
- End DoDot:1
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +4 IF $GET(ACRY)=1
- DO EDIE1
- +5 QUIT
- EDIE1 ;EP;
- +1 SET DA=ACRZDA
- +2 SET DIE=ACRDIE
- +3 SET DR=ACRDR
- +4 SET DIE("NO^")="NO"
- +5 IF ACRENTRY["OBLAMT"
- Begin DoDot:1
- +6 KILL DIE("NO^")
- +7 SET ACRCAN=$PIECE(^ACROBL(ACRDOCDA,0),U,4)
- +8 SET DA=ACRDOCDA
- +9 SET DIE="^ACROBL("
- +10 SET DR=$PIECE(ACRENTRY,";;",5)
- +11 IF ACRREF=130!(ACRREF=600)
- SET DR="[ACR TRAVEL INFO]"
- End DoDot:1
- +12 WRITE !
- +13 DO DDS^ACRFDIC
- +14 IF '$DATA(ACRSCREN)
- GOTO EDIEOUT
- +15 KILL ACRSCREN
- +16 DO DIE^ACRFDIC
- EDIEOUT IF ACRENTRY["OBLAMT"
- SET ACRCAN=$PIECE(^AUTTCAN(ACRCAN,0),U)
- +1 QUIT
- OUT ;EP;FOR FAST OUT CHOICE
- +1 SET DIR(0)="SOA^1:YES;2:NO;3:OUT"
- +2 IF '$DATA(DIR("B"))
- SET DIR("B")="NO"
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +5 SET ACRY=+Y
- +6 IF ACRY=3
- SET (ACRQUIT,ACROUT)=""
- +7 IF ACRY=2
- SET ACRQUIT=""
- +8 QUIT
- DIC1 ;EP;
- +1 KILL ACRNEW
- +2 DO ADD
- +3 IF $DATA(ACRQUIT)
- QUIT
- +4 SET DIC=ACRDIC
- +5 SET DIC(0)=ACRDIC(0)
- +6 SET DIC("A")=ACRDIC("A")
- +7 SET D=ACRD
- +8 WRITE !
- +9 IF $DATA(ACRNEW)
- IF $GET(ACRZDA)
- SET Y=ACRZDA
- SET $PIECE(ACRYY,U,3)=1
- SET X=ACRZDA
- SET Y(0,0)=@(ACRDIC_ACRZDA_",0)")
- +10 IF '$TEST
- Begin DoDot:1
- +11 IF ACRDIC["ACRLOCB"
- IF ACRDIC(0)["L"
- WRITE !,"(NON-Personnel Amount ONLY)"
- +12 DO DIC^ACRFDIC
- +13 SET ACRYY=Y
- +14 IF +Y<1
- QUIT
- +15 IF $PIECE(Y,U,3)'=1
- QUIT
- +16 SET DA=+Y
- +17 NEW Y
- +18 SET DIE=ACRDIC
- +19 SET DR=".8////O"
- +20 DO DIE^ACRFDIC
- End DoDot:1
- +21 IF U[$EXTRACT(X)!(X="")!(+Y<1)
- SET ACRQUIT=""
- QUIT
- +22 IF $PIECE($GET(ACRYY),U,3)=1
- IF ACRENTRY'["APPAMT"
- IF $GET(ACRORIG)'="D"
- IF (ACRFTOT+Y(0,0))>ACRFDNAM
- Begin DoDot:1
- +23 SET DA=+Y
- +24 SET DIK=ACRDIC
- +25 IF DIK'["("
- SET DIK=DIK_"("
- +26 DO EXCTOT^ACRFWARN
- +27 SET ACRQUIT=""
- End DoDot:1
- QUIT
- +28 IF $PIECE(ACRYY,U,3)=1
- SET ACRNEW=""
- +29 SET ACRZDA=+Y
- +30 SET ACRZY=Y
- +31 IF $PIECE(ACRYY,U,3)=1
- Begin DoDot:1
- +32 SET ACRNEW=""
- +33 IF ACRDIC["OBL"
- QUIT
- +34 SET (DA(1),DA)=+Y
- +35 SET DIC=ACRDIC_DA_",""SC"","
- +36 SET DIC(0)="L"
- +37 IF '$DATA(@(DIC_"0)"))
- SET @(DIC_"0)")="^"_$SELECT(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
- +38 DO NOW^%DTC
- +39 SET DIC("DR")=".17////"_%_";.18////"_DUZ
- +40 SET X=DUZ
- +41 DO FILE^ACRFDIC
- End DoDot:1
- +42 QUIT
- ACRDIE ;EP;
- +1 SET (ACRDOCDA,DA)=+ACROBLDT
- +2 SET ACRLBDA=$PIECE(ACROBL0,U,3)
- +3 SET ACRDOC=$SELECT($PIECE(ACRDOC0,U,2)]""&'$DATA(ACRREQST):$PIECE(ACRDOC0,U,2),1:$PIECE(ACRDOC0,U))
- +4 SET ACRREFDA=$PIECE(ACRDOC0,U,13)
- +5 SET ACRREF=$PIECE(^AUTTDOCR(ACRREFDA,0),U)
- +6 IF "^103^349^326^210^"[(U_ACRREF_U)&($DATA(ACRREQST)!$DATA(ACRCOMP))
- Begin DoDot:1
- +7 SET ACRREFX=116
- +8 SET ACRREFDA=$ORDER(^AUTTDOCR("B",116,0))
- End DoDot:1
- IF 1
- +9 IF '$TEST
- IF ACRREF=600&($DATA(ACRREQST)!$DATA(ACRCOMP))
- Begin DoDot:1
- +10 SET ACRREFX=130
- +11 SET ACRREFDA=$ORDER(^AUTTDOCR("B",130,0))
- End DoDot:1
- IF 1
- +12 IF '$TEST
- SET ACRREFX=$SELECT(ACRREF=210:103,1:ACRREF)
- +13 SET ACRDATA=$TEXT(@ACRREFX^ACRFCTL1)
- +14 SET ACRRTN2="^"_$PIECE(ACRDATA,";;",3)
- +15 SET ACRDIE="^ACRDOC("
- +16 SET ACRDR="[ACR "_$PIECE(ACRDATA,";;",2)_"]"
- +17 IF ACRREF'=103&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210)&'$DATA(ACRREV)
- DO ^ACRFCHK
- +18 IF ACRREFX=349!(ACRREFX=326)
- Begin DoDot:1
- +19 NEW X
- +20 SET X=$PIECE(^ACRDOC(ACRDOCDA,0),U,24)
- +21 IF X=1
- SET ACRDR="[ACR CONTRACT ACTION-26]"
- +22 IF X=2
- SET ACRDR="[ACR CONTRACT ACTION-33]"
- +23 IF X=3
- SET ACRDR="[ACR CONTRACT ACTION-1449]"
- +24 IF X=4
- SET ACRDR="[ACR CONTRACT ACTION-TRIBAL]"
- End DoDot:1
- +25 SET DA=ACRDOCDA
- +26 SET DIE=ACRDIE
- +27 SET DR=ACRDR
- +28 IF $DATA(ACRREV)
- SET ACRSCREN=""
- +29 IF '$TEST
- DO DDS^ACRFDIC
- +30 IF '$DATA(ACRSCREN)
- SET ACRQUIT=""
- QUIT
- +31 KILL ACRSCREN
- +32 DO DISP
- +33 IF $DATA(ACRREV)
- DO PAUSE^ACRFWARN
- QUIT
- +34 KILL ACRQUIT
- +35 DO ^ACRFEA3
- +36 IF '$DATA(ACRQUIT)
- DO ^ACRFCHK
- +37 QUIT
- DRAFT ;EP;UTILITY TO FLAG DOCUMENT FOR DRAFT CHECK PAYMENT
- +1 SET DA=ACRDOCDA
- +2 SET DIE="^ACRDOC("
- +3 SET DR=".12 Draft Payment"
- +4 DO DIE^ACRFDIC
- +5 QUIT
- APPROVE1 ;EP;
- +1 WRITE !
- +2 IF $EXTRACT($GET(IOST),1,2)="C-"
- DO WAIT^DICD
- +3 DO ^ACRFAPVS
- +4 QUIT
- TRANS ;EP;FOR ELECTRONIC TRANSMISSION OF FUNDS DISTRIBUTION
- +1 WRITE !
- +2 SET DIR(0)="YO"
- +3 SET DIR("A")="Transmit this "_ACRY_" now"
- +4 SET DIR("B")="NO"
- +5 DO DIR^ACRFDIC
- +6 IF ACRY'=1
- QUIT
- +7 DO ^%ZIS
- +8 IF $DATA(DUOUT)!$DATA(DTOUT)!(POP'=0)
- QUIT
- +9 DO ^ACRFCAA
- DO ^%ZISC
- +10 QUIT
- DISP WRITE @IOF
- +1 SET ACRTXDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,4)
- +2 ;S ACREB=$P(^VA(200,$P(^ACROBL(ACRDOCDA,0),U,5),0),U) ;ACR*2.1*19.02 IM16848
- +3 ;ACR*2.1*19.02 IM16848
- SET ACREB=$$NAME2^ACRFUTL1($PIECE(^ACROBL(ACRDOCDA,0),U,5))
- +4 WRITE !,"DOCUMENT NO: ",@ACRON,ACRDOC,@ACROF," ",$PIECE(^ACRTXTYP(ACRTXDA,0),U)
- +5 WRITE !,"PREPARED BY: ",$PIECE($PIECE(ACREB,",",2)," ")," ",$PIECE(ACREB,",")
- +6 KILL ACREB
- +7 IF $DATA(ACRPRCS)
- IF $DATA(ACRAPDA)
- Begin DoDot:1
- +8 ;W ?$X+1,"REVIEW FOR: ",$P(^VA(200,$P(^ACRAPVS(ACRAPDA,0),U,3),0),U) ;ACR*2.1*19.02 IM16848
- +9 ;ACR*2.1*19.02 IM16848
- WRITE ?$X+1,"REVIEW FOR: ",$$NAME2^ACRFUTL1($PIECE(^ACRAPVS(ACRAPDA,0),U,3))
- End DoDot:1
- +10 NEW ACRI
- +11 WRITE $$DASH^ACRFMENU
- +12 NEW DXS,DIP,DC,DN,D0
- +13 SET D0=ACRDOCDA
- +14 DO @ACRRTN2
- +15 IF $DATA(ACRDOCDT)
- IF $PIECE(ACRDOCDT,U,5)]""
- Begin DoDot:1
- +16 WRITE !,"JUSTIFY PRIORITY:"
- +17 NEW ACR
- +18 FOR ACR=5:1:9
- IF $PIECE(ACRDOCDT,U,ACR)]""
- Begin DoDot:2
- +19 IF ACR'=5
- WRITE !
- +20 WRITE ?19,$PIECE(ACRDOCDT,U,ACR)
- End DoDot:2
- End DoDot:1
- +21 WRITE $$DASH^ACRFMENU
- +22 QUIT
- ADD ;ADD OR EDIT ACCOUNT
- +1 SET DIR(0)="SO^1:ADD New Account;2:INCREASE Existing Account;3:DECREASE Existing Account;4:EDIT Existing Account"
- +2 SET DIR("A")="Which one"
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)
- QUIT
- +5 IF "1234"'[+Y
- SET ACRQUIT=""
- QUIT
- +6 IF Y=1
- Begin DoDot:1
- +7 KILL ACRQUIT,ACRNEW
- +8 SET ACRDIC(0)="AELQZ"
- +9 SET ACRDIC("A")="New ACCOUNT DOLLAR AMOUNT: "
- End DoDot:1
- QUIT
- +10 IF Y=2!(Y=3)
- Begin DoDot:1
- +11 DO ORIG
- End DoDot:1
- QUIT
- +12 IF Y=4
- Begin DoDot:1
- +13 SET ACRDIC(0)=$TRANSLATE(ACRDIC(0),"L","")
- End DoDot:1
- QUIT
- +14 QUIT
- ORIG ;ID INCREASES AND DECREASES
- +1 KILL ACRORIG
- +2 NEW ACRXX,ACRAMT,ACR0,ACRDT
- +3 SET ACRORIG=$SELECT(Y=2:"I",Y=3:"D",1:"")
- +4 IF ACRORIG=""
- SET ACRQUIT=""
- QUIT
- +5 DO AMT
- +6 IF $DATA(ACRQUIT)
- QUIT
- +7 SET DIC=ACRDIC
- +8 SET DIC(0)="AENQZ"
- +9 SET DIC("A")="ID NO. of Account to be Increased or Decreased: "
- +10 SET DIC("S")="I $P(^(0),U,8)=""O"""
- +11 WRITE !
- +12 DO DIC^ACRFDIC
- +13 IF +Y<1
- SET ACRQUIT=""
- QUIT
- +14 SET ACRXX=+Y
- +15 SET X=ACRAMT
- +16 SET DIC=ACRDIC
- +17 SET DIC(0)="L"
- +18 SET ACR0=@(ACRDIC_ACRXX_",0)")
- SET ACRDT=@(ACRDIC_ACRXX_","_"""DT"""_")")
- +19 SET DIC("DR")=".02////"_$PIECE(ACR0,U,2)_";.03////"_$PIECE(ACR0,U,3)_";.04////"_$PIECE(ACR0,U,4)_";.05////"_$PIECE(ACR0,U,5)_";.16////N;.17////"_DT_";.18////"_DUZ_";.2////"_$PIECE(ACR0,U,12)_";.21////"_$PIECE(ACR0,U,21)_";.3////"_$PIECE(ACR0,U,
- 13)
- +20 SET DIC("DR")=DIC("DR")_";.8////"_ACRORIG_";.9////"_ACRXX
- +21 DO FILE^ACRFDIC
- +22 SET (ACRZDA,DA)=+Y
- +23 SET ACRYY=Y
- +24 SET DIE=ACRDIC
- +25 SET DR="10////"_$PIECE(ACRDT,U)_";20////"_$PIECE(ACRDT,U,2)_";30////"_$PIECE(ACRDT,U,3)_";40////"_$PIECE(ACRDT,U,4)_";50////"_$PIECE(ACRDT,U,5)_";60////"_$PIECE(ACRDT,U,6)_";70////"_$PIECE(ACRDT,U,7)_";80////"_$PIECE(ACRDT,U,8)_";90////"_...
- ... $PIECE(ACRDT,U,9)
- +26 SET DR=DR_";110////"_$PIECE(ACRDT,U,11)_";130////"_$PIECE(ACRDT,U,13)_";150////"_$PIECE(ACRDT,U,15)
- +27 DO DIE^ACRFDIC
- +28 SET (ACRQUIT,ACRNEW)=""
- +29 SET X=DUZ
- +30 SET DA(1)=ACRZDA
- +31 SET DIC=ACRDIC_ACRZDA_",""SC"","
- +32 SET DIC(0)="L"
- +33 IF '$DATA(@(ACRDIC_ACRZDA_",""SC"",0)"))
- SET $PIECE(^(0),U,2)=$SELECT(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
- +34 DO FILE^ACRFDIC
- +35 QUIT
- AMT ;ENTER ACCOUNT AMOUNT
- +1 SET DIR(0)="NOA^0:9999999"
- +2 IF $GET(ACRDIC)["ACRLOCB"
- IF $GET(ACRDIC(0))["L"
- SET DIR("A",1)="(NON-Personnel Amount ONLY)"
- +3 SET DIR("A")="Amount of Increase/Decrease: "
- +4 WRITE !
- +5 DO DIR^ACRFDIC
- +6 IF $DATA(ACRQUIT)
- QUIT
- +7 SET ACRAMT=Y
- +8 QUIT
