58 lines
4.8 KiB
Mathematica
58 lines
4.8 KiB
Mathematica
RMPRAVR ;PHX/JLT-ADD MODIFY REPAIR AUTO ADPT ;8/29/1994
|
|
;;3.0;PROSTHETICS;;Feb 09, 1996
|
|
ENT ;ENTER AUTO-ADAPTIVE TRANSACTION
|
|
L +^RMPR(667,RMPRDA,0):1 I '$T W !,"Someone else is editing this record!" Q
|
|
W ! K DIR,DIC S DIC="^RMPR(667.1,",DIC(0)="AEQZ",DIC("A")="ITEM: ",DIC("W")="I $D(DZ) W:DZ[""?"" $E(^(0),31,70)" D ^DIC G:+Y'>0 EDT
|
|
S RMPRC(3)=+Y
|
|
S Y=RMPRC(5) D DD^%DT S DIR("B")=Y,DIR(0)="667.3,.01" D ^DIR G:$D(DTOUT)!($D(DIRUT)) EDT S RMPRC(5)=Y
|
|
K Y,DA,DIR S DIR(0)="667.3,8",DIR("B")="INITIAL ISSUE" D ^DIR G:$D(DTOUT)!(X["^") EDT S RMPRC(8)=Y
|
|
K Y,DA,DIR S DIR(0)="667.3,9",DIR("B")="SC/OP" D ^DIR G:$D(DTOUT)!(X["^") EDT S RMPRC(9)=Y
|
|
K DIR I $D(RMPRC(9)),RMPRC(9)=4 S DIR(0)="667.3,10" D ^DIR G:$D(DTOUT)!(X["^") EDT S RMPRC(10)=Y
|
|
K DIR,DA,Y S DIR(0)="667.3,11",DIR("B")="COMMERCIAL" D ^DIR G:$D(DTOUT)!(X["^") EDT S RMPRC(11)=Y
|
|
K Y,DA,DIR S DIR(0)="667.3,6" D ^DIR G:$D(DTOUT)!(X["^") EDT S RMPRC(6)=Y
|
|
K Y,DA S DIR(0)="667.3,3" D ^DIR G:$D(DTOUT)!($D(DIRUT)) EDT S RMPRC(4)=Y
|
|
K Y,DA S DIR(0)="667.3,2.5",DIR("B")=1 D ^DIR G:$D(DTOUT)!($D(DIRUT)) EDT S QTY=Y
|
|
FILE I $D(RMPRG) G GGC
|
|
L +^RMPR(669.9,RMPRSITE,0):999 I $T=0 S RMPRG=DT_99 G GGC
|
|
S RMPRG=$P(^RMPR(669.9,RMPRSITE,0),U,7),RMPRG=RMPRG-1,$P(^RMPR(669.9,RMPRSITE,0),U,7)=RMPRG L -^RMPR(669.9,RMPRSITE,0)
|
|
GGC S X=RMPRC(5),DIC(0)="ZL",DIC="^RMPR(667.3,",DLAYGO=667.3 K DD,DO D FILE^DICN I +Y'>0 W !!,$C(7),"RECORD NOT ENTERED SEE YOUR IRM SERVICE" G EXIT
|
|
S RDA=+Y,$P(^RMPR(667.3,RDA,0),U,2)=RMPRDA,$P(^(0),U,3)=RMPRC(3),$P(^(0),U,4)=RMPRC(4),$P(^(0),U,5)=RMPRAM,$P(^(0),U,6)=RMPRC(6),$P(^(0),U,7)=QTY,$P(^(0),U,8)=RMPRC(8),$P(^(0),U,9)=RMPRC(9)
|
|
S $P(^RMPR(667.3,RDA,0),U,11)=RMPRC(11) S:$D(RMPRC(10)) $P(^(0),U,10)=RMPRC(10) S ^(2)=RMPR("STA")_"^"_DUZ,^(3)=RMPRG,DA=RDA,DIK="^RMPR(667.3," D IX1^DIK S RMPRADD=1
|
|
S DA=RDA,DR="5",DIE="^RMPR(667.3," D ^DIE
|
|
K DA,DLAYGO G ENT
|
|
EDT I '$D(RMPRADD) W !!,?5,$C(7),"< NO RECORD ADDED >" G EXIT
|
|
W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to Edit/Delete an item " D ^DIR G:$D(DTOUT)!($D(DIRUT))!(Y=0) EXIT
|
|
LP D DSP G:'$D(RID) EDT
|
|
S DA=+Y,DR=".01;8;9;S:$P(^RMPR(667.3,DA,0),U,9)=""4"" Y=""@5"";10///@;11;2;6;4;3;2.5;5;S Y="""";@5;10;11;2;6;4;3;2.5;5",DIE="^RMPR(667.3," D ^DIE K:'$D(DA) RID(RY) G:$O(RID(0)) EDT
|
|
EXIT K DIR,DIC,DA,Y S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to add an another Item " W ! D ^DIR I +Y=1 G ENT
|
|
L:$D(RMPRDA) -^RMPR(667,RMPRDA,0) W:'$D(RMPRADD) !!,$C(7),"NO ITEMS ADDED TO THIS RECORD",! K RMPRDA,RMPRC,RMPRGO,RMPRADD,DIC,DIR,DIE,RDA,REX,RLF,RID,RMPRITM,RMPRED,RMPREP,RMRPITM,Y,RMPRG,RMPR45,DLAYGO
|
|
D:'$D(DTOUT) LINK^RMPRS K DR,RC,RV,RY,RMPRAM,RMPRDFN,RMPRDOB,RMPRNAM,RMPRSSN,RMPRR,RA,RAC,RB,RD,RE,RF,RK,RLP,QTY Q
|
|
LK ;LOOK UP
|
|
S RA=$P(^RMPR(667,+Y,0),U,2) I +RA W ?40,$E($P(^DPT(RA,0),U,1),1,15),?60,$P(^RMPR(667,+Y,0),U,7) K RAA
|
|
Q
|
|
EIT ;ENTER/EDIT AUTO-ADAPTIVE EQUIPMENT
|
|
S DIC=667.1,DIC(0)="AEQML",DLAYGO=667.1 D ^DIC K DLAYGO I +Y'>0 K DIC Q
|
|
S RMPRA=+Y L +^RMPR(667.1,+Y,0):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry!" K DIC,DA,Y,RMPRA G EIT
|
|
S DA=+Y,DIE="^RMPR(667.1,",DR=".01" D ^DIE L -^RMPR(667.1,RMPRA,0) K DIC,DIE,DA,RMPRA,Y G EIT
|
|
EMN ;ENTER/EDIT VEHICLE MANUFACTURERS
|
|
S DIC=667.2,DIC(0)="AEQML",DLAYGO=667.2 D ^DIC K DLAYGO I +Y'>0 K DIC Q
|
|
S RMPRA=+Y L +^RMPR(667.2,+Y,0):3 I $T=0 W !,?5,$C(7),!,"Someone else is Editing the entry!" K DIC,DA,Y,RMPRA Q
|
|
S DA=+Y,DIE=667.2,DR=".01" D ^DIE L -^RMPR(667.2,RMPRA,0) K DIC,DA,Y,RMPRA G EMN
|
|
DSP ;DISPLAY ITEMS ON VEHICLE OF RECORD ENTRY
|
|
I '$D(^RMPR(667.3,"AD",RMPRDA)) W !!,"No Items for the V.O.R",$C(7) G EXIT
|
|
S RV=0 F RK=0:0 S RK=$O(^RMPR(667.3,"AD",RMPRDA,RK)) Q:RK'>0 F RE=0:0 S RE=$O(^RMPR(667.3,"AD",RMPRDA,RK,RE)) Q:RE'>0 I $D(^RMPR(667.3,RE,0)),$P(^(3),U)=RMPRG S RV=RV+1,RID(RV)=+RE_"^"_^(0)_"^"_$S($D(^(3)):^(3),1:0) D WR
|
|
Q:'$D(RID)
|
|
W ! K DIR S DIR(0)="N",DIR("A")="Please enter Item Number" D ^DIR I $D(DTOUT)!($D(DIRUT)) K RID Q
|
|
I $D(RID(+Y)) S RMPRR=$P(RID(Y),"^",2,13),RY=Y,Y=+RID(+Y) Q
|
|
W $C(7) G DSP
|
|
WR W !,RV W ?10 I $P(RID(RV),U,4),$D(^RMPR(667.1,$P(RID(RV),U,4),0)) W $E($P(^(0),U),1,30) W ?45,"$ ",$P(RID(RV),U,5) W ?60 W $S($P(RID(RV),U,6)["R":"REPAIR",$P(RID(RV),U,6)["A":"VAN MOD",$P(RID(RV),U,6)["B":"ADAP EQP",1:"UNK")
|
|
Q
|
|
DSPR ;DISPLAY REPAIR ITEMS ON VEHICLE OF RECORD
|
|
I '$D(^RMPR(667.3,"AD",RMPRDA)) W !!,"No Items for the V.O.R",$C(7) G EXIT
|
|
I $D(RMPRED) S RV=0,RI=0 F RK=0:0 S RK=$O(^RMPR(667.3,"AD",RMPRDA,RK)) Q:RK'>0 F RE=0:0 S RE=$O(^RMPR(667.3,"AD",RMPRDA,RK,RE)) Q:RE'>0 I $D(^RMPR(667.3,RE,0)) S RV=RV+1,RID(RV)=+RE_"^"_^(0) D WR
|
|
I $D(RMPREP) S RV=0,RI=0 F RK=0:0 S RK=$O(^RMPR(667.3,"AD",RMPRDA,RK)) Q:RK'>0 F RE=0:0 S RE=$O(^RMPR(667.3,"AD",RMPRDA,RK,RE)) Q:RE'>0 I $D(^RMPR(667.3,RE,0)),$P(^(0),U,8)'="X" S RV=RV+1,RID(RV)=+RE_"^"_^(0) D WR
|
|
Q:'$D(RID)
|
|
W ! K DIR S DIR(0)="N",DIR("A")="Please enter Item Number" D ^DIR I $D(DTOUT)!($D(DIRUT)) K RID Q
|
|
I $D(RID(+Y)) S RMPRR=$P(RID(Y),"^",2,13),RY=Y,Y=+RID(+Y) Q
|
|
W $C(7) G DSPR
|