source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRAINQ.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1RMPRAINQ ;PHX/JLT/HNB -Print History, Vehicle of Reg. ;1/30/1995
2 ;;3.0;PROSTHETICS;**20,90**;Feb 09, 1996
3 D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
4 S %ZIS="QM" D ^%ZIS G:POP EXIT
5 I $D(IO("Q")) K IO("Q") D
6 .S ZTRTN="DU^RMPRAINQ",ZTDESC="PROSTHETICS INQUIRE TO PATIENT VEHICLE OF RECORD",ZTIO=ION
7 .F RMPRB="RMPRDFN","RMPRNAM","RMPRSSN" S ZTSAVE(RMPRB)=""
8 .D ^%ZTLOAD
9 I $D(ZTSK) G EXIT
10DU ;PRINT AUTO-ADAPTIVE EQUIPMENT, entry point from ??
11 N PAGE,RMPRL,RMPRI,RMPRT,RMPRD,RDAT,RMPRB,FL
12 ;K RMPRBACK
13 S DFN=RMPRDFN D ELIG^VADPT S RMPRCNUM=VAEL(7) K VAEL
14 S PAGE=0,RMPRI=0,$P(RMPRL,"-",IOM)=""
15 U IO D HDR
16 F S RMPRI=$O(^RMPR(667,"C",RMPRDFN,RMPRI)) Q:RMPRI'>0!($D(FL)) D
17 .S RMPRB=^RMPR(667,RMPRI,0)
18 .S RMPRT=$O(^RMPR(667,"B",$P(RMPRB,U,1),0)),RMPRD=$P(^RMPR(667,RMPRT,0),U,3)
19 .;vehicle
20 .I $D(^RMPR(667.3,"C",RMPRT)) D LP Q
21 .;vehicle, no transactions
22 .S RDAT=1 D ONE
23 W:'$D(RDAT) !!,?15,"NO VEHICLE OF RECORD FOR THIS PATIENT",!
24 I IOST["C-" I $Y<IOSL-5 F W ! Q:$Y>IOSL-5
25 I IOST["C-"&('$D(FL)) K DIR S DIR(0)="E" D ^DIR
26 W @IOF
27 ;
28EXIT K DIC,RMPRINFO,RA,RK,RI,FL,DIR,Y,RMPRB D ^%ZISC
29 I $D(RMPRBACK)!($D(RMPRBAC1)) G ASK1^RMPRPAT
30 ;E K RMPRDFN,RMPRNAM,RMPRSSN,RMPRDOB,RMPRCNUM
31 Q
32LP ;find vehicle entries
33 D WR W ! N CNT,RPREV S RK=0,CNT=0,RPREV=0
34 F S RK=$O(^RMPR(667.3,"C",RMPRT,RK)) Q:RK'>0!($D(FL)) D
35 .S RDAT=1 D WR1
36 D TOT
37 Q
38HDR S PAGE=PAGE+1
39 W @IOF,!,"NAME: ",RMPRNAM,?33,"SSN: ",RMPRSSN
40 W ?50,"CLAIM NO. ",RMPRCNUM
41 W !,"VEHICLE ID#",?20,"YEAR",?25,"PURCHASE DATE",?40,"MAKE"
42 W ?51,"MODEL",?70,"PAGE ",PAGE
43 W !,"PROCESS DATE",?15,"ITEM",?40,"QTY",?51,"COST",?62,"AMIS"
44 W ?72,"TYPE",!?30,"'*' Denotes Inactive Vehicle of Record",!,RMPRL
45 Q
46WR I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
47 D:$Y+6>IOSL HDR I $D(^RMPR(667,RMPRT,2)),$P(^(2),U)=0 S RMPRB="*"_RMPRB
48PG ;display auto, no items
49 W !,$E($P(RMPRB,U,1),1,19),?20,$P(RMPRB,U,5)
50 S Y=$P(RMPRB,U,4) D DD^%DT W ?25,Y
51 W:+$P(RMPRB,U,6) ?40,$E(^RMPR(667.2,$P(RMPRB,U,6),0),1,9)
52 W ?51,$E($P(RMPRB,U,7),1,9)
53 I RMPRD S Y=RMPRD D DD^%DT W ?62,"4502: ",Y
54 W ?62,$S($P(RMPRB,U,9)="A":"ANKYLOSIS",$P(RMPRB,U,9)="V":"VOC REHAB",1:"")
55 I $D(^RMPR(667,RMPRT,1,0)) S RA=0 F S RA=$O(^RMPR(667,RMPRT,1,RA)) Q:RA'>0 W !,^(RA,0)
56 Q
57WR1 ;items, or transactions
58 I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
59 I $Y+6>IOSL D HDR,PG W !
60 S RMPRINFO=^RMPR(667.3,RK,0),$P(RMPRINFO,U,15)=+$P(RMPRINFO,U,4)*+$P(RMPRINFO,U,7)
61 S:'$P(RMPRINFO,U,15) $P(RMPRINFO,U,15)=$P(RMPRINFO,U,4)
62 S Y=$P(RMPRINFO,U) D DD^%DT
63 ;print total if process date different
64 I RPREV'=Y&(RPREV'=0) D TOT
65 S RPREV=Y
66 W !,Y
67 W ?15,$S($D(^RMPR(667.1,+$P(RMPRINFO,U,3),0)):$E(^RMPR(667.1,$P(RMPRINFO,U,3),0),1,20),1:"UNK")
68 W ?40,$P(RMPRINFO,U,7),?48
69 W ?48+(10-($L($FN($P(RMPRINFO,U,15),",",2)))),"$",$FN($P(RMPRINFO,U,15),",",2)
70 S CNT=CNT+$P(RMPRINFO,U,15)
71 W ?62,$S($P(RMPRINFO,U,5)["R":"REPAIR",$P(RMPRINFO,U,5)["A":"VAN MOD",$P(RMPRINFO,U,5)["B":"ADAP EQP",1:"")
72 W ?72,$S($P(RMPRINFO,U,8)="I":"INITIAL",$P(RMPRINFO,U,8)="R":"REPLACE",$P(RMPRINFO,U,8)="X":"REPAIR",$P(RMPRINFO,U,8)="S":"SPARE",$P(RMPRINFO,U,8)=5:"RENTAL",1:"")
73 I $D(^RMPR(667.3,RK,1,0)) D
74 .S RA=0
75 .F S RA=$O(^RMPR(667.3,RK,1,RA)) Q:RA'>0 W !,^(RA,0)
76 Q
77TOT Q:$D(FL)
78 W !!?31,"Total/Date:"
79 W ?48+(10-$L($FN(CNT,",",2))),"$",$FN(CNT,",",2),!
80 S CNT=0
81 Q
82ONE ;vehicle, no items.
83 I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
84 D:$Y+6>IOSL HDR
85 I $D(^RMPR(667,RMPRT,2)),$P(^(2),U)=0 S RMPRB="*"_RMPRB
86 W !,$E($P(RMPRB,U,1),1,19),?20,$P(RMPRB,U,5)
87 S Y=$P(RMPRB,U,4) D DD^%DT W ?25,Y
88 W:$P(RMPRB,U,6) ?40,$S($D(^RMPR(667.2,+$P(RMPRB,U,6),0)):$E(^RMPR(667.2,$P(RMPRB,U,6),0),1,9),1:"UNK")
89 W ?51,$E($P(RMPRB,U,7),1,9)
90 I RMPRD S Y=RMPRD D DD^%DT W ?62,"4502: ",Y
91 W ?62,$S($P(RMPRB,U,9)="A":"ANKYLOSIS",$P(RMPRB,U,9)="V":"VOC REHAB",1:"")
92 I $D(^RMPR(667,RMPRT,1,0)) S RA=0 F S RA=$O(^RMPR(667,RMPRT,1,RA)) Q:RA'>0 W !,^(RA,0)
93 W !?15,"NO ITEMS ON THIS VEHICLE OF RECORD",!,RMPRL ;K DIR S DIR(0)="E" D ^DIR Q:$D(DUOUT)!($D(DTOUT)) W @IOF
94 Q
95VOR ;EDIT/DELETE VEHICLE OF RECORD
96 K DIC,DIE,DA,DIK,RMPRA,DR D DIV4^RMPRSIT I $D(X) Q
97VH S DIC=667,DIC(0)="AEQMNZ"
98 S DIC("A")="Please Enter Patient Name or Vehicle ID#: "
99 S DIC("W")="D LK^RMPRAVR"
100 S DIC("S")="I $P(^(0),U,10)=RMPR(""STA"")"
101 I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
102 D ^DIC I +Y'>0 K DIC,Y Q
103 L +^RMPR(667,+Y,0):1
104 I $T=0 W ?5,$C(7),!,"Someone else is Editing this Entry!" K DIC,Y Q
105 S (RMPRDA,DA)=+Y,DR=".01;9STATUS;10;2;2.1;3;4;5;6;7;11;2.2;2.3;I $P(^RMPR(667,DA,2),U,3)'=4 S Y="""";2.4"
106 S DIE=DIC D ^DIE
107 I '$D(DA) S RI=0 F S RI=$O(^RMPR(667.3,"C",RMPRDA,RI)) Q:RI'>0 S DA=RI,DIK="^RMPR(667.3," D ^DIK
108 W ! L -^RMPR(667,RMPRDA,0) K DR,DIE G VH
Note: See TracBrowser for help on using the repository browser.