53 lines
2.2 KiB
Mathematica
53 lines
2.2 KiB
Mathematica
PRPFDAY ;ALTOONA/CTB BALANCE ON SPECIFIED DAY ;3/7/97 2:44 PM
|
|
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1,1989
|
|
N NAME,Y,DATE
|
|
S DIC=470,DIC(0)="AEMNZ" D ^DIC Q:Y<0 S DA=+Y
|
|
S NAME=$P(Y(0),"^")
|
|
S %DT="A",%DT("A")="Select Ending Date: " D ^%DT S DATE=+Y
|
|
S X=$$ONE(DA,DATE)
|
|
W !!,NAME," ",$P(X,"^",1)," ",$P(X,"^",2)," ",$P(X,"^",3)
|
|
QUIT
|
|
HDR N PDATE
|
|
D NOW^%DTC S PDATE=$$DATE^PRPFU1(%)
|
|
W !,"Patient Funds Balances as of "_$$DATE^PRPFU1(DATE),?(IOM-($L(PDATE)+1)),PDATE
|
|
W !!,?35,"LAST",?50,"COMPUTED",?65,"STORED"
|
|
W !,"PATIENT NAME",?35,"TRANSACTION",?50,"BALANCE",?65,"BAL"
|
|
W ! F I=1:1:IOM-2 W "-"
|
|
W !
|
|
QUIT
|
|
LOOP ;;LOOP THROUGH ALL PATIENTS FOR BALANCE IN ACCOUNTS ON SPECIFIED DATE
|
|
S %DT="AQX",%DT("A")="Select Ending Date: " D ^%DT Q:Y<0 S DATE=+Y
|
|
S ZTDESC="BALANCE IN ACCOUNTS",ZTSAVE("DATE")=DATE,ZTRTN="L1^PRPFDAY" D ^PRPFQ
|
|
QUIT
|
|
L1 N TBAL,LTBAL,LINE,DAX,BALANCE,LASTBAL,LASTDATE
|
|
S TBAL=0,LTBAL=0
|
|
;LOOP TO CREATE ALPHABETICAL ORDER
|
|
K ^TMP($J,"PRPFDAY")
|
|
D HDR S LINE=0
|
|
S DA=0 F S DA=$O(^PRPF(470,DA)) Q:'DA D
|
|
. S X=$$ONE(DA,DATE)
|
|
. I +$P(X,"^",2)=0,+$P(X,"^",3)=0 QUIT
|
|
. S LASTDATE=$$DATE^PRPFU1($P(X,"^",1)),BALANCE=$P(X,"^",2),LASTBAL=$P(X,"^",3)
|
|
. S ^TMP($J,"PRPFDAY",$P(^DPT(DA,0),"^",1),DA)=LASTDATE_U_BALANCE_U_LASTBAL
|
|
.QUIT
|
|
S NAME="" F S NAME=$O(^TMP($J,"PRPFDAY",NAME)) Q:NAME="" S DA=0 F S DA=$O(^(NAME,DA)) Q:'DA D
|
|
. S X=^(DA)
|
|
. S LASTDATE=$P(X,"^",1),BALANCE=$P(X,"^",2),LASTBAL=$P(X,"^",3)
|
|
. 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
|
|
. S TBAL=TBAL+BALANCE,LTBAL=LTBAL+LASTBAL
|
|
. QUIT
|
|
W !!,?50,$J(TBAL,10,2),?65,$J(LTBAL,10,2)
|
|
QUIT
|
|
ONE(DA,DATE) ;;EXTRINSIC FUNCTION RETURNS THE BALANCE IN THE ACCOUNT OF PATIENT (DA) AS OF 2359 HOURS ON THE DATE SPECIFIED (DATE)
|
|
;;ASSUMES DA AND DATE ARE VALID
|
|
N X,TRDATE,TRAMT,TRBAL,LASTDATE,N,BALANCE
|
|
S DATE=$P(DATE,".",1)_"."_2399
|
|
S BALANCE=0,LASTBAL=0
|
|
S N=0,LASTDATE="" F S N=$O(^PRPF(470,DA,3,N)) Q:'N D
|
|
. S X=$G(^(N,0)),TRDATE=$P(X,"^",2),TRAMT=$P(X,"^",3),TRBAL=$P(X,"^",6)
|
|
. Q:TRDATE>DATE
|
|
. S BALANCE=BALANCE+TRAMT
|
|
. I LASTDATE'>TRDATE S LASTDATE=TRDATE,LASTBAL=TRBAL
|
|
. QUIT
|
|
QUIT LASTDATE_U_BALANCE_U_LASTBAL
|