PRPFED ;ALTOONA/CTB EDIT ROUTINE FOR PATIENT FUNDS PACKAGE ;2/24/97 5:09 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
DEAD I $D(^DPT(DFN,.35)),$P(^(.35),"^")]"" W !,*7,"PATIENT HAS DIED!" Q
Q
GETPAT K DFN S %PRPF=0,DIC(0)="IAEZMQ",DIC=470,DLAYGO=470 D ^DIC K DIC("A"),DLAYGO Q:Y<0 S DFN=+Y,DFN(0)=Y(0),DFN(0,0)=Y(0,0) I $D(^DPT(DFN,.31)) W:$P(^(.31),"^",3)]"" ?($X+5),"Claim #: ",$P(^(.31),"^",3)
I $D(^PRPF(470,DFN,9)) S X=^(9) W !!,*7,"This File is being edited",$S($P(X,"^",2)>0:" by "_$P(^VA(200,$P(X,"^",2),0),"^"),1:" ")," on Device ",$P(X,"^",3)_".",!," Please try later." R X:3 W ! G GETPAT
S ^PRPF(470,DFN,9)="1^"_DUZ_"^"_$S($D(ION):ION,1:""),%PRPF=1 Q
;
GETTRANS ;GET TEMP TRANS NUMBER FROM TEMP TRANSACTION FILE
S (DLAYGO,DIC)=470.5,DIC(0)="XOLM",X="T"_^%ZOSF("VOL")_$J,%PRPF=0
S:'$D(COUNT) COUNT=0 D ^DIC Q:Y<0 I $P(Y,"^",3)="" S COUNT=COUNT+1 Q:COUNT>3 S DIK=DIC,DA=+Y D ^DIK K DIK G GETTRANS
S (TRDA,DA)=+Y,%PRPF=1 Q
;
POST ;POST TRANSACTION
D GETPAT G:'%PRPF OUT D EN1^PRPFBAL D DEAD S %=1,%A="Do you wish to continue with this transaction",%B="" D ^PRPFYN I %'=1 G OUT
D GETTRANS G:'%PRPF OUT S TRDA=+Y,DIE=DIC,%=1
EDIT S $P(^PRPFT(470.5,DA,0),"^",4)="",DR="[PRPF TEMP TRANS POST]",DIE("NO^")="OUTOK" D ^DIE I $D(Y)'=0!($D(PRPF("KILL"))) K PRPF("KILL") S DIK=DIC D ^DIK K DIK S X=" < Option Terminated >*" D MSG^PRPFU1 R X:3 G OUT
S Y=DFN,Y(0)=DFN(0) D ^PRPFPOST G:%=3 EDIT G:%=1 CL
K ^PRPF(470,DFN,9) G POST
CL K ^PRPF(470,DFN,9) D EN1^PRPFBAL,ENCON^PRPFQ,OUT G POST
;
DEF ;EDIT DEFERRAL
D GETPAT G:'%PRPF OUT
I $S('$D(^PRPF(470,DFN,4,0)):1,$P(^(0),"^",4)=0:1,1:0) S X="No Deferrals recorded for this account.*" D MSG^PRPFU1,ENCON^PRPFQ,OUT G DEF
S DA=DFN,DIC="^PRPF(470,"_DA_",4,",DIC(0)="AEMN" D ^DIC G:Y<0 OUT S DIE=DIC,DR=1,DA=+Y D ^DIE,OUT G DEF Q
CKINACT ;CHECK BALANCE DURING INPUT TRANSFORM FOR ACCOUNT STATUS
Q:$E(X,1)="A"
I $D(^PRPF(470,DA,1)),+$P(^(1),"^",4)'=0 W " BALANCE IS $",$J($P(^(1),"^",4),0,2),*7,!," You may not Inactivate an Account unless the Balance is zero" K X Q
Q
CLEAR ;CLEAR LOCK ON ACCOUNT
S DIC=470,DIC(0)="AEMN" D ^DIC G:Y<0 OUTC S DFN=+Y I '$D(^PRPF(470,DFN,9)) W !,"Account is already clear. No action is required.",! R X:3 G OUTC
S X=^PRPF(470,DFN,9),%A="The lock indicates that the file is being edited"_$S($P(X,"^",2)>0:" by "_$P(^VA(200,$P(X,"^",2),0),"^"),1:" "),%A(1)="Are you sure you want to clear the lock",%B="",%=2 D ^PRPFYN
I %'=1 G CLEAR
K ^PRPF(470,DFN,9) W *7,"---CLEARED---",! R X:3 D OUTC Q
SUSPENSE ;ADD/EDIT SUSPENSE ITEM
S DIC=470,DIC(0)="AEMNQ" D ^DIC G OUT:Y<0 S DIE=DIC,DA=+Y,DR="[PRPF SUSPENSE ENTER EDIT]" D ^DIE G SUSPENSE
FORM ;ADD/EDIT PATIENT FUNDS FORM
S (DLAYGO,DIC)=470.2,DIC(0)="AEMZLQ" D ^DIC K DIC,DLAYGO G:Y<0 OUT S DIE="^PRPF(470.2,",DA=+Y,DR="[PRPF FORMS EDIT]" D ^DIE S DIC("A")="Select Next PATIENT FUNDS FORM: " G FORM
OUT I $D(DFN)#2,DFN]"" K ^PRPF(470,DFN,9)
I $D(TRDA),TRDA>0 S DIK="^PRPFT(470.5,",DA=TRDA D ^DIK
W:$D(IOF) @IOF
OUTC K %,%DT,%H,%I,%PRPF,%W,%X,%Y,C,COUNT,D,D0,D1,DA,DEFDATE,DEP,DFN,DG1,DGA1,DGT,DGX,DI,DIC,DIE,DIK,DIPGM,DIW,DIWT,DIYS,DLAYGO,DN,DQ,DR,DUOUT,DWLW
K FORM,I,J,K,N,P,PFHI,PFLO,PFNORM,POP,PRBAL,PRPF,Q3,RES,S,SOURCE,TMP,TRDA,TYPE,X,X1,X2,Y,Z Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFED 3245 printed Jan 18, 2025@03:02:53 Page 2
PRPFED ;ALTOONA/CTB EDIT ROUTINE FOR PATIENT FUNDS PACKAGE ;2/24/97 5:09 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
DEAD IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),"^")]""
WRITE !,*7,"PATIENT HAS DIED!"
QUIT
+1 QUIT
GETPAT KILL DFN
SET %PRPF=0
SET DIC(0)="IAEZMQ"
SET DIC=470
SET DLAYGO=470
DO ^DIC
KILL DIC("A"),DLAYGO
if Y<0
QUIT
SET DFN=+Y
SET DFN(0)=Y(0)
SET DFN(0,0)=Y(0,0)
IF $DATA(^DPT(DFN,.31))
if $PIECE(^(.31),"^",3)]""
WRITE ?($X+5),"Claim #: ",$PIECE(^(.31),"^",3)
+1 IF $DATA(^PRPF(470,DFN,9))
SET X=^(9)
WRITE !!,*7,"This File is being edited",$SELECT($PIECE(X,"^",2)>0:" by "_$PIECE(^VA(200,$PIECE(X,"^",2),0),"^"),1:" ")," on Device ",$PIECE(X,"^",3)_".",!," Please try later."
READ X:3
WRITE !
GOTO GETPAT
+2 SET ^PRPF(470,DFN,9)="1^"_DUZ_"^"_$SELECT($DATA(ION):ION,1:"")
SET %PRPF=1
QUIT
+3 ;
GETTRANS ;GET TEMP TRANS NUMBER FROM TEMP TRANSACTION FILE
+1 SET (DLAYGO,DIC)=470.5
SET DIC(0)="XOLM"
SET X="T"_^%ZOSF("VOL")_$JOB
SET %PRPF=0
+2 if '$DATA(COUNT)
SET COUNT=0
DO ^DIC
if Y<0
QUIT
IF $PIECE(Y,"^",3)=""
SET COUNT=COUNT+1
if COUNT>3
QUIT
SET DIK=DIC
SET DA=+Y
DO ^DIK
KILL DIK
GOTO GETTRANS
+3 SET (TRDA,DA)=+Y
SET %PRPF=1
QUIT
+4 ;
POST ;POST TRANSACTION
+1 DO GETPAT
if '%PRPF
GOTO OUT
DO EN1^PRPFBAL
DO DEAD
SET %=1
SET %A="Do you wish to continue with this transaction"
SET %B=""
DO ^PRPFYN
IF %'=1
GOTO OUT
+2 DO GETTRANS
if '%PRPF
GOTO OUT
SET TRDA=+Y
SET DIE=DIC
SET %=1
EDIT SET $PIECE(^PRPFT(470.5,DA,0),"^",4)=""
SET DR="[PRPF TEMP TRANS POST]"
SET DIE("NO^")="OUTOK"
DO ^DIE
IF $DATA(Y)'=0!($DATA(PRPF("KILL")))
KILL PRPF("KILL")
SET DIK=DIC
DO ^DIK
KILL DIK
SET X=" < Option Terminated >*"
DO MSG^PRPFU1
READ X:3
GOTO OUT
+1 SET Y=DFN
SET Y(0)=DFN(0)
DO ^PRPFPOST
if %=3
GOTO EDIT
if %=1
GOTO CL
+2 KILL ^PRPF(470,DFN,9)
GOTO POST
CL KILL ^PRPF(470,DFN,9)
DO EN1^PRPFBAL
DO ENCON^PRPFQ
DO OUT
GOTO POST
+1 ;
DEF ;EDIT DEFERRAL
+1 DO GETPAT
if '%PRPF
GOTO OUT
+2 IF $SELECT('$DATA(^PRPF(470,DFN,4,0)):1,$PIECE(^(0),"^",4)=0:1,1:0)
SET X="No Deferrals recorded for this account.*"
DO MSG^PRPFU1
DO ENCON^PRPFQ
DO OUT
GOTO DEF
+3 SET DA=DFN
SET DIC="^PRPF(470,"_DA_",4,"
SET DIC(0)="AEMN"
DO ^DIC
if Y<0
GOTO OUT
SET DIE=DIC
SET DR=1
SET DA=+Y
DO ^DIE
DO OUT
GOTO DEF
QUIT
CKINACT ;CHECK BALANCE DURING INPUT TRANSFORM FOR ACCOUNT STATUS
+1 if $EXTRACT(X,1)="A"
QUIT
+2 IF $DATA(^PRPF(470,DA,1))
IF +$PIECE(^(1),"^",4)'=0
WRITE " BALANCE IS $",$JUSTIFY($PIECE(^(1),"^",4),0,2),*7,!," You may not Inactivate an Account unless the Balance is zero"
KILL X
QUIT
+3 QUIT
CLEAR ;CLEAR LOCK ON ACCOUNT
+1 SET DIC=470
SET DIC(0)="AEMN"
DO ^DIC
if Y<0
GOTO OUTC
SET DFN=+Y
IF '$DATA(^PRPF(470,DFN,9))
WRITE !,"Account is already clear. No action is required.",!
READ X:3
GOTO OUTC
+2 SET X=^PRPF(470,DFN,9)
SET %A="The lock indicates that the file is being edited"_$SELECT($PIECE(X,"^",2)>0:" by "_$PIECE(^VA(200,$PIECE(X,"^",2),0),"^"),1:" ")
SET %A(1)="Are you sure you want to clear the lock"
SET %B=""
SET %=2
DO ^PRPFYN
+3 IF %'=1
GOTO CLEAR
+4 KILL ^PRPF(470,DFN,9)
WRITE *7,"---CLEARED---",!
READ X:3
DO OUTC
QUIT
SUSPENSE ;ADD/EDIT SUSPENSE ITEM
+1 SET DIC=470
SET DIC(0)="AEMNQ"
DO ^DIC
if Y<0
GOTO OUT
SET DIE=DIC
SET DA=+Y
SET DR="[PRPF SUSPENSE ENTER EDIT]"
DO ^DIE
GOTO SUSPENSE
FORM ;ADD/EDIT PATIENT FUNDS FORM
+1 SET (DLAYGO,DIC)=470.2
SET DIC(0)="AEMZLQ"
DO ^DIC
KILL DIC,DLAYGO
if Y<0
GOTO OUT
SET DIE="^PRPF(470.2,"
SET DA=+Y
SET DR="[PRPF FORMS EDIT]"
DO ^DIE
SET DIC("A")="Select Next PATIENT FUNDS FORM: "
GOTO FORM
OUT IF $DATA(DFN)#2
IF DFN]""
KILL ^PRPF(470,DFN,9)
+1 IF $DATA(TRDA)
IF TRDA>0
SET DIK="^PRPFT(470.5,"
SET DA=TRDA
DO ^DIK
+2 if $DATA(IOF)
WRITE @IOF
OUTC KILL %,%DT,%H,%I,%PRPF,%W,%X,%Y,C,COUNT,D,D0,D1,DA,DEFDATE,DEP,DFN,DG1,DGA1,DGT,DGX,DI,DIC,DIE,DIK,DIPGM,DIW,DIWT,DIYS,DLAYGO,DN,DQ,DR,DUOUT,DWLW
+1 KILL FORM,I,J,K,N,P,PFHI,PFLO,PFNORM,POP,PRBAL,PRPF,Q3,RES,S,SOURCE,TMP,TRDA,TYPE,X,X1,X2,Y,Z
QUIT
