source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFDAY.m@ 1042

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRPFDAY ;ALTOONA/CTB BALANCE ON SPECIFIED DAY ;3/7/97 2:44 PM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989
3 N NAME,Y,DATE
4 S DIC=470,DIC(0)="AEMNZ" D ^DIC Q:Y<0 S DA=+Y
5 S NAME=$P(Y(0),"^")
6 S %DT="A",%DT("A")="Select Ending Date: " D ^%DT S DATE=+Y
7 S X=$$ONE(DA,DATE)
8 W !!,NAME," ",$P(X,"^",1)," ",$P(X,"^",2)," ",$P(X,"^",3)
9 QUIT
10HDR N PDATE
11 D NOW^%DTC S PDATE=$$DATE^PRPFU1(%)
12 W !,"Patient Funds Balances as of "_$$DATE^PRPFU1(DATE),?(IOM-($L(PDATE)+1)),PDATE
13 W !!,?35,"LAST",?50,"COMPUTED",?65,"STORED"
14 W !,"PATIENT NAME",?35,"TRANSACTION",?50,"BALANCE",?65,"BAL"
15 W ! F I=1:1:IOM-2 W "-"
16 W !
17 QUIT
18LOOP ;;LOOP THROUGH ALL PATIENTS FOR BALANCE IN ACCOUNTS ON SPECIFIED DATE
19 S %DT="AQX",%DT("A")="Select Ending Date: " D ^%DT Q:Y<0 S DATE=+Y
20 S ZTDESC="BALANCE IN ACCOUNTS",ZTSAVE("DATE")=DATE,ZTRTN="L1^PRPFDAY" D ^PRPFQ
21 QUIT
22L1 N TBAL,LTBAL,LINE,DAX,BALANCE,LASTBAL,LASTDATE
23 S TBAL=0,LTBAL=0
24 ;LOOP TO CREATE ALPHABETICAL ORDER
25 K ^TMP($J,"PRPFDAY")
26 D HDR S LINE=0
27 S DA=0 F S DA=$O(^PRPF(470,DA)) Q:'DA D
28 . S X=$$ONE(DA,DATE)
29 . I +$P(X,"^",2)=0,+$P(X,"^",3)=0 QUIT
30 . S LASTDATE=$$DATE^PRPFU1($P(X,"^",1)),BALANCE=$P(X,"^",2),LASTBAL=$P(X,"^",3)
31 . S ^TMP($J,"PRPFDAY",$P(^DPT(DA,0),"^",1),DA)=LASTDATE_U_BALANCE_U_LASTBAL
32 .QUIT
33 S NAME="" F S NAME=$O(^TMP($J,"PRPFDAY",NAME)) Q:NAME="" S DA=0 F S DA=$O(^(NAME,DA)) Q:'DA D
34 . S X=^(DA)
35 . S LASTDATE=$P(X,"^",1),BALANCE=$P(X,"^",2),LASTBAL=$P(X,"^",3)
36 . W !,NAME,?35,LASTDATE,?50,$J(BALANCE,10,2),?65,$J(LASTBAL,10,2) I BALANCE'=LASTBAL W " ***" S LINE=LINE+1 I LINE>(IOSL-10) W @IOF D HDR S LINE=0
37 . S TBAL=TBAL+BALANCE,LTBAL=LTBAL+LASTBAL
38 . QUIT
39 W !!,?50,$J(TBAL,10,2),?65,$J(LTBAL,10,2)
40 QUIT
41ONE(DA,DATE) ;;EXTRINSIC FUNCTION RETURNS THE BALANCE IN THE ACCOUNT OF PATIENT (DA) AS OF 2359 HOURS ON THE DATE SPECIFIED (DATE)
42 ;;ASSUMES DA AND DATE ARE VALID
43 N X,TRDATE,TRAMT,TRBAL,LASTDATE,N,BALANCE
44 S DATE=$P(DATE,".",1)_"."_2399
45 S BALANCE=0,LASTBAL=0
46 S N=0,LASTDATE="" F S N=$O(^PRPF(470,DA,3,N)) Q:'N D
47 . S X=$G(^(N,0)),TRDATE=$P(X,"^",2),TRAMT=$P(X,"^",3),TRBAL=$P(X,"^",6)
48 . Q:TRDATE>DATE
49 . S BALANCE=BALANCE+TRAMT
50 . I LASTDATE'>TRDATE S LASTDATE=TRDATE,LASTBAL=TRBAL
51 . QUIT
52 QUIT LASTDATE_U_BALANCE_U_LASTBAL
Note: See TracBrowser for help on using the repository browser.