source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFED1.m

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