| 1 | PRCARFP ;WASH-ISC@ALTOONA,PA/CMS-PREPAYMENT POST REPT ;1/11/95 9:24 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**90**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;Automatic payment posting from prepayment
|
|---|
| 5 | N BEG,END,X,Y,%DT,%ZIS
|
|---|
| 6 | ST W !! D NOW^%DTC S %DT(0)=-%,%DT="AEXP",%DT("A")="Enter Transaction START Date: " D ^%DT G:Y<0 REPQ S BEG=Y
|
|---|
| 7 | W !! S %DT="AEX",%DT("A")="Enter Transaction END Date: " D ^%DT G:Y<0 REPQ S END=Y
|
|---|
| 8 | I BEG>END W !!,*7," (Ending date must be greater than Start date.)" G ST
|
|---|
| 9 | S %ZIS="MQ" D ^%ZIS G:POP REPQ
|
|---|
| 10 | I $D(IO("Q")) S ZTRTN="DQ^PRCARFP",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTDESC="Prepayment Posting Report" D ^%ZTLOAD G REPQ
|
|---|
| 11 | U IO D DQ
|
|---|
| 12 | REPQ W:$E(IOST,1,2)'="C-" @IOF D ^%ZISC Q
|
|---|
| 13 | DQ ;
|
|---|
| 14 | N BN,DAT,DFN,NOW,OUT,PAGE,PTN,TN,X,Y
|
|---|
| 15 | D NOW^%DTC S Y=X D DD^%DT S NOW=Y
|
|---|
| 16 | S (PAGE,OUT)=0 D HD
|
|---|
| 17 | S DAT=0 F S DAT=$O(^PRCA(433,"AP",DAT)) Q:'DAT!(DAT>END)!(OUT) I DAT'<BEG F PTN=0:0 S PTN=$O(^PRCA(433,"AP",DAT,PTN)) Q:'PTN!(OUT) F TN=0:0 S TN=$O(^PRCA(433,"AP",DAT,PTN,TN)) Q:'TN!(OUT) D
|
|---|
| 18 | .N VA,VADM,VAERR I ($Y+7)>IOSL D HD Q:OUT
|
|---|
| 19 | .W !,$E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_$E(DAT,2,3),?11,+$G(^PRCA(433,TN,0))
|
|---|
| 20 | .S Y=$P(^PRCA(430.3,$P(^PRCA(433,TN,1),U,2),0),U,1) W ?18,$S(Y["FULL":"PAYMNT (FULL)",Y["PART":"PAYMNT (PART)",1:$E(Y,1,9))
|
|---|
| 21 | .W ?32,"$"_$FN($P(^PRCA(433,TN,1),U,5),",",2)
|
|---|
| 22 | .S BN=+$P(^PRCA(433,TN,0),U,2) I Y["PAY",",22,23,"'[(","_$P(^PRCA(430,BN,0),U,2)_","),$P(^(0),U,18)'="36X5287" W "*"
|
|---|
| 23 | .I $P($G(^RCD(340,+$P(^PRCA(430,BN,0),U,9),0)),U,1)["DPT" S DFN=+$P(^(0),U,1) D DEM^VADPT
|
|---|
| 24 | .W ?45,+$G(^PRCA(433,PTN,0)),?55,$G(VADM(1)),?69,$P(^PRCA(430,BN,0),U,1)
|
|---|
| 25 | .I '$D(^PRCA(433,"AP",DAT,TN,PTN)) W !,?11,"**ERROR MESSAGE: Corresponding Transaction not found!" Q
|
|---|
| 26 | .I +$P($G(^PRCA(433,TN,1)),U,5)'=+$P($G(^PRCA(433,PTN,1)),U,5) W !,?11,"**ERROR MESSAGE: Unbalanced Transaction Amounts"
|
|---|
| 27 | .QUIT
|
|---|
| 28 | W !!,"* - Include the payment amount on an FMS ET document",!
|
|---|
| 29 | DQQ Q
|
|---|
| 30 | HD ;
|
|---|
| 31 | D:PAGE>0 SCRN G:OUT HDQ S PAGE=PAGE+1
|
|---|
| 32 | W @IOF W !,?5,"Background Payment Posting from Prepayment Receivables",?60,"Page ",PAGE," ",NOW
|
|---|
| 33 | W !,?10,"Reporting period: " S Y=BEG X ^DD("DD") W Y," thru " S Y=END X ^DD("DD") W Y
|
|---|
| 34 | W !! F Y=1:1:79 W "="
|
|---|
| 35 | W !,"Tran.",?11,"Tran.",?18,"Tran.",?32,"Tran.",?40,"Corresponding",?55,"Patient",?69,"Bill"
|
|---|
| 36 | W !,"Date",?11,"No.",?18,"Type",?32,"Amount",?43,"Tran. No.",?55,"Name",?69,"No.",!!
|
|---|
| 37 | HDQ Q
|
|---|
| 38 | SCRN ;crt display exit
|
|---|
| 39 | W !!,"* - Include the payment amount on an FMS ET document"
|
|---|
| 40 | Q:$E(IOST,1,2)'["C-"
|
|---|
| 41 | N DIR,DIRUT,DUOUT,DIROUT,X,Y
|
|---|
| 42 | F Y=$Y:1:(IOSL-4) W !
|
|---|
| 43 | S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S OUT=1
|
|---|
| 44 | Q
|
|---|
