PRPFMUL ;ALTOONA/CTB  MULTIPLE TRANSACTION POSTING ;11/22/96  4:40 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
 W !!,"This option will accept entry of transactions in which the basic information",!,"is the same for each patient.",!
 W !,"When entering the following information, REMEMBER that this information",!,"WILL be used for all patients until you exit from this option.",!
 S PRPFMUL="",PRPF("XDEF")=$P(^DD(470,30.5,0),"^",5,99) D LKUP G:'OUT OUT D LIST
 S %A="OK to continue",%B="",%=1 D ^PRPFYN I %'=1 G OUT
PAT W ! K PRPF("KILL") D GETPAT^PRPFED G:'%PRPF OUT
 D ^PRPFDEF S D0=DFN X PRPF("XDEF") K D0 S PRBAL("DEF")=X,DFN(1)=$S($D(^PRPF(470,DFN,1)):^(1),1:"")
 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
 S PRPFDATE=PRPFT(5) D EN^PRPFRES
 G:'$D(DEP) B G:DEP'["W" B
 W !,"ACCOUNT TYPE: * * * ",TYPE," * * "
 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)
 W !,"BALANCE INFORMATION:",?40,"RESTRICTION AVAILABILITY: ",!
 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)
 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)
 W !?4,"AVAILABLE: $",$J(PRBAL("SB")-PRBAL("DEF"),9,2),!
B S $P(^PRPFT(470.5,TRDA,0),"^",4)="",$P(^(0),"^",12,13)="^",$P(^(0),"^",18,20)="^^"
 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
 D ^PRPFPOST,CLEAR I $Y>20 D LIST
 S DIC("A")="Select Next Patient: " G PAT
CLEAR K ^PRPF(470,DFN,9) Q
LIST ;LIST SELECTION FROM MULTIPLES
 D HILO^PRPFBAL I $D(IOF) W @IOF
 E  W !!
 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)
 ;I PRPFT(21)>0 S X1=PRPFT(5),X2=PRPFT(21) D C^%DTC S PRPFT(22)=X
 W @PFHI,?15,"MULTIPLE TRANSACTION POSTING",!!,@PFLO,"REFERENCE: ",@PFHI,PRPFT(7),!,@PFLO,"DEPOSIT/WITHDRAWAL: ",@PFHI,$S(PRPFT(8)="D":"DEPOSIT",1:"WITHDRAWAL")
 W !,@PFLO,"CASH/CHECK/OTHER: ",@PFHI,$S(PRPFT(9)=1:"CASH",PRPFT(9)=2:"CHECK",1:"OTHER")
 W !,@PFLO,"FORM: ",@PFHI,$P(^PRPF(470.2,PRPFT(11),0),"^"),!,@PFLO,"SOURCE: ",@PFHI,$S(PRPFT(10)="G":"GRATUITOUS",1:"PRIVATE SOURCE")
 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
 W @PFNORM Q
LKUP S OUT=1 S DIC=470.5,DIC(0)="LMN",DLAYGO=470.5,X="T"_$J
 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
 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
 Q
OUT ;PRIMARY EXIT POINT
 I $D(TRDA),TRDA>0 S DA=TRDA,DIK="^PRPFT(470.5," D ^DIK
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