Routine: RMPRPIYK

RMPRPIYK ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;2/10/03  08:41

 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 ; RVD - patch #61 - pip phase III

 ;DBIA # 800 - global read of file #440.

 ;DBIA # 801 - global read of 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.5,RMLOC,0)),U,1)

 W !,HL

 K RUNICOST,RTOTCOST

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYK   1430     printed  Apr 23, 2025@18:51:37                                                                                                                                                                                                    Page 2

RMPRPIYK  ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;2/10/03  08:41

 +1       ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 +2       ; RVD - patch #61 - pip phase III

 +3       ;

 +4       ;DBIA # 800 - global read of file #440.

 +5       ;DBIA # 801 - global read of file #441.

 +6       ;

 +7        WRITE @IOF

           SET $PIECE(HL,"=",IOM-1)=""

           WRITE !,HL

 +8        if '$DATA(RMPRHISD)

               WRITE !?31,"***STOCK ISSUE***"

           if $DATA(RMPRHISD)

               WRITE !!?31,"***HISTORICAL DATA***"

           WRITE !!?5,"PATIENT NAME: ",RMPRNAM,?50,"SSN: ",RMPRSSN

 +9        WRITE !!?5,"TYPE OF TRANSACTION: ",$PIECE(R3("D"),U,4),?43,"SOURCE: ",$PIECE(R3("D"),U,14)

 +10       WRITE !!?5,"PATIENT CATEGORY: ",$PIECE(R4("D"),U,3),?43,"SPECIAL CATEGORY: ",$PIECE(R4("D"),U,4)

 +11       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)

 +12       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)

 +13       IF $DATA(R1(2))

               WRITE !!?5,"HCPCS/ITEM: ",$PIECE(R1(2),U,1),"  ",$PIECE(R1(2),U,2)

 +14       if '$DATA(RMLACO)

               SET RMLACO=0

 +15       SET RUNICOST=$PIECE(R1(0),U,16)/$PIECE(R1(0),U,7)

 +16       SET RTOTCOST=$PIECE(R1(0),U,16)+RMLACO

 +17       WRITE !!?5,"QUANTITY: ",$PIECE(R1(0),U,7),?23,"UNIT COST: ",$JUSTIFY(RUNICOST,0,2),?43,"TOTAL COST: ",$JUSTIFY(RTOTCOST,0,2)

 +18       WRITE !!?5,"SERIAL NUMBER: ",$PIECE(R1(0),U,11),?43,"LOT NUMBER: ",$PIECE(R1(0),U,24),!?5,"REMARKS: ",$PIECE(R1(0),U,18)

 +19       WRITE !?5,"DATE OF SERVICE: ",$PIECE($GET(R1("D")),U,8)

 +20       WRITE ?43,"Inventory Location: "

 +21       IF $GET(RMLOC)

               WRITE $PIECE($GET(^RMPR(661.5,RMLOC,0)),U,1)

 +22       WRITE !,HL

 +23       KILL RUNICOST,RTOTCOST

 +24       QUIT

RMPRPIYK.m