RMPRST2 ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;3/8/05 08:07
;;3.0;PROSTHETICS;**12,28,33,41,53,61**;Feb 09, 1996
; DBIA #800 - Read Access to file 440.
; DBIA #801 - Read Access to file 441.
;
W @IOF S $P(HL,"=",IOM-1)="" W !,HL
W:'$D(RMPRHISD) !?31,"***STOCK ISSUE***" W:$D(RMPRHISD) !!?31,"***HISTORICAL DATA***" W !!?5,"PATIENT NAME: ",RMPRNAM,?50,"SSN: ",RMPRSSN
W !!?5,"TYPE OF TRANSACTION: ",$P(R3("D"),U,4),?43,"SOURCE: ",$P(R3("D"),U,14)
W !!?5,"PATIENT CATEGORY: ",$P(R4("D"),U,3),?43,"SPECIAL CATEGORY: ",$P(R4("D"),U,4)
W !!?5,"ITEM: ",$E($P(^PRC(441,$P(^RMPR(661,$P(R1(0),U,6),0),U,1),0),U,2),1,30),?43,"VENDOR: " I +$P(R1(0),U,9) W $E($P(^PRC(440,+$P(R1(0),U,9),0),U,1),1,29)
I $D(R1(1)),$P(R1(1),U,4)>0 W !!?5,"PSAS HCPCS: ",$P(^RMPR(661.1,$P(R1(1),U,4),0),U,1)," ",$P(^(0),U,2),!!?5,"CPT MODIFIER: ",$P(R1(1),U,6)
I $D(R1(2)) W !!?5,"HCPCS/ITEM: ",$P(R1(2),U,1)," ",$P(R1(2),U,2)
S:'$D(RMLACO) RMLACO=0
S RUNICOST=$P(R1(0),U,16)/$P(R1(0),U,7)
S RTOTCOST=$P(R1(0),U,16)+RMLACO
W !!?5,"QUANTITY: ",$P(R1(0),U,7),?23,"UNIT COST: ",$J(RUNICOST,0,2),?43,"TOTAL COST: ",$J(RTOTCOST,0,2)
W !!?5,"SERIAL NUMBER: ",$P(R1(0),U,11),?43,"LOT NUMBER: ",$P(R1(0),U,24),!?5,"REMARKS: ",$P(R1(0),U,18)
W !?5,"DATE OF SERVICE: ",$P($G(R1("D")),U,8)
W ?43,"Inventory Location: "
;I $G(RMLOC) W $P($G(^RMPR(661.3,RMLOC,0)),U,1)
I $G(RMLOC) W $P($G(^RMPR(661.5,RMLOC,0)),U,1)
W !,HL
K RUNICOST,RTOTCOST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRST2 1451 printed Sep 23, 2025@20:14:01 Page 2
RMPRST2 ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;3/8/05 08:07
+1 ;;3.0;PROSTHETICS;**12,28,33,41,53,61**;Feb 09, 1996
+2 ; DBIA #800 - Read Access to file 440.
+3 ; DBIA #801 - Read Access to file 441.
+4 ;
+5 WRITE @IOF
SET $PIECE(HL,"=",IOM-1)=""
WRITE !,HL
+6 if '$DATA(RMPRHISD)
WRITE !?31,"***STOCK ISSUE***"
if $DATA(RMPRHISD)
WRITE !!?31,"***HISTORICAL DATA***"
WRITE !!?5,"PATIENT NAME: ",RMPRNAM,?50,"SSN: ",RMPRSSN
+7 WRITE !!?5,"TYPE OF TRANSACTION: ",$PIECE(R3("D"),U,4),?43,"SOURCE: ",$PIECE(R3("D"),U,14)
+8 WRITE !!?5,"PATIENT CATEGORY: ",$PIECE(R4("D"),U,3),?43,"SPECIAL CATEGORY: ",$PIECE(R4("D"),U,4)
+9 WRITE !!?5,"ITEM: ",$EXTRACT($PIECE(^PRC(441,$PIECE(^RMPR(661,$PIECE(R1(0),U,6),0),U,1),0),U,2),1,30),?43,"VENDOR: "
IF +$PIECE(R1(0),U,9)
WRITE $EXTRACT($PIECE(^PRC(440,+$PIECE(R1(0),U,9),0),U,1),1,29)
+10 IF $DATA(R1(1))
IF $PIECE(R1(1),U,4)>0
WRITE !!?5,"PSAS HCPCS: ",$PIECE(^RMPR(661.1,$PIECE(R1(1),U,4),0),U,1)," ",$PIECE(^(0),U,2),!!?5,"CPT MODIFIER: ",$PIECE(R1(1),U,6)
+11 IF $DATA(R1(2))
WRITE !!?5,"HCPCS/ITEM: ",$PIECE(R1(2),U,1)," ",$PIECE(R1(2),U,2)
+12 if '$DATA(RMLACO)
SET RMLACO=0
+13 SET RUNICOST=$PIECE(R1(0),U,16)/$PIECE(R1(0),U,7)
+14 SET RTOTCOST=$PIECE(R1(0),U,16)+RMLACO
+15 WRITE !!?5,"QUANTITY: ",$PIECE(R1(0),U,7),?23,"UNIT COST: ",$JUSTIFY(RUNICOST,0,2),?43,"TOTAL COST: ",$JUSTIFY(RTOTCOST,0,2)
+16 WRITE !!?5,"SERIAL NUMBER: ",$PIECE(R1(0),U,11),?43,"LOT NUMBER: ",$PIECE(R1(0),U,24),!?5,"REMARKS: ",$PIECE(R1(0),U,18)
+17 WRITE !?5,"DATE OF SERVICE: ",$PIECE($GET(R1("D")),U,8)
+18 WRITE ?43,"Inventory Location: "
+19 ;I $G(RMLOC) W $P($G(^RMPR(661.3,RMLOC,0)),U,1)
+20 IF $GET(RMLOC)
WRITE $PIECE($GET(^RMPR(661.5,RMLOC,0)),U,1)
+21 WRITE !,HL
+22 KILL RUNICOST,RTOTCOST
+23 QUIT
