PRPFDST ;ALTOONA/CTB DISPLAY TRANACTIONS ;7/24/97 8:36 AM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
D ^PRPFSITE I % D HILO^PRPFBAL S PAGE=1,DIC=470,DIC(0)="AEMNZ" D ^DIC I Y>0 S DFN=+Y D D W !! G V
OUT K %,%W,%Y,C,DA,DFN,DIC,DIYS,J,K,LINE,MADA,N,P,PAGE,FR,TO,PFHI,PFLO,PFNORM,POP,PRPF,PRPFQ,PRPFL,PTRDA,S,TMP,X,X1,Y,ZDA Q
D ;;DISPLAY/PRINT PATIENT FUNDS TRANSACTIONS
D DRNG^PRPFQ G:'% OUT
S ZTRTN="EN1^PRPFDST",(ZTSAVE("FR"),ZTSAVE("TO"),ZTSAVE("PRPF*"),ZTSAVE("DFN"))="",ZTDESC=$P($T(D),";",3) D ^PRPFQ
Q
EN1 ;DIRECT ENTRY POINT, UN QUEUED
I $D(ZTQUEUED) S ZTREQ="@"
S IOP=PRIOP,U="^"
H I '$D(PFHI)!('$D(PFLO))!('$D(PFNORM)) S (PFHI,PFLO,PFNORM)="*0"
K LINE S $P(LINE,"-",(IOM+1))=""
S DFN(0)=^DPT(DFN,0),DFN(.31)=$S($D(^(.31)):^(.31),1:""),PAGE=1
S FR=FR-.1,TO=TO+.1
S N=FR F K=1:1 S N=$O(^PRPF(470,DFN,3,"AC",N)) D A Q:'%
D OUT Q
A I N="",K=1 G W1
I N'<TO,K=1 G W1
I N'<TO S %=0 Q
I 'N S %=0 Q
S DA=0,%=1 F J=1:1 S DA=$O(^PRPF(470,DFN,3,"AC",N,DA)) Q:'DA S ZDA=DA D B S DA=ZDA I '% K ZDA Q
Q
B S %=1,X="" I $Y>(IOSL-5)!(K=1&(J=1)) R:PAGE>1&('$D(ZTSK)) !,"Press return to continue or '^' to exit:",X:$S($D(DTIME):DTIME,1:60) S:X["^" %=0 Q:'% D HDR S X1=1
S PTRDA=DA,PTRDA(0)=^PRPF(470,DFN,3,DA,0),MADA=+PTRDA(0),MADA(0)=^PRPF(470.1,MADA,0) W:X1>1 ! S X1=2 W !,$P(MADA(0),"^") S X=$P(MADA(0),U,5) D DATE
W ?7,X,?17,$P(MADA(0),U,7),?29,$P(MADA(0),U,8) S X=$P(PTRDA(0),U,3),X=$S($P(MADA(0),"^",8)["D":X,1:-X) W $J(X,9,2),?41,$J($P(PTRDA(0),U,6),8,2)
S X=$P(MADA(0),U,21) D:X]"" DATE W ?54,X,?66,$P(MADA(0),U,10),?71 S X=$P(MADA(0),U,9),DD=470.1,F=8 D ^PRPFU1
W:% Y S DA=MADA_"^"_$P(MADA(0),"^",4,6),DA=$$SUM^PRPFSIG(DA),X=$P(MADA(0),U,15),P=$P(MADA(0),U,14)
W:IOM<81 ! S X=$X W " /ES/"_$$DECODE^PRPFSIG1(MADA),?X+35,$P(MADA(0),"^",16)
S %=1 Q
W1 W *7,!!," No transactions recorded for this Period." H 2 S %=0 Q
HDR W @IOF W "Name: ",@PFHI,$P(DFN(0),"^"),?$X+3 S SSN=$P(DFN(0),"^",9) W @PFLO,"SSN: ",@PFHI,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9)
W @PFLO," Claim #: ",@PFHI,$P(DFN(.31),"^",3),?72,@PFLO,"PAGE: ",@PFHI,PAGE K SSN S PAGE=PAGE+1 W @PFNORM
W !!,"TR # DATE",?17,"REFERENCE D/W AMOUNT BALANCE DEFERRED P/G CA/CK/OTH" W:IOM<81 ! W " SIGNATURE",?$X+20,"REMARKS"
W !,LINE
Q
DATE ;CONVERT DATE TO SLASH FORMAT
I +X<2000000 S X="" Q
S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDST 2383 printed Apr 09, 2024@21:04:49 Page 2
PRPFDST ;ALTOONA/CTB DISPLAY TRANACTIONS ;7/24/97 8:36 AM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
+1 DO ^PRPFSITE
IF %
DO HILO^PRPFBAL
SET PAGE=1
SET DIC=470
SET DIC(0)="AEMNZ"
DO ^DIC
IF Y>0
SET DFN=+Y
DO D
WRITE !!
GOTO V
OUT KILL %,%W,%Y,C,DA,DFN,DIC,DIYS,J,K,LINE,MADA,N,P,PAGE,FR,TO,PFHI,PFLO,PFNORM,POP,PRPF,PRPFQ,PRPFL,PTRDA,S,TMP,X,X1,Y,ZDA
QUIT
D ;;DISPLAY/PRINT PATIENT FUNDS TRANSACTIONS
+1 DO DRNG^PRPFQ
if '%
GOTO OUT
+2 SET ZTRTN="EN1^PRPFDST"
SET (ZTSAVE("FR"),ZTSAVE("TO"),ZTSAVE("PRPF*"),ZTSAVE("DFN"))=""
SET ZTDESC=$PIECE($TEXT(D),";",3)
DO ^PRPFQ
+3 QUIT
EN1 ;DIRECT ENTRY POINT, UN QUEUED
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 SET IOP=PRIOP
SET U="^"
H IF '$DATA(PFHI)!('$DATA(PFLO))!('$DATA(PFNORM))
SET (PFHI,PFLO,PFNORM)="*0"
+1 KILL LINE
SET $PIECE(LINE,"-",(IOM+1))=""
+2 SET DFN(0)=^DPT(DFN,0)
SET DFN(.31)=$SELECT($DATA(^(.31)):^(.31),1:"")
SET PAGE=1
+3 SET FR=FR-.1
SET TO=TO+.1
+4 SET N=FR
FOR K=1:1
SET N=$ORDER(^PRPF(470,DFN,3,"AC",N))
DO A
if '%
QUIT
+5 DO OUT
QUIT
A IF N=""
IF K=1
GOTO W1
+1 IF N'<TO
IF K=1
GOTO W1
+2 IF N'<TO
SET %=0
QUIT
+3 IF 'N
SET %=0
QUIT
+4 SET DA=0
SET %=1
FOR J=1:1
SET DA=$ORDER(^PRPF(470,DFN,3,"AC",N,DA))
if 'DA
QUIT
SET ZDA=DA
DO B
SET DA=ZDA
IF '%
KILL ZDA
QUIT
+5 QUIT
B SET %=1
SET X=""
IF $Y>(IOSL-5)!(K=1&(J=1))
if PAGE>1&('$DATA(ZTSK))
READ !,"Press return to continue or '^' to exit:",X:$SELECT($DATA(DTIME):DTIME,1:60)
if X["^"
SET %=0
if '%
QUIT
DO HDR
SET X1=1
+1 SET PTRDA=DA
SET PTRDA(0)=^PRPF(470,DFN,3,DA,0)
SET MADA=+PTRDA(0)
SET MADA(0)=^PRPF(470.1,MADA,0)
if X1>1
WRITE !
SET X1=2
WRITE !,$PIECE(MADA(0),"^")
SET X=$PIECE(MADA(0),U,5)
DO DATE
+2 WRITE ?7,X,?17,$PIECE(MADA(0),U,7),?29,$PIECE(MADA(0),U,8)
SET X=$PIECE(PTRDA(0),U,3)
SET X=$SELECT($PIECE(MADA(0),"^",8)["D":X,1:-X)
WRITE $JUSTIFY(X,9,2),?41,$JUSTIFY($PIECE(PTRDA(0),U,6),8,2)
+3 SET X=$PIECE(MADA(0),U,21)
if X]""
DO DATE
WRITE ?54,X,?66,$PIECE(MADA(0),U,10),?71
SET X=$PIECE(MADA(0),U,9)
SET DD=470.1
SET F=8
DO ^PRPFU1
+4 if %
WRITE Y
SET DA=MADA_"^"_$PIECE(MADA(0),"^",4,6)
SET DA=$$SUM^PRPFSIG(DA)
SET X=$PIECE(MADA(0),U,15)
SET P=$PIECE(MADA(0),U,14)
+5 if IOM<81
WRITE !
SET X=$X
WRITE " /ES/"_$$DECODE^PRPFSIG1(MADA),?X+35,$PIECE(MADA(0),"^",16)
+6 SET %=1
QUIT
W1 WRITE *7,!!," No transactions recorded for this Period."
HANG 2
SET %=0
QUIT
HDR WRITE @IOF
WRITE "Name: ",@PFHI,$PIECE(DFN(0),"^"),?$X+3
SET SSN=$PIECE(DFN(0),"^",9)
WRITE @PFLO,"SSN: ",@PFHI,$EXTRACT(SSN,1,3),"-",$EXTRACT(SSN,4,5),"-",$EXTRACT(SSN,6,9)
+1 WRITE @PFLO," Claim #: ",@PFHI,$PIECE(DFN(.31),"^",3),?72,@PFLO,"PAGE: ",@PFHI,PAGE
KILL SSN
SET PAGE=PAGE+1
WRITE @PFNORM
+2 WRITE !!,"TR # DATE",?17,"REFERENCE D/W AMOUNT BALANCE DEFERRED P/G CA/CK/OTH"
if IOM<81
WRITE !
WRITE " SIGNATURE",?$X+20,"REMARKS"
+3 WRITE !,LINE
+4 QUIT
DATE ;CONVERT DATE TO SLASH FORMAT
+1 IF +X<2000000
SET X=""
QUIT
+2 SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
QUIT
