source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCCPW1.m@ 1211

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1RCCPW1 ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER (BACKGROUND) ;11/23/94 9:52 AM
2V ;;4.5;Accounts Receivable;;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 N BILL,TRANS,WAIVE,TDATE,TTYPE,T0,T1,TAMT,LINE,LNNO,CAT,I,TEXT
5 S (BILL,TDATE)=0 F I=1:1:8 S LINE(I)="0^0"
6 F S BILL=$O(^PRCA(430,BILL)) Q:BILL'?1N.N I ",22,23,"[(","_$P(^(BILL,0),U,2)_",") S CAT=$P(^(0),U,2),(TRANS,WAIVE)=0 D
7 .F S TRANS=$O(^PRCA(433,"C",BILL,TRANS)) Q:'TRANS D Q:TDATE>END
8 ..S T0=$G(^PRCA(433,TRANS,0)),T1=$G(^(1)) Q:$P(T0,U,4)'=2
9 ..S TTYPE=$P(T1,U,2),TDATE=$P(T1,U)
10 ..Q:TDATE>END
11 ..Q:",47,46,"'[(","_TTYPE_",")
12 ..I TDATE<BEG S WAIVE=$S(TTYPE=46:0,1:$P(T1,U,11)) Q
13 ..S TAMT=$P(T1,U,5)
14 ..G UNSUS:TTYPE=46
15 ..S WAIVE=$P(T1,U,11) Q:'WAIVE
16 ..G NSC1:CAT=23 S LNNO=$S(WAIVE=1:1,1:5) G SETLINE
17NSC1 ..S LNNO=$S(WAIVE=1:2,1:6) G SETLINE
18UNSUS ..Q:'WAIVE
19 ..G NSC2:CAT=23 S LNNO=$S(WAIVE=1:3,1:7),WAIVE=0 G SETLINE
20NSC2 ..S LNNO=$S(WAIVE=1:4,1:8),WAIVE=0
21SETLINE ..S LINE(LNNO)=($P(LINE(LNNO),U)+1)_U_($P(LINE(LNNO),U,2)+TAMT)
22 ..Q
23 .Q
24MSG ;COMPILES MAIL MESSAGES
25 N DATA1,DATA2,CNT,AMT
26 F I=1:1:8 S ^TMP("RCCPW",$J,I)=LINE(I)
27 F I=1:1:20 D
28 .S CNT=$P(^TMP("RCCPW",$J,I),U),AMT=$P(^(I),U,2)
29 .S TEXT=$S(I>18:"Appeal Approved Refund",I>16:"Waiver Approved Refund",'(I#8)!((I#8)=7):"Appeal Waiver Resolved",(I#8)<3:"Initial Waiver Request",(I#8)<5:"Waiver Request Resolved",1:"Appeal Waiver")
30 .S DATA1="LINE"_I_":"_$S(I<9:"OC",1:"PC")_","_SITE_","
31 .S DATA1=DATA1_$S(I#2:"SC",1:"NSC")_","_TEXT_","
32 .S DATA1=DATA1_CNT_","_AMT
33 .S ^TMP("RCCPW1",$J,"DATA1",I)=DATA1
34 .S DATA2="Line "_$J(I,2)_" "_$S(I#2:"SC ",1:"NSC")_","_$J(TEXT,25)
35 .S DATA2=DATA2_": COUNT: "_$J(CNT,6)_" AMOUNT: "_$J(AMT,12,2)
36 .S ^TMP("RCCPW1",$J,"DATA2",I+1)=DATA2
37 .Q
38 S ^TMP("RCCPW1",$J,"DATA2",1)="Pharmacy Co-Pay Waiver Data for Site "_SITE_" "_$E(END,4,5)_"/"_$E(END,2,3)
39SEND S XMDUZ="AR Package",XMTEXT="^TMP(""RCCPW1"","_$J_",""DATA1"","
40 S XMY("G.PCWMCCR@FORUM.VA.GOV")="",XMDUZ="AR PACKAGE"
41 S XMSUB="Rx Copay Waivers-Site #"_SITE_":"_$$DATE(END)
42 D ^XMD K XMY
43 S XMDUZ="AR Package",XMTEXT="^TMP(""RCCPW1"","_$J_",""DATA2"","
44 S XMSUB="Pharmacy Co-pay Waiver Report: "_$$DATE(END)
45 S XMY(DUZ)="" D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
46 K ^TMP("RCCPW1",$J),^TMP("RCCPW",$J),BEG,END,SITE
47 Q
48DATE(X) ;
49 S X=$E(X,4,5)_"/"_$E(X,2,3)
50 Q X
Note: See TracBrowser for help on using the repository browser.