53 lines
4.1 KiB
Mathematica
53 lines
4.1 KiB
Mathematica
|
RMPRL9 ;PHX/HNB-DISPLAY ITEMS ON 1358 TRANSACTION ;8/29/1994
|
||
|
|
;;3.0;PROSTHETICS;**19,90**;Feb 09, 1996
|
||
|
|
S:'$D(RMPRDELN) RMPRDELN="" S (RMPRI,RMPRCNT)=0,RMPRX="" D HOME^%ZIS W @IOF S:'$D(RMPRSER) RMPRSER=""
|
||
|
|
W ?0,$E($G(^UTILITY("DIQ1",$J,664.1,RMPRDA,.02)),1,30),?40,"WORK ORDER #: ",$G(^UTILITY("DIQ1",$J,664.1,RMPRDA,4))
|
||
|
|
S $P(LINE,"=",IOM)="",RZZZ=0
|
||
|
|
W !,LINE
|
||
|
|
LI F S RMPRI=$O(^RMPR(664,RMPRA,1,RMPRI)) Q:RMPRI'>0!($G(RMPRX)="^") S RMPRCNT=RMPRCNT+1,RMPRI1=^RMPR(664,RMPRA,1,RMPRI,0) D PRT
|
||
|
|
I $G(RMPRX)="^" I $Y<17 F W ! Q:$Y>17
|
||
|
|
I $G(RMPRX)="^" Q
|
||
|
|
W !,?25,"TOTAL COST: ",?65,"$",$J(RZZZ,0,2)
|
||
|
|
I $Y<17 F W ! Q:$Y>17
|
||
|
|
Q
|
||
|
|
PRT I RMPRCNT<0 W !,"NO ITEMS ON FILE" Q
|
||
|
|
W !!?5,"ITEM: "
|
||
|
|
S RMPRIT=$P(RMPRI1,U,1),RMPRIT1=$P(^RMPR(661,RMPRIT,0),U,1)
|
||
|
|
W $P(^PRC(441,RMPRIT1,0),U,1)," ",$P(^(0),U,2)," ",?45,"AMIS: " S RMPRAMIS=$S($P(RMPRI1,U,9)'="X":$P(^RMPR(661,RMPRIT,0),U,3),1:$P(^RMPR(661,RMPRIT,0),U,4))
|
||
|
|
W !!?5,"DESCRIPTION: ",$P(RMPRI1,U,2)
|
||
|
|
W !?5,"SERIAL NUMBER: " S RMPRSER=$S($P(^RMPR(664,RMPRA,1,RMPRI,0),U,15)]"":$P(^(0),U,15),$D(^RMPR(660,+$P(^(0),U,13),0)):$P(^(0),U,11),1:"") W RMPRSER
|
||
|
|
W !?5,"UNIT COST: ",$J($S($P(RMPRI1,U,7):$P(RMPRI1,U,7),1:$P(RMPRI1,U,3)),0,2),?25,"UNIT OF ISSUE: "
|
||
|
|
S RMPRU=$P(RMPRI1,U,5) W:RMPRU'="" $P(^PRCD(420.5,RMPRU,0),U,1),?45,"QTY: ",$P(RMPRI1,U,4),?55,"ITEM COST: "
|
||
|
|
S R1=$S($P(RMPRI1,U,7):$P(RMPRI1,U,7),1:$P(RMPRI1,U,3)),R2=$P(RMPRI1,U,4),RZZZ=RZZZ+(R1*R2) W $J(R1*R2,0,2)
|
||
|
|
W !?5,"TYPE: ",$S($P(RMPRI1,U,9)="X":"REPAIR",$P(RMPRI1,U,9)="I":"INITIAL",$P(RMPRI1,U,9)="R":"REPLACE",$P(RMPRI1,U,9)="S":"SPARE",$P(RMPRI1,U,9)="5":"RENTAL",1:"")
|
||
|
|
W ?25,"CATEGORY: ",$S($P(RMPRI1,U,10)=1:"SC/OP",$P(RMPRI1,U,10)=2:"SC/IP",$P(RMPRI1,U,10)=3:"NSC/IP",$P(RMPRI1,U,10)=4:"NSC/OP",1:"")
|
||
|
|
W ?44,"SPECIAL CATEGORY: "
|
||
|
|
W $S($P(RMPRI1,U,11)=1:"SPEC/LEG",$P(RMPRI1,U,11)=2:"A&A",$P(RMPRI1,U,11)=3:"PHC",$P(RMPRI1,U,11)=4:"ELIG/REF",1:"")
|
||
|
|
ASK I $Y>17 R !!,"Enter '^' to Quit Display, <Return> to Continue : ",RMPRX:DTIME S:'$T RMPRX="^" Q:RMPRX="^"
|
||
|
|
Q
|
||
|
|
C21 ;COMPLETE 2421 REQUEST FROM LAB
|
||
|
|
S RT=$O(^RMPR(664,RMPRA,1,0)) I RT>0,$D(^(RT,0)) S:$G(RMPRCONT)="" RMPRCONT=$P(^(0),U,14)
|
||
|
|
K FL D ^RMPRLI I RMPRX]"" G CHK
|
||
|
|
L2 W !! K DIR S DIR(0)="FO",DIR("A")="Select Item to Edit",DIR("?")="^S ZFL=1 D ZDSP^RMPR21A" D ^DIR G:$D(DTOUT) EXIT G:$D(DIRUT) COT S DIC="^RMPR(661,",DIC(0)="EQMZ" D ^DIC G:+Y'>0 L2
|
||
|
|
D EDT^RMPRUTIL G:$D(DTOUT) EXIT G L2
|
||
|
|
COT S DIE="^RMPR(664,",DR="4",DA=RMPRA D ^DIE I $D(DTOUT)!($D(Y)'=0) G CHK
|
||
|
|
S RMPRV=$P(^RMPR(664,RMPRA,0),U,4) G:'$D(^PRC(440,RMPRV,4)) L2 K DIR S DIR(0)="PO^PRC(440,"_RMPRV_",4,:QEM" S:$G(RMPRCONT)'="" DIR("B")=RMPRCONT D ^DIR I (Y'>0)&(X'="")&(X'["^") G COT
|
||
|
|
I X["^" G CHK
|
||
|
|
I Y>0,$P(^PRC(440,RMPRV,4,+Y,0),U,2)<DT W $C(7),!,"Sorry, contract has expired. Enter another contract or `return` to continue." G COT
|
||
|
|
K DIR,DA S:Y>0 (RMPRCONT,RMPRCTK)=$P(Y,U,2)
|
||
|
|
K DA S DIE="^RMPR(664,",DA=RMPRA,DR="11;17;20" D ^DIE G:$D(Y) CHK G:$D(DTOUT) EXIT
|
||
|
|
K DIR S:$G(RMPRDELN)'="" DIR("B")=RMPRDELN
|
||
|
|
S DIR(0)="SA^1:VETERAN;2:VAMC WAREHOUSE;3:PROSTHETICS;4:OTHER;",DIR("A")="DELIVER TO: "
|
||
|
|
D ^DIR G:$D(DIRUT) CHK G:$D(DTOUT) EXIT
|
||
|
|
S RMPRDELN=Y(0) I Y'=4 S $P(^RMPR(664,RMPRA,3),U)=RMPRDELN K RMPRDLC G CHK
|
||
|
|
S $P(^RMPR(664,RMPRA,3),U)=$S($G(RMPRDLC)'="":RMPRDLC,1:""),DIE="^RMPR(664,",DA=RMPRA,DR="19T" D ^DIE G:$D(DTOUT) EXIT S RMPRDLC=$P(^RMPR(664,RMPRA,3),U)
|
||
|
|
CHK S FL=1 I $D(^RMPR(664,RMPRA,1)) S FL=0 F RI=0:0 S RI=$O(^RMPR(664,RMPRA,1,RI)) Q:RI'>0 I $D(^(RI,0)) S FL=1 I $P(^(0),U,4)=""!($P(^(0),U,5)="")!($P(^(0),U,9)="")!($P(^(0),U,10)="") S FL=0 Q
|
||
|
|
I $P($G(^RMPR(664,RMPRA,3)),U)="" W !!,$C(7),"Deliver To information is Missing!! 2421 is incomplete" G EXIT
|
||
|
|
I 'FL W !!,?5,$C(7),"REQUIRED ITEM INFORMATION IS MISSING",! G EXIT
|
||
|
|
ASK5 S %=2 W !!,"Are you ready to POST to IFCAP and 10-2319 NOW" D YN^DICN G:%=1 FILE^RMPR21B G:$D(DTOUT) EXIT
|
||
|
|
I %=0 W !,"This will Create a Daily Transaction in the 1358 Module of IFCAP,",!,"and Create an Entry on the Prosthetic 10-2319 Record" G ASK5
|
||
|
|
I %'>0 S %=2 R !,"Do you want to delete the 2421 Request" D YN^DICN I $D(DTOUT)!(%=1) D DEL^RMPR29M(RMPRA) G KILL^RMPR21
|
||
|
|
G C21
|
||
|
|
EXIT I '$D(DTOUT) K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do You want to delete the 2421 Request" D ^DIR Q:$D(DTOUT) I +Y=1 D DEL^RMPR29M(RMPRA) G KILL^RMPR21
|
||
|
|
Q
|