- 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
