source: FOIAVistA/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFED1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1PRPFED1 ;ALTOONA/CTB CONTINUATION OF EDIT ROUTINE ;11/22/96 4:38 PM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
3BCF ;ENTER BALANCE CARRIED FORWARD
4 D GETPAT^PRPFED G:'%PRPF OUT I $D(^PRPF(470,DFN,3,0)),$O(^(0))'="" D W1 G BCF
5 D GETTRANS^PRPFED G:'%PRPF OUT
6BCF1 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)
7 I +PRTOT'=(PRPVT+PRGRAT) W !,"Total of Gratuitous and Private Source must equal Total",*7,! G BCF1
8 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)
9 S Y=DFN,Y(0)=DFN(0) D ^PRPFPOST I %=1 W !! D OUT S DIC("A")="Select Next Patient: " G BCF
10 S X=" <Option Terminated, No Posting Has Occurred>*" D MSG^PRPFU1 R X:3
11OUT 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
12W1 W !,*7,"This option may not be used when a patient already has transactions",!,"entered for his account." R X:4 D OUT Q
13 D GETTRANS^PRPFED G:'%PRPF OUT S SINGLE=1 D BCF1,EN1^PRPFBAL,OUT K SINGLE Q
14FORMS ;ADD/EDIT FORMS FILE
15 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
16RCODE ;ENTER/EDIT REMARKS CODE FILE
17 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
18REM ;INPUT TRANSFORM FOR 'FULL REMARK' FIELD OF FILE 470.5
19 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
20 S X=$P(Y(0),"^",2)_$S(ZX]"":" "_ZX,1:"") K ZX G RE2
21REM1 S DIC=470.6,DIC(0)="ZMN" D ^DIC G:Y<0 RE2
22 S X=$P(Y(0),"^",2)
23RE2 I $L(X)>50 W ?$X+5,"EXCEEDS 50 CHARACTERS, PLEASE REENTER" K X Q
24 W ?$X+8,X Q
Note: See TracBrowser for help on using the repository browser.