ACRFDTP ;IHS/OIRM/DSD/THL,AEF - LOOKUP AND DISPLAY FINANCIAL DATA; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE CALLED FOR DISPLAY AND SELECTION OF ALL ACCOUNTS
EN Q:$D(ACROUT)
N ACRI
K ACRQUIT
F D EN1 Q:$D(ACROUT)!$D(ACRQUIT)!$D(ACROUT)
EXIT D EXIT^ACRFEXIT:'$D(ACRDEL)
Q
EN1 D SET
D ^ACRFONE:ACRENTR1["LOCBAMT"&(ACRENTRY["OBLAMT")
Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
S ACRENTRY=$P(ACRENTRY," ")
I $D(ACRUP) D Q
.D FDTP
.S:$D(ACRFDNO) ACRUP=ACRFDNO
.S ACRQUIT=""
D FDTP:'$D(ACRONE)
D SOF^ACRFDTP4:($D(ACRSOFX)!$D(ACRSOF))&$D(ACRONE)
I $D(ACRFDNO),'$D(ACRQUIT),'$D(ACRSOF),'$D(ACRSOFX),'$D(ACRTDEL) D
.D ENTRY^ACRFEA:'$D(ACRCSI)
.D CSI:$D(ACRCSI)
.K ACRX,ACRJ,ACR,ACRY,ACRZ,ACRFD,ACRFDNA,ACRFDNO,ACRCONT,ACRCSIS,ACRTYPS
.S:$D(ACRONE) ACRQUIT=""
I $D(ACRFDNO),$D(ACRTDEL) D T1^ACRFDEL
Q
FDTP ;EP;TO DISPLAY FINANCIAL DATA
Q:$D(ACROUT)
W @IOF
K:ACRGREF["OBL" ACRDISP
D SUBHEAD^ACRFDTP2:'$D(ACRQUIT)&$D(ACRDISP)
I '$D(ACRFDNO) D @ACRENTR1^ACRFDTP3 I 1
E D @ACRENTR2^ACRFDTP3:$D(ACRENTR2)
FDTP11 D FDTPX2:$D(ACRCONV)&$D(ACRFDNO)&'$D(ACRQUIT)
D FDTPX1:'$D(ACRFDNO)!'$D(ACRCONV)
Q
FDTPX1 S ACRFD=0
S ACRK=$S(ACRENTRY["OBLAMT":31,1:21)
S ACRXREF=$S('$D(ACRFDNO):"SEC",ACRGREF["OBL":"D",1:"M")
S ACRDFN=$S('$D(ACRFDNO):DUZ,1:ACRFDNO)
S ACRJ=0
K ACR
S ACRFD=999999999
F S ACRFD=$O(@ACRGREF@(ACRXREF,ACRDFN,ACRFD),-1) Q:'ACRFD D DTP Q:$D(ACRPSE)
D DISP2^ACRFDTP5:$D(ACR(ACRJ))&'$D(ACRPSE)
K ACRJ,ACRPSE
D FDTP1:'$D(ACRFDNO)
K ACRFD
Q
DTP Q:'$D(@ACRGREF@(ACRFD,0))
D FDTPA1:'$D(ACRFDNO)
D FDTPA2:$D(ACRFDNO)&'$D(ACRCONV)
I (ACRGREF["LOCB"&(ACRJ#10=0))!((ACRGREF'["LOCB")&(ACRJ#20=0)) D DISP2^ACRFDTP5
Q
FDTPX2 S (ACRJ,ACRFD)=0
K ACR
S ACRFD=999999999
F S ACRFD=$O(^ACROBL("ACONV",ACRFDNO,"Y",ACRFD),-1) Q:'ACRFD D FDTPA2 Q:$D(ACRPSE)
D DISP2^ACRFDTP5:$D(ACR(ACRJ))&'$D(ACRPSE)
D FDTP1:'$D(ACRFDNO)
K ACRFD,ACRPSE
Q
FDTPA1 D D
Q
FDTPA2 ;SCREEN ENTRIES FOR DISPLAY
Q:'$D(@ACRGREF@(ACRFD,0))
Q:$P(@ACRGREF@(ACRFD,0),U,$S(ACRENTRY["ALC"!(ACRENTRY["OBL"):3,ACRENTRY["LOCB":4,1:2))'=ACRFDNO
I ACRENTRY'["OBLAMT" D D Q
S ACRDOCDA=ACRFD
D SETDOC^ACRFEA1
I $D(ACRQUIT) K ACRQUIT Q
I ACRENTRY["OBLAMT",'$D(ACRCTV) D
.I '$D(ACRCOMP),'$D(ACRCONV),'$D(ACRREACT),$D(ACRCSI) D D Q
.I '$D(ACRCOMP),'$D(ACRCONV),'$D(ACRREACT),$P(ACROBLAP,U)="A"!($P(ACROBLAP,U,3)="A")!($P(ACROBLAP,U,6)="A") Q
.I '$D(ACRCOMP),'$D(ACRCONV),'$D(ACRREACT),$P(ACROBLAP,U)]"","CD"[$P(ACROBLAP,U)!($P(ACROBLAP,U,3)="D")!($P(ACROBLAP,U,6)="D") Q
.I '$D(ACRCOMP),'$D(ACRCONV),$D(ACRREACT),'$D(ACRJVOD) D Q
..I $P(ACROBLAP,U)]"","ACD"[$P(ACROBLAP,U)!($P(ACROBLAP,U,3)="D"),'$$OBL^ACRFEA(ACRDOCDA) D D Q
.I '$D(ACRCOMP),'$D(ACRCONV),$D(ACRJVOD) D Q
..I $E(ACROBLAP)="A",$P(ACROBLAP,U,3)="A" D D Q
.I $D(ACRCOMP),$P(ACROBLAP,U)="",$P(ACROBLAP,U,3)="" Q
.I $D(ACRCOMP),$P(ACROBLAP,U)]"","ACD"[$P(ACROBLAP,U)!("ACD"[$P(ACROBLAP,U,3)) D D Q
.D D
Q:$D(ACRCOMP)
I ACRENTRY["OBLAMT",$D(ACRCTV) D
.I ACRREF=600,$P(ACRDOC0,U,6)=ACRFDNO,$P(ACROBLAP,U)]"","CD"'[$E(ACROBLAP),$P(ACROBLAP,U,7)=19,$P(ACROBLAP,U,8)="" D D
Q Q
FDTP1 S ACRDIC(0)=$S(ACRENTRY["APPAMT":"AELNZ",1:"AENQZ")
S (ACRDIC,ACRDIE)=ACRGREF_"("
I ACRENTRY'["APP",'$D(ACRCONV) D
.S DIC("S")="I $D("_$S(ACRENTRY["ALLAMT"&(ACRENTR1["APP"):"^ACRAPP",ACRENTR1["ALLAMT":"^ACRALW",ACRENTR1["ALC":"^ACRALC",ACRENTR1["LOCB":"^ACRLOCB")_"(""SEC"",DUZ,+Y))"
I ACRENTRY["OBLA",'$D(ACRCONV) D
.S DIC("S")=DIC("S")_",$P(^ACRLOCB(+Y,0),U,8)=""O"""
W !
D EDIC^ACRFDTP4
S ACRGL=$P($P($T(@ACRENTRY^ACRFCTL1),";;",3),"(")
I '$D(ACRQUIT),'$D(@ACRGL@("M",ACRZDA)),ACRENTRY["ALL"!(ACRENTRY["ALC")!(ACRENTRY["LOC") D ^ACRFDF
Q
D Q:'$D(@ACRGREF@(ACRFD,0))
S ACRFD1=$P(@ACRGREF@(ACRFD,0),U,8)
S ACRJ=ACRJ+1
I '$D(ACRFDNO) D @ACRENTR1^ACRFDTP4 Q
D @ACRENTR2^ACRFDTP4
Q
ENTRY ;EP;
S:$D(ACRENTR1) ACRDATA1=$T(@ACRENTR1^ACRFCTL1)
D EN
Q
SET N X
S X=ACRDATA1
S ACRRTN=$P(X,";;",4)
S ACRGREF=$P($P(X,";;",3),"(")
S (ACRTYPS,ACRY)=$P(X,";;",2)
S ACRDR=$P(X,";;",5)
S ACRDIC("A")=$P(X,";;",6)
S ACRD=$TR($P(X,";;",7),",","^")
Q
CSI ;
S DIR(0)="SO^1:Individual Request;2:Summary of All Requests"
S DIR("A")="Which one"
D DIR^ACRFDIC
Q:+$G(Y)<1
I Y=1 K ACRCSIS D ENTRY^ACRFEA Q
I Y=2 D
.S ACRCSIS=""
.S ACRRTN="ENTRY^ACRFEA"
.S ZTDESC="REPORT OF PENDING DOCUMENTS."
.S ACRPRT=""
.D ^ACRFZIS
.K ACRDISP,ACRPRT
Q
ACRFDTP ;IHS/OIRM/DSD/THL,AEF - LOOKUP AND DISPLAY FINANCIAL DATA; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE CALLED FOR DISPLAY AND SELECTION OF ALL ACCOUNTS
EN IF $DATA(ACROUT)
QUIT
+1 NEW ACRI
+2 KILL ACRQUIT
+3 FOR
DO EN1
IF $DATA(ACROUT)!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT IF '$DATA(ACRDEL)
DO EXIT^ACRFEXIT
+1 QUIT
EN1 DO SET
+1 IF ACRENTR1["LOCBAMT"&(ACRENTRY["OBLAMT")
DO ^ACRFONE
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 KILL ACRQUIT
+4 SET ACRENTRY=$PIECE(ACRENTRY," ")
+5 IF $DATA(ACRUP)
Begin DoDot:1
+6 DO FDTP
+7 IF $DATA(ACRFDNO)
SET ACRUP=ACRFDNO
+8 SET ACRQUIT=""
End DoDot:1
QUIT
+9 IF '$DATA(ACRONE)
DO FDTP
+10 IF ($DATA(ACRSOFX)!$DATA(ACRSOF))&$DATA(ACRONE)
DO SOF^ACRFDTP4
+11 IF $DATA(ACRFDNO)
IF '$DATA(ACRQUIT)
IF '$DATA(ACRSOF)
IF '$DATA(ACRSOFX)
IF '$DATA(ACRTDEL)
Begin DoDot:1
+12 IF '$DATA(ACRCSI)
DO ENTRY^ACRFEA
+13 IF $DATA(ACRCSI)
DO CSI
+14 KILL ACRX,ACRJ,ACR,ACRY,ACRZ,ACRFD,ACRFDNA,ACRFDNO,ACRCONT,ACRCSIS,ACRTYPS
+15 IF $DATA(ACRONE)
SET ACRQUIT=""
End DoDot:1
+16 IF $DATA(ACRFDNO)
IF $DATA(ACRTDEL)
DO T1^ACRFDEL
+17 QUIT
FDTP ;EP;TO DISPLAY FINANCIAL DATA
+1 IF $DATA(ACROUT)
QUIT
+2 WRITE @IOF
+3 IF ACRGREF["OBL"
KILL ACRDISP
+4 IF '$DATA(ACRQUIT)&$DATA(ACRDISP)
DO SUBHEAD^ACRFDTP2
+5 IF '$DATA(ACRFDNO)
DO @ACRENTR1^ACRFDTP3
IF 1
+6 IF '$TEST
IF $DATA(ACRENTR2)
DO @ACRENTR2^ACRFDTP3
FDTP11 IF $DATA(ACRCONV)&$DATA(ACRFDNO)&'$DATA(ACRQUIT)
DO FDTPX2
+1 IF '$DATA(ACRFDNO)!'$DATA(ACRCONV)
DO FDTPX1
+2 QUIT
FDTPX1 SET ACRFD=0
+1 SET ACRK=$SELECT(ACRENTRY["OBLAMT":31,1:21)
+2 SET ACRXREF=$SELECT('$DATA(ACRFDNO):"SEC",ACRGREF["OBL":"D",1:"M")
+3 SET ACRDFN=$SELECT('$DATA(ACRFDNO):DUZ,1:ACRFDNO)
+4 SET ACRJ=0
+5 KILL ACR
+6 SET ACRFD=999999999
+7 FOR
SET ACRFD=$ORDER(@ACRGREF@(ACRXREF,ACRDFN,ACRFD),-1)
IF 'ACRFD
QUIT
DO DTP
IF $DATA(ACRPSE)
QUIT
+8 IF $DATA(ACR(ACRJ))&'$DATA(ACRPSE)
DO DISP2^ACRFDTP5
+9 KILL ACRJ,ACRPSE
+10 IF '$DATA(ACRFDNO)
DO FDTP1
+11 KILL ACRFD
+12 QUIT
DTP IF '$DATA(@ACRGREF@(ACRFD,0))
QUIT
+1 IF '$DATA(ACRFDNO)
DO FDTPA1
+2 IF $DATA(ACRFDNO)&'$DATA(ACRCONV)
DO FDTPA2
+3 IF (ACRGREF["LOCB"&(ACRJ#10=0))!((ACRGREF'["LOCB")&(ACRJ#20=0))
DO DISP2^ACRFDTP5
+4 QUIT
FDTPX2 SET (ACRJ,ACRFD)=0
+1 KILL ACR
+2 SET ACRFD=999999999
+3 FOR
SET ACRFD=$ORDER(^ACROBL("ACONV",ACRFDNO,"Y",ACRFD),-1)
IF 'ACRFD
QUIT
DO FDTPA2
IF $DATA(ACRPSE)
QUIT
+4 IF $DATA(ACR(ACRJ))&'$DATA(ACRPSE)
DO DISP2^ACRFDTP5
+5 IF '$DATA(ACRFDNO)
DO FDTP1
+6 KILL ACRFD,ACRPSE
+7 QUIT
FDTPA1 DO D
+1 QUIT
FDTPA2 ;SCREEN ENTRIES FOR DISPLAY
+1 IF '$DATA(@ACRGREF@(ACRFD,0))
QUIT
+2 IF $PIECE(@ACRGREF@(ACRFD,0),U,$SELECT(ACRENTRY["ALC"!(ACRENTRY["OBL")
QUIT
+3 IF ACRENTRY'["OBLAMT"
DO D
QUIT
+4 SET ACRDOCDA=ACRFD
+5 DO SETDOC^ACRFEA1
+6 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+7 IF ACRENTRY["OBLAMT"
IF '$DATA(ACRCTV)
Begin DoDot:1
+8 IF '$DATA(ACRCOMP)
IF '$DATA(ACRCONV)
IF '$DATA(ACRREACT)
IF $DATA(ACRCSI)
DO D
QUIT
+9 IF '$DATA(ACRCOMP)
IF '$DATA(ACRCONV)
IF '$DATA(ACRREACT)
IF $PIECE(ACROBLAP,U)="A"!($PIECE(ACROBLAP,U,3)="A")!($PIECE(ACROBLAP,U,6)="A")
QUIT
+10 IF '$DATA(ACRCOMP)
IF '$DATA(ACRCONV)
IF '$DATA(ACRREACT)
IF $PIECE(ACROBLAP,U)]""
IF "CD"[$PIECE(ACROBLAP,U)!($PIECE(ACROBLAP,U,3)="D")!($PIECE(ACROBLAP,U,6)="D")
QUIT
+11 IF '$DATA(ACRCOMP)
IF '$DATA(ACRCONV)
IF $DATA(ACRREACT)
IF '$DATA(ACRJVOD)
Begin DoDot:2
+12 IF $PIECE(ACROBLAP,U)]""
IF "ACD"[$PIECE(ACROBLAP,U)!($PIECE(ACROBLAP,U,3)="D")
IF '$$OBL^ACRFEA(ACRDOCDA)
DO D
QUIT
End DoDot:2
QUIT
+13 IF '$DATA(ACRCOMP)
IF '$DATA(ACRCONV)
IF $DATA(ACRJVOD)
Begin DoDot:2
+14 IF $EXTRACT(ACROBLAP)="A"
IF $PIECE(ACROBLAP,U,3)="A"
DO D
QUIT
End DoDot:2
QUIT
+15 IF $DATA(ACRCOMP)
IF $PIECE(ACROBLAP,U)=""
IF $PIECE(ACROBLAP,U,3)=""
QUIT
+16 IF $DATA(ACRCOMP)
IF $PIECE(ACROBLAP,U)]""
IF "ACD"[$PIECE(ACROBLAP,U)!("ACD"[$PIECE(ACROBLAP,U,3))
DO D
QUIT
+17 DO D
End DoDot:1
+18 IF $DATA(ACRCOMP)
QUIT
+19 IF ACRENTRY["OBLAMT"
IF $DATA(ACRCTV)
Begin DoDot:1
+20 IF ACRREF=600
IF $PIECE(ACRDOC0,U,6)=ACRFDNO
IF $PIECE(ACROBLAP,U)]""
IF "CD"'[$EXTRACT(ACROBLAP)
IF $PIECE(ACROBLAP,U,7)=19
IF $PIECE(ACROBLAP,U,8)=""
DO D
End DoDot:1
Q QUIT
FDTP1 SET ACRDIC(0)=$SELECT(ACRENTRY["APPAMT":"AELNZ",1:"AENQZ")
+1 SET (ACRDIC,ACRDIE)=ACRGREF_"("
+2 IF ACRENTRY'["APP"
IF '$DATA(ACRCONV)
Begin DoDot:1
+3 SET DIC("S")="I $D("_$SELECT(ACRENTRY["ALLAMT"&(ACRENTR1["APP"):"^ACRAPP",ACRENTR1["ALLAMT":"^ACRALW",ACRENTR1["ALC":"^ACRALC",ACRENTR1["LOCB":"^ACRLOCB")_"(""SEC"",DUZ,+Y))"
End DoDot:1
+4 IF ACRENTRY["OBLA"
IF '$DATA(ACRCONV)
Begin DoDot:1
+5 SET DIC("S")=DIC("S")_",$P(^ACRLOCB(+Y,0),U,8)=""O"""
End DoDot:1
+6 WRITE !
+7 DO EDIC^ACRFDTP4
+8 SET ACRGL=$PIECE($PIECE($TEXT(@ACRENTRY^ACRFCTL1),";;",3),"(")
+9 IF '$DATA(ACRQUIT)
IF '$DATA(@ACRGL@("M",ACRZDA))
IF ACRENTRY["ALL"!(ACRENTRY["ALC")!(ACRENTRY["LOC")
DO ^ACRFDF
+10 QUIT
D IF '$DATA(@ACRGREF@(ACRFD,0))
QUIT
+1 SET ACRFD1=$PIECE(@ACRGREF@(ACRFD,0),U,8)
+2 SET ACRJ=ACRJ+1
+3 IF '$DATA(ACRFDNO)
DO @ACRENTR1^ACRFDTP4
QUIT
+4 DO @ACRENTR2^ACRFDTP4
+5 QUIT
ENTRY ;EP;
+1 IF $DATA(ACRENTR1)
SET ACRDATA1=$TEXT(@ACRENTR1^ACRFCTL1)
+2 DO EN
+3 QUIT
SET NEW X
+1 SET X=ACRDATA1
+2 SET ACRRTN=$PIECE(X,";;",4)
+3 SET ACRGREF=$PIECE($PIECE(X,";;",3),"(")
+4 SET (ACRTYPS,ACRY)=$PIECE(X,";;",2)
+5 SET ACRDR=$PIECE(X,";;",5)
+6 SET ACRDIC("A")=$PIECE(X,";;",6)
+7 SET ACRD=$TRANSLATE($PIECE(X,";;",7),",","^")
+8 QUIT
CSI ;
+1 SET DIR(0)="SO^1:Individual Request;2:Summary of All Requests"
+2 SET DIR("A")="Which one"
+3 DO DIR^ACRFDIC
+4 IF +$GET(Y)<1
QUIT
+5 IF Y=1
KILL ACRCSIS
DO ENTRY^ACRFEA
QUIT
+6 IF Y=2
Begin DoDot:1
+7 SET ACRCSIS=""
+8 SET ACRRTN="ENTRY^ACRFEA"
+9 SET ZTDESC="REPORT OF PENDING DOCUMENTS."
+10 SET ACRPRT=""
+11 DO ^ACRFZIS
+12 KILL ACRDISP,ACRPRT
End DoDot:1
+13 QUIT
