ACRFTRX ;IHS/OIRM/DSD/THL,AEF - DOCUMENT TRANSACTION HISTORY DISPLAY AND EDIT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE USED FOR DOCUMENT TRANSACTION HISTORY DISPLAY AND EDIT
EN F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRJ,ACRX,ACRDOCDA,ACRDOCDA,ACRTTYP,ACRTX,ACRTX1,ACRX,ACRDELM,ACRDOC
K ACRLBDA,ACRNOW,ACROBL,ACRQUIT,ACRSPT,ACRTXAMT,ACRTXCOD,ACRTXDA
K ACRTXDAT,ACRTXDA
Q
EN1 D DISPLAY
D SELECT
Q
DISPLAY W @IOF
S ACRTX=$O(^ACRTRX("C",ACRDOCDA,""))
S ACRTX=^ACRTRX(ACRTX,0)
I ACRTX="" S ACRQUIT="" Q
S ACRDOCDA=$P(ACRTX,U,2)
S ACRDOCDA=$P(ACRTX,U,3)
S ACRLBDA=$P(ACRTX,U,4)
S ACROBL=$P(^ACROBL(ACRDOCDA,0),U)
S ACRSPT=$P(^ACROBL(ACRDOCDA,"DT"),U,2)
S ACRDOC=$S($P(^ACRDOC(ACRDOCDA,0),U)]""&'$D(ACRREQST):$P(^(0),U,2),1:$P(^(0),U))
S ACRX="DOCUMENT TRANSACTION HISTORY"
W !!?80-$L(ACRX)\2,ACRX
K ACRX
W !!?38,"TOTAL"
W ?50,"TOTAL"
W !?20,"DOCUMENT NO."
W ?35,"REQUEST"
W ?49,"PAYMENT"
W !?20,"------------"
W ?35,"----------"
W ?47,"-----------"
W !?20,ACRDOC
W ?35,$J(ACROBL,10)
W ?$X+3,$J(ACRSPT,10)
W !!?29,"TRANSACTION"
W ?42,"TRANSACTION"
W ?55,"TRANSACTION"
W !?2,"NO."
W ?7,"TRANSACTION TYPE"
W ?31,"AMOUNT"
W ?46,"DATE"
W ?59,"CODE"
W !?2,"---"
W ?7,"--------------------"
W ?29,"-----------"
W ?42,"-----------"
W ?55,"-----------"
S (ACRTTYP,ACRJ)=0
F S ACRTTYP=$O(^ACRTRX("AC",ACRDOCDA,ACRTTYP)) Q:'ACRTTYP D
.S ACRTXDA=0
.F S ACRTXDA=$O(^ACRTRX("AC",ACRDOCDA,ACRTTYP,ACRTXDA)) Q:'ACRTXDA D
..S ACRJ=ACRJ+1
..D DISP1
Q
DISP1 Q:ACRTTYP="O"
S ACRTX=ACRTXDA_"^"_^ACRTRX(ACRTXDA,0)
S ACRTX1=^ACRTRX(ACRTXDA,"DT")
S ACRTX(ACRJ)=ACRTX
S ACRTXAMT=$P(ACRTX1,U)
S ACRTXCOD=$P(ACRTX1,U,2)
S ACRTXDAT=$P(ACRTX,U,11)
S Y=ACRTXDAT
X ^DD("DD")
S ACRTXDAT=Y
K Y
S ACRX=$P(^DD(9002192,.01,0),U,3)
S ACRDELM=ACRTTYP_":"
S ACRTXDA=$P(ACRX,ACRDELM,2)
S ACRTXDA=$P(ACRTXDA,";")
W !?2,$J(ACRJ,3)
W ?7,ACRTXDA
W ?29,$J(ACRTXAMT,10)
W ?42,$E(ACRTXDAT,1,11)
W ?55,ACRTXCOD
Q
SELECT S DIR(0)="SO^1:Edit one of the above;2:Add another transaction^K:X'?1N!(X<1)!(X>2) X"
S DIR("A")="Your choice ==> "
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
I X=1 D EDIT Q
D ADD
Q
EDIT S DIR(0)="NOA^1:"_ACRJ_"^K:X'?1N.2N!(X<1)!(X>ACRJ)!'$D(ACRSS(X)) X"
S DIR("A")="Transaction NO. ==> "
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
S ACRX=ACRTX(X)
S ACRTXDA=$P(ACRX,U)
S ACRTTYP=$P(ACRX,U,2)
I "I"[ACRTTYP S ACROBL=ACROBL-$P(^ACRTRX(ACRTXDA,"DT"),U) D DIE
I "D"[ACRTTYP S ACROBL=ACROBL+$P(^ACRTRX(ACRTXDA,"DT"),U) D DIE
I "C"[ACRTTYP D DIE
I "APF"[ACRTTYP D
.S ACRSPT=ACRSPT-$P(^ACRTRX(ACRTXDA,"DT"),U)
.S:ACRSPT'["." ACRSPT=ACRSPT_".00"
.D DIE
D DIE^ACRFDIC
Q
ADD S DIR(0)="9002192,.01"
S DIR("A")="Transation type"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S (X,ACRTTYP)=X
S DIC="^ACRTRX("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACRLBDA
D FILE^ACRFDIC
S ACRTXDA=+Y
D EDIE
Q
EDIE W !!
D NOW^%DTC
S ACRNOW=%
S DA=ACRTXDA
S DIE="^ACRTRX("
S DR="10T;1T;2////"_ACRNOW_";3////"_DUZ
S DIE("NO^")="NO"
D DIE^ACRFDIC
I "I"[ACRTTYP D
.S ACROBL=ACROBL+$P(^ACRTRX(ACRTXDA,"DT"),U)
.S:ACROBL'["." ACROBL=ACROBL_".00"
.D DIE
I "D"[ACRTTYP D
.S ACROBL=ACROBL-$P(^ACRTRX(ACRTXDA,"DT"),U)
.S:ACROBL'["." ACROBL=ACROBL_".00"
.D DIE
I "C"[ACRTTYP D DIE
I "PF"[ACRTTYP D
.S ACRSPT=ACRSPT+$P(^ACRTRX(ACRTXDA,"DT"),U)
.S:ACRSPT'["." ACRSPT=ACRSPT_".00"
.D DIE
Q
DIE S:ACROBL'["." ACROBL=ACROBL_".00"
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=".01///"_ACROBL
I "C"[ACRTTYP S DR=".01///0;2////0.00"
I "APF"[ACRTTYP S DR="2///"_ACRSPT
D DIE^ACRFDIC
Q
ACRFTRX ;IHS/OIRM/DSD/THL,AEF - DOCUMENT TRANSACTION HISTORY DISPLAY AND EDIT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE USED FOR DOCUMENT TRANSACTION HISTORY DISPLAY AND EDIT
EN FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRJ,ACRX,ACRDOCDA,ACRDOCDA,ACRTTYP,ACRTX,ACRTX1,ACRX,ACRDELM,ACRDOC
+1 KILL ACRLBDA,ACRNOW,ACROBL,ACRQUIT,ACRSPT,ACRTXAMT,ACRTXCOD,ACRTXDA
+2 KILL ACRTXDAT,ACRTXDA
+3 QUIT
EN1 DO DISPLAY
+1 DO SELECT
+2 QUIT
DISPLAY WRITE @IOF
+1 SET ACRTX=$ORDER(^ACRTRX("C",ACRDOCDA,""))
+2 SET ACRTX=^ACRTRX(ACRTX,0)
+3 IF ACRTX=""
SET ACRQUIT=""
QUIT
+4 SET ACRDOCDA=$PIECE(ACRTX,U,2)
+5 SET ACRDOCDA=$PIECE(ACRTX,U,3)
+6 SET ACRLBDA=$PIECE(ACRTX,U,4)
+7 SET ACROBL=$PIECE(^ACROBL(ACRDOCDA,0),U)
+8 SET ACRSPT=$PIECE(^ACROBL(ACRDOCDA,"DT"),U,2)
+9 SET ACRDOC=$SELECT($PIECE(^ACRDOC(ACRDOCDA,0),U)]""&'$DATA(ACRREQST):$PIECE(^(0),U,2),1:$PIECE(^(0),U))
+10 SET ACRX="DOCUMENT TRANSACTION HISTORY"
+11 WRITE !!?80-$LENGTH(ACRX)\2,ACRX
+12 KILL ACRX
+13 WRITE !!?38,"TOTAL"
+14 WRITE ?50,"TOTAL"
+15 WRITE !?20,"DOCUMENT NO."
+16 WRITE ?35,"REQUEST"
+17 WRITE ?49,"PAYMENT"
+18 WRITE !?20,"------------"
+19 WRITE ?35,"----------"
+20 WRITE ?47,"-----------"
+21 WRITE !?20,ACRDOC
+22 WRITE ?35,$JUSTIFY(ACROBL,10)
+23 WRITE ?$X+3,$JUSTIFY(ACRSPT,10)
+24 WRITE !!?29,"TRANSACTION"
+25 WRITE ?42,"TRANSACTION"
+26 WRITE ?55,"TRANSACTION"
+27 WRITE !?2,"NO."
+28 WRITE ?7,"TRANSACTION TYPE"
+29 WRITE ?31,"AMOUNT"
+30 WRITE ?46,"DATE"
+31 WRITE ?59,"CODE"
+32 WRITE !?2,"---"
+33 WRITE ?7,"--------------------"
+34 WRITE ?29,"-----------"
+35 WRITE ?42,"-----------"
+36 WRITE ?55,"-----------"
+37 SET (ACRTTYP,ACRJ)=0
+38 FOR
SET ACRTTYP=$ORDER(^ACRTRX("AC",ACRDOCDA,ACRTTYP))
IF 'ACRTTYP
QUIT
Begin DoDot:1
+39 SET ACRTXDA=0
+40 FOR
SET ACRTXDA=$ORDER(^ACRTRX("AC",ACRDOCDA,ACRTTYP,ACRTXDA))
IF 'ACRTXDA
QUIT
Begin DoDot:2
+41 SET ACRJ=ACRJ+1
+42 DO DISP1
End DoDot:2
End DoDot:1
+43 QUIT
DISP1 IF ACRTTYP="O"
QUIT
+1 SET ACRTX=ACRTXDA_"^"_^ACRTRX(ACRTXDA,0)
+2 SET ACRTX1=^ACRTRX(ACRTXDA,"DT")
+3 SET ACRTX(ACRJ)=ACRTX
+4 SET ACRTXAMT=$PIECE(ACRTX1,U)
+5 SET ACRTXCOD=$PIECE(ACRTX1,U,2)
+6 SET ACRTXDAT=$PIECE(ACRTX,U,11)
+7 SET Y=ACRTXDAT
+8 XECUTE ^DD("DD")
+9 SET ACRTXDAT=Y
+10 KILL Y
+11 SET ACRX=$PIECE(^DD(9002192,.01,0),U,3)
+12 SET ACRDELM=ACRTTYP_":"
+13 SET ACRTXDA=$PIECE(ACRX,ACRDELM,2)
+14 SET ACRTXDA=$PIECE(ACRTXDA,";")
+15 WRITE !?2,$JUSTIFY(ACRJ,3)
+16 WRITE ?7,ACRTXDA
+17 WRITE ?29,$JUSTIFY(ACRTXAMT,10)
+18 WRITE ?42,$EXTRACT(ACRTXDAT,1,11)
+19 WRITE ?55,ACRTXCOD
+20 QUIT
SELECT SET DIR(0)="SO^1:Edit one of the above;2:Add another transaction^K:X'?1N!(X<1)!(X>2) X"
+1 SET DIR("A")="Your choice ==> "
+2 DO DIR^ACRFDIC
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+4 IF X=1
DO EDIT
QUIT
+5 DO ADD
+6 QUIT
EDIT SET DIR(0)="NOA^1:"_ACRJ_"^K:X'?1N.2N!(X<1)!(X>ACRJ)!'$D(ACRSS(X)) X"
+1 SET DIR("A")="Transaction NO. ==> "
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+5 SET ACRX=ACRTX(X)
+6 SET ACRTXDA=$PIECE(ACRX,U)
+7 SET ACRTTYP=$PIECE(ACRX,U,2)
+8 IF "I"[ACRTTYP
SET ACROBL=ACROBL-$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
DO DIE
+9 IF "D"[ACRTTYP
SET ACROBL=ACROBL+$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
DO DIE
+10 IF "C"[ACRTTYP
DO DIE
+11 IF "APF"[ACRTTYP
Begin DoDot:1
+12 SET ACRSPT=ACRSPT-$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
+13 IF ACRSPT'["."
SET ACRSPT=ACRSPT_".00"
+14 DO DIE
End DoDot:1
+15 DO DIE^ACRFDIC
+16 QUIT
ADD SET DIR(0)="9002192,.01"
+1 SET DIR("A")="Transation type"
+2 DO DIR^ACRFDIC
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 SET (X,ACRTTYP)=X
+5 SET DIC="^ACRTRX("
+6 SET DIC(0)="L"
+7 SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACRLBDA
+8 DO FILE^ACRFDIC
+9 SET ACRTXDA=+Y
+10 DO EDIE
+11 QUIT
EDIE WRITE !!
+1 DO NOW^%DTC
+2 SET ACRNOW=%
+3 SET DA=ACRTXDA
+4 SET DIE="^ACRTRX("
+5 SET DR="10T;1T;2////"_ACRNOW_";3////"_DUZ
+6 SET DIE("NO^")="NO"
+7 DO DIE^ACRFDIC
+8 IF "I"[ACRTTYP
Begin DoDot:1
+9 SET ACROBL=ACROBL+$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
+10 IF ACROBL'["."
SET ACROBL=ACROBL_".00"
+11 DO DIE
End DoDot:1
+12 IF "D"[ACRTTYP
Begin DoDot:1
+13 SET ACROBL=ACROBL-$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
+14 IF ACROBL'["."
SET ACROBL=ACROBL_".00"
+15 DO DIE
End DoDot:1
+16 IF "C"[ACRTTYP
DO DIE
+17 IF "PF"[ACRTTYP
Begin DoDot:1
+18 SET ACRSPT=ACRSPT+$PIECE(^ACRTRX(ACRTXDA,"DT"),U)
+19 IF ACRSPT'["."
SET ACRSPT=ACRSPT_".00"
+20 DO DIE
End DoDot:1
+21 QUIT
DIE IF ACROBL'["."
SET ACROBL=ACROBL_".00"
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACROBL("
+3 SET DR=".01///"_ACROBL
+4 IF "C"[ACRTTYP
SET DR=".01///0;2////0.00"
+5 IF "APF"[ACRTTYP
SET DR="2///"_ACRSPT
+6 DO DIE^ACRFDIC
+7 QUIT
