- 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
