- 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