[613] | 1 | RMPRAINQ ;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
|
---|
| 10 | DU ;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 | ;
|
---|
| 28 | EXIT 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
|
---|
| 32 | LP ;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
|
---|
| 38 | HDR 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
|
---|
| 46 | WR 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
|
---|
| 48 | PG ;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
|
---|
| 57 | WR1 ;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
|
---|
| 77 | TOT 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
|
---|
| 82 | ONE ;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
|
---|
| 95 | VOR ;EDIT/DELETE VEHICLE OF RECORD
|
---|
| 96 | K DIC,DIE,DA,DIK,RMPRA,DR D DIV4^RMPRSIT I $D(X) Q
|
---|
| 97 | VH 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
|
---|