PRPFDSI1 ;ALTOONA/CTB CONTINUATION OF INFORMATION DISPLAY ;11/22/96 4:37 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
S2 ;SCREEN 2
I IOSL<40 W @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,"Nearest Relative:",?31,"VA Guardian",?56,"Civil Guardian"
W @PFHI F I=1:1:9 I $P(DFN(.29),U,I)]""!($P(DFN(.21),U,I)]"")!($P(DFN(.291),U,I)]"") W !,$E($P(DFN(.21),U,I),1,29),?31,$E($P(DFN(.29),U,I),1,24),?56,$E($P(DFN(.291),U,I),1,24)
W !!,@PFLO,"General Information/Remarks: ",!
I $D(^PRPF(470,DFN,7)),$O(^(7,0))>0 D GI
I $D(^XUSEC("PRPF CLERK",DUZ)) W !,@PFLO,"Special Information: ",! I $D(^PRPF(470,DFN,8)),$O(^(8,0))>0 D SI
W !,@PFLO,"Sources of Income: ",@PFHI S I=$S('$D(^PRPF(470,DFN,6,0)):0,$O(^(0))="":0,1:1) I 'I W "NONE LISTED" G A
W !!,@PFLO,"Source:",?24,"Payee:",?46,"Amount:",?60,"Frequency:"
W @PFHI S N1=0 F J=1:1 S N1=$O(^PRPF(470,DFN,6,N1)) Q:'N1 I $D(^(N1,0)) S Z=^(0) W !,$P(Z,U),?24,$P(Z,U,2),?46 S X=$P(Z,U,3) D C W X,?60 S DD=470.05,F=3,X=$P(Z,U,4) D ^PRPFU1 W Y
A I IOST["C-" W @PFNORM,!!,"Press RETURN to continue or 'B' to BACKUP to previous screen: " R X:DTIME G END:X="",A:X["?",B^PRPFDSI:"Bb"[X
END W @IOF,@PFNORM K %I,%W,%Y,C,DIYS,DFN,DG1,DGT,DGX,DIC,DIW,DIWT,DN,DOA,N,PDFN,Z,TMP Q
GI ;PRINT GENERAL INFORMATION REMARKS
W @PFHI S N=0,DIWF="W",DIWL=5,DIWR=IOM-10 F I=1:1 S N=$O(^PRPF(470,DFN,7,N)) Q:N="" S X=^(N,0) D ^DIWP
D ^DIWW K DIWF,DIWL,DIWR,X W @PFNORM Q
SI ;PRINT SPECIAL INFORMATION
W @PFHI S N=0,DIWF="W",DIWL=5,DIWR=IOM-10 F I=1:1 S N=$O(^PRPF(470,DFN,8,N)) Q:N="" S X=^(N,0) D ^DIWP
D ^DIWW K DIWF,DIWL,DIWR,X W @PFNORM Q
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[HPRPFDSI1 2009 printed Apr 09, 2024@21:04:47 Page 2
PRPFDSI1 ;ALTOONA/CTB CONTINUATION OF INFORMATION DISPLAY ;11/22/96 4:37 PM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
S2 ;SCREEN 2
+1 IF IOSL<40
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
+2 DO DEAD^PRPFED
+3 WRITE !,@PFLO,"Nearest Relative:",?31,"VA Guardian",?56,"Civil Guardian"
+4 WRITE @PFHI
FOR I=1:1:9
IF $PIECE(DFN(.29),U,I)]""!($PIECE(DFN(.21),U,I)]"")!($PIECE(DFN(.291),U,I)]"")
WRITE !,$EXTRACT($PIECE(DFN(.21),U,I),1,29),?31,$EXTRACT($PIECE(DFN(.29),U,I),1,24),?56,$EXTRACT($PIECE(DFN(.291),U,I),1,24)
+5 WRITE !!,@PFLO,"General Information/Remarks: ",!
+6 IF $DATA(^PRPF(470,DFN,7))
IF $ORDER(^(7,0))>0
DO GI
+7 IF $DATA(^XUSEC("PRPF CLERK",DUZ))
WRITE !,@PFLO,"Special Information: ",!
IF $DATA(^PRPF(470,DFN,8))
IF $ORDER(^(8,0))>0
DO SI
+8 WRITE !,@PFLO,"Sources of Income: ",@PFHI
SET I=$SELECT('$DATA(^PRPF(470,DFN,6,0)):0,$ORDER(^(0))="":0,1:1)
IF 'I
WRITE "NONE LISTED"
GOTO A
+9 WRITE !!,@PFLO,"Source:",?24,"Payee:",?46,"Amount:",?60,"Frequency:"
+10 WRITE @PFHI
SET N1=0
FOR J=1:1
SET N1=$ORDER(^PRPF(470,DFN,6,N1))
if 'N1
QUIT
IF $DATA(^(N1,0))
SET Z=^(0)
WRITE !,$PIECE(Z,U),?24,$PIECE(Z,U,2),?46
SET X=$PIECE(Z,U,3)
DO C
WRITE X,?60
SET DD=470.05
SET F=3
SET X=$PIECE(Z,U,4)
DO ^PRPFU1
WRITE Y
A IF IOST["C-"
WRITE @PFNORM,!!,"Press RETURN to continue or 'B' to BACKUP to previous screen: "
READ X:DTIME
if X=""
GOTO END
if X["?"
GOTO A
if "Bb"[X
GOTO B^PRPFDSI
END WRITE @IOF,@PFNORM
KILL %I,%W,%Y,C,DIYS,DFN,DG1,DGT,DGX,DIC,DIW,DIWT,DN,DOA,N,PDFN,Z,TMP
QUIT
GI ;PRINT GENERAL INFORMATION REMARKS
+1 WRITE @PFHI
SET N=0
SET DIWF="W"
SET DIWL=5
SET DIWR=IOM-10
FOR I=1:1
SET N=$ORDER(^PRPF(470,DFN,7,N))
if N=""
QUIT
SET X=^(N,0)
DO ^DIWP
+2 DO ^DIWW
KILL DIWF,DIWL,DIWR,X
WRITE @PFNORM
QUIT
SI ;PRINT SPECIAL INFORMATION
+1 WRITE @PFHI
SET N=0
SET DIWF="W"
SET DIWL=5
SET DIWR=IOM-10
FOR I=1:1
SET N=$ORDER(^PRPF(470,DFN,8,N))
if N=""
QUIT
SET X=^(N,0)
DO ^DIWP
+2 DO ^DIWW
KILL DIWF,DIWL,DIWR,X
WRITE @PFNORM
QUIT
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
