- 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 Jan 18, 2025@03:03:01 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