1 | PRPFMUL ;ALTOONA/CTB MULTIPLE TRANSACTION POSTING ;11/22/96 4:40 PM
|
---|
2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
---|
3 | W !!,"This option will accept entry of transactions in which the basic information",!,"is the same for each patient.",!
|
---|
4 | W !,"When entering the following information, REMEMBER that this information",!,"WILL be used for all patients until you exit from this option.",!
|
---|
5 | S PRPFMUL="",PRPF("XDEF")=$P(^DD(470,30.5,0),"^",5,99) D LKUP G:'OUT OUT D LIST
|
---|
6 | S %A="OK to continue",%B="",%=1 D ^PRPFYN I %'=1 G OUT
|
---|
7 | PAT W ! K PRPF("KILL") D GETPAT^PRPFED G:'%PRPF OUT
|
---|
8 | D ^PRPFDEF S D0=DFN X PRPF("XDEF") K D0 S PRBAL("DEF")=X,DFN(1)=$S($D(^PRPF(470,DFN,1)):^(1),1:"")
|
---|
9 | S TYPEX=$P(DFN(0),U,3),Y=$P(^DD(470,2,0),"^",3) F I=1:1 I TYPEX=$P($P(Y,";",I),":") S TYPE=$P($P(Y,";",I),":",2) Q
|
---|
10 | S PRPFDATE=PRPFT(5) D EN^PRPFRES
|
---|
11 | G:'$D(DEP) B G:DEP'["W" B
|
---|
12 | W !,"ACCOUNT TYPE: * * * ",TYPE," * * "
|
---|
13 | D ^PRPFDEF S D0=DFN X PRPF("XDEF") K D0 S PRBAL("DEF")=X,PRBAL("SB")=$P(DFN(1),"^",4),PRBAL("PB")=$P(DFN(1),"^",5),PRBAL("GB")=$P(DFN(1),"^",6)
|
---|
14 | W !,"BALANCE INFORMATION:",?40,"RESTRICTION AVAILABILITY: ",!
|
---|
15 | W !,"TOTAL BALANCE: $",$J(PRBAL("SB"),9,2) I $P(DFN(1),"^",7)>0,"LR"[TYPEX W ?40,"MONTH: $",$J($P(DFN(1),"^",7)-$P(DFN(1),"^",11),9,2)
|
---|
16 | W !?5,"DEFERRED: $",$J(PRBAL("DEF"),9,2) I $P(DFN(1),"^",8)>0,"LR"[TYPEX W ?41,"WEEK: $",$J(($P(DFN(1),"^",8)-$P(DFN(1),"^",12)),9,2)
|
---|
17 | W !?4,"AVAILABLE: $",$J(PRBAL("SB")-PRBAL("DEF"),9,2),!
|
---|
18 | B S $P(^PRPFT(470.5,TRDA,0),"^",4)="",$P(^(0),"^",12,13)="^",$P(^(0),"^",18,20)="^^"
|
---|
19 | S DA=TRDA,$P(^PRPFT(470.5,DA,0),"^",12,13)="^",DIE="^PRPFT(470.5,",DR="[PRPF MULTIPLE AMT]" D ^DIE I $D(Y)'=0!($D(PRPF("KILL"))) S X="<NO ACTION TAKEN>*" D MSG^PRPFU1 R X:3 D CLEAR D LIST:$Y>20 S DIC("A")="Select Next Patient: " G PAT
|
---|
20 | D ^PRPFPOST,CLEAR I $Y>20 D LIST
|
---|
21 | S DIC("A")="Select Next Patient: " G PAT
|
---|
22 | CLEAR K ^PRPF(470,DFN,9) Q
|
---|
23 | LIST ;LIST SELECTION FROM MULTIPLES
|
---|
24 | D HILO^PRPFBAL I $D(IOF) W @IOF
|
---|
25 | E W !!
|
---|
26 | K PRPFT S TRDA(0)=^PRPFT(470.5,TRDA,0) F I=5,7,8,9,10,11,16,21 S PRPFT(I)=$P(TRDA(0),"^",I)
|
---|
27 | ;I PRPFT(21)>0 S X1=PRPFT(5),X2=PRPFT(21) D C^%DTC S PRPFT(22)=X
|
---|
28 | W @PFHI,?15,"MULTIPLE TRANSACTION POSTING",!!,@PFLO,"REFERENCE: ",@PFHI,PRPFT(7),!,@PFLO,"DEPOSIT/WITHDRAWAL: ",@PFHI,$S(PRPFT(8)="D":"DEPOSIT",1:"WITHDRAWAL")
|
---|
29 | W !,@PFLO,"CASH/CHECK/OTHER: ",@PFHI,$S(PRPFT(9)=1:"CASH",PRPFT(9)=2:"CHECK",1:"OTHER")
|
---|
30 | W !,@PFLO,"FORM: ",@PFHI,$P(^PRPF(470.2,PRPFT(11),0),"^"),!,@PFLO,"SOURCE: ",@PFHI,$S(PRPFT(10)="G":"GRATUITOUS",1:"PRIVATE SOURCE")
|
---|
31 | W !,@PFLO,"DATE: " S Y=PRPFT(5) X ^DD("DD") W @PFHI,Y,!,@PFLO,"REMARKS: ",@PFHI,PRPFT(16),! I PRPFT(21)>0 W @PFLO,"DEFERRAL DATE: ",@PFHI S Y=PRPFT(21) X ^DD("DD") W Y
|
---|
32 | W @PFNORM Q
|
---|
33 | LKUP S OUT=1 S DIC=470.5,DIC(0)="LMN",DLAYGO=470.5,X="T"_$J
|
---|
34 | S:'$D(COUNT) COUNT=0 D ^DIC G:Y<0 OUT I $P(Y,"^",3)="" S COUNT=COUNT+1 G:COUNT>3 OUT S DIK=DIC,DA=+Y D ^DIK G LKUP
|
---|
35 | S DIE("NO^")="OUTOK",DA=+Y,TRDA=+Y,DIE=DIC,DR="[PRPF TEMP MULTIPLE]" D ^DIE K DIE("NO^") I $D(Y)'=0!($D(PRPF("KILL"))) K PRPF("KILL") S DIK=DIC D ^DIK S X="< Option Terminated >*" D MSG^PRPFU1 R X:3 S OUT=0 Q
|
---|
36 | Q
|
---|
37 | OUT ;PRIMARY EXIT POINT
|
---|
38 | I $D(TRDA),TRDA>0 S DA=TRDA,DIK="^PRPFT(470.5," D ^DIK
|
---|
39 | OUT1 K %,%DT,%PRPF,%W,%X,%Y,COUNT,D,D0,DA,DEP,DFN,DI,DIC,DIE,DIK,DIYS,DLAYGO,DQ,DR,K,OUT,PFHI,PFLO,PFNORM,POP,PRPFMUL,PRPF,PRPFT,Q3,S,SOURCE,TMP,TRDA,X,X1,Y Q
|
---|