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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFMUL 3317 printed Oct 16, 2024@18:02:35 Page 2
PRPFMUL ;ALTOONA/CTB MULTIPLE TRANSACTION POSTING ;11/22/96 4:40 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
+1 WRITE !!,"This option will accept entry of transactions in which the basic information",!,"is the same for each patient.",!
+2 WRITE !,"When entering the following information, REMEMBER that this information",!,"WILL be used for all patients until you exit from this option.",!
+3 SET PRPFMUL=""
SET PRPF("XDEF")=$PIECE(^DD(470,30.5,0),"^",5,99)
DO LKUP
if 'OUT
GOTO OUT
DO LIST
+4 SET %A="OK to continue"
SET %B=""
SET %=1
DO ^PRPFYN
IF %'=1
GOTO OUT
PAT WRITE !
KILL PRPF("KILL")
DO GETPAT^PRPFED
if '%PRPF
GOTO OUT
+1 DO ^PRPFDEF
SET D0=DFN
XECUTE PRPF("XDEF")
KILL D0
SET PRBAL("DEF")=X
SET DFN(1)=$SELECT($DATA(^PRPF(470,DFN,1)):^(1),1:"")
+2 SET TYPEX=$PIECE(DFN(0),U,3)
SET Y=$PIECE(^DD(470,2,0),"^",3)
FOR I=1:1
IF TYPEX=$PIECE($PIECE(Y,";",I),":")
SET TYPE=$PIECE($PIECE(Y,";",I),":",2)
QUIT
+3 SET PRPFDATE=PRPFT(5)
DO EN^PRPFRES
+4 if '$DATA(DEP)
GOTO B
if DEP'["W"
GOTO B
+5 WRITE !,"ACCOUNT TYPE: * * * ",TYPE," * * "
+6 DO ^PRPFDEF
SET D0=DFN
XECUTE PRPF("XDEF")
KILL D0
SET PRBAL("DEF")=X
SET PRBAL("SB")=$PIECE(DFN(1),"^",4)
SET PRBAL("PB")=$PIECE(DFN(1),"^",5)
SET PRBAL("GB")=$PIECE(DFN(1),"^",6)
+7 WRITE !,"BALANCE INFORMATION:",?40,"RESTRICTION AVAILABILITY: ",!
+8 WRITE !,"TOTAL BALANCE: $",$JUSTIFY(PRBAL("SB"),9,2)
IF $PIECE(DFN(1),"^",7)>0
IF "LR"[TYPEX
WRITE ?40,"MONTH: $",$JUSTIFY($PIECE(DFN(1),"^",7)-$PIECE(DFN(1),"^",11),9,2)
+9 WRITE !?5,"DEFERRED: $",$JUSTIFY(PRBAL("DEF"),9,2)
IF $PIECE(DFN(1),"^",8)>0
IF "LR"[TYPEX
WRITE ?41,"WEEK: $",$JUSTIFY(($PIECE(DFN(1),"^",8)-$PIECE(DFN(1),"^",12)),9,2)
+10 WRITE !?4,"AVAILABLE: $",$JUSTIFY(PRBAL("SB")-PRBAL("DEF"),9,2),!
B SET $PIECE(^PRPFT(470.5,TRDA,0),"^",4)=""
SET $PIECE(^(0),"^",12,13)="^"
SET $PIECE(^(0),"^",18,20)="^^"
+1 SET DA=TRDA
SET $PIECE(^PRPFT(470.5,DA,0),"^",12,13)="^"
SET DIE="^PRPFT(470.5,"
SET DR="[PRPF MULTIPLE AMT]"
DO ^DIE
IF $DATA(Y)'=0!($DATA(PRPF("KILL")))
SET X="<NO ACTION TAKEN>*"
DO MSG^PRPFU1
READ X:3
DO CLEAR
if $Y>20
DO LIST
SET DIC("A")="Select Next Patient: "
GOTO PAT
+2 DO ^PRPFPOST
DO CLEAR
IF $Y>20
DO LIST
+3 SET DIC("A")="Select Next Patient: "
GOTO PAT
CLEAR KILL ^PRPF(470,DFN,9)
QUIT
LIST ;LIST SELECTION FROM MULTIPLES
+1 DO HILO^PRPFBAL
IF $DATA(IOF)
WRITE @IOF
+2 IF '$TEST
WRITE !!
+3 KILL PRPFT
SET TRDA(0)=^PRPFT(470.5,TRDA,0)
FOR I=5,7,8,9,10,11,16,21
SET PRPFT(I)=$PIECE(TRDA(0),"^",I)
+4 ;I PRPFT(21)>0 S X1=PRPFT(5),X2=PRPFT(21) D C^%DTC S PRPFT(22)=X
+5 WRITE @PFHI,?15,"MULTIPLE TRANSACTION POSTING",!!,@PFLO,"REFERENCE: ",@PFHI,PRPFT(7),!,@PFLO,"DEPOSIT/WITHDRAWAL: ",@PFHI,$SELECT(PRPFT(8)="D":"DEPOSIT",1:"WITHDRAWAL")
+6 WRITE !,@PFLO,"CASH/CHECK/OTHER: ",@PFHI,$SELECT(PRPFT(9)=1:"CASH",PRPFT(9)=2:"CHECK",1:"OTHER")
+7 WRITE !,@PFLO,"FORM: ",@PFHI,$PIECE(^PRPF(470.2,PRPFT(11),0),"^"),!,@PFLO,"SOURCE: ",@PFHI,$SELECT(PRPFT(10)="G":"GRATUITOUS",1:"PRIVATE SOURCE")
+8 WRITE !,@PFLO,"DATE: "
SET Y=PRPFT(5)
XECUTE ^DD("DD")
WRITE @PFHI,Y,!,@PFLO,"REMARKS: ",@PFHI,PRPFT(16),!
IF PRPFT(21)>0
WRITE @PFLO,"DEFERRAL DATE: ",@PFHI
SET Y=PRPFT(21)
XECUTE ^DD("DD")
WRITE Y
+9 WRITE @PFNORM
QUIT
LKUP SET OUT=1
SET DIC=470.5
SET DIC(0)="LMN"
SET DLAYGO=470.5
SET X="T"_$JOB
+1 if '$DATA(COUNT)
SET COUNT=0
DO ^DIC
if Y<0
GOTO OUT
IF $PIECE(Y,"^",3)=""
SET COUNT=COUNT+1
if COUNT>3
GOTO OUT
SET DIK=DIC
SET DA=+Y
DO ^DIK
GOTO LKUP
+2 SET DIE("NO^")="OUTOK"
SET DA=+Y
SET TRDA=+Y
SET DIE=DIC
SET DR="[PRPF TEMP MULTIPLE]"
DO ^DIE
KILL DIE("NO^")
IF $DATA(Y)'=0!($DATA(PRPF("KILL")))
KILL PRPF("KILL")
SET DIK=DIC
DO ^DIK
SET X="< Option Terminated >*"
DO MSG^PRPFU1
READ X:3
SET OUT=0
QUIT
+3 QUIT
OUT ;PRIMARY EXIT POINT
+1 IF $DATA(TRDA)
IF TRDA>0
SET DA=TRDA
SET DIK="^PRPFT(470.5,"
DO ^DIK
OUT1 KILL %,%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
QUIT
