RCCPW1 ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER (BACKGROUND) ;11/23/94 9:52 AM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
N BILL,TRANS,WAIVE,TDATE,TTYPE,T0,T1,TAMT,LINE,LNNO,CAT,I,TEXT
S (BILL,TDATE)=0 F I=1:1:8 S LINE(I)="0^0"
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
.F S TRANS=$O(^PRCA(433,"C",BILL,TRANS)) Q:'TRANS D Q:TDATE>END
..S T0=$G(^PRCA(433,TRANS,0)),T1=$G(^(1)) Q:$P(T0,U,4)'=2
..S TTYPE=$P(T1,U,2),TDATE=$P(T1,U)
..Q:TDATE>END
..Q:",47,46,"'[(","_TTYPE_",")
..I TDATE<BEG S WAIVE=$S(TTYPE=46:0,1:$P(T1,U,11)) Q
..S TAMT=$P(T1,U,5)
..G UNSUS:TTYPE=46
..S WAIVE=$P(T1,U,11) Q:'WAIVE
..G NSC1:CAT=23 S LNNO=$S(WAIVE=1:1,1:5) G SETLINE
NSC1 ..S LNNO=$S(WAIVE=1:2,1:6) G SETLINE
UNSUS ..Q:'WAIVE
..G NSC2:CAT=23 S LNNO=$S(WAIVE=1:3,1:7),WAIVE=0 G SETLINE
NSC2 ..S LNNO=$S(WAIVE=1:4,1:8),WAIVE=0
SETLINE ..S LINE(LNNO)=($P(LINE(LNNO),U)+1)_U_($P(LINE(LNNO),U,2)+TAMT)
..Q
.Q
MSG ;COMPILES MAIL MESSAGES
N DATA1,DATA2,CNT,AMT
F I=1:1:8 S ^TMP("RCCPW",$J,I)=LINE(I)
F I=1:1:20 D
.S CNT=$P(^TMP("RCCPW",$J,I),U),AMT=$P(^(I),U,2)
.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")
.S DATA1="LINE"_I_":"_$S(I<9:"OC",1:"PC")_","_SITE_","
.S DATA1=DATA1_$S(I#2:"SC",1:"NSC")_","_TEXT_","
.S DATA1=DATA1_CNT_","_AMT
.S ^TMP("RCCPW1",$J,"DATA1",I)=DATA1
.S DATA2="Line "_$J(I,2)_" "_$S(I#2:"SC ",1:"NSC")_","_$J(TEXT,25)
.S DATA2=DATA2_": COUNT: "_$J(CNT,6)_" AMOUNT: "_$J(AMT,12,2)
.S ^TMP("RCCPW1",$J,"DATA2",I+1)=DATA2
.Q
S ^TMP("RCCPW1",$J,"DATA2",1)="Pharmacy Co-Pay Waiver Data for Site "_SITE_" "_$E(END,4,5)_"/"_$E(END,2,3)
SEND S XMDUZ="AR Package",XMTEXT="^TMP(""RCCPW1"","_$J_",""DATA1"","
S XMY("G.PCWMCCR@DOMAIN.EXT")="",XMDUZ="AR PACKAGE"
S XMSUB="Rx Copay Waivers-Site #"_SITE_":"_$$DATE(END)
D ^XMD K XMY
S XMDUZ="AR Package",XMTEXT="^TMP(""RCCPW1"","_$J_",""DATA2"","
S XMSUB="Pharmacy Co-pay Waiver Report: "_$$DATE(END)
S XMY(DUZ)="" D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
K ^TMP("RCCPW1",$J),^TMP("RCCPW",$J),BEG,END,SITE
Q
DATE(X) ;
S X=$E(X,4,5)_"/"_$E(X,2,3)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPW1 2499 printed Sep 23, 2025@19:19:21 Page 2
RCCPW1 ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER (BACKGROUND) ;11/23/94 9:52 AM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 NEW BILL,TRANS,WAIVE,TDATE,TTYPE,T0,T1,TAMT,LINE,LNNO,CAT,I,TEXT
+3 SET (BILL,TDATE)=0
FOR I=1:1:8
SET LINE(I)="0^0"
+4 FOR
SET BILL=$ORDER(^PRCA(430,BILL))
if BILL'?1N.N
QUIT
IF ",22,23,"[(","_$PIECE(^(BILL,0),U,2)_",")
SET CAT=$PIECE(^(0),U,2)
SET (TRANS,WAIVE)=0
Begin DoDot:1
+5 FOR
SET TRANS=$ORDER(^PRCA(433,"C",BILL,TRANS))
if 'TRANS
QUIT
Begin DoDot:2
+6 SET T0=$GET(^PRCA(433,TRANS,0))
SET T1=$GET(^(1))
if $PIECE(T0,U,4)'=2
QUIT
+7 SET TTYPE=$PIECE(T1,U,2)
SET TDATE=$PIECE(T1,U)
+8 if TDATE>END
QUIT
+9 if ",47,46,"'[(","_TTYPE_",")
QUIT
+10 IF TDATE<BEG
SET WAIVE=$SELECT(TTYPE=46:0,1:$PIECE(T1,U,11))
QUIT
+11 SET TAMT=$PIECE(T1,U,5)
+12 if TTYPE=46
GOTO UNSUS
+13 SET WAIVE=$PIECE(T1,U,11)
if 'WAIVE
QUIT
+14 if CAT=23
GOTO NSC1
SET LNNO=$SELECT(WAIVE=1:1,1:5)
GOTO SETLINE
NSC1 SET LNNO=$SELECT(WAIVE=1:2,1:6)
GOTO SETLINE
UNSUS if 'WAIVE
QUIT
+1 if CAT=23
GOTO NSC2
SET LNNO=$SELECT(WAIVE=1:3,1:7)
SET WAIVE=0
GOTO SETLINE
NSC2 SET LNNO=$SELECT(WAIVE=1:4,1:8)
SET WAIVE=0
SETLINE SET LINE(LNNO)=($PIECE(LINE(LNNO),U)+1)_U_($PIECE(LINE(LNNO),U,2)+TAMT)
+1 QUIT
End DoDot:2
if TDATE>END
QUIT
+2 QUIT
End DoDot:1
MSG ;COMPILES MAIL MESSAGES
+1 NEW DATA1,DATA2,CNT,AMT
+2 FOR I=1:1:8
SET ^TMP("RCCPW",$JOB,I)=LINE(I)
+3 FOR I=1:1:20
Begin DoDot:1
+4 SET CNT=$PIECE(^TMP("RCCPW",$JOB,I),U)
SET AMT=$PIECE(^(I),U,2)
+5 SET TEXT=$SELECT(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")
+6 SET DATA1="LINE"_I_":"_$SELECT(I<9:"OC",1:"PC")_","_SITE_","
+7 SET DATA1=DATA1_$SELECT(I#2:"SC",1:"NSC")_","_TEXT_","
+8 SET DATA1=DATA1_CNT_","_AMT
+9 SET ^TMP("RCCPW1",$JOB,"DATA1",I)=DATA1
+10 SET DATA2="Line "_$JUSTIFY(I,2)_" "_$SELECT(I#2:"SC ",1:"NSC")_","_$JUSTIFY(TEXT,25)
+11 SET DATA2=DATA2_": COUNT: "_$JUSTIFY(CNT,6)_" AMOUNT: "_$JUSTIFY(AMT,12,2)
+12 SET ^TMP("RCCPW1",$JOB,"DATA2",I+1)=DATA2
+13 QUIT
End DoDot:1
+14 SET ^TMP("RCCPW1",$JOB,"DATA2",1)="Pharmacy Co-Pay Waiver Data for Site "_SITE_" "_$EXTRACT(END,4,5)_"/"_$EXTRACT(END,2,3)
SEND SET XMDUZ="AR Package"
SET XMTEXT="^TMP(""RCCPW1"","_$JOB_",""DATA1"","
+1 SET XMY("G.PCWMCCR@DOMAIN.EXT")=""
SET XMDUZ="AR PACKAGE"
+2 SET XMSUB="Rx Copay Waivers-Site #"_SITE_":"_$$DATE(END)
+3 DO ^XMD
KILL XMY
+4 SET XMDUZ="AR Package"
SET XMTEXT="^TMP(""RCCPW1"","_$JOB_",""DATA2"","
+5 SET XMSUB="Pharmacy Co-pay Waiver Report: "_$$DATE(END)
+6 SET XMY(DUZ)=""
DO ^XMD
KILL XMDUZ,XMSUB,XMTEXT,XMY
+7 KILL ^TMP("RCCPW1",$JOB),^TMP("RCCPW",$JOB),BEG,END,SITE
+8 QUIT
DATE(X) ;
+1 SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,2,3)
+2 QUIT X
