source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCARFP.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PRCARFP ;WASH-ISC@ALTOONA,PA/CMS-PREPAYMENT POST REPT ;1/11/95 9:24 AM
2V ;;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
6ST 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
12REPQ W:$E(IOST,1,2)'="C-" @IOF D ^%ZISC Q
13DQ ;
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",!
29DQQ Q
30HD ;
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.",!!
37HDQ Q
38SCRN ;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
Note: See TracBrowser for help on using the repository browser.