| 1 | PRPFTRCK ;ALTOONA/CTB MODIFIED INPUT TRANS FOR PATIENT FUNDS SYSTEM ;11/22/96 4:47 PM
|
|---|
| 2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
|---|
| 3 | ; USED TO CHECK THE TRANSACTION AMOUNT
|
|---|
| 4 | I X=""!(X["^") K X Q
|
|---|
| 5 | S:X["$" X=$P(X,"$",2) I X'?."-".N.1".".2N K X Q
|
|---|
| 6 | W " $ ",$J(X,0,2)
|
|---|
| 7 | 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
|
|---|
| 8 | I '$D(DEP) K X Q
|
|---|
| 9 | 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)
|
|---|
| 10 | I -X1'<0,PRBAL("SB")<-X1 W !,"The balance of $ ",$J(PRBAL("SB"),0,2)," is not sufficient to complete this transaction. " G OVRDRW
|
|---|
| 11 | 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
|
|---|
| 12 | 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
|
|---|
| 13 | 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
|
|---|
| 14 | A1 S X=X1 Q
|
|---|
| 15 | DELETE S X="K",PRPF("KILL")="" Q
|
|---|
| 16 | OVRDRW ;CHECK FOR AUTHORIZATION TO OVERDRAW
|
|---|
| 17 | G:'$D(^XUSEC("PRPF OVERDRAW",DUZ)) DELETE
|
|---|
| 18 | 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."
|
|---|
| 19 | S %A(3)="DO YOU WISH TO OVERDRAW THIS ACCOUNT",%B="",%=2 D ^PRPFYN I %'=1 G DELETE
|
|---|
| 20 | W !,*7 K % S %A="Are you sure you wish to OVERDRAW this account",%B="" D ^PRPFYN G:%'=1 DELETE
|
|---|
| 21 | W *7,!,"* * * ACCOUNT OVERDRAWN * * *"
|
|---|
| 22 | S PRPFBUL("OVERDRAW")=""
|
|---|
| 23 | G A1
|
|---|
| 24 | 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
|
|---|
| 25 | S:%=1 PRPFBUL("RESTRICTION")=""
|
|---|
| 26 | Q
|
|---|
| 27 | OVRDEF ;OVERRIDE DEFERRAL
|
|---|
| 28 | I $D(^XUSEC("PRPF DEFERRAL OVERRIDE")),'$D(^XUSEC("PRPF DEFERRAL OVERRIDE",DUZ)) G DELETE
|
|---|
| 29 | 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."
|
|---|
| 30 | S %A(2)="DO YOU WISH TO OVERRIDE",%B="" S %=2 D ^PRPFYN G:%'=1 DELETE
|
|---|
| 31 | 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
|
|---|
| 32 | S PRPFBUL("DEFERRAL")=""
|
|---|
| 33 | Q
|
|---|
