ACRFEA ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO EDIT FINANCIAL DATA
EN ;EP;
I $D(ACRNEWOB),(ACRENTRY["OBLAMT") D EN1,EXIT Q
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT D EXITFEA^ACRFEXIT
W @IOF
Q
EN1 D SET
I $D(ACRRR)#2 D Q
.D ^ACRFRR
.K ACRRR
.S ACRQUIT=""
D FDTP1:'$D(ACRQUIT)
D ^ACRFEA4:'$D(ACRQUIT)&'$D(ACRPRT)&'$D(ACRCSI)
Q:$D(ACROUT)!$D(ACRQUIT)!$D(ACROUT)
D TRANS^ACRFEA2:ACRENTRY'["APP"&(ACRENTRY'["OBLAMT")
Q
FDTP1 ;CONTROLLER FOR DIC("S") FOR ALL ACCOUNT AND OBLIGATIONS LOOKUPS
I ACRENTRY["APPAMT",$D(ACRFDNO) D Q
.S DA=ACRFDNO
.D ^ACRFEA4
.S ACRQUIT=""
I ACRENTRY["FDIS",$D(ACRFDNO) D FDTP11 Q
I '$D(ACRNEWOB) D FDTP12
I ACRENTRY["ALLAMT" D Q
.S DIC("S")="I $P(^ACRALW(+Y,0),U,2)=ACRFDNO,$D(^ACRALW(""SEC"","_DUZ_",+Y))"
.D DIC
I ACRENTRY["ALC" D Q
.S DIC("S")="I $P(^ACRALC(+Y,0),U,3)=ACRFDNO,$D(^ACRALC(""SEC"","_DUZ_",+Y))"
.D DIC
I ACRENTRY["LOCB" D Q
.S DIC("S")="I $P(^ACRLOCB(+Y,0),U,4)=ACRFDNO,$D(^ACRLOCB(""SEC"","_DUZ_",+Y))"
.D DIC
Q:ACRENTRY'["OBLA"
ACRREV I $D(ACRREV),$D(ACRCOMP) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,""ACD""[$E(ACRAPV)!(""ACD""[$P(ACRAPV,U,3)) W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
I $D(ACRREV) D Q
.S DIC("S")="I $P(ACR,U,6)=ACRFDNO W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
ACRCSI I $D(ACRCSI) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0) I $P(ACR,U,6)=ACRFDNO W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
REACT I $D(ACRREACT),'$D(ACRJVOD) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,'$$OBL^ACRFEA(+Y),$P(ACRAPV,U)]"""",""ACD""[$P(ACRAPV,U)!(""D""[$P(ACRAPV,U,3)) W @(""$E(""_DIC_""Y,0),0)"")"
.K ACRQUIT
.D DIC
JVOD I $D(ACRJVOD) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$E(ACRAPV)=""A"",$P(ACRAPV,U,3)=""A"" W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
ACRCTV I $D(ACRCTV) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(ACRAPV,U)]"""",""CD""'[$E(ACRAPV),$P(ACRAPV,U,7)=19,$P(ACRAPV,U,8)="""",$P(ACR,U,13)=$O(^AUTTDOCR(""B"",600,0)) W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
ACRCONV I $D(ACRCONV),'$D(ACRCTV) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(^ACROBL(Y,""CONV""),U)=""Y"" W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
ACRTV I '$D(ACRREACT) D Q
.S DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(ACRAPV,U)="""",$P(ACRAPV,U,3)="""" W @(""$E(""_DIC_""Y,0),0)"")"
.D DIC
Q
DIC I $D(ACRCSIS) D PAUSE^ACRFWARN S ACRQUIT="" Q
W !
D EDIC
Q:$D(ACRQUIT)!$D(ACROUT)
Q
FDTP11 S ACRLBDA=ACRFDNO
S ACRALCDA=$P(^ACRLOCB(ACRLBDA,0),U,4)
D ^ACRFDIS
S ACRQUIT=""
Q
FDTP12 S ACRFADD=""
S:$D(ACRLBDA) ACRDISDA=ACRLBDA
S ACRDISP=""
D FDTP^ACRFDTP
K ACRFADD
Q
SET ;EP;
S (ACRDIC,ACRDIE)=$P(ACRENTRY,";;",3)
S ACRGREF=$P(ACRDIC,"(")
S ACRDR=$P(ACRENTRY,";;",5)
S ACRDIC("A")=$P(ACRENTRY,";;",6)
S ACRD=$P(ACRENTRY,";;",7)
S ACRDIC(0)="AELNZ"
S ACRRTN="^"_$P(ACRENTRY,";;",4)
S (ACRY,ACRTYPS)=$P(ACRENTRY,";;",2)
S ACRENTR2=$P(ACRENTRY," ")
Q
EDIC S DIC("DR")=""
I ACRENTRY["OBLAMT" D I 1
.D ^ACRFEA1
.K ACRCONT
E D DIC1^ACRFEA2
DICC Q:$D(ACRQUIT)!$D(ACROUT)!'$D(ACRZY)
Q:($P(ACRZY,U,3)'=1)!$D(ACRPRT)
I ACRENTRY'["DOC",ACRENTRY'["APP",ACRENTRY'["OBLA" D Q
.S DA=ACRZDA
.S DIE=ACRDIE
.S DR=$S((ACRENTRY["ALLAMT"):".02",ACRENTRY["LOCB":".04",1:".03")
.S DR=DR_"////"_ACRFDNO_";2////0.00;3////0.00;800////N"
.D DIE^ACRFDIC
I ACRENTRY["OBLA" D
.S ACRFINSS=""
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR=".05////"_ACRDOCDA_";.06////"_ACRFDNO
.D DIE^ACRFDIC
I ACRENTRY'["OBLA" D
.S ACRFINSS=""
.S DA=ACRZDA
.S DIE=ACRDIE
.S DR=ACRDR
.D DIE^ACRFDIC
Q
ENTRY ;EP;CONTROLS EDITING DEPENDING ON VALUE OF 'ACRENTRY' WHEN ROUTINE CALLED
S ACRENTRY=$T(@ACRENTRY^ACRFCTL1)
S ACRZY=""
G EN
Q
DISP ;EP;TO DISPLAY FINANCIAL ACCOUNT DATA
W @IOF
W ?20,"Current ",@ACRON,ACRFDNY,@ACROF," data:"
W !
N DXS,DIP,DC,DN,D0
S D0=ACRZDA
D @ACRRTN
Q
OBL(X) ;EP;DETERMINE IF OBLIGATION HAS BEEN MADE AGAINST THE DOCUMENT
Q:'X
N Y,ACRQUIT
S Y=0
S ACRQUIT=""
F S Y=$O(^ACRDHR("E",X,Y)) Q:'Y D
.I $P($G(^ACRDHR(+Y,1)),U,3,4)="050^1" S ACRQUIT=1
.I $P($G(^ACRDHR(+Y,1)),U,3,4)="050^2" S ACRQUIT=0
Q ACRQUIT
ACRFEA ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO EDIT FINANCIAL DATA
EN ;EP;
+1 IF $DATA(ACRNEWOB)
IF (ACRENTRY["OBLAMT")
DO EN1
DO EXIT
QUIT
+2 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT DO EXITFEA^ACRFEXIT
+1 WRITE @IOF
+2 QUIT
EN1 DO SET
+1 IF $DATA(ACRRR)#2
Begin DoDot:1
+2 DO ^ACRFRR
+3 KILL ACRRR
+4 SET ACRQUIT=""
End DoDot:1
QUIT
+5 IF '$DATA(ACRQUIT)
DO FDTP1
+6 IF '$DATA(ACRQUIT)&'$DATA(ACRPRT)&'$DATA(ACRCSI)
DO ^ACRFEA4
+7 IF $DATA(ACROUT)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF ACRENTRY'["APP"&(ACRENTRY'["OBLAMT")
DO TRANS^ACRFEA2
+9 QUIT
FDTP1 ;CONTROLLER FOR DIC("S") FOR ALL ACCOUNT AND OBLIGATIONS LOOKUPS
+1 IF ACRENTRY["APPAMT"
IF $DATA(ACRFDNO)
Begin DoDot:1
+2 SET DA=ACRFDNO
+3 DO ^ACRFEA4
+4 SET ACRQUIT=""
End DoDot:1
QUIT
+5 IF ACRENTRY["FDIS"
IF $DATA(ACRFDNO)
DO FDTP11
QUIT
+6 IF '$DATA(ACRNEWOB)
DO FDTP12
+7 IF ACRENTRY["ALLAMT"
Begin DoDot:1
+8 SET DIC("S")="I $P(^ACRALW(+Y,0),U,2)=ACRFDNO,$D(^ACRALW(""SEC"","_DUZ_",+Y))"
+9 DO DIC
End DoDot:1
QUIT
+10 IF ACRENTRY["ALC"
Begin DoDot:1
+11 SET DIC("S")="I $P(^ACRALC(+Y,0),U,3)=ACRFDNO,$D(^ACRALC(""SEC"","_DUZ_",+Y))"
+12 DO DIC
End DoDot:1
QUIT
+13 IF ACRENTRY["LOCB"
Begin DoDot:1
+14 SET DIC("S")="I $P(^ACRLOCB(+Y,0),U,4)=ACRFDNO,$D(^ACRLOCB(""SEC"","_DUZ_",+Y))"
+15 DO DIC
End DoDot:1
QUIT
+16 IF ACRENTRY'["OBLA"
QUIT
ACRREV IF $DATA(ACRREV)
IF $DATA(ACRCOMP)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,""ACD""[$E(ACRAPV)!(""ACD""[$P(ACRAPV,U,3)) W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
+3 IF $DATA(ACRREV)
Begin DoDot:1
+4 SET DIC("S")="I $P(ACR,U,6)=ACRFDNO W @(""$E(""_DIC_""Y,0),0)"")"
+5 DO DIC
End DoDot:1
QUIT
ACRCSI IF $DATA(ACRCSI)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0) I $P(ACR,U,6)=ACRFDNO W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
REACT IF $DATA(ACRREACT)
IF '$DATA(ACRJVOD)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,'$$OBL^ACRFEA(+Y),$P(ACRAPV,U)]"""",""ACD""[$P(ACRAPV,U)!(""D""[$P(ACRAPV,U,3)) W @(""$E(""_DIC_""Y,0),0)"")"
+2 KILL ACRQUIT
+3 DO DIC
End DoDot:1
QUIT
JVOD IF $DATA(ACRJVOD)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$E(ACRAPV)=""A"",$P(ACRAPV,U,3)=""A"" W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
ACRCTV IF $DATA(ACRCTV)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(ACRAPV,U)]"""",""CD""'[$E(ACRAPV),$P(ACRAPV,U,7)=19,$P(ACRAPV,U,8)="""",$P(ACR,U,13)=$O(^AUTTDOCR(""B"",600,0)) W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
ACRCONV IF $DATA(ACRCONV)
IF '$DATA(ACRCTV)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(^ACROBL(Y,""CONV""),U)=""Y"" W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
ACRTV IF '$DATA(ACRREACT)
Begin DoDot:1
+1 SET DIC("S")="S ACR=^ACRDOC(+Y,0),ACRAPV=$G(^ACROBL(+Y,""APV"")) I $P(ACR,U,6)=ACRFDNO,$P(ACRAPV,U)="""",$P(ACRAPV,U,3)="""" W @(""$E(""_DIC_""Y,0),0)"")"
+2 DO DIC
End DoDot:1
QUIT
+3 QUIT
DIC IF $DATA(ACRCSIS)
DO PAUSE^ACRFWARN
SET ACRQUIT=""
QUIT
+1 WRITE !
+2 DO EDIC
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 QUIT
FDTP11 SET ACRLBDA=ACRFDNO
+1 SET ACRALCDA=$PIECE(^ACRLOCB(ACRLBDA,0),U,4)
+2 DO ^ACRFDIS
+3 SET ACRQUIT=""
+4 QUIT
FDTP12 SET ACRFADD=""
+1 IF $DATA(ACRLBDA)
SET ACRDISDA=ACRLBDA
+2 SET ACRDISP=""
+3 DO FDTP^ACRFDTP
+4 KILL ACRFADD
+5 QUIT
SET ;EP;
+1 SET (ACRDIC,ACRDIE)=$PIECE(ACRENTRY,";;",3)
+2 SET ACRGREF=$PIECE(ACRDIC,"(")
+3 SET ACRDR=$PIECE(ACRENTRY,";;",5)
+4 SET ACRDIC("A")=$PIECE(ACRENTRY,";;",6)
+5 SET ACRD=$PIECE(ACRENTRY,";;",7)
+6 SET ACRDIC(0)="AELNZ"
+7 SET ACRRTN="^"_$PIECE(ACRENTRY,";;",4)
+8 SET (ACRY,ACRTYPS)=$PIECE(ACRENTRY,";;",2)
+9 SET ACRENTR2=$PIECE(ACRENTRY," ")
+10 QUIT
EDIC SET DIC("DR")=""
+1 IF ACRENTRY["OBLAMT"
Begin DoDot:1
+2 DO ^ACRFEA1
+3 KILL ACRCONT
End DoDot:1
IF 1
+4 IF '$TEST
DO DIC1^ACRFEA2
DICC IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$DATA(ACRZY)
QUIT
+1 IF ($PIECE(ACRZY,U,3)'=1)!$DATA(ACRPRT)
QUIT
+2 IF ACRENTRY'["DOC"
IF ACRENTRY'["APP"
IF ACRENTRY'["OBLA"
Begin DoDot:1
+3 SET DA=ACRZDA
+4 SET DIE=ACRDIE
+5 SET DR=$SELECT((ACRENTRY["ALLAMT"):".02",ACRENTRY["LOCB":".04",1:".03")
+6 SET DR=DR_"////"_ACRFDNO_";2////0.00;3////0.00;800////N"
+7 DO DIE^ACRFDIC
End DoDot:1
QUIT
+8 IF ACRENTRY["OBLA"
Begin DoDot:1
+9 SET ACRFINSS=""
+10 SET DA=ACRDOCDA
+11 SET DIE="^ACRDOC("
+12 SET DR=".05////"_ACRDOCDA_";.06////"_ACRFDNO
+13 DO DIE^ACRFDIC
End DoDot:1
+14 IF ACRENTRY'["OBLA"
Begin DoDot:1
+15 SET ACRFINSS=""
+16 SET DA=ACRZDA
+17 SET DIE=ACRDIE
+18 SET DR=ACRDR
+19 DO DIE^ACRFDIC
End DoDot:1
+20 QUIT
ENTRY ;EP;CONTROLS EDITING DEPENDING ON VALUE OF 'ACRENTRY' WHEN ROUTINE CALLED
+1 SET ACRENTRY=$TEXT(@ACRENTRY^ACRFCTL1)
+2 SET ACRZY=""
+3 GOTO EN
+4 QUIT
DISP ;EP;TO DISPLAY FINANCIAL ACCOUNT DATA
+1 WRITE @IOF
+2 WRITE ?20,"Current ",@ACRON,ACRFDNY,@ACROF," data:"
+3 WRITE !
+4 NEW DXS,DIP,DC,DN,D0
+5 SET D0=ACRZDA
+6 DO @ACRRTN
+7 QUIT
OBL(X) ;EP;DETERMINE IF OBLIGATION HAS BEEN MADE AGAINST THE DOCUMENT
+1 IF 'X
QUIT
+2 NEW Y,ACRQUIT
+3 SET Y=0
+4 SET ACRQUIT=""
+5 FOR
SET Y=$ORDER(^ACRDHR("E",X,Y))
IF 'Y
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^ACRDHR(+Y,1)),U,3,4)="050^1"
SET ACRQUIT=1
+7 IF $PIECE($GET(^ACRDHR(+Y,1)),U,3,4)="050^2"
SET ACRQUIT=0
End DoDot:1
+8 QUIT ACRQUIT
