| 1 | PRCAHIS ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report ;9/27/93 4:32 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**110,198**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;Ask debtor and date range for transaction history
|
|---|
| 6 | K DIR S POP=0
|
|---|
| 7 | N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 8 | S DIR(0)="PO^340:QEAMZ",DIR("A")="Select Patient ",DIR("?")="Enter a Patient name" D ^DIR
|
|---|
| 9 | I $D(DIRUT)!(Y="") G EXIT1
|
|---|
| 10 | I $P($G(^RCD(340,+Y,0)),U)'["DPT" W *7 G EN
|
|---|
| 11 | S DEB=+Y K DIR
|
|---|
| 12 | I '$D(^PRCA(433,"ATD",DEB)),'$D(^PRCA(430,"ATD",DEB)),'$D(^RC(341,"AD",DEB)) W !,"This patient has no activity." Q
|
|---|
| 13 | S BDATE=$O(^PRCA(433,"ATD",+DEB,0)),DIR(0)="DO" S:'BDATE BDATE=2910101
|
|---|
| 14 | S DIR("A")="History beginning",DIR("B")=$$FMTE^XLFDT(BDATE,"1D")
|
|---|
| 15 | S DIR("?")="The default date is either the last statement day or T-30, but any date may be entered."
|
|---|
| 16 | D ^DIR
|
|---|
| 17 | S:Y'="" BDATE=Y I $D(DIRUT)&'Y G EXIT1 Q
|
|---|
| 18 | K DIR,X,Y
|
|---|
| 19 | S DIR(0)="DO^"_BDATE_":DT"
|
|---|
| 20 | S DIR("A")="History ending",DIR("B")=$$FMTE^XLFDT(DT,"1D")
|
|---|
| 21 | D ^DIR S:Y="" Y=DT I $D(DIRUT)&'Y G EXIT1 Q
|
|---|
| 22 | S EDATE=Y
|
|---|
| 23 | K DIR
|
|---|
| 24 | TYPE S DIC="^PRCA(430.3,",DIC(0)="QEMZ",DIC("S")="I +Y,(+Y<15!(""25^29^34^35^40^41^43^45^47""[(""^""_+Y_""^"")))"
|
|---|
| 25 | S Y=0 R !,"TRANSACTION TYPE: ALL//",X:DTIME I '$T!(X="^") Q
|
|---|
| 26 | I X]"",X'="ALL" D ^DIC
|
|---|
| 27 | I X["?" W !!,"Enter 'ALL' for all types of transactions in the AR TRANSACTION TYPE FILE",!,"including COMMENTS and STATEMENT DATES.",! G TYPE
|
|---|
| 28 | G:Y<0 EXIT1 S TYP=$S(+Y:+Y,1:X)
|
|---|
| 29 | I $P($G(^PRCA(430.3,+Y,0)),"^",3)>100 W !!,"This is STATUS. Enter a transaction type only." G TYPE
|
|---|
| 30 | S %ZIS="AEQ" D ^%ZIS G:POP EXIT1
|
|---|
| 31 | I $D(IO("Q")) D Q
|
|---|
| 32 | .S ZTSAVE("DEB")="",ZTSAVE("BDATE")="",ZTSAVE("EDATE")="",ZTSAVE("TYP")="",ZTRTN="DQ^PRCAHIS",ZTDESC="Patient Transaction History Report"
|
|---|
| 33 | .D ^%ZTLOAD,^%ZISC,EXIT1 K ZTSAVE,ZTRTN Q
|
|---|
| 34 | ;
|
|---|
| 35 | DQ ;Call to build array of payment transactions
|
|---|
| 36 | ;
|
|---|
| 37 | U IO
|
|---|
| 38 | D TRANS^PRCAHIS1
|
|---|
| 39 | I '$D(^TMP("PRCAGT",$J)) W !!,"This patient has no activity during this time period."
|
|---|
| 40 | I $D(^TMP("PRCAGT",$J)) D HDR,PRINT
|
|---|
| 41 | ;
|
|---|
| 42 | EXIT1 K AMT,BDATE,BN,BN0,CAT,CATCARE,EDATE,EVNTT,DAT1,DAT2,DATE,DEB,DIC,DIR,DIWL,DIWF,DIWR,DIWT,DUOUT,DX,DY,EVNT,EVNTT,LINE,PG,PNODE,TBAL,TOTPRIN,TOTTRAN,TTYP,TYP,TN,TN0,X,Y,Z,ZTSK,^TMP("PRCAGT",$J),^UTILITY($J)
|
|---|
| 43 | I $D(DIRUT)!POP K DIRUT,POP Q
|
|---|
| 44 | ;end of routine
|
|---|
| 45 | EXIT2 I $E(IOST,1,2)'="C-" W @IOF D ^%ZISC Q
|
|---|
| 46 | I $E(IOST,1,2)="C-" W ! D ENS^%ZISS S DY=IOM-1,DX=0 X IOXY D KILL^%ZISS K DIR,X,Y,^UTILITY($J) S DIR(0)="E" D ^DIR
|
|---|
| 47 | I $D(DIRUT) K DIRUT Q
|
|---|
| 48 | D ^%ZISC
|
|---|
| 49 | G EN
|
|---|
| 50 | ;
|
|---|
| 51 | ;
|
|---|
| 52 | PRINT ;Print transactions
|
|---|
| 53 | K DIRUT
|
|---|
| 54 | S DATE=0 F S DATE=$O(^TMP("PRCAGT",$J,DEB,DATE)) Q:'DATE Q:$D(DIRUT) D
|
|---|
| 55 | .S BN="" F S BN=$O(^TMP("PRCAGT",$J,DEB,DATE,BN)) Q:BN=""!($D(DIRUT)) D SCRN D
|
|---|
| 56 | ..I $D(^TMP("PRCAGT",$J,DEB,DATE,0)) S (BN0,PNODE)=^(0) D
|
|---|
| 57 | ...W !,$$FMTE^XLFDT($P(DATE,".")),?16
|
|---|
| 58 | ...S TYP=$P(BN0,"^",2) W $S(TYP=1:"COMMENT",1:"PATIENT STATEMENT PRINTED") I TYP=1 S EVNT=$P(BN0,"^",3) D
|
|---|
| 59 | ....W:$D(^RC(341,+EVNT,4)) !,?16,$P(^(4),"^")
|
|---|
| 60 | ....I $O(^RC(341,+EVNT,2,0)) S EVNTT=0 F S EVNTT=$O(^RC(341,+EVNT,2,EVNTT)) Q:'EVNTT I $D(^(EVNTT,0)) S X=^(0) D Q:$D(DIRUT) D ^DIWW
|
|---|
| 61 | .....S DIWL=17,DIWF="WC63" D ^DIWP
|
|---|
| 62 | .....D SCRN
|
|---|
| 63 | ..Q:(BN=0) S TN="" F S TN=$O(^TMP("PRCAGT",$J,DEB,DATE,BN,TN)) Q:TN="" Q:$D(DIRUT) D SCRN D
|
|---|
| 64 | ...I 'TN,$D(^TMP("PRCAGT",$J,DEB,DATE,BN,0)) S PNODE=^(0),BN0=$G(^PRCA(430,+BN,0)) W !!,$$FMTE^XLFDT($P(DATE,".")) D
|
|---|
| 65 | ....S CAT=$P(BN0,"^",2),CAT=$S(CAT=24&$P(BN0,"^",16):$P(^PRCA(430.2,$P(BN0,"^",16),0),"^"),1:$P($G(^PRCA(430.2,+CAT,0)),"^"))
|
|---|
| 66 | ....W ?16,CAT," BILL",?58,$P($G(^PRCA(430,+BN,0)),"^"),?68,$J(+PNODE,10,2)
|
|---|
| 67 | ....W !,?16,$P($G(^PRCA(430.3,+$P(BN0,"^",8),0)),"^")
|
|---|
| 68 | ...I TN S PNODE=^TMP("PRCAGT",$J,DEB,DATE,BN,TN) W !!,$$FMTE^XLFDT(DATE,"1D"),?16 S TYP=$P($G(^PRCA(433,+TN,1)),"^",2),TTYP=$P($G(^PRCA(430.3,+TYP,0)),U) W TTYP D
|
|---|
| 69 | ....S CAT=$P($G(^PRCA(430,+BN,0)),"^",2),CAT=$P($G(^PRCA(430.2,+CAT,0)),"^")
|
|---|
| 70 | ....S CATCARE=$P($G(^PRCA(430,+BN,0)),"^",16),CATCARE=$P($G(^PRCA(430.2,+$P(^(0),"^",16),0)),"^")
|
|---|
| 71 | ...I TN W ?58,$P($G(^PRCA(430,+BN,0)),"^") W:+TYP'=45 ?68,$J(+PNODE,10,2)
|
|---|
| 72 | ...I TN W !?16,CAT W:CATCARE]"" !,?16,CATCARE
|
|---|
| 73 | ...I TN,(+TYP=45) D
|
|---|
| 74 | ....I $D(^PRCA(433,+TN,5)) W !?16,$P(^(5),"^",2)
|
|---|
| 75 | ....I $O(^PRCA(433,+TN,7,0)) S TN0=0 F S TN0=$O(^PRCA(433,+TN,7,TN0)) Q:'TN0 I $D(^(TN0,0)) S X=^(0) D Q:$D(DIRUT) D ^DIWW
|
|---|
| 76 | .....S DIWL=17,DIWF="C63W" D ^DIWP
|
|---|
| 77 | ...D SCRN
|
|---|
| 78 | ..Q
|
|---|
| 79 | .Q
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | SCRN ;Check for screen
|
|---|
| 83 | N X,Y K DIR I ($Y+5)>IOSL D
|
|---|
| 84 | .I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR Q:$D(DIRUT)
|
|---|
| 85 | .D HDR
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | HDR ;Heading for report
|
|---|
| 89 | S PG=PG+1
|
|---|
| 90 | W @IOF,!,?20,"Patient Transaction History Report",?70,"Page ",PG
|
|---|
| 91 | W !,?20,"-------------------------------------"
|
|---|
| 92 | W !!,?18,"For Patient: ",$$NAM^RCFN01(DEB),!,?25,"SSN : ",$$SSN^RCFN01(DEB)
|
|---|
| 93 | W !,?20,"For dates: ",$$FMTE^XLFDT(BDATE,"1D"),"-",$$FMTE^XLFDT(EDATE,"1D")
|
|---|
| 94 | W !!," DATE",?16,"ACTIVITY",?58,"BILL #",?73,"AMOUNT",!,LINE
|
|---|
