| 1 | PRPFDAY ;ALTOONA/CTB BALANCE ON SPECIFIED DAY ;3/7/97 2:44 PM
|
|---|
| 2 | V ;;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
|
|---|
| 10 | HDR 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
|
|---|
| 18 | LOOP ;;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
|
|---|
| 22 | L1 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
|
|---|
| 41 | ONE(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
|
|---|
