- 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 23, 2025@18:16:07 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
