- RCCPW ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER ;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 SITE,MO,YR,LINE,BEG,END,START,QUIT,DIR,DIRUT,LNNO,TEXT
- 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
- S SITE=$$SITE^RCMSITE()
- S MO=$E(DT,4,5)-1,YR=$E(DT,2,3) S:$L(MO)'=2 MO="0"_MO
- I +MO=0 S MO=12,YR=YR-1 S:+YR=0 YR=100
- S YR=YR+200
- S DIR("A")="Enter Month/Year of Waiver Data"
- S DIR(0)="D^:"_(YR_MO_31)_":EP"
- S Y=YR_MO_"00" D DD^%DT S DIR("B")=Y
- D ^DIR Q:Y<0 K DIR
- I $E(Y,4,5)="00" W !,*7,"You must enter month and year" G ENTERDT
- S BEG=$E(Y,1,5)_"00",END=$E(Y,1,5)_32
- S START=9
- READ F I=START:1:20 Q:$D(QUIT) D ENTER(I)
- I $D(QUIT),QUIT S START=QUIT K QUIT G READ
- Q:$D(QUIT)
- DISPLAY ;Display user input-allows editing of data
- W @IOF F I=9:1:20 D
- .W !,"LINE ",I,?10,$S(I#2:"SC",1:"NSC")_","_$$TEXT(I)
- .W ?40,"# OF BILLS: ",$J($P(LINE(I),U),6)," ","Amount: ",$J($P(LINE(I),U,2),12,2)
- .Q
- K DIR S DIR(0)="Y",DIR("A")="Is Data Correct",DIR("B")="NO"
- D ^DIR G LOAD:Y Q:$D(DIRUT)
- K DIR S DIR(0)="NO^9:20:0",DIR("A")="Line Number to Edit" D ^DIR
- G DISPLAY:Y="",DISPLAY:$D(DIRUT) D ENTER(Y) G DISPLAY
- LOAD ;CALLS TASKMAN TO DO BACKGROUND JOB
- K ^TMP("RCCPW",$J) F I=9:1:20 S ^TMP("RCCPW",$J,I)=LINE(I)
- S ZTRTN="^RCCPW1",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTSAVE("SITE")=""
- S ZTSAVE("^TMP(""RCCPW"",$J,")="",ZTDTH=$H,ZTIO="" D ^%ZTLOAD
- K ^TMP("RCCPW",$J) W !,*7,"Report Queued"
- K ZTDTH,ZTIO,ZTRTN,ZTSAVE
- Q
- ENTER(LNNO) ;Data entry done here--needs Line number
- W !!,"Data Entry for Line ",LNNO,!,$S(I#2:"SC",1:"NSC")," ",$$TEXT(LNNO)
- K DIR,X,Y S DIR(0)="N^0:999999:0",DIR("A")="Enter Total Number of Bills"
- I $P($G(LINE(LNNO)),U) S DIR("B")=$P(LINE(LNNO),U)
- D ^DIR,CHECK Q:$D(QUIT)
- S $P(LINE(LNNO),U)=Y
- K DIR,X,Y S DIR(0)="N^0:999999999.99:2",DIR("A")="Enter Total Amount"
- I $P($G(LINE(LNNO)),U,2) S DIR("B")=$P(LINE(LNNO),U,2)
- D ^DIR,CHECK Q:$D(QUIT)
- K DIR S $P(LINE(LNNO),U,2)=Y
- Q
- CHECK ;
- K QUIT
- 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
- I $D(DIRUT) S QUIT="" Q
- Q
- TEXT(I) ;Computes Line Text
- 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")
- Q TEXT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPW 2482 printed Mar 13, 2025@20:47:59 Page 2
- RCCPW ;WASH-ISC@ALTOONA,PA/TJK-CO-PAY WAIVER ;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 SITE,MO,YR,LINE,BEG,END,START,QUIT,DIR,DIRUT,LNNO,TEXT
- ENTERDT IF +$EXTRACT(DT,6,7)>7
- WRITE !,*7,"This data can only be entered between the 1st and the 7th of the month."
- HANG 3
- QUIT
- +1 SET SITE=$$SITE^RCMSITE()
- +2 SET MO=$EXTRACT(DT,4,5)-1
- SET YR=$EXTRACT(DT,2,3)
- if $LENGTH(MO)'=2
- SET MO="0"_MO
- +3 IF +MO=0
- SET MO=12
- SET YR=YR-1
- if +YR=0
- SET YR=100
- +4 SET YR=YR+200
- +5 SET DIR("A")="Enter Month/Year of Waiver Data"
- +6 SET DIR(0)="D^:"_(YR_MO_31)_":EP"
- +7 SET Y=YR_MO_"00"
- DO DD^%DT
- SET DIR("B")=Y
- +8 DO ^DIR
- if Y<0
- QUIT
- KILL DIR
- +9 IF $EXTRACT(Y,4,5)="00"
- WRITE !,*7,"You must enter month and year"
- GOTO ENTERDT
- +10 SET BEG=$EXTRACT(Y,1,5)_"00"
- SET END=$EXTRACT(Y,1,5)_32
- +11 SET START=9
- READ FOR I=START:1:20
- if $DATA(QUIT)
- QUIT
- DO ENTER(I)
- +1 IF $DATA(QUIT)
- IF QUIT
- SET START=QUIT
- KILL QUIT
- GOTO READ
- +2 if $DATA(QUIT)
- QUIT
- DISPLAY ;Display user input-allows editing of data
- +1 WRITE @IOF
- FOR I=9:1:20
- Begin DoDot:1
- +2 WRITE !,"LINE ",I,?10,$SELECT(I#2:"SC",1:"NSC")_","_$$TEXT(I)
- +3 WRITE ?40,"# OF BILLS: ",$JUSTIFY($PIECE(LINE(I),U),6)," ","Amount: ",$JUSTIFY($PIECE(LINE(I),U,2),12,2)
- +4 QUIT
- End DoDot:1
- +5 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Is Data Correct"
- SET DIR("B")="NO"
- +6 DO ^DIR
- if Y
- GOTO LOAD
- if $DATA(DIRUT)
- QUIT
- +7 KILL DIR
- SET DIR(0)="NO^9:20:0"
- SET DIR("A")="Line Number to Edit"
- DO ^DIR
- +8 if Y=""
- GOTO DISPLAY
- if $DATA(DIRUT)
- GOTO DISPLAY
- DO ENTER(Y)
- GOTO DISPLAY
- LOAD ;CALLS TASKMAN TO DO BACKGROUND JOB
- +1 KILL ^TMP("RCCPW",$JOB)
- FOR I=9:1:20
- SET ^TMP("RCCPW",$JOB,I)=LINE(I)
- +2 SET ZTRTN="^RCCPW1"
- SET ZTSAVE("BEG")=""
- SET ZTSAVE("END")=""
- SET ZTSAVE("SITE")=""
- +3 SET ZTSAVE("^TMP(""RCCPW"",$J,")=""
- SET ZTDTH=$HOROLOG
- SET ZTIO=""
- DO ^%ZTLOAD
- +4 KILL ^TMP("RCCPW",$JOB)
- WRITE !,*7,"Report Queued"
- +5 KILL ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +6 QUIT
- ENTER(LNNO) ;Data entry done here--needs Line number
- +1 WRITE !!,"Data Entry for Line ",LNNO,!,$SELECT(I#2:"SC",1:"NSC")," ",$$TEXT(LNNO)
- +2 KILL DIR,X,Y
- SET DIR(0)="N^0:999999:0"
- SET DIR("A")="Enter Total Number of Bills"
- +3 IF $PIECE($GET(LINE(LNNO)),U)
- SET DIR("B")=$PIECE(LINE(LNNO),U)
- +4 DO ^DIR
- DO CHECK
- if $DATA(QUIT)
- QUIT
- +5 SET $PIECE(LINE(LNNO),U)=Y
- +6 KILL DIR,X,Y
- SET DIR(0)="N^0:999999999.99:2"
- SET DIR("A")="Enter Total Amount"
- +7 IF $PIECE($GET(LINE(LNNO)),U,2)
- SET DIR("B")=$PIECE(LINE(LNNO),U,2)
- +8 DO ^DIR
- DO CHECK
- if $DATA(QUIT)
- QUIT
- +9 KILL DIR
- SET $PIECE(LINE(LNNO),U,2)=Y
- +10 QUIT
- CHECK ;
- +1 KILL QUIT
- +2 IF X?1"^"1.2N
- SET QUIT=$EXTRACT(X,2,3)
- if QUIT'>LNNO
- QUIT
- IF QUIT>LNNO
- WRITE !,*7,"No Forward Jumping Allowed"
- SET QUIT=LNNO
- QUIT
- +3 IF $DATA(DIRUT)
- SET QUIT=""
- QUIT
- +4 QUIT
- TEXT(I) ;Computes Line Text
- +1 SET TEXT=$SELECT(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")
- +2 QUIT TEXT
