source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFCD1.m@ 938

Last change on this file since 938 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1PRPFCD1 ;ALTOONA/CTB EXPANDED HEADER FOR PATIENT FUNDS CARD ;11/22/96 4:34 PM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
3LHDR ;PRINTS THE EXPANDED HEADER FOR THE PATIENT CARD
4 F I=0,.31 S DFN(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
5 D ADD
6 S PDFN(0)=^PRPF(470,DFN,0),PDFN(1)=$S($D(^(1)):^(1),1:""),PDFN(2)=$S($D(^(2)):^(2),1:"")
7 D DGINPW^PRPFU1 W:$Y>1 @IOF
8 I $D(PRPF("ARCHIVE")) D
9 . S X="",$P(X," ",20)=""
10 . W "~~PRPF~~",!,$P(DFN(0),U)_"^"_$P(DFN(.31),U,3)_"^"_$P(DFN(0),"^",9),!
11 . S:$D(PGCOUNT)["0" PGCOUNT=0
12 . S PGCOUNT=PGCOUNT+1
13 . QUIT
14 W "BENEFICIARY: ",?32,"CLAIM #:",?48,"I.D. #",?64,"WARD",?75,"INDIGENT",?88,"DATE OF BIRTH",?105,"DATE OF ADMISSION"
15 W !,$P(DFN(0),U),?32,"C-",$P(DFN(.31),U,3),?48,$P(DFN(0),U,9),?64,$P(DFN(.1),U)
16 S X=$P(PDFN(0),U,5) I X]"" S DD=470,F=4 D ^PRPFU1 W ?78,Y
17 S Y=$P(DFN(0),U,3) D D^PRPFU1 W ?89,Y,?105,DOA
18 W !!,"TYPE OF ACCOUNT",?25,"DATE OF RESTRICTION",?50,"COMPETENCY",?84,"APPORTIONEE",?100,"GUARDIAN",?116,"INST'L AWARD"
19 S X=$P(PDFN(0),U,3),F=2,DD=470 D ^PRPFU1 W !,Y
20 S Y=$P(PDFN(0),U,12) D D^PRPFU1 W ?25,Y
21 S X=$P(PDFN(0),U,4),F=3,DD=470 D ^PRPFU1
22 W ?50,Y,?86,"$",$J($P(PDFN(0),U,6),0,2),?100,"$",$J($P(PDFN(0),U,7),0,2),?118,"$",$J($P(PDFN(0),U,8),0,2)
23 W !!,"PATIENT ADDRESS",?32,"NEAREST RELATIVE",?64,"VA GUARDIAN",?96,"CIVIL GUARDIAN"
24 F I=1:1:9 I $P(DFN(.11),U,I)]""!($P(DFN(.21),U,I)]"")!($P(DFN(.29),U,I)]"")!($P(DFN(.291),U,I)]"") W !,$E($P(DFN(.11),U,I),1,30),?32,$E($P(DFN(.21),U,I),1,30),?64,$E($P(DFN(.29),U,I),1,30),?96,$E($P(DFN(.291),U,I),1,30)
25 W !,LINE
26 G LHDR1^PRPFCD
27 Q
28ADD ;COMPRESS ADDRESS INFO
29 ;COMPRESS VA GUARDIAN ADDRESS
30 K TMP S:$D(^DPT(DFN,.29)) TMP=^(.29) S DFN(.29)="" G:'$D(TMP) ADD1 I $P(TMP,"^",4)="" K TMP G ADD1
31 S DFN(.29)=$P(TMP,"^",4),J=2 F I=6,7 I $P(TMP,"^",I)]"" S $P(DFN(.29),"^",J)=$P(TMP,"^",I) S J=J+1
32 S:$P(TMP,"^",8)]"" $P(DFN(.29),"^",J)=$P(TMP,"^",8)_","
33 I +$P(TMP,"^",9)>0 S $P(DFN(.29),"^",J)=$P(DFN(.29),"^",J)_$P(^DIC(5,$P(TMP,"^",9),0),"^",2)_" "_$P(TMP,"^",10) S J=J+1
34 S:$P(TMP,"^",11)]"" $P(DFN(.29),"^",J)=$P(TMP,"^",11)
35ADD1 ;COMPRESS RELATIVE ADDRESS
36 K TMP S:$D(^DPT(DFN,.21)) TMP=^(.21) S DFN(.21)="" G:'$D(TMP) ADD2 I $P(TMP,"^",1)="" K TMP G ADD2
37 S DFN(.21)=$P(TMP,"^"),J=2 F I=3:1:5 I $P(TMP,"^",I)]"" S $P(DFN(.21),"^",J)=$P(TMP,"^",I),J=J+1
38 S:$P(TMP,"^",6)]"" $P(DFN(.21),"^",J)=$P(TMP,"^",6)_","
39 I +$P(TMP,"^",7)>0 S $P(DFN(.21),"^",J)=$P(DFN(.21),"^",J)_$P(^DIC(5,$P(TMP,"^",7),0),"^",2)_" "_$P(TMP,"^",8),J=J+1
40 S:$P(TMP,"^",9)]"" $P(DFN(.21),"^",J)=$P(TMP,"^",9)
41 K TMP
42ADD2 ;COMPRESS PATIENT ADDRESS
43 K TMP S:$D(^DPT(DFN,.11)) TMP=^(.11) S DFN(.11)="" G:'$D(TMP) ADD3 I $P(TMP,"^",1)="" K TMP G ADD3
44 S J=1 F I=1:1:3 I $P(TMP,"^",I)]"" S $P(DFN(.11),"^",J)=$P(TMP,"^",I),J=J+1
45 S:$P(TMP,"^",4)]"" $P(DFN(.11),"^",J)=$P(TMP,"^",4)_","
46 I +$P(TMP,"^",5)>0 S $P(DFN(.11),"^",J)=$P(DFN(.11),"^",J)_$P(^DIC(5,$P(TMP,"^",5),0),"^",2)_" "_$P(TMP,"^",6),J=J+1
47 I $D(^DPT(DFN,.13)),$P(^(.13),U,1)]"" S $P(DFN(.11),U,J)=$P(^(.13),U)
48ADD3 ;COMPRESS CIVIL GUARDIAN ADDRESS
49 K TMP S:$D(^DPT(DFN,.291)) TMP=^(.291) S DFN(.291)="" Q:'$D(TMP) I $P(TMP,"^",4)="" K TMP,J,I Q
50 S DFN(.291)=$P(TMP,"^",4),J=2 F I=6,7 I $P(TMP,"^",I)]"" S $P(DFN(.291),"^",J)=$P(TMP,"^",I) S J=J+1
51 S:$P(TMP,"^",8)]"" $P(DFN(.291),"^",J)=$P(TMP,"^",8)_","
52 I +$P(TMP,"^",9)>0 S $P(DFN(.291),"^",J)=$P(DFN(.291),"^",J)_$P(^DIC(5,$P(TMP,"^",9),0),"^",2)_" "_$P(TMP,"^",10) S J=J+1
53 S:$P(TMP,"^",11)]"" $P(DFN(.291),"^",J)=$P(TMP,"^",11)
54 K TMP,J,I Q
Note: See TracBrowser for help on using the repository browser.