- PRPFED1 ;ALTOONA/CTB CONTINUATION OF EDIT ROUTINE ;11/22/96 4:38 PM
- V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
- BCF ;ENTER BALANCE CARRIED FORWARD
- D GETPAT^PRPFED G:'%PRPF OUT I $D(^PRPF(470,DFN,3,0)),$O(^(0))'="" D W1 G BCF
- D GETTRANS^PRPFED G:'%PRPF OUT
- BCF1 S DIE=DIC,DR="[PRPF TEMP BCF AMTS]" D ^DIE G:$D(Y) OUT S TRDA(0)=^PRPFT(470.5,DA,0),PRTOT=$P(TRDA(0),"^",18),PRPVT=$P(TRDA(0),"^",19),PRGRAT=$P(TRDA(0),"^",20)
- I +PRTOT'=(PRPVT+PRGRAT) W !,"Total of Gratuitous and Private Source must equal Total",*7,! G BCF1
- S $P(TRDA(0),"^",4,16)=PRTOT_U_DT_"^^BALCARFWD^D^3^B^^"_PRPVT_U_PRGRAT_U_DUZ_"^^Balance Carried Forward" S DIC=470.2,DIC(0)="MN",X="BALCARFWD" D ^DIC I Y>0 S $P(TRDA(0),"^",11)=+Y,^PRPFT(470.5,DA,0)=TRDA(0)
- S Y=DFN,Y(0)=DFN(0) D ^PRPFPOST I %=1 W !! D OUT S DIC("A")="Select Next Patient: " G BCF
- S X=" <Option Terminated, No Posting Has Occurred>*" D MSG^PRPFU1 R X:3
- OUT K:$D(DFN) ^PRPF(470,DFN,9) K %,%PRPF,%W,%X,%Y,C,COUNT,D,D0,DA,DFN,DI,DIC,DIE,DIYS,DLAYGO,DQ,DR,I,K,P,POP,PRGRAT,PRPF,PRPVT,PRTOT,S,SOURCE,TRDA,X,Y Q
- W1 W !,*7,"This option may not be used when a patient already has transactions",!,"entered for his account." R X:4 D OUT Q
- D GETTRANS^PRPFED G:'%PRPF OUT S SINGLE=1 D BCF1,EN1^PRPFBAL,OUT K SINGLE Q
- FORMS ;ADD/EDIT FORMS FILE
- S DIC=470.2,DIC(0)="AEMNZL",DLAYGO=470.2 D ^DIC G:Y<0 OUT S DA=+Y,DR="[PRPF FORMS EDIT]" D ^DIE G FORMS
- RCODE ;ENTER/EDIT REMARKS CODE FILE
- S DIC=470.6,DIC(0)="AEMNL",DLAYGO=470.6 D ^DIC K DIC G:Y<0 OUT S DIE="^PRPF(470.6,",DA=+Y,DR=".01;1" D ^DIE W ! G RCODE
- REM ;INPUT TRANSFORM FOR 'FULL REMARK' FIELD OF FILE 470.5
- G REM1:X'["," S ZX=$P(X,",",2,99),X=$P(X,","),DIC=470.6,DIC(0)="ZMN" D ^DIC I Y<0 S:ZX]"" X=ZX K ZX G RE2
- S X=$P(Y(0),"^",2)_$S(ZX]"":" "_ZX,1:"") K ZX G RE2
- REM1 S DIC=470.6,DIC(0)="ZMN" D ^DIC G:Y<0 RE2
- S X=$P(Y(0),"^",2)
- RE2 I $L(X)>50 W ?$X+5,"EXCEEDS 50 CHARACTERS, PLEASE REENTER" K X Q
- W ?$X+8,X Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFED1 1928 printed Feb 18, 2025@23:28:04 Page 2
- PRPFED1 ;ALTOONA/CTB CONTINUATION OF EDIT ROUTINE ;11/22/96 4:38 PM
- V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
- BCF ;ENTER BALANCE CARRIED FORWARD
- +1 DO GETPAT^PRPFED
- if '%PRPF
- GOTO OUT
- IF $DATA(^PRPF(470,DFN,3,0))
- IF $ORDER(^(0))'=""
- DO W1
- GOTO BCF
- +2 DO GETTRANS^PRPFED
- if '%PRPF
- GOTO OUT
- BCF1 SET DIE=DIC
- SET DR="[PRPF TEMP BCF AMTS]"
- DO ^DIE
- if $DATA(Y)
- GOTO OUT
- SET TRDA(0)=^PRPFT(470.5,DA,0)
- SET PRTOT=$PIECE(TRDA(0),"^",18)
- SET PRPVT=$PIECE(TRDA(0),"^",19)
- SET PRGRAT=$PIECE(TRDA(0),"^",20)
- +1 IF +PRTOT'=(PRPVT+PRGRAT)
- WRITE !,"Total of Gratuitous and Private Source must equal Total",*7,!
- GOTO BCF1
- +2 SET $PIECE(TRDA(0),"^",4,16)=PRTOT_U_DT_"^^BALCARFWD^D^3^B^^"_PRPVT_U_PRGRAT_U_DUZ_"^^Balance Carried Forward"
- SET DIC=470.2
- SET DIC(0)="MN"
- SET X="BALCARFWD"
- DO ^DIC
- IF Y>0
- SET $PIECE(TRDA(0),"^",11)=+Y
- SET ^PRPFT(470.5,DA,0)=TRDA(0)
- +3 SET Y=DFN
- SET Y(0)=DFN(0)
- DO ^PRPFPOST
- IF %=1
- WRITE !!
- DO OUT
- SET DIC("A")="Select Next Patient: "
- GOTO BCF
- +4 SET X=" <Option Terminated, No Posting Has Occurred>*"
- DO MSG^PRPFU1
- READ X:3
- OUT if $DATA(DFN)
- KILL ^PRPF(470,DFN,9)
- KILL %,%PRPF,%W,%X,%Y,C,COUNT,D,D0,DA,DFN,DI,DIC,DIE,DIYS,DLAYGO,DQ,DR,I,K,P,POP,PRGRAT,PRPF,PRPVT,PRTOT,S,SOURCE,TRDA,X,Y
- QUIT
- W1 WRITE !,*7,"This option may not be used when a patient already has transactions",!,"entered for his account."
- READ X:4
- DO OUT
- QUIT
- +1 DO GETTRANS^PRPFED
- if '%PRPF
- GOTO OUT
- SET SINGLE=1
- DO BCF1
- DO EN1^PRPFBAL
- DO OUT
- KILL SINGLE
- QUIT
- FORMS ;ADD/EDIT FORMS FILE
- +1 SET DIC=470.2
- SET DIC(0)="AEMNZL"
- SET DLAYGO=470.2
- DO ^DIC
- if Y<0
- GOTO OUT
- SET DA=+Y
- SET DR="[PRPF FORMS EDIT]"
- DO ^DIE
- GOTO FORMS
- RCODE ;ENTER/EDIT REMARKS CODE FILE
- +1 SET DIC=470.6
- SET DIC(0)="AEMNL"
- SET DLAYGO=470.6
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO OUT
- SET DIE="^PRPF(470.6,"
- SET DA=+Y
- SET DR=".01;1"
- DO ^DIE
- WRITE !
- GOTO RCODE
- REM ;INPUT TRANSFORM FOR 'FULL REMARK' FIELD OF FILE 470.5
- +1 if X'[","
- GOTO REM1
- SET ZX=$PIECE(X,",",2,99)
- SET X=$PIECE(X,",")
- SET DIC=470.6
- SET DIC(0)="ZMN"
- DO ^DIC
- IF Y<0
- if ZX]""
- SET X=ZX
- KILL ZX
- GOTO RE2
- +2 SET X=$PIECE(Y(0),"^",2)_$SELECT(ZX]"":" "_ZX,1:"")
- KILL ZX
- GOTO RE2
- REM1 SET DIC=470.6
- SET DIC(0)="ZMN"
- DO ^DIC
- if Y<0
- GOTO RE2
- +1 SET X=$PIECE(Y(0),"^",2)
- RE2 IF $LENGTH(X)>50
- WRITE ?$X+5,"EXCEEDS 50 CHARACTERS, PLEASE REENTER"
- KILL X
- QUIT
- +1 WRITE ?$X+8,X
- QUIT
