| 1 | PRPFDEF ;CTB/ALTOONA PATIENT FUNDS DEFERRED CREDIT ;2/25/97 1:44 PM
|
|---|
| 2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
|---|
| 3 | ;CHECKS FOR EXISTENCE OF DEFERRED CREDIT ITEMS
|
|---|
| 4 | ;DELETES DEFERRED CREDIT ITEMS WITH DATES < DT
|
|---|
| 5 | ;UPDATES ZEROTH NODE
|
|---|
| 6 | EN ;UPDATES THE DEFERRED FILE FOR A SINGLE PATIENT. REQUIRES 'DFN' AS THE
|
|---|
| 7 | ;INTERNAL REFERENCE NUMBER OF THE PATIENT.
|
|---|
| 8 | I '$D(^PRPF(470,DFN,4,0)) Q
|
|---|
| 9 | S PRQ1=$P(^PRPF(470,DFN,4,0),U,3),PRQ2=$P(^(0),U,4),Q3=1,PRD2=""
|
|---|
| 10 | S PRD1=0 F S PRD1=$O(^PRPF(470,DFN,4,PRD1)) Q:PRD1'>0 I $P(^PRPF(470,DFN,4,PRD1,0),U,2)'>DT K ^PRPF(470,DFN,4,PRD1,0) S PRQ2=PRQ2-1 S:PRQ1=PRD1 PRQ1=PRD2 S PRD2=PRD1
|
|---|
| 11 | S PRQ4=$P(^PRPF(470,DFN,4,0),U,2) S ^(0)=U_PRQ4_U_PRQ1_U_PRQ2 D KILL Q
|
|---|
| 12 | ;
|
|---|
| 13 | EN1 ;ADDS NEW ENTRY TO THE DEFERRED CREDIT ITEM FILE
|
|---|
| 14 | I '$D(^PRPF(470,DFN,4,0)) S ^(0)="^470.02A"
|
|---|
| 15 | S PRQ1=($P(^PRPF(470,DFN,4,0),U,3))+1,PRQ2=($P(^(0),U,4))+1
|
|---|
| 16 | S ^PRPF(470,DFN,4,PRQ1,0)=PATRID_U_DEFDATE_U_AMT_U_PATRDA
|
|---|
| 17 | S $P(^PRPF(470,DFN,4,0),"^",3,4)=PRQ1_U_PRQ2
|
|---|
| 18 | D KILL Q
|
|---|
| 19 | EN2 ;UPDATE DEFERRED BALANCES ON ALL PATIENTS
|
|---|
| 20 | NEW X,DFN,PR1
|
|---|
| 21 | S U="^" D NOW^PRPFQ S DT=X
|
|---|
| 22 | S DFN=0 F PR1=1:1 S DFN=$O(^PRPF(470,DFN)) Q:+DFN'=DFN!(DFN="") I $D(^PRPF(470,DFN,4,0)),$P(^(0),U,2)'="A" D EN
|
|---|
| 23 | D KILL Q
|
|---|
| 24 | ;
|
|---|
| 25 | KILL ;THIS LINE DELETES ALL LOCAL VARIABLES CALLED BY THIS ROUTINE EXCEPTDFN
|
|---|
| 26 | K PRQ1,PRQ2,PRQ3,PRQ4,PRD1,PRD2 Q
|
|---|
