1 | PRPFED ;ALTOONA/CTB EDIT ROUTINE FOR PATIENT FUNDS PACKAGE ;2/24/97 5:09 PM
|
---|
2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
---|
3 | DEAD I $D(^DPT(DFN,.35)),$P(^(.35),"^")]"" W !,*7,"PATIENT HAS DIED!" Q
|
---|
4 | Q
|
---|
5 | GETPAT K DFN S %PRPF=0,DIC(0)="IAEZMQ",DIC=470,DLAYGO=470 D ^DIC K DIC("A"),DLAYGO Q:Y<0 S DFN=+Y,DFN(0)=Y(0),DFN(0,0)=Y(0,0) I $D(^DPT(DFN,.31)) W:$P(^(.31),"^",3)]"" ?($X+5),"Claim #: ",$P(^(.31),"^",3)
|
---|
6 | I $D(^PRPF(470,DFN,9)) S X=^(9) W !!,*7,"This File is being edited",$S($P(X,"^",2)>0:" by "_$P(^VA(200,$P(X,"^",2),0),"^"),1:" ")," on Device ",$P(X,"^",3)_".",!," Please try later." R X:3 W ! G GETPAT
|
---|
7 | S ^PRPF(470,DFN,9)="1^"_DUZ_"^"_$S($D(ION):ION,1:""),%PRPF=1 Q
|
---|
8 | ;
|
---|
9 | GETTRANS ;GET TEMP TRANS NUMBER FROM TEMP TRANSACTION FILE
|
---|
10 | S (DLAYGO,DIC)=470.5,DIC(0)="XOLM",X="T"_^%ZOSF("VOL")_$J,%PRPF=0
|
---|
11 | S:'$D(COUNT) COUNT=0 D ^DIC Q:Y<0 I $P(Y,"^",3)="" S COUNT=COUNT+1 Q:COUNT>3 S DIK=DIC,DA=+Y D ^DIK K DIK G GETTRANS
|
---|
12 | S (TRDA,DA)=+Y,%PRPF=1 Q
|
---|
13 | ;
|
---|
14 | POST ;POST TRANSACTION
|
---|
15 | D GETPAT G:'%PRPF OUT D EN1^PRPFBAL D DEAD S %=1,%A="Do you wish to continue with this transaction",%B="" D ^PRPFYN I %'=1 G OUT
|
---|
16 | D GETTRANS G:'%PRPF OUT S TRDA=+Y,DIE=DIC,%=1
|
---|
17 | EDIT S $P(^PRPFT(470.5,DA,0),"^",4)="",DR="[PRPF TEMP TRANS POST]",DIE("NO^")="OUTOK" D ^DIE I $D(Y)'=0!($D(PRPF("KILL"))) K PRPF("KILL") S DIK=DIC D ^DIK K DIK S X=" < Option Terminated >*" D MSG^PRPFU1 R X:3 G OUT
|
---|
18 | S Y=DFN,Y(0)=DFN(0) D ^PRPFPOST G:%=3 EDIT G:%=1 CL
|
---|
19 | K ^PRPF(470,DFN,9) G POST
|
---|
20 | CL K ^PRPF(470,DFN,9) D EN1^PRPFBAL,ENCON^PRPFQ,OUT G POST
|
---|
21 | ;
|
---|
22 | DEF ;EDIT DEFERRAL
|
---|
23 | D GETPAT G:'%PRPF OUT
|
---|
24 | I $S('$D(^PRPF(470,DFN,4,0)):1,$P(^(0),"^",4)=0:1,1:0) S X="No Deferrals recorded for this account.*" D MSG^PRPFU1,ENCON^PRPFQ,OUT G DEF
|
---|
25 | S DA=DFN,DIC="^PRPF(470,"_DA_",4,",DIC(0)="AEMN" D ^DIC G:Y<0 OUT S DIE=DIC,DR=1,DA=+Y D ^DIE,OUT G DEF Q
|
---|
26 | CKINACT ;CHECK BALANCE DURING INPUT TRANSFORM FOR ACCOUNT STATUS
|
---|
27 | Q:$E(X,1)="A"
|
---|
28 | I $D(^PRPF(470,DA,1)),+$P(^(1),"^",4)'=0 W " BALANCE IS $",$J($P(^(1),"^",4),0,2),*7,!," You may not Inactivate an Account unless the Balance is zero" K X Q
|
---|
29 | Q
|
---|
30 | CLEAR ;CLEAR LOCK ON ACCOUNT
|
---|
31 | S DIC=470,DIC(0)="AEMN" D ^DIC G:Y<0 OUTC S DFN=+Y I '$D(^PRPF(470,DFN,9)) W !,"Account is already clear. No action is required.",! R X:3 G OUTC
|
---|
32 | S X=^PRPF(470,DFN,9),%A="The lock indicates that the file is being edited"_$S($P(X,"^",2)>0:" by "_$P(^VA(200,$P(X,"^",2),0),"^"),1:" "),%A(1)="Are you sure you want to clear the lock",%B="",%=2 D ^PRPFYN
|
---|
33 | I %'=1 G CLEAR
|
---|
34 | K ^PRPF(470,DFN,9) W *7,"---CLEARED---",! R X:3 D OUTC Q
|
---|
35 | SUSPENSE ;ADD/EDIT SUSPENSE ITEM
|
---|
36 | S DIC=470,DIC(0)="AEMNQ" D ^DIC G OUT:Y<0 S DIE=DIC,DA=+Y,DR="[PRPF SUSPENSE ENTER EDIT]" D ^DIE G SUSPENSE
|
---|
37 | FORM ;ADD/EDIT PATIENT FUNDS FORM
|
---|
38 | S (DLAYGO,DIC)=470.2,DIC(0)="AEMZLQ" D ^DIC K DIC,DLAYGO G:Y<0 OUT S DIE="^PRPF(470.2,",DA=+Y,DR="[PRPF FORMS EDIT]" D ^DIE S DIC("A")="Select Next PATIENT FUNDS FORM: " G FORM
|
---|
39 | OUT I $D(DFN)#2,DFN]"" K ^PRPF(470,DFN,9)
|
---|
40 | I $D(TRDA),TRDA>0 S DIK="^PRPFT(470.5,",DA=TRDA D ^DIK
|
---|
41 | W:$D(IOF) @IOF
|
---|
42 | OUTC K %,%DT,%H,%I,%PRPF,%W,%X,%Y,C,COUNT,D,D0,D1,DA,DEFDATE,DEP,DFN,DG1,DGA1,DGT,DGX,DI,DIC,DIE,DIK,DIPGM,DIW,DIWT,DIYS,DLAYGO,DN,DQ,DR,DUOUT,DWLW
|
---|
43 | K FORM,I,J,K,N,P,PFHI,PFLO,PFNORM,POP,PRBAL,PRPF,Q3,RES,S,SOURCE,TMP,TRDA,TYPE,X,X1,X2,Y,Z Q
|
---|