PRPFTRCK ;ALTOONA/CTB MODIFIED INPUT TRANS FOR PATIENT FUNDS SYSTEM ;11/22/96 4:47 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
; USED TO CHECK THE TRANSACTION AMOUNT
I X=""!(X["^") K X Q
S:X["$" X=$P(X,"$",2) I X'?."-".N.1".".2N K X Q
W " $ ",$J(X,0,2)
I X>100000!(X<-100000) S %=1,%A="Are you sure about this amount",%B="" D ^PRPFYN G:%<0 DELETE I %=2 K X Q
I '$D(DEP) K X Q
S:DEP="W" X=-X S X1=X D ^PRPFDEF S D0(1)=D0,D0=+DFN X $P(^DD(470,30.5,0),"^",5,99) S D0=D0(1) K D0(1) S PRBAL("DEF")=X,PRBAL("SB")=$P(DFN(1),"^",4)
I -X1'<0,PRBAL("SB")<-X1 W !,"The balance of $ ",$J(PRBAL("SB"),0,2)," is not sufficient to complete this transaction. " G OVRDRW
I -X1'<0,(PRBAL("SB")-PRBAL("DEF"))<-X1 W *7,!,"Because of a deferred item in this account, the available balance is",!,"insufficient to fund this withdrawal.",! D OVRDEF I X="K",$D(PRPF("KILL")) Q
S DFN(1)=^PRPF(470,DFN,1) I DEP="W",$P(DFN(1),"^",7)>0,$P(DFN(1),"^",7)-$P(DFN(1),"^",11)<-X1 S PRPFW="MONTHLY" D WARN K PRPFW I %'=1 G DELETE
I DEP="W",$P(DFN(1),"^",8)>0,$P(DFN(1),"^",8)-$P(DFN(1),"^",12)<-X1 S PRPFW="WEEKLY" D WARN K PRPFW I %'=1 G DELETE
A1 S X=X1 Q
DELETE S X="K",PRPF("KILL")="" Q
OVRDRW ;CHECK FOR AUTHORIZATION TO OVERDRAW
G:'$D(^XUSEC("PRPF OVERDRAW",DUZ)) DELETE
S %A="Processing of this transaction will cause this patient's account",%A(1)="to be overdrawn. You will be assuming PERSONAL responsibility",%A(2)="for this action."
S %A(3)="DO YOU WISH TO OVERDRAW THIS ACCOUNT",%B="",%=2 D ^PRPFYN I %'=1 G DELETE
W !,*7 K % S %A="Are you sure you wish to OVERDRAW this account",%B="" D ^PRPFYN G:%'=1 DELETE
W *7,!,"* * * ACCOUNT OVERDRAWN * * *"
S PRPFBUL("OVERDRAW")=""
G A1
WARN S %A="** WARNING, Posting this amount will exceed the "_PRPFW_" withdrawal limitation **",%A(1)="Is is OK to exceed the "_PRPFW_" limitation",%B="",%=2 D ^PRPFYN
S:%=1 PRPFBUL("RESTRICTION")=""
Q
OVRDEF ;OVERRIDE DEFERRAL
I $D(^XUSEC("PRPF DEFERRAL OVERRIDE")),'$D(^XUSEC("PRPF DEFERRAL OVERRIDE",DUZ)) G DELETE
S %A="When overriding a deferral date, you are assuming PERSONAL responsibility for a",%A(1)="loss of funds, should one occur as a result of this action."
S %A(2)="DO YOU WISH TO OVERRIDE",%B="" S %=2 D ^PRPFYN G:%'=1 DELETE
I -X1'<0,(PRBAL("SB")-PRBAL("DEF"))<-X1 W ! S %A="ARE YOU SURE THAT YOU WANT TO OVERRIDE",%B="",%=2 D ^PRPFYN G:%'=1 DELETE
S PRPFBUL("DEFERRAL")=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFTRCK 2413 printed Apr 09, 2024@21:04:59 Page 2
PRPFTRCK ;ALTOONA/CTB MODIFIED INPUT TRANS FOR PATIENT FUNDS SYSTEM ;11/22/96 4:47 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
+1 ; USED TO CHECK THE TRANSACTION AMOUNT
+2 IF X=""!(X["^")
KILL X
QUIT
+3 if X["$"
SET X=$PIECE(X,"$",2)
IF X'?."-".N.1".".2N
KILL X
QUIT
+4 WRITE " $ ",$JUSTIFY(X,0,2)
+5 IF X>100000!(X<-100000)
SET %=1
SET %A="Are you sure about this amount"
SET %B=""
DO ^PRPFYN
if %<0
GOTO DELETE
IF %=2
KILL X
QUIT
+6 IF '$DATA(DEP)
KILL X
QUIT
+7 if DEP="W"
SET X=-X
SET X1=X
DO ^PRPFDEF
SET D0(1)=D0
SET D0=+DFN
XECUTE $PIECE(^DD(470,30.5,0),"^",5,99)
SET D0=D0(1)
KILL D0(1)
SET PRBAL("DEF")=X
SET PRBAL("SB")=$PIECE(DFN(1),"^",4)
+8 IF -X1'<0
IF PRBAL("SB")<-X1
WRITE !,"The balance of $ ",$JUSTIFY(PRBAL("SB"),0,2)," is not sufficient to complete this transaction. "
GOTO OVRDRW
+9 IF -X1'<0
IF (PRBAL("SB")-PRBAL("DEF"))<-X1
WRITE *7,!,"Because of a deferred item in this account, the available balance is",!,"insufficient to fund this withdrawal.",!
DO OVRDEF
IF X="K"
IF $DATA(PRPF("KILL"))
QUIT
+10 SET DFN(1)=^PRPF(470,DFN,1)
IF DEP="W"
IF $PIECE(DFN(1),"^",7)>0
IF $PIECE(DFN(1),"^",7)-$PIECE(DFN(1),"^",11)<-X1
SET PRPFW="MONTHLY"
DO WARN
KILL PRPFW
IF %'=1
GOTO DELETE
+11 IF DEP="W"
IF $PIECE(DFN(1),"^",8)>0
IF $PIECE(DFN(1),"^",8)-$PIECE(DFN(1),"^",12)<-X1
SET PRPFW="WEEKLY"
DO WARN
KILL PRPFW
IF %'=1
GOTO DELETE
A1 SET X=X1
QUIT
DELETE SET X="K"
SET PRPF("KILL")=""
QUIT
OVRDRW ;CHECK FOR AUTHORIZATION TO OVERDRAW
+1 if '$DATA(^XUSEC("PRPF OVERDRAW",DUZ))
GOTO DELETE
+2 SET %A="Processing of this transaction will cause this patient's account"
SET %A(1)="to be overdrawn. You will be assuming PERSONAL responsibility"
SET %A(2)="for this action."
+3 SET %A(3)="DO YOU WISH TO OVERDRAW THIS ACCOUNT"
SET %B=""
SET %=2
DO ^PRPFYN
IF %'=1
GOTO DELETE
+4 WRITE !,*7
KILL %
SET %A="Are you sure you wish to OVERDRAW this account"
SET %B=""
DO ^PRPFYN
if %'=1
GOTO DELETE
+5 WRITE *7,!,"* * * ACCOUNT OVERDRAWN * * *"
+6 SET PRPFBUL("OVERDRAW")=""
+7 GOTO A1
WARN SET %A="** WARNING, Posting this amount will exceed the "_PRPFW_" withdrawal limitation **"
SET %A(1)="Is is OK to exceed the "_PRPFW_" limitation"
SET %B=""
SET %=2
DO ^PRPFYN
+1 if %=1
SET PRPFBUL("RESTRICTION")=""
+2 QUIT
OVRDEF ;OVERRIDE DEFERRAL
+1 IF $DATA(^XUSEC("PRPF DEFERRAL OVERRIDE"))
IF '$DATA(^XUSEC("PRPF DEFERRAL OVERRIDE",DUZ))
GOTO DELETE
+2 SET %A="When overriding a deferral date, you are assuming PERSONAL responsibility for a"
SET %A(1)="loss of funds, should one occur as a result of this action."
+3 SET %A(2)="DO YOU WISH TO OVERRIDE"
SET %B=""
SET %=2
DO ^PRPFYN
if %'=1
GOTO DELETE
+4 IF -X1'<0
IF (PRBAL("SB")-PRBAL("DEF"))<-X1
WRITE !
SET %A="ARE YOU SURE THAT YOU WANT TO OVERRIDE"
SET %B=""
SET %=2
DO ^PRPFYN
if %'=1
GOTO DELETE
+5 SET PRPFBUL("DEFERRAL")=""
+6 QUIT
