source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFED.m@ 1806

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRPFED ;ALTOONA/CTB EDIT ROUTINE FOR PATIENT FUNDS PACKAGE ;2/24/97 5:09 PM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
3DEAD I $D(^DPT(DFN,.35)),$P(^(.35),"^")]"" W !,*7,"PATIENT HAS DIED!" Q
4 Q
5GETPAT 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)
6 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
7 S ^PRPF(470,DFN,9)="1^"_DUZ_"^"_$S($D(ION):ION,1:""),%PRPF=1 Q
8 ;
9GETTRANS ;GET TEMP TRANS NUMBER FROM TEMP TRANSACTION FILE
10 S (DLAYGO,DIC)=470.5,DIC(0)="XOLM",X="T"_^%ZOSF("VOL")_$J,%PRPF=0
11 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
12 S (TRDA,DA)=+Y,%PRPF=1 Q
13 ;
14POST ;POST TRANSACTION
15 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
16 D GETTRANS G:'%PRPF OUT S TRDA=+Y,DIE=DIC,%=1
17EDIT 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
18 S Y=DFN,Y(0)=DFN(0) D ^PRPFPOST G:%=3 EDIT G:%=1 CL
19 K ^PRPF(470,DFN,9) G POST
20CL K ^PRPF(470,DFN,9) D EN1^PRPFBAL,ENCON^PRPFQ,OUT G POST
21 ;
22DEF ;EDIT DEFERRAL
23 D GETPAT G:'%PRPF OUT
24 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
25 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
26CKINACT ;CHECK BALANCE DURING INPUT TRANSFORM FOR ACCOUNT STATUS
27 Q:$E(X,1)="A"
28 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
29 Q
30CLEAR ;CLEAR LOCK ON ACCOUNT
31 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
32 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
33 I %'=1 G CLEAR
34 K ^PRPF(470,DFN,9) W *7,"---CLEARED---",! R X:3 D OUTC Q
35SUSPENSE ;ADD/EDIT SUSPENSE ITEM
36 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
37FORM ;ADD/EDIT PATIENT FUNDS FORM
38 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
39OUT I $D(DFN)#2,DFN]"" K ^PRPF(470,DFN,9)
40 I $D(TRDA),TRDA>0 S DIK="^PRPFT(470.5,",DA=TRDA D ^DIK
41 W:$D(IOF) @IOF
42OUTC 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
43 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
Note: See TracBrowser for help on using the repository browser.