PRPFDSI ;ALTOONA/CTB INFORMATION DISPLAY ;11/22/96 4:36 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
SE D HILO^PRPFBAL S DIC=470,DIC(0)="AEMNZ" D ^DIC I Y>0 S PDFN("ZERO")=Y(0),DFN=+Y S ZTRTN="INFO^PRPFDSI",(ZTSAVE("PDFN*"),ZTSAVE("DFN"))="",ZTDESC="PATIENT FUNDS INFORMATION DISPLAY" D ^PRPFQ G SE
K %,%H,%W,%Y,C,DFN,DIC,DIYS,F,I,J,K,N1,PDFN,PFHI,PFLO,PFNORM,POP,TMP,S,X,X2,Y Q
INFO I $D(ZTSK) S (PFHI,PFLO,PFNORM)="*0" K ^%ZTSK(ZTSK)
F I=0,1 S DFN(I)=$S($D(^PRPF(470,DFN,I)):^(I),1:"")
D EN^PRPFRES K DFN(0),DFN(1)
F I=0,.31 S DFN(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
D ADD^PRPFCD1 F I=1,2 S PDFN(I)=$S($D(^PRPF(470,DFN,I)):^(I),1:"")
B D DGINPW^PRPFU1 W:$Y>1 @IOF W @PFLO,"Name: ",@PFHI,$P(DFN(0),"^"),?44 S SSN=$P(DFN(0),"^",9) W @PFLO,"SSN: ",@PFHI,$E(SSN,1,3),@PFLO,"-",@PFHI,$E(SSN,4,5),@PFLO,"-",@PFHI,$E(SSN,6,9),@PFLO," Claim #: ",@PFHI,$P(DFN(.31),"^",3) K SSN
D DEAD^PRPFED
W !,@PFLO,"Patient Address: " I '$D(DFN(.11)) W @PFHI,"NOT IN FILE"
E W @PFHI F I=1:1:3 W:$P(DFN(.11),"^",I)]"" ?19,$E($P(DFN(.11),"^",I),1,29),?50,$E($P(DFN(.11),"^",I+3),1,29),!
W:$Y<12 ! W !,@PFLO,"Ward: ",@PFHI,$P(DFN(.1),U),?44,@PFLO,"Date of Admission: ",@PFHI,DOA
W !,@PFLO,"Regional Office: ",@PFHI,$S($P(PDFN("ZERO"),U,9)>0:$P(^DIC(4,$P(PDFN("ZERO"),U,9),0),U),1:"") S Y=$P(DFN(0),U,3) D D^PRPFU1 W ?44,@PFLO,"Date of Birth: ",@PFHI,Y
W !!,@PFLO,"Type of Account: ",@PFHI S X=$P(PDFN("ZERO"),U,3),F=2,DD=470 D ^PRPFU1 W Y,?44,@PFLO,"Date of Restriction: " S Y=$P(PDFN("ZERO"),U,12) D D^PRPFU1 W @PFHI,Y
W !,@PFLO,"Amt Restricted/Month: ",@PFHI S X=$P(PDFN(1),"^",7) D C W X,?44,@PFLO,"Amt Restricted/Week: " S X=$P(PDFN(1),"^",8) D C W @PFHI,X
W !,@PFLO,"Monthly Restriction Balance: " S X=$P(PDFN(1),"^",11) D C W @PFHI,X,?44,@PFLO,"Weekly Restriction Balance: " S X=$P(PDFN(1),"^",12) D C W @PFHI,X
W !,@PFLO,"Provider Authorizing Restriction: " S X=$P(PDFN("ZERO"),"^",13),F=10.7,DD=470 D ^PRPFU1 W @PFHI,Y
W !!,@PFLO,"Minimum Balance 1: ",@PFHI S X=$P(PDFN(2),U) D C W X,?44,@PFLO,"Minimum Balance 2: ",@PFHI S X=$P(PDFN(2),U,3) D C W X
W !,@PFLO,"Maximum Balance 2: ",@PFHI S X=$P(PDFN(2),U,2) D C W X,@PFLO,?44,"Maximum Balance 2: ",@PFHI S X=$P(PDFN(2),U,4) D C W X
W !,@PFLO,"Apportionee: ",@PFHI S X=$P(PDFN("ZERO"),U,6) D C W X,?44,@PFLO,"Competency: " S X=$P(PDFN("ZERO"),U,4),F=3,DD=470 D ^PRPFU1 W @PFHI,Y
W !,@PFLO,"Guardian: ",@PFHI S X=$P(PDFN("ZERO"),U,7) D C W X,?44,@PFLO,"Gratuitous Balance: ",@PFHI S X=$P(PDFN(1),U,6) D C W X
W !,@PFLO,"Institutional Award: ",@PFHI S X=$P(PDFN("ZERO"),U,8) D C W X,@PFLO,?44,"Private Balance: ",@PFHI S X=$P(PDFN(1),U,5) D C W X
W !,@PFLO,"Other Assest: ",@PFHI S X=$P(PDFN("ZERO"),U,10) D C W X,@PFLO,?44,"Account Balance: ",@PFHI S X=$P(PDFN(1),U,4) D C W X
W !,@PFLO,"Indigent: ",@PFHI S DD=470,F=4,X=$P(PDFN("ZERO"),U,5) D ^PRPFU1 W Y
I IOST["C-" W @PFNORM,!,"Press RETURN to view next screen or '^' to EXIT: " R X:$S($D(DTIME):DTIME,1:120) G:X["^" END^PRPFDSI1 G ^PRPFDSI1
G ^PRPFDSI1
C S X2="2$"
S %D=X<0 S:%D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23456789,%)
F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99)
S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),0) K %,%D Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDSI 3217 printed Oct 16, 2024@18:02:25 Page 2
PRPFDSI ;ALTOONA/CTB INFORMATION DISPLAY ;11/22/96 4:36 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
SE DO HILO^PRPFBAL
SET DIC=470
SET DIC(0)="AEMNZ"
DO ^DIC
IF Y>0
SET PDFN("ZERO")=Y(0)
SET DFN=+Y
SET ZTRTN="INFO^PRPFDSI"
SET (ZTSAVE("PDFN*"),ZTSAVE("DFN"))=""
SET ZTDESC="PATIENT FUNDS INFORMATION DISPLAY"
DO ^PRPFQ
GOTO SE
+1 KILL %,%H,%W,%Y,C,DFN,DIC,DIYS,F,I,J,K,N1,PDFN,PFHI,PFLO,PFNORM,POP,TMP,S,X,X2,Y
QUIT
INFO IF $DATA(ZTSK)
SET (PFHI,PFLO,PFNORM)="*0"
KILL ^%ZTSK(ZTSK)
+1 FOR I=0,1
SET DFN(I)=$SELECT($DATA(^PRPF(470,DFN,I)):^(I),1:"")
+2 DO EN^PRPFRES
KILL DFN(0),DFN(1)
+3 FOR I=0,.31
SET DFN(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
+4 DO ADD^PRPFCD1
FOR I=1,2
SET PDFN(I)=$SELECT($DATA(^PRPF(470,DFN,I)):^(I),1:"")
B DO DGINPW^PRPFU1
if $Y>1
WRITE @IOF
WRITE @PFLO,"Name: ",@PFHI,$PIECE(DFN(0),"^"),?44
SET SSN=$PIECE(DFN(0),"^",9)
WRITE @PFLO,"SSN: ",@PFHI,$EXTRACT(SSN,1,3),@PFLO,"-",@PFHI,$EXTRACT(SSN,4,5),@PFLO,"-",@PFHI,$EXTRACT(SSN,6,9),@PFLO," Claim #: ",@PFHI,$PIECE(DFN(.31),"^",3)
KILL SSN
+1 DO DEAD^PRPFED
+2 WRITE !,@PFLO,"Patient Address: "
IF '$DATA(DFN(.11))
WRITE @PFHI,"NOT IN FILE"
+3 IF '$TEST
WRITE @PFHI
FOR I=1:1:3
if $PIECE(DFN(.11),"^",I)]""
WRITE ?19,$EXTRACT($PIECE(DFN(.11),"^",I),1,29),?50,$EXTRACT($PIECE(DFN(.11),"^",I+3),1,29),!
+4 if $Y<12
WRITE !
WRITE !,@PFLO,"Ward: ",@PFHI,$PIECE(DFN(.1),U),?44,@PFLO,"Date of Admission: ",@PFHI,DOA
+5 WRITE !,@PFLO,"Regional Office: ",@PFHI,$SELECT($PIECE(PDFN("ZERO"),U,9)>0:$PIECE(^DIC(4,$PIECE(PDFN("ZERO"),U,9),0),U),1:"")
SET Y=$PIECE(DFN(0),U,3)
DO D^PRPFU1
WRITE ?44,@PFLO,"Date of Birth: ",@PFHI,Y
+6 WRITE !!,@PFLO,"Type of Account: ",@PFHI
SET X=$PIECE(PDFN("ZERO"),U,3)
SET F=2
SET DD=470
DO ^PRPFU1
WRITE Y,?44,@PFLO,"Date of Restriction: "
SET Y=$PIECE(PDFN("ZERO"),U,12)
DO D^PRPFU1
WRITE @PFHI,Y
+7 WRITE !,@PFLO,"Amt Restricted/Month: ",@PFHI
SET X=$PIECE(PDFN(1),"^",7)
DO C
WRITE X,?44,@PFLO,"Amt Restricted/Week: "
SET X=$PIECE(PDFN(1),"^",8)
DO C
WRITE @PFHI,X
+8 WRITE !,@PFLO,"Monthly Restriction Balance: "
SET X=$PIECE(PDFN(1),"^",11)
DO C
WRITE @PFHI,X,?44,@PFLO,"Weekly Restriction Balance: "
SET X=$PIECE(PDFN(1),"^",12)
DO C
WRITE @PFHI,X
+9 WRITE !,@PFLO,"Provider Authorizing Restriction: "
SET X=$PIECE(PDFN("ZERO"),"^",13)
SET F=10.7
SET DD=470
DO ^PRPFU1
WRITE @PFHI,Y
+10 WRITE !!,@PFLO,"Minimum Balance 1: ",@PFHI
SET X=$PIECE(PDFN(2),U)
DO C
WRITE X,?44,@PFLO,"Minimum Balance 2: ",@PFHI
SET X=$PIECE(PDFN(2),U,3)
DO C
WRITE X
+11 WRITE !,@PFLO,"Maximum Balance 2: ",@PFHI
SET X=$PIECE(PDFN(2),U,2)
DO C
WRITE X,@PFLO,?44,"Maximum Balance 2: ",@PFHI
SET X=$PIECE(PDFN(2),U,4)
DO C
WRITE X
+12 WRITE !,@PFLO,"Apportionee: ",@PFHI
SET X=$PIECE(PDFN("ZERO"),U,6)
DO C
WRITE X,?44,@PFLO,"Competency: "
SET X=$PIECE(PDFN("ZERO"),U,4)
SET F=3
SET DD=470
DO ^PRPFU1
WRITE @PFHI,Y
+13 WRITE !,@PFLO,"Guardian: ",@PFHI
SET X=$PIECE(PDFN("ZERO"),U,7)
DO C
WRITE X,?44,@PFLO,"Gratuitous Balance: ",@PFHI
SET X=$PIECE(PDFN(1),U,6)
DO C
WRITE X
+14 WRITE !,@PFLO,"Institutional Award: ",@PFHI
SET X=$PIECE(PDFN("ZERO"),U,8)
DO C
WRITE X,@PFLO,?44,"Private Balance: ",@PFHI
SET X=$PIECE(PDFN(1),U,5)
DO C
WRITE X
+15 WRITE !,@PFLO,"Other Assest: ",@PFHI
SET X=$PIECE(PDFN("ZERO"),U,10)
DO C
WRITE X,@PFLO,?44,"Account Balance: ",@PFHI
SET X=$PIECE(PDFN(1),U,4)
DO C
WRITE X
+16 WRITE !,@PFLO,"Indigent: ",@PFHI
SET DD=470
SET F=4
SET X=$PIECE(PDFN("ZERO"),U,5)
DO ^PRPFU1
WRITE Y
+17 IF IOST["C-"
WRITE @PFNORM,!,"Press RETURN to view next screen or '^' to EXIT: "
READ X:$SELECT($DATA(DTIME):DTIME,1:120)
if X["^"
GOTO END^PRPFDSI1
GOTO ^PRPFDSI1
+18 GOTO ^PRPFDSI1
C SET X2="2$"
+1 SET %D=X<0
if %D
SET X=-X
SET %=$SELECT($DATA(X2):+X2,1:2)
SET X=$JUSTIFY(X,1,%)
SET %=$LENGTH(X)-3-$EXTRACT(23456789,%)
+2 FOR %=%:-3
if $EXTRACT(X,%)=""
QUIT
SET X=$EXTRACT(X,1,%)_","_$EXTRACT(X,%+1,99)
+3 if $DATA(X2)
SET X=$EXTRACT("$",X2["$")_X
SET X=$JUSTIFY($EXTRACT("(",%D)_X_$EXTRACT(" )",%D+1),0)
KILL %,%D
QUIT
