| [613] | 1 | RMPRLI ;PHX/HNB,RVD-DISPLAY ITEMS ON 1358 TRANSACTION ;10/19/1993
|
|---|
| 2 | ;;3.0;PROSTHETICS;**12,19,28,41,90**;Feb 09, 1996
|
|---|
| 3 | ;pass RMPRSSN,RMPRNAM,RMPRA,RMPROB
|
|---|
| 4 | S:'$D(RMPRDELN) RMPRDELN="" S (RMPRI,RMPRCNT)=0,RMPRX="" D HOME^%ZIS W @IOF S:'$D(RMPRSER) RMPRSER=""
|
|---|
| 5 | W !?5,RMPRNAM,?35,$E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,9),?55,RMPROB,!
|
|---|
| 6 | N RBO S RBO=0
|
|---|
| 7 | W !,RMPR("L")
|
|---|
| 8 | LI F S RMPRI=$O(^RMPR(664,RMPRA,1,RMPRI)) Q:RMPRI'>0 D G:$G(RMPRX)["^" EXIT
|
|---|
| 9 | .S RMPRCNT=RMPRCNT+1
|
|---|
| 10 | .S RMPRI1=^RMPR(664,RMPRA,1,RMPRI,0)
|
|---|
| 11 | .D PRT
|
|---|
| 12 | I $D(^RMPR(664,RMPRA,1)) W !!,?25,"SUB TOTAL: ",?65,"$",$J(RBO,7,2)
|
|---|
| 13 | I $D(^RMPR(664,RMPRA,2)),$P(^(2),U,6) S DCT=$P(^(2),U,6),DCT=DCT/100
|
|---|
| 14 | I $D(RMPRF) I ((RMPRF=9)!(RMPRF=2)!(RMPRF="E")),$D(^RMPR(664,RMPRA,1)) D
|
|---|
| 15 | .W !!,?25,"% DISCOUNT: "
|
|---|
| 16 | .Q:'$D(DCT)
|
|---|
| 17 | .W DCT*100
|
|---|
| 18 | .S DCTT=$J(RBO*DCT,7,2)
|
|---|
| 19 | .W ?65,"$",DCTT
|
|---|
| 20 | .S DCTT=$TR(DCTT," ","")
|
|---|
| 21 | .S RBO=RBO-DCTT
|
|---|
| 22 | .K DCT,DCTT
|
|---|
| 23 | W !?25,"SHIPPING CHARGE: "
|
|---|
| 24 | S R2=$S($P(^RMPR(664,RMPRA,0),U,11)]"":$P(^(0),U,11),$P(^(0),U,10):$P(^(0),U,10),1:"") W ?65,"$",$J(R2,7,2) W !
|
|---|
| 25 | W !,?25,"TOTAL COST: ",?65,"$",$J(R2+RBO,7,2)
|
|---|
| 26 | G EXIT
|
|---|
| 27 | PRT I RMPRCNT<0 W !,"NO ITEMS ON FILE" Q
|
|---|
| 28 | W !!?5,"ITEM: "
|
|---|
| 29 | S RMPRIT=$P(RMPRI1,U,1),RMPRIT1=$P(^RMPR(661,RMPRIT,0),U,1)
|
|---|
| 30 | 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))
|
|---|
| 31 | W $S(RMPRAMIS="":"NO CODE FOR THIS ITEM",1:$P(^RMPR(663,RMPRAMIS,0),U,1))
|
|---|
| 32 | S RCPT=$P(^RMPR(664,RMPRA,1,RMPRI,0),U,16)
|
|---|
| 33 | S:RCPT RMPRCPT=$G(^RMPR(661.1,RCPT,0))
|
|---|
| 34 | I $D(RMPRCPT) W !,?5,"PSAS HCPCS CODE: ",$P(RMPRCPT,U,1),?29,$P(RMPRCPT,U,2)
|
|---|
| 35 | W !,?5,"CPT MODIFIER: ",$P($G(^RMPR(664,RMPRA,1,RMPRI,4)),U,2)
|
|---|
| 36 | K RCPT,RMPRCPT
|
|---|
| 37 | I $P(^RMPR(664,RMPRA,1,RMPRI,0),U,8)'="" W !?5,"REMARKS: ",$P(^(0),U,8)
|
|---|
| 38 | I $D(RMPRF),RMPRF=2 W !!?5,"DELIVER TO: ",RMPRDELN
|
|---|
| 39 | W !!?5,"DESCRIPTION: ",$P(RMPRI1,U,2)
|
|---|
| 40 | 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
|
|---|
| 41 | ;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: "
|
|---|
| 42 | W !,?5,"UNIT COST: " S R1=$P(RMPRI1,U,7) S:R1=""!(R1<0) R1=$P(RMPRI1,U,3) W R1,?25,"UNIT OF ISSUE: "
|
|---|
| 43 | 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: "
|
|---|
| 44 | ;S R1=$S($P(RMPRI1,U,7):$P(RMPRI1,U,7),1:$P(RMPRI1,U,3)),R2=$P(RMPRI1,U,4),RBO=RBO+(R1*R2) W $J(R1*R2,0,2)
|
|---|
| 45 | S R2=$P(RMPRI1,U,4)
|
|---|
| 46 | S RBO=RBO+(R1*R2) W $J(R1*R2,0,2)
|
|---|
| 47 | 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:"")
|
|---|
| 48 | 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:"")
|
|---|
| 49 | W ?44,"SPECIAL CATEGORY: "
|
|---|
| 50 | 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:"ELIGIBILITY REFORM",1:"")
|
|---|
| 51 | ASK I $Y>17 R !!,"Enter '^' to Quit Display, <Return> to Continue : ",RMPRX:DTIME S:'$T RMPRX="^" Q:RMPRX="^"
|
|---|
| 52 | W:$Y>17 @IOF
|
|---|
| 53 | Q
|
|---|
| 54 | EXIT K RMPRI1,R1,R2,ON,OFF Q
|
|---|
