ACRFDTP4 ;IHS/OIRM/DSD/THL,AEF - ACRFDTP CON'T; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
;;CONTINUATION OF ACRFDTP TO DISPLAY FINANCIAL DATA AND ACCOUNTS
DISP ;EP;
OBLAMT I '$D(^ACROBL(ACRFD,0))!'$D(^ACROBL(ACRFD,"DT")) D Q
.S (DA,ACRFD2)=ACRFD
.S DIK="^ACROBL("
.D DIK^ACRFDIC
.S DA=ACRFD
.S DIK="^ACRDOC("
.D DIK^ACRFDIC
.S ACRDA=0
.F S ACRDA=$O(^ACRSS("C",ACRFD,ACRDA)) Q:'ACRDA D
..S DA=ACRDA
..S DIK="^ACRSS("
..D DIK^ACRFDIC
.S ACRJ=ACRJ-1
S ACRDISA=""
I $D(^ACRAPVS("AB",ACRFD)) D
.S ACR=0
.F S ACR=$O(^ACRAPVS("AB",ACRFD,ACR)) Q:'ACR D
..I $D(^ACRAPVS(ACR,"DT")),$P(^("DT"),U)="D" S ACRDISA="D"
I ACRDISA="",$E(^ACRDOC(ACRFD,"DT"),1,3)="1^0" S ACRDISA="*"
S ACRFD2=$S($P(^ACRDOC(ACRFD,0),U,2)]""&($D(ACRPO)!$D(ACRPOA)):$P(^(0),U,2),1:$P(^(0),U))
S ACRID=$E($P(^ACRDOC(ACRDOCDA,0),U,14),1,16)
S ACR(ACRJ)=ACRFD_U_U_(ACRFD2)_U_ACRID_U_ACRDISA_U_U_$P($G(^ACRDOC(ACRFD,"REQ2")),U,6)
Q
LOCBAMT N ACRFY
S ACRFD0=$G(^ACRLOCB(ACRFD,0))
S ACRFDT=$G(^ACRLOCB(ACRFD,"DT"))
S ACRCANDA=$P(ACRFDT,U,9)
S ACRFY=$P(ACRFDT,U)
S ACRSSADA=$P(ACRFDT,U,8)
S ACRALCDA=$P(ACRFD0,U,4)
S ACRFD3=$S(ACRSSADA:$P(^AUTTSSA(ACRSSADA,0),U,4),1:"XX")
S ACRFD2=$S(ACRCANDA:$P(^AUTTCAN(ACRCANDA,0),U),1:"<UNDEF>")
S ACRFDX=$S($P(ACRFD0,U,5):$P(^AUTTPRG($P(ACRFD0,U,5),0),U)_" ("_$P(^(0),U,2)_")",1:"** NO DEPARTMENT LISTED **")
S ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_U_ACRFDX_U_ACRCANDA_U_(ACRFD3)_U_$S(ACRFY]"":ACRFY,1:"**")
Q
ALCAMT S ACRFD0=^ACRALC(ACRFD,0)
S ACRFDT=^ACRALC(ACRFD,"DT")
S ACRFY=$P(ACRFDT,U)
S ACRFD2=$S($P(ACRFDT,U,5):$P(^AUTTALLW($P(ACRFDT,U,5),0),U),1:"XX")
S ACRFDX=$E($P(ACRFD0,U,12),1,18)
S ACRFD3=$S($P(ACRFDT,U,8):$P(^AUTTSSA($P(ACRFDT,U,8),0),U),1:"XX")
S ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_(ACRFD3)_U_ACRFDX_U_$S(ACRFY]"":ACRFY,1:"**")
Q
ALLAMT S ACRFDT=$G(^ACRALW(ACRFD,"DT"))
S ACRFY=$P(ACRFDT,U)
S ACRFDX=$E($P(^ACRALW(ACRFD,0),U,12),1,18)
S ACRFD2=$S($P(ACRFDT,U,5):$P(^AUTTALLW($P(ACRFDT,U,5),0),U),1:"XXXXX")
S ACRFD3=$S($P(ACRFDT,U,8):$P(^AUTTSSA($P(ACRFDT,U,8),0),U),1:"XX")
S ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_(ACRFD3)_U_ACRFDX_U_$S(ACRFY]"":ACRFY,1:"**")
Q
APPAMT S ACRFD2=$P(^AUTTPRO($P(^ACRAPP(ACRFD,0),U,2),0),U)
S ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_"^^^"_$S($P(^ACRAPP(ACRFD,"DT"),U)]"":$P(^("DT"),U),1:"**")
Q
EDIC ;EP;
D:$G(ACRI)>9 CHOOSE Q:$D(ACRQUIT)!$D(ACROUT)
K ACRXACT,ACRI
S DIC=ACRDIC
S DIC("A")=ACRDIC("A")
S DIC(0)=ACRDIC(0)
S DIC("DR")="",D=ACRD
D DIC^ACRFDIC:ACRDIC(0)["M"
D IX^ACRFDIC:ACRDIC(0)'["M"
I $E(X)=U!(X="")!(Y<1) S (ACRQUIT,ACROUT)="" K ACRFD,ACRFDNA Q
I ACRDIC(0)["N",$P(Y,U,3)'=1,X,+Y'=+X S Y=+X
S (DA,ACRZDA,ACRFDNO)=+Y
S ACRFDNA=Y(0,0)
S ACRZY=Y
Q:'$D(@(ACRDIC_DA_",0)"))
S ACRFD0=@(ACRDIC_DA_",0)")
I $P(Y,U,3)'=1 D ICHECK
I $D(ACRQUIT) S (ACRQUIT,ACROUT)="" K ACRFD,ACRFDNA Q
I $P(Y,U,3)=1,ACRDIC'["OBL" D
.S X=DUZ
.S DIC=ACRDIC_DA_",""SC"","
.S DIC(0)="L"
.S DA(1)=DA
.S:'$D(@(DIC_"0)")) @(DIC_"0)")="^"_$S(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
.D FILE^ACRFDIC
I ACRENTR1["LOCB" D Q:$D(ACRQUIT)
.S ACRAPP=$P(^ACRLOCB(DA,"DT"),U,4)
.S ACRAPP=$P(^AUTTPRO(ACRAPP,0),U)
.S:$E(ACRAPP,3)="X" ACRXACT=""
.D LBCHK
.Q:$D(ACRQUIT)
.D CALC
I $D(ACRSOF)!$D(ACRSOFT) S ACRQUIT="" Q
F ACRI="APP","ALLAMT","ALCAMT" D:ACRENTRY[ACRI&($P(ACRZY,U,3)=1) EDIC1
I ACRENTRY["OBLA" D Q:$D(ACRQUIT)
.S ACRCANDA=$P(^ACRLOCB(ACRZDA,"DT"),U,9)
.S ACRPODA=$P($G(^ACRCAN(ACRCANDA,"DFLT1")),U,15)
.S ACRADA=$P($G(^ACRPO(+ACRPODA,0)),U,19)
.;I 'ACRPODA!'ACRADA D ; ACR*2.1*20.13 IM20924
.I 'ACRPODA!'ACRADA D Q ; ACR*2.1*20.13 IM20924
..W !!,"The DEFAULT DATA including defining the PURCHASING OFFICE for this CAN"
..W !,"has not been completed."
..W !!,"Please report this to your ARMS Manager immediately."
..D PAUSE^ACRFWARN
..S (ACRQUIT,ACROUT)=""
.D LBCHK
D EN^ACRFDTP2
S ACRDISP=""
Q
SOF ;EP;FOR STATUS OF FUNDS
D:'$D(ACRSOFX) DETAIL^ACRFSOF
Q:$D(ACRQUIT)!$D(ACROUT)
S:$D(ACRDTAIL) ZTSAVE("ACRDTAIL")=""
S ACRRTN="^ACRFSOF"
S ZTDESC="STATUS OF FUNDS REPORT"
D ^ACRFZIS
K ACRFDNO
Q
EDIC1 S ACRFINSS=""
S DA=ACRZDA
S DIE=ACRDIE
S DR=ACRDR_";2////0;3////0;800////N"
D DIE^ACRFDIC
S DA=ACRZDA
Q
ICHECK ;INTEGRITY CHECK FOR FUNDS
K ACR
S X=@(ACRDIC_DA_",""DT"")")
I ACRDIC["LOCB",$P(X,U)="" S ACR(Y)="FISCAL YEAR"
I ACRDIC'["ACRAPP" D
.F Y=3,4,5,8 I $P(X,U,Y)="" D
..S ACR(Y)=$S(Y=3:"RECUR/NON-RECUR",Y=4:"APPROPRIATION NO.",Y=5:"ALLOWANCE",1:"SUB-SUB-ACTIVITY")
Q:'$D(ACR)#2
W *7,*7
W !!,"The entry you selected has the following missing data."
W !
S ACR=0
F S ACR=$O(ACR(ACR)) Q:'ACR W !?10,ACR(ACR)
W !!,"This entry cannot be used until missing data has been corrected."
D PAUSE^ACRFWARN
S ACRQUIT=""
Q
CALC N ACR,X,I,ACRDT
Q:ACRENTR1["LOCB"
F I=4,21,9 S X(I)=0
S ACR=0
F S ACR=$O(^ACRSS("F",ACRZDA,ACR)) Q:'ACR D
.I $D(^ACRSS(ACR,"DT")) S ACRDT=^("DT") D
..F I=4,21,9 S X(I)=X(I)+$P(ACRDT,U,I)
F I=2,3,5 S $P(ACRFDNAC,U,I)=X($S(I=2:4,I=3:21,1:9))
S DA=ACRZDA
S DIE="^ACRLOCB("
S DR="2////"_X(4)_";3////"_X(21)_";7////"_X(9)
D DIE^ACRFDIC
S DA=ACRZDA
Q
CHOOSE ;EP;TO CHOOSE LOOKUP FORMAT
S DIR(0)="SO^1:By ID NO.;2:By DEPARTMENT Name;3:By CAN NO."
S:ACRDIC["ACRAPP" DIR(0)="SO^1:By ID NO.;2:Appropriation Number"
S:ACRDIC["ACRAL" DIR(0)="SO^1:By ID NO.;2:Location Name;3:Allowance"
S DIR("A")="Select Account by"
S DIR("B")="By ID NO."
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I +Y<1 S ACRQUIT="" Q
I Y=1 S:ACRDIC'["ACRAPP" ACRDIC(0)="AENQZ" S ACRDIC("A")="ID NO.: ",(ACRD,D)="B"
I Y=2 D
.S:ACRDIC'["ACRAPP" ACRDIC(0)="AEQZ"
.S:ACRDIC'["ACRAPP" ACRDIC("A")="DEPARTMENT/LOCATION Name: "
.S:ACRDIC["ACRAPP" ACRDIC("A")="Appropriation NO.: "
.I ACRDIC["ACRAPP" S ACRD="C"
.I ACRDIC["ACRALW" S ACRD="D"
.I ACRDIC["ACRALC" S ACRD="C"
.I ACRDIC["ACRLOCB" S ACRD="DEPT"
I Y=3 D
.S:ACRDIC'["ACRAPP" ACRDIC(0)="AEQZ"
.S ACRDIC("A")="Allowance NO.: "
.I ACRDIC["ACRALW" S ACRD="C"
.I ACRDIC["ACRALC" S ACRD="E"
.I ACRDIC["ACRLOCB" S ACRD="DCAN",ACRDIC("A")="CAN NO.: "
W !
Q
LBCHK ;CHECK DEPARTMENT ACCOUNT FOR REQUIRED DATA
K ACRQUIT
W !
S ACRDT=$G(^ACRLOCB(ACRZDA,"DT"))
I ACRDT="" W !,"Department Account information" S ACRQUIT=""
I $P(ACRDT,U)="" W !,"Fiscal Year" S ACRQUIT=""
I $P(ACRDT,U,4)="" W:$D(ACRQUIT) " and" W !,"Appropriation information" S ACRQUIT=""
I $P(ACRDT,U,5)="" W:$D(ACRQUIT) " and" W !,"Allowance information" S ACRQUIT=""
I $P(ACRDT,U,8)="" W:$D(ACRQUIT) " and" W !,"Sub-Sub-Activity information" S ACRQUIT=""
I $P(ACRDT,U,9)="" W:$D(ACRQUIT) " and" W !,"Common Accounting Number" S ACRQUIT=""
I $P(ACRDT,U,11)="" W:$D(ACRQUIT) " and" W !,"Location Code information" S ACRQUIT=""
I $P(ACRDT,U,15)=""&($P($G(^ACRLOCB(ACRZDA,3)),U)="") W:$D(ACRQUIT) " and" W !,"Cost Center and/or Project Number information" S ACRQUIT=""
I $D(ACRQUIT) D
.W " MISSING in"
.W !!,"Department Account ID NO. ",ACRZDA
.W !,"(Sub-Allowance ID NO. ",$P(^ACRLOCB(ACRZDA,0),U,4)
.D PAUSE^ACRFWARN
.S (ACRQUIT,ACROUT)=""
Q
ACRFDTP4 ;IHS/OIRM/DSD/THL,AEF - ACRFDTP CON'T; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFDTP TO DISPLAY FINANCIAL DATA AND ACCOUNTS
DISP ;EP;
OBLAMT IF '$DATA(^ACROBL(ACRFD,0))!'$DATA(^ACROBL(ACRFD,"DT"))
Begin DoDot:1
+1 SET (DA,ACRFD2)=ACRFD
+2 SET DIK="^ACROBL("
+3 DO DIK^ACRFDIC
+4 SET DA=ACRFD
+5 SET DIK="^ACRDOC("
+6 DO DIK^ACRFDIC
+7 SET ACRDA=0
+8 FOR
SET ACRDA=$ORDER(^ACRSS("C",ACRFD,ACRDA))
IF 'ACRDA
QUIT
Begin DoDot:2
+9 SET DA=ACRDA
+10 SET DIK="^ACRSS("
+11 DO DIK^ACRFDIC
End DoDot:2
+12 SET ACRJ=ACRJ-1
End DoDot:1
QUIT
+13 SET ACRDISA=""
+14 IF $DATA(^ACRAPVS("AB",ACRFD))
Begin DoDot:1
+15 SET ACR=0
+16 FOR
SET ACR=$ORDER(^ACRAPVS("AB",ACRFD,ACR))
IF 'ACR
QUIT
Begin DoDot:2
+17 IF $DATA(^ACRAPVS(ACR,"DT"))
IF $PIECE(^("DT"),U)="D"
SET ACRDISA="D"
End DoDot:2
End DoDot:1
+18 IF ACRDISA=""
IF $EXTRACT(^ACRDOC(ACRFD,"DT"),1,3)="1^0"
SET ACRDISA="*"
+19 SET ACRFD2=$SELECT($PIECE(^ACRDOC(ACRFD,0),U,2)]""&($DATA(ACRPO)!$DATA(ACRPOA)):$PIECE(^(0),U,2),1:$PIECE(^(0),U))
+20 SET ACRID=$EXTRACT($PIECE(^ACRDOC(ACRDOCDA,0),U,14),1,16)
+21 SET ACR(ACRJ)=ACRFD_U_U_(ACRFD2)_U_ACRID_U_ACRDISA_U_U_$PIECE($GET(^ACRDOC(ACRFD,"REQ2")),U,6)
+22 QUIT
LOCBAMT NEW ACRFY
+1 SET ACRFD0=$GET(^ACRLOCB(ACRFD,0))
+2 SET ACRFDT=$GET(^ACRLOCB(ACRFD,"DT"))
+3 SET ACRCANDA=$PIECE(ACRFDT,U,9)
+4 SET ACRFY=$PIECE(ACRFDT,U)
+5 SET ACRSSADA=$PIECE(ACRFDT,U,8)
+6 SET ACRALCDA=$PIECE(ACRFD0,U,4)
+7 SET ACRFD3=$SELECT(ACRSSADA:$PIECE(^AUTTSSA(ACRSSADA,0),U,4),1:"XX")
+8 SET ACRFD2=$SELECT(ACRCANDA:$PIECE(^AUTTCAN(ACRCANDA,0),U),1:"<UNDEF>")
+9 SET ACRFDX=$SELECT($PIECE(ACRFD0,U,5):$PIECE(^AUTTPRG($PIECE(ACRFD0,U,5),0),U)_" ("_$PIECE(^(0),U,2)_")",1:"** NO DEPARTMENT LISTED **")
+10 SET ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_U_ACRFDX_U_ACRCANDA_U_(ACRFD3)_U_$SELECT(ACRFY]"":ACRFY,1:"**")
+11 QUIT
ALCAMT SET ACRFD0=^ACRALC(ACRFD,0)
+1 SET ACRFDT=^ACRALC(ACRFD,"DT")
+2 SET ACRFY=$PIECE(ACRFDT,U)
+3 SET ACRFD2=$SELECT($PIECE(ACRFDT,U,5):$PIECE(^AUTTALLW($PIECE(ACRFDT,U,5),0),U),1:"XX")
+4 SET ACRFDX=$EXTRACT($PIECE(ACRFD0,U,12),1,18)
+5 SET ACRFD3=$SELECT($PIECE(ACRFDT,U,8):$PIECE(^AUTTSSA($PIECE(ACRFDT,U,8),0),U),1:"XX")
+6 SET ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_(ACRFD3)_U_ACRFDX_U_$SELECT(ACRFY]"":ACRFY,1:"**")
+7 QUIT
ALLAMT SET ACRFDT=$GET(^ACRALW(ACRFD,"DT"))
+1 SET ACRFY=$PIECE(ACRFDT,U)
+2 SET ACRFDX=$EXTRACT($PIECE(^ACRALW(ACRFD,0),U,12),1,18)
+3 SET ACRFD2=$SELECT($PIECE(ACRFDT,U,5):$PIECE(^AUTTALLW($PIECE(ACRFDT,U,5),0),U),1:"XXXXX")
+4 SET ACRFD3=$SELECT($PIECE(ACRFDT,U,8):$PIECE(^AUTTSSA($PIECE(ACRFDT,U,8),0),U),1:"XX")
+5 SET ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_U_(ACRFD3)_U_ACRFDX_U_$SELECT(ACRFY]"":ACRFY,1:"**")
+6 QUIT
APPAMT SET ACRFD2=$PIECE(^AUTTPRO($PIECE(^ACRAPP(ACRFD,0),U,2),0),U)
+1 SET ACR(ACRJ)=ACRFD_U_ACRFD1_U_(ACRFD2)_"^^^"_$SELECT($PIECE(^ACRAPP(ACRFD,"DT"),U)]"":$PIECE(^("DT"),U),1:"**")
+2 QUIT
EDIC ;EP;
+1 IF $GET(ACRI)>9
DO CHOOSE
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRXACT,ACRI
+3 SET DIC=ACRDIC
+4 SET DIC("A")=ACRDIC("A")
+5 SET DIC(0)=ACRDIC(0)
+6 SET DIC("DR")=""
SET D=ACRD
+7 IF ACRDIC(0)["M"
DO DIC^ACRFDIC
+8 IF ACRDIC(0)'["M"
DO IX^ACRFDIC
+9 IF $EXTRACT(X)=U!(X="")!(Y<1)
SET (ACRQUIT,ACROUT)=""
KILL ACRFD,ACRFDNA
QUIT
+10 IF ACRDIC(0)["N"
IF $PIECE(Y,U,3)'=1
IF X
IF +Y'=+X
SET Y=+X
+11 SET (DA,ACRZDA,ACRFDNO)=+Y
+12 SET ACRFDNA=Y(0,0)
+13 SET ACRZY=Y
+14 IF '$DATA(@(ACRDIC_DA_",0)"))
QUIT
+15 SET ACRFD0=@(ACRDIC_DA_",0)")
+16 IF $PIECE(Y,U,3)'=1
DO ICHECK
+17 IF $DATA(ACRQUIT)
SET (ACRQUIT,ACROUT)=""
KILL ACRFD,ACRFDNA
QUIT
+18 IF $PIECE(Y,U,3)=1
IF ACRDIC'["OBL"
Begin DoDot:1
+19 SET X=DUZ
+20 SET DIC=ACRDIC_DA_",""SC"","
+21 SET DIC(0)="L"
+22 SET DA(1)=DA
+23 IF '$DATA(@(DIC_"0)"))
SET @(DIC_"0)")="^"_$SELECT(ACRDIC["ACRAPP":9002185.01,ACRDIC["ACRALW":9002186.01,ACRDIC["ACRALC":9002187.04,1:9002188.04)_"P"
+24 DO FILE^ACRFDIC
End DoDot:1
+25 IF ACRENTR1["LOCB"
Begin DoDot:1
+26 SET ACRAPP=$PIECE(^ACRLOCB(DA,"DT"),U,4)
+27 SET ACRAPP=$PIECE(^AUTTPRO(ACRAPP,0),U)
+28 IF $EXTRACT(ACRAPP,3)="X"
SET ACRXACT=""
+29 DO LBCHK
+30 IF $DATA(ACRQUIT)
QUIT
+31 DO CALC
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+32 IF $DATA(ACRSOF)!$DATA(ACRSOFT)
SET ACRQUIT=""
QUIT
+33 FOR ACRI="APP","ALLAMT","ALCAMT"
IF ACRENTRY[ACRI&($PIECE(ACRZY,U,3)=1)
DO EDIC1
+34 IF ACRENTRY["OBLA"
Begin DoDot:1
+35 SET ACRCANDA=$PIECE(^ACRLOCB(ACRZDA,"DT"),U,9)
+36 SET ACRPODA=$PIECE($GET(^ACRCAN(ACRCANDA,"DFLT1")),U,15)
+37 SET ACRADA=$PIECE($GET(^ACRPO(+ACRPODA,0)),U,19)
+38 ;I 'ACRPODA!'ACRADA D ; ACR*2.1*20.13 IM20924
+39 ; ACR*2.1*20.13 IM20924
IF 'ACRPODA!'ACRADA
Begin DoDot:2
+40 WRITE !!,"The DEFAULT DATA including defining the PURCHASING OFFICE for this CAN"
+41 WRITE !,"has not been completed."
+42 WRITE !!,"Please report this to your ARMS Manager immediately."
+43 DO PAUSE^ACRFWARN
+44 SET (ACRQUIT,ACROUT)=""
End DoDot:2
QUIT
+45 DO LBCHK
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+46 DO EN^ACRFDTP2
+47 SET ACRDISP=""
+48 QUIT
SOF ;EP;FOR STATUS OF FUNDS
+1 IF '$DATA(ACRSOFX)
DO DETAIL^ACRFSOF
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 IF $DATA(ACRDTAIL)
SET ZTSAVE("ACRDTAIL")=""
+4 SET ACRRTN="^ACRFSOF"
+5 SET ZTDESC="STATUS OF FUNDS REPORT"
+6 DO ^ACRFZIS
+7 KILL ACRFDNO
+8 QUIT
EDIC1 SET ACRFINSS=""
+1 SET DA=ACRZDA
+2 SET DIE=ACRDIE
+3 SET DR=ACRDR_";2////0;3////0;800////N"
+4 DO DIE^ACRFDIC
+5 SET DA=ACRZDA
+6 QUIT
ICHECK ;INTEGRITY CHECK FOR FUNDS
+1 KILL ACR
+2 SET X=@(ACRDIC_DA_",""DT"")")
+3 IF ACRDIC["LOCB"
IF $PIECE(X,U)=""
SET ACR(Y)="FISCAL YEAR"
+4 IF ACRDIC'["ACRAPP"
Begin DoDot:1
+5 FOR Y=3,4,5,8
IF $PIECE(X,U,Y)=""
Begin DoDot:2
+6 SET ACR(Y)=$SELECT(Y=3:"RECUR/NON-RECUR",Y=4:"APPROPRIATION NO.",Y=5:"ALLOWANCE",1:"SUB-SUB-ACTIVITY")
End DoDot:2
End DoDot:1
+7 IF '$DATA(ACR)#2
QUIT
+8 WRITE *7,*7
+9 WRITE !!,"The entry you selected has the following missing data."
+10 WRITE !
+11 SET ACR=0
+12 FOR
SET ACR=$ORDER(ACR(ACR))
IF 'ACR
QUIT
WRITE !?10,ACR(ACR)
+13 WRITE !!,"This entry cannot be used until missing data has been corrected."
+14 DO PAUSE^ACRFWARN
+15 SET ACRQUIT=""
+16 QUIT
CALC NEW ACR,X,I,ACRDT
+1 IF ACRENTR1["LOCB"
QUIT
+2 FOR I=4,21,9
SET X(I)=0
+3 SET ACR=0
+4 FOR
SET ACR=$ORDER(^ACRSS("F",ACRZDA,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+5 IF $DATA(^ACRSS(ACR,"DT"))
SET ACRDT=^("DT")
Begin DoDot:2
+6 FOR I=4,21,9
SET X(I)=X(I)+$PIECE(ACRDT,U,I)
End DoDot:2
End DoDot:1
+7 FOR I=2,3,5
SET $PIECE(ACRFDNAC,U,I)=X($SELECT(I=2:4,I=3:21,1:9))
+8 SET DA=ACRZDA
+9 SET DIE="^ACRLOCB("
+10 SET DR="2////"_X(4)_";3////"_X(21)_";7////"_X(9)
+11 DO DIE^ACRFDIC
+12 SET DA=ACRZDA
+13 QUIT
CHOOSE ;EP;TO CHOOSE LOOKUP FORMAT
+1 SET DIR(0)="SO^1:By ID NO.;2:By DEPARTMENT Name;3:By CAN NO."
+2 IF ACRDIC["ACRAPP"
SET DIR(0)="SO^1:By ID NO.;2:Appropriation Number"
+3 IF ACRDIC["ACRAL"
SET DIR(0)="SO^1:By ID NO.;2:Location Name;3:Allowance"
+4 SET DIR("A")="Select Account by"
+5 SET DIR("B")="By ID NO."
+6 DO DIR^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF +Y<1
SET ACRQUIT=""
QUIT
+9 IF Y=1
IF ACRDIC'["ACRAPP"
SET ACRDIC(0)="AENQZ"
SET ACRDIC("A")="ID NO.: "
SET (ACRD,D)="B"
+10 IF Y=2
Begin DoDot:1
+11 IF ACRDIC'["ACRAPP"
SET ACRDIC(0)="AEQZ"
+12 IF ACRDIC'["ACRAPP"
SET ACRDIC("A")="DEPARTMENT/LOCATION Name: "
+13 IF ACRDIC["ACRAPP"
SET ACRDIC("A")="Appropriation NO.: "
+14 IF ACRDIC["ACRAPP"
SET ACRD="C"
+15 IF ACRDIC["ACRALW"
SET ACRD="D"
+16 IF ACRDIC["ACRALC"
SET ACRD="C"
+17 IF ACRDIC["ACRLOCB"
SET ACRD="DEPT"
End DoDot:1
+18 IF Y=3
Begin DoDot:1
+19 IF ACRDIC'["ACRAPP"
SET ACRDIC(0)="AEQZ"
+20 SET ACRDIC("A")="Allowance NO.: "
+21 IF ACRDIC["ACRALW"
SET ACRD="C"
+22 IF ACRDIC["ACRALC"
SET ACRD="E"
+23 IF ACRDIC["ACRLOCB"
SET ACRD="DCAN"
SET ACRDIC("A")="CAN NO.: "
End DoDot:1
+24 WRITE !
+25 QUIT
LBCHK ;CHECK DEPARTMENT ACCOUNT FOR REQUIRED DATA
+1 KILL ACRQUIT
+2 WRITE !
+3 SET ACRDT=$GET(^ACRLOCB(ACRZDA,"DT"))
+4 IF ACRDT=""
WRITE !,"Department Account information"
SET ACRQUIT=""
+5 IF $PIECE(ACRDT,U)=""
WRITE !,"Fiscal Year"
SET ACRQUIT=""
+6 IF $PIECE(ACRDT,U,4)=""
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Appropriation information"
SET ACRQUIT=""
+7 IF $PIECE(ACRDT,U,5)=""
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Allowance information"
SET ACRQUIT=""
+8 IF $PIECE(ACRDT,U,8)=""
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Sub-Sub-Activity information"
SET ACRQUIT=""
+9 IF $PIECE(ACRDT,U,9)=""
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Common Accounting Number"
SET ACRQUIT=""
+10 IF $PIECE(ACRDT,U,11)=""
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Location Code information"
SET ACRQUIT=""
+11 IF $PIECE(ACRDT,U,15)=""&($PIECE($GET(^ACRLOCB(ACRZDA,3)),U)="")
IF $DATA(ACRQUIT)
WRITE " and"
WRITE !,"Cost Center and/or Project Number information"
SET ACRQUIT=""
+12 IF $DATA(ACRQUIT)
Begin DoDot:1
+13 WRITE " MISSING in"
+14 WRITE !!,"Department Account ID NO. ",ACRZDA
+15 WRITE !,"(Sub-Allowance ID NO. ",$PIECE(^ACRLOCB(ACRZDA,0),U,4)
+16 DO PAUSE^ACRFWARN
+17 SET (ACRQUIT,ACROUT)=""
End DoDot:1
+18 QUIT
