Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRAINQ

RMPRAINQ.m

Go to the documentation of this file.
RMPRAINQ ;PHX/JLT/HNB  -Print History, Vehicle of Reg. ;1/30/1995
 ;;3.0;PROSTHETICS;**20,90**;Feb 09, 1996
 D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
 S %ZIS="QM" D ^%ZIS G:POP EXIT
 I $D(IO("Q")) K IO("Q") D
 .S ZTRTN="DU^RMPRAINQ",ZTDESC="PROSTHETICS INQUIRE TO PATIENT VEHICLE OF RECORD",ZTIO=ION
 .F RMPRB="RMPRDFN","RMPRNAM","RMPRSSN" S ZTSAVE(RMPRB)=""
 .D ^%ZTLOAD
 I $D(ZTSK) G EXIT
DU ;PRINT AUTO-ADAPTIVE EQUIPMENT, entry point from ??
 N PAGE,RMPRL,RMPRI,RMPRT,RMPRD,RDAT,RMPRB,FL
 ;K RMPRBACK
 S DFN=RMPRDFN D ELIG^VADPT S RMPRCNUM=VAEL(7) K VAEL
 S PAGE=0,RMPRI=0,$P(RMPRL,"-",IOM)=""
 U IO D HDR
 F  S RMPRI=$O(^RMPR(667,"C",RMPRDFN,RMPRI)) Q:RMPRI'>0!($D(FL))  D
 .S RMPRB=^RMPR(667,RMPRI,0)
 .S RMPRT=$O(^RMPR(667,"B",$P(RMPRB,U,1),0)),RMPRD=$P(^RMPR(667,RMPRT,0),U,3)
 .;vehicle
 .I $D(^RMPR(667.3,"C",RMPRT)) D LP Q
 .;vehicle, no transactions
 .S RDAT=1 D ONE
 W:'$D(RDAT) !!,?15,"NO VEHICLE OF RECORD FOR THIS PATIENT",!
 I IOST["C-" I $Y<IOSL-5 F  W ! Q:$Y>IOSL-5 
 I IOST["C-"&('$D(FL)) K DIR S DIR(0)="E" D ^DIR
 W @IOF
 ;
EXIT K DIC,RMPRINFO,RA,RK,RI,FL,DIR,Y,RMPRB D ^%ZISC
 I $D(RMPRBACK)!($D(RMPRBAC1)) G ASK1^RMPRPAT
 ;E  K RMPRDFN,RMPRNAM,RMPRSSN,RMPRDOB,RMPRCNUM
 Q
LP ;find vehicle entries
 D WR W ! N CNT,RPREV S RK=0,CNT=0,RPREV=0
 F  S RK=$O(^RMPR(667.3,"C",RMPRT,RK)) Q:RK'>0!($D(FL))  D
 .S RDAT=1 D WR1
 D TOT
 Q
HDR S PAGE=PAGE+1
 W @IOF,!,"NAME: ",RMPRNAM,?33,"SSN: ",RMPRSSN
 W ?50,"CLAIM NO. ",RMPRCNUM
 W !,"VEHICLE ID#",?20,"YEAR",?25,"PURCHASE DATE",?40,"MAKE"
 W ?51,"MODEL",?70,"PAGE ",PAGE
 W !,"PROCESS DATE",?15,"ITEM",?40,"QTY",?51,"COST",?62,"AMIS"
 W ?72,"TYPE",!?30,"'*' Denotes Inactive Vehicle of Record",!,RMPRL
 Q
WR I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
 D:$Y+6>IOSL HDR I $D(^RMPR(667,RMPRT,2)),$P(^(2),U)=0 S RMPRB="*"_RMPRB
PG ;display auto, no items
 W !,$E($P(RMPRB,U,1),1,19),?20,$P(RMPRB,U,5)
 S Y=$P(RMPRB,U,4) D DD^%DT W ?25,Y
 W:+$P(RMPRB,U,6) ?40,$E(^RMPR(667.2,$P(RMPRB,U,6),0),1,9)
 W ?51,$E($P(RMPRB,U,7),1,9)
 I RMPRD S Y=RMPRD D DD^%DT W ?62,"4502: ",Y
 W ?62,$S($P(RMPRB,U,9)="A":"ANKYLOSIS",$P(RMPRB,U,9)="V":"VOC REHAB",1:"")
 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)
 Q
WR1 ;items, or transactions
 I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
 I $Y+6>IOSL D HDR,PG W !
 S RMPRINFO=^RMPR(667.3,RK,0),$P(RMPRINFO,U,15)=+$P(RMPRINFO,U,4)*+$P(RMPRINFO,U,7)
 S:'$P(RMPRINFO,U,15) $P(RMPRINFO,U,15)=$P(RMPRINFO,U,4)
 S Y=$P(RMPRINFO,U) D DD^%DT
 ;print total if process date different
 I RPREV'=Y&(RPREV'=0) D TOT
 S RPREV=Y
 W !,Y
 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")
 W ?40,$P(RMPRINFO,U,7),?48
 W ?48+(10-($L($FN($P(RMPRINFO,U,15),",",2)))),"$",$FN($P(RMPRINFO,U,15),",",2)
 S CNT=CNT+$P(RMPRINFO,U,15)
 W ?62,$S($P(RMPRINFO,U,5)["R":"REPAIR",$P(RMPRINFO,U,5)["A":"VAN MOD",$P(RMPRINFO,U,5)["B":"ADAP EQP",1:"")
 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:"")
 I $D(^RMPR(667.3,RK,1,0)) D
 .S RA=0
 .F  S RA=$O(^RMPR(667.3,RK,1,RA)) Q:RA'>0  W !,^(RA,0)
 Q
TOT Q:$D(FL)
 W !!?31,"Total/Date:"
 W ?48+(10-$L($FN(CNT,",",2))),"$",$FN(CNT,",",2),!
 S CNT=0
 Q
ONE ;vehicle, no items.
 I IOST["C-"&($Y+6>IOSL) S DIR(0)="E" D ^DIR I 'Y S FL=1 Q
 D:$Y+6>IOSL HDR
 I $D(^RMPR(667,RMPRT,2)),$P(^(2),U)=0 S RMPRB="*"_RMPRB
 W !,$E($P(RMPRB,U,1),1,19),?20,$P(RMPRB,U,5)
 S Y=$P(RMPRB,U,4) D DD^%DT W ?25,Y
 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")
 W ?51,$E($P(RMPRB,U,7),1,9)
 I RMPRD S Y=RMPRD D DD^%DT W ?62,"4502: ",Y
 W ?62,$S($P(RMPRB,U,9)="A":"ANKYLOSIS",$P(RMPRB,U,9)="V":"VOC REHAB",1:"")
 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)
 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
 Q
VOR ;EDIT/DELETE VEHICLE OF RECORD
 K DIC,DIE,DA,DIK,RMPRA,DR D DIV4^RMPRSIT I $D(X) Q
VH S DIC=667,DIC(0)="AEQMNZ"
 S DIC("A")="Please Enter Patient Name or Vehicle ID#: "
 S DIC("W")="D LK^RMPRAVR"
 S DIC("S")="I $P(^(0),U,10)=RMPR(""STA"")"
 I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
 D ^DIC I +Y'>0 K DIC,Y Q
 L +^RMPR(667,+Y,0):1
 I $T=0 W ?5,$C(7),!,"Someone else is Editing this Entry!" K DIC,Y Q
 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"
 S DIE=DIC D ^DIE
 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
 W ! L -^RMPR(667,RMPRDA,0) K DR,DIE G VH