| 1 | RCCPW ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER ;11/23/94  9:52 AM
 | 
|---|
| 2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  N SITE,MO,YR,LINE,BEG,END,START,QUIT,DIR,DIRUT,LNNO,TEXT
 | 
|---|
| 5 | ENTERDT I +$E(DT,6,7)>7 W !,*7,"This data can only be entered between the 1st and the 7th of the month."  H 3 Q
 | 
|---|
| 6 |  S SITE=$$SITE^RCMSITE()
 | 
|---|
| 7 |  S MO=$E(DT,4,5)-1,YR=$E(DT,2,3) S:$L(MO)'=2 MO="0"_MO
 | 
|---|
| 8 |  I +MO=0 S MO=12,YR=YR-1 S:+YR=0 YR=100
 | 
|---|
| 9 |  S YR=YR+200
 | 
|---|
| 10 |  S DIR("A")="Enter Month/Year of Waiver Data"
 | 
|---|
| 11 |  S DIR(0)="D^:"_(YR_MO_31)_":EP"
 | 
|---|
| 12 |  S Y=YR_MO_"00" D DD^%DT S DIR("B")=Y
 | 
|---|
| 13 |  D ^DIR Q:Y<0  K DIR
 | 
|---|
| 14 |  I $E(Y,4,5)="00" W !,*7,"You must enter month and year" G ENTERDT
 | 
|---|
| 15 |  S BEG=$E(Y,1,5)_"00",END=$E(Y,1,5)_32
 | 
|---|
| 16 |  S START=9
 | 
|---|
| 17 | READ F I=START:1:20 Q:$D(QUIT)  D ENTER(I)
 | 
|---|
| 18 |  I $D(QUIT),QUIT S START=QUIT K QUIT G READ
 | 
|---|
| 19 |  Q:$D(QUIT)
 | 
|---|
| 20 | DISPLAY ;Display user input-allows editing of data
 | 
|---|
| 21 |  W @IOF F I=9:1:20 D
 | 
|---|
| 22 |     .W !,"LINE ",I,?10,$S(I#2:"SC",1:"NSC")_","_$$TEXT(I)
 | 
|---|
| 23 |     .W ?40,"# OF BILLS: ",$J($P(LINE(I),U),6),"  ","Amount: ",$J($P(LINE(I),U,2),12,2)
 | 
|---|
| 24 |     .Q
 | 
|---|
| 25 |  K DIR S DIR(0)="Y",DIR("A")="Is Data Correct",DIR("B")="NO"
 | 
|---|
| 26 |  D ^DIR G LOAD:Y Q:$D(DIRUT)
 | 
|---|
| 27 |  K DIR S DIR(0)="NO^9:20:0",DIR("A")="Line Number to Edit" D ^DIR
 | 
|---|
| 28 |  G DISPLAY:Y="",DISPLAY:$D(DIRUT) D ENTER(Y) G DISPLAY
 | 
|---|
| 29 | LOAD ;CALLS TASKMAN TO DO BACKGROUND JOB
 | 
|---|
| 30 |  K ^TMP("RCCPW",$J) F I=9:1:20 S ^TMP("RCCPW",$J,I)=LINE(I)
 | 
|---|
| 31 |  S ZTRTN="^RCCPW1",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTSAVE("SITE")=""
 | 
|---|
| 32 |  S ZTSAVE("^TMP(""RCCPW"",$J,")="",ZTDTH=$H,ZTIO="" D ^%ZTLOAD
 | 
|---|
| 33 |  K ^TMP("RCCPW",$J) W !,*7,"Report Queued"
 | 
|---|
| 34 |  K ZTDTH,ZTIO,ZTRTN,ZTSAVE
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 | ENTER(LNNO) ;Data entry done here--needs Line number
 | 
|---|
| 37 |  W !!,"Data Entry for Line ",LNNO,!,$S(I#2:"SC",1:"NSC")," ",$$TEXT(LNNO)
 | 
|---|
| 38 |  K DIR,X,Y S DIR(0)="N^0:999999:0",DIR("A")="Enter Total Number of Bills"
 | 
|---|
| 39 |  I $P($G(LINE(LNNO)),U) S DIR("B")=$P(LINE(LNNO),U)
 | 
|---|
| 40 |  D ^DIR,CHECK Q:$D(QUIT)
 | 
|---|
| 41 |  S $P(LINE(LNNO),U)=Y
 | 
|---|
| 42 |  K DIR,X,Y S DIR(0)="N^0:999999999.99:2",DIR("A")="Enter Total Amount"
 | 
|---|
| 43 |  I $P($G(LINE(LNNO)),U,2) S DIR("B")=$P(LINE(LNNO),U,2)
 | 
|---|
| 44 |  D ^DIR,CHECK Q:$D(QUIT)
 | 
|---|
| 45 |  K DIR S $P(LINE(LNNO),U,2)=Y
 | 
|---|
| 46 |  Q
 | 
|---|
| 47 | CHECK ;
 | 
|---|
| 48 |  K QUIT
 | 
|---|
| 49 |  I X?1"^"1.2N S QUIT=$E(X,2,3) Q:QUIT'>LNNO  I QUIT>LNNO W !,*7,"No Forward Jumping Allowed" S QUIT=LNNO Q
 | 
|---|
| 50 |  I $D(DIRUT) S QUIT="" Q
 | 
|---|
| 51 |  Q
 | 
|---|
| 52 | TEXT(I) ;Computes Line Text
 | 
|---|
| 53 |  S TEXT=$S(I<11:"Initial Waiver Request",I<13:"Waiver Request Resolved",I<15:"Appeal Waiver",I<17:"Appeal Waiver Resolved",I<19:"Waiver Approved Refund",1:"Appeal Approved Refund")
 | 
|---|
| 54 |  Q TEXT
 | 
|---|