RMPR5HQ5 ;HCIOFO/ODJ - INVENTORY REPORT - BUILD ^TMP SORT ARRAY ; 20 SEP 00
;;3.0;PROSTHETICS;**51,61,127**;Feb 09, 1996
;
;RVD -patch #61 - modified to read the new PIP files; 661.11, 661.6
; 661.7, 661.9
Q
;
; Start of Report build and print. Enter here after report params.
; entered by user (see RMPR5HQ4).
; Also called by TaskMan if report queued.
;
; Variables required
;
; RMPR("STA")
; RMPRSDT
; RMPREDT
; RMPRDET
; RMPRSEL
; {IO vars}
;
REPORT I $E(IOST)["C" W !!,"Processing report......."
D GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPR("STA")) ;generate ^TMP sort array
D CALC^RMPR5HQ6 ;calculations
U IO D ^RMPR5HQ2 ;print report
D ^%ZISC
;K ^TMP($J,"RMPR5") ;make live after testing
N RMPR,RMPRSITE D KILL^XUSCLEAN
Q
;
; Entry point for national roll-up
NATION N RMPRSEL,RMPRDET,RMPRSTN,RMPRSDT,RMPREDT,X,RSTN
S RMPRSTN="*"
S RMPRDET="H"
;D NOW^%DTC S RMPREDT=X S %H=%H-30 D YMD^%DTC S RMPRSDT=X
S RMPRSDT=RMPRPIP1,RMPREDT=RMPRPIP2
S RMPRSEL("*")=""
D GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPRSTN)
D CALC^RMPR5HQ6 ;put calcs in TMP array
D MAIL^RMPR5HQ7 ;build ^TMP($J,"RMPR5A" array for mailing
Q
;
;
; Generate temporary index global ^TMP($J,"RMPR5"
; (as of 11/29/00 we use the 660 file, not 661.2)
;
GEN(STDT,ENDT,DETAIL,RMPRSEL,RMPRSTN) ;
N TNAM,FROM,EOF,DAT,HCDAT,HCPCIEN,NPGRP,NPLIN,S,HCPC,HCPCITEM
N OUPIEN,ITEM,ALLGRP,HCPCREF,SELECTED,STATION,QTY,STR,MULITEM
N ITMIEN,INVDT,SOURCE,ISCOST,PATIENT,COST
S TNAM="RMPR5" ;TMP global name
K ^TMP($J,TNAM)
D CURVAL(TNAM,RMPRSTN,.RMPRSEL,DETAIL)
;S FROM="" S:$G(STDT)'="*" FROM=STDT-1
S RSTN=RMPRSTN
S:RMPRSTN="*" RSTN=0
S EOF=0,ENDT=ENDT+1
F RSTN=RSTN:0 S RSTN=$O(^RMPR(661.6,"XSTD",RSTN)) Q:RSTN'>0 D
.F RSDT=STDT:0 S RSDT=$O(^RMPR(661.6,"XSTD",RSTN,3,RSDT)) Q:(RSDT>ENDT)!(RSDT="") D Q:EOF
.. S OUPIEN=0
.. F S OUPIEN=$O(^RMPR(661.6,"XSTD",RSTN,3,RSDT,OUPIEN)) Q:OUPIEN'>0 D
... S S=$G(^RMPR(661.6,OUPIEN,0))
... S PATIENT=$P(S,"^",2) Q:PATIENT=""
... S QTY=+$P(S,"^",5) Q:QTY<1
... S HCPC=$P(S,"^",1) Q:HCPC=""
... S HCPCIEN=$O(^RMPR(661.1,"B",HCPC,0)) Q:HCPCIEN=""
... S STATION=RSTN Q:STATION=""
... I RMPRSTN'="*",STATION'=RSTN Q
... Q:'$D(^TMP($J,TNAM,"Z",HCPCIEN))
... Q:$P(^TMP($J,TNAM,"Z",HCPCIEN),"^",3)=1
... S HCPCITEM=HCPC_"-"_$P(S,"^",11)
... S ITEM=$P(HCPCITEM,"-",2)
... S:ITEM="" ITEM="?"
... S ISCOST=$P(S,"^",6)
...; S COST=$$PRECOST(OUPIEN,HCPCIEN,HCPCITEM,STATION)
...; I COST'="" S ISCOST=COST-ISCOST
...; S:COST="" ISCOST=QTY*$P(S,"^",5)
... S R11=$O(^RMPR(661.11,"C",HCPCITEM,0))
... S R11DAT=$G(^RMPR(661.11,R11,0))
... S SOURCE=$P(R11DAT,"^",5)
... S STR=^TMP($J,TNAM,"Z",HCPCIEN)
... S NPGRP=$P(STR,"^",1)
... S NPLIN=$P(STR,"^",2)
... S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN
... I '$D(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)) D Q:'+QTY
.... S:+QTY ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)=""
.... Q
... S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM,OUPIEN)=QTY_"^"_ISCOST_"^"_SOURCE
... Q
.. Q
Q
;
; Get total cost of item just prior to current issue
PRECOST(INVIEN,HCPCIEN,HCPCITEM,STATION) ;
N IEN,COST,STR,LOC
S COST=""
S IEN=INVIEN,RD=RMPRSDT
S RD=$O(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD),-1)
Q:'$G(RD) COST S RIEN=$O(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD,0))
S STR=^RMPR(661.9,RIEN,0)
S COST=$P(STR,"^",9)
Q COST
;
; Get QOH for HCPC
CURVAL(RMPRNAM,RMPRSTN,RMPRSEL,DETAIL) ;
N INVIEN,STR,IEN1,IEN2,LOCN,HCPCIEN,HCDAT,NPLIN,NPGRP,ALLGRP,SELECTED
N S,SOURCE,STATION,QOH,COST,HCPC,HCPCREF,ITEM,RSTN
S ALLGRP=0 S:$O(RMPRSEL(""))="*" ALLGRP=1
S RSTN=RMPRSTN
S:RMPRSTN="*" RSTN=0
F RSTN=RSTN:0 S RSTN=$O(^RMPR(661.9,"ASHID",RSTN)) Q:RSTN'>0 D
.S RH=""
.F S RH=$O(^RMPR(661.9,"ASHID",RSTN,RH)) Q:RH="" D
.. S IEN1=0
.. F S IEN1=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1)) Q:'+IEN1 D
... S HCPCIEN=$O(^RMPR(661.1,"B",RH,0)) Q:HCPCIEN=""
... I '$D(^TMP($J,RMPRNAM,"Z",HCPCIEN)) D
.... S S=^RMPR(661.1,HCPCIEN,0)
.... S NPLIN=$P(S,"^",7)
.... S:NPLIN="" NPLIN="999 X"
.... S NPGRP=$P(NPLIN," ",1) ;group num. is 1st set of digits of new line
.... S STR=NPGRP
.... S $P(STR,"^",2)=NPLIN
.... S ^TMP($J,RMPRNAM,"Z",HCPCIEN)=STR
.... Q
... E D Q:$P(S,"^",3)=1
.... S S=^TMP($J,RMPRNAM,"Z",HCPCIEN)
.... S NPGRP=$P(S,"^",1)
.... S NPLIN=$P(S,"^",2)
.... Q
... ;
... ; Test if record matches selection criteria
... ; (only needed if not all groups selected)
... I 'ALLGRP D I 'SELECTED S $P(^TMP($J,RMPRNAM,"Z",HCPCIEN),"^",3)=1 Q
.... S SELECTED=0
.... I '$D(RMPRSEL(NPGRP)) Q
.... I DETAIL="G" S SELECTED=1 Q
.... I $O(RMPRSEL(NPGRP,""))="*" S SELECTED=1 Q
.... I '$D(RMPRSEL(NPGRP,NPLIN)) Q
.... I DETAIL="L" S SELECTED=1 Q
.... I $O(RMPRSEL(NPGRP,NPLIN,""))="*" S SELECTED=1 Q
.... I '$D(RMPRSEL(NPGRP,NPLIN,HCPCIEN)) Q
.... S SELECTED=1
.... Q
... S RD=ENDT+1
... S RD=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD),-1) Q:RD="" S RIEN=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD,""),-1) D
.... S HCPC=RH,S=^RMPR(661.9,RIEN,0)
.... S QOH=+$P(S,"^",8) Q:'QOH
.... S COST=$P(S,"^",9)
.... S ITEM=IEN1
.... S RS=$O(^RMPR(661.11,"C",HCPC_"-"_ITEM,0)) Q:RS=""
.... S SOURCE=$P($G(^RMPR(661.11,RS,0)),U,5)
.... S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN
.... S S=$G(^TMP($J,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM))
.... I SOURCE="C" D
..... S $P(S,"^",9)=QOH+$P(S,"^",9)
..... S $P(S,"^",11)=COST+$P(S,"^",11)
..... Q
.... E D
..... S $P(S,"^",8)=QOH+$P(S,"^",8)
..... S $P(S,"^",10)=COST+$P(S,"^",10)
..... Q
.... S ^TMP($J,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM)=S
.... Q
... Q
.. Q
Q
;
; return item text string given HCPC and ITEM IENs to 661.11
; if null ITEMIEN passed the just return the HCPC short name text
GETITEM(HCPCIEN,ITEMIEN) ;
N STR,ITEMTXT
S ITEMTXT=""
I ITEMIEN="" D G GETITEMX
. S STR=$G(^RMPR(661.1,HCPCIEN,0))
. S ITEMTXT=$P(STR,"^",2)
. Q
S HCPC=$P($G(^RMPR(661.1,HCPCIEN,0)),U,1)
S STR=$G(^RMPR(661.11,"C",HCPC_"-"_ITEMIEN,0))
I STR="" D
. S ITEMTXT=$P(^RMPR(661.1,HCPCIEN,0),"^",2)
. Q
E D
. S ITEMTXT=$P(STR,"^",1)
. Q
S:ITEMTXT="" ITEMTXT="ITEM "_ITEMIEN
GETITEMX Q ITEMTXT
;
; return NPPD line text from line code (New lines only)
NPLIN(CODE) ;
N I,S,LINTXT
S LINTXT=""
F I=1:1 S S=$P($T(DES+I^RMPRN62),";;",2) Q:$E(S,1,3)="END" D Q:LINTXT'=""
. I $P(S,";",1)=CODE S LINTXT=$P(S,";",2)
. Q
Q LINTXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR5HQ5 6521 printed Dec 13, 2024@02:33 Page 2
RMPR5HQ5 ;HCIOFO/ODJ - INVENTORY REPORT - BUILD ^TMP SORT ARRAY ; 20 SEP 00
+1 ;;3.0;PROSTHETICS;**51,61,127**;Feb 09, 1996
+2 ;
+3 ;RVD -patch #61 - modified to read the new PIP files; 661.11, 661.6
+4 ; 661.7, 661.9
+5 QUIT
+6 ;
+7 ; Start of Report build and print. Enter here after report params.
+8 ; entered by user (see RMPR5HQ4).
+9 ; Also called by TaskMan if report queued.
+10 ;
+11 ; Variables required
+12 ;
+13 ; RMPR("STA")
+14 ; RMPRSDT
+15 ; RMPREDT
+16 ; RMPRDET
+17 ; RMPRSEL
+18 ; {IO vars}
+19 ;
REPORT IF $EXTRACT(IOST)["C"
WRITE !!,"Processing report......."
+1 ;generate ^TMP sort array
DO GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPR("STA"))
+2 ;calculations
DO CALC^RMPR5HQ6
+3 ;print report
USE IO
DO ^RMPR5HQ2
+4 DO ^%ZISC
+5 ;K ^TMP($J,"RMPR5") ;make live after testing
+6 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
+7 QUIT
+8 ;
+9 ; Entry point for national roll-up
NATION NEW RMPRSEL,RMPRDET,RMPRSTN,RMPRSDT,RMPREDT,X,RSTN
+1 SET RMPRSTN="*"
+2 SET RMPRDET="H"
+3 ;D NOW^%DTC S RMPREDT=X S %H=%H-30 D YMD^%DTC S RMPRSDT=X
+4 SET RMPRSDT=RMPRPIP1
SET RMPREDT=RMPRPIP2
+5 SET RMPRSEL("*")=""
+6 DO GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPRSTN)
+7 ;put calcs in TMP array
DO CALC^RMPR5HQ6
+8 ;build ^TMP($J,"RMPR5A" array for mailing
DO MAIL^RMPR5HQ7
+9 QUIT
+10 ;
+11 ;
+12 ; Generate temporary index global ^TMP($J,"RMPR5"
+13 ; (as of 11/29/00 we use the 660 file, not 661.2)
+14 ;
GEN(STDT,ENDT,DETAIL,RMPRSEL,RMPRSTN) ;
+1 NEW TNAM,FROM,EOF,DAT,HCDAT,HCPCIEN,NPGRP,NPLIN,S,HCPC,HCPCITEM
+2 NEW OUPIEN,ITEM,ALLGRP,HCPCREF,SELECTED,STATION,QTY,STR,MULITEM
+3 NEW ITMIEN,INVDT,SOURCE,ISCOST,PATIENT,COST
+4 ;TMP global name
SET TNAM="RMPR5"
+5 KILL ^TMP($JOB,TNAM)
+6 DO CURVAL(TNAM,RMPRSTN,.RMPRSEL,DETAIL)
+7 ;S FROM="" S:$G(STDT)'="*" FROM=STDT-1
+8 SET RSTN=RMPRSTN
+9 if RMPRSTN="*"
SET RSTN=0
+10 SET EOF=0
SET ENDT=ENDT+1
+11 FOR RSTN=RSTN:0
SET RSTN=$ORDER(^RMPR(661.6,"XSTD",RSTN))
if RSTN'>0
QUIT
Begin DoDot:1
+12 FOR RSDT=STDT:0
SET RSDT=$ORDER(^RMPR(661.6,"XSTD",RSTN,3,RSDT))
if (RSDT>ENDT)!(RSDT="")
QUIT
Begin DoDot:2
+13 SET OUPIEN=0
+14 FOR
SET OUPIEN=$ORDER(^RMPR(661.6,"XSTD",RSTN,3,RSDT,OUPIEN))
if OUPIEN'>0
QUIT
Begin DoDot:3
+15 SET S=$GET(^RMPR(661.6,OUPIEN,0))
+16 SET PATIENT=$PIECE(S,"^",2)
if PATIENT=""
QUIT
+17 SET QTY=+$PIECE(S,"^",5)
if QTY<1
QUIT
+18 SET HCPC=$PIECE(S,"^",1)
if HCPC=""
QUIT
+19 SET HCPCIEN=$ORDER(^RMPR(661.1,"B",HCPC,0))
if HCPCIEN=""
QUIT
+20 SET STATION=RSTN
if STATION=""
QUIT
+21 IF RMPRSTN'="*"
IF STATION'=RSTN
QUIT
+22 if '$DATA(^TMP($JOB,TNAM,"Z",HCPCIEN))
QUIT
+23 if $PIECE(^TMP($JOB,TNAM,"Z",HCPCIEN),"^",3)=1
QUIT
+24 SET HCPCITEM=HCPC_"-"_$PIECE(S,"^",11)
+25 SET ITEM=$PIECE(HCPCITEM,"-",2)
+26 if ITEM=""
SET ITEM="?"
+27 SET ISCOST=$PIECE(S,"^",6)
+28 ; S COST=$$PRECOST(OUPIEN,HCPCIEN,HCPCITEM,STATION)
+29 ; I COST'="" S ISCOST=COST-ISCOST
+30 ; S:COST="" ISCOST=QTY*$P(S,"^",5)
+31 SET R11=$ORDER(^RMPR(661.11,"C",HCPCITEM,0))
+32 SET R11DAT=$GET(^RMPR(661.11,R11,0))
+33 SET SOURCE=$PIECE(R11DAT,"^",5)
+34 SET STR=^TMP($JOB,TNAM,"Z",HCPCIEN)
+35 SET NPGRP=$PIECE(STR,"^",1)
+36 SET NPLIN=$PIECE(STR,"^",2)
+37 SET HCPCREF=HCPC
SET $PIECE(HCPCREF,"/",2)=HCPCIEN
+38 IF '$DATA(^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM))
Begin DoDot:4
+39 if +QTY
SET ^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)=""
+40 QUIT
End DoDot:4
if '+QTY
QUIT
+41 SET ^TMP($JOB,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM,OUPIEN)=QTY_"^"_ISCOST_"^"_SOURCE
+42 QUIT
End DoDot:3
+43 QUIT
End DoDot:2
if EOF
QUIT
End DoDot:1
+44 QUIT
+45 ;
+46 ; Get total cost of item just prior to current issue
PRECOST(INVIEN,HCPCIEN,HCPCITEM,STATION) ;
+1 NEW IEN,COST,STR,LOC
+2 SET COST=""
+3 SET IEN=INVIEN
SET RD=RMPRSDT
+4 SET RD=$ORDER(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD),-1)
+5 if '$GET(RD)
QUIT COST
SET RIEN=$ORDER(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD,0))
+6 SET STR=^RMPR(661.9,RIEN,0)
+7 SET COST=$PIECE(STR,"^",9)
+8 QUIT COST
+9 ;
+10 ; Get QOH for HCPC
CURVAL(RMPRNAM,RMPRSTN,RMPRSEL,DETAIL) ;
+1 NEW INVIEN,STR,IEN1,IEN2,LOCN,HCPCIEN,HCDAT,NPLIN,NPGRP,ALLGRP,SELECTED
+2 NEW S,SOURCE,STATION,QOH,COST,HCPC,HCPCREF,ITEM,RSTN
+3 SET ALLGRP=0
if $ORDER(RMPRSEL(""))="*"
SET ALLGRP=1
+4 SET RSTN=RMPRSTN
+5 if RMPRSTN="*"
SET RSTN=0
+6 FOR RSTN=RSTN:0
SET RSTN=$ORDER(^RMPR(661.9,"ASHID",RSTN))
if RSTN'>0
QUIT
Begin DoDot:1
+7 SET RH=""
+8 FOR
SET RH=$ORDER(^RMPR(661.9,"ASHID",RSTN,RH))
if RH=""
QUIT
Begin DoDot:2
+9 SET IEN1=0
+10 FOR
SET IEN1=$ORDER(^RMPR(661.9,"ASHID",RSTN,RH,IEN1))
if '+IEN1
QUIT
Begin DoDot:3
+11 SET HCPCIEN=$ORDER(^RMPR(661.1,"B",RH,0))
if HCPCIEN=""
QUIT
+12 IF '$DATA(^TMP($JOB,RMPRNAM,"Z",HCPCIEN))
Begin DoDot:4
+13 SET S=^RMPR(661.1,HCPCIEN,0)
+14 SET NPLIN=$PIECE(S,"^",7)
+15 if NPLIN=""
SET NPLIN="999 X"
+16 ;group num. is 1st set of digits of new line
SET NPGRP=$PIECE(NPLIN," ",1)
+17 SET STR=NPGRP
+18 SET $PIECE(STR,"^",2)=NPLIN
+19 SET ^TMP($JOB,RMPRNAM,"Z",HCPCIEN)=STR
+20 QUIT
End DoDot:4
+21 IF '$TEST
Begin DoDot:4
+22 SET S=^TMP($JOB,RMPRNAM,"Z",HCPCIEN)
+23 SET NPGRP=$PIECE(S,"^",1)
+24 SET NPLIN=$PIECE(S,"^",2)
+25 QUIT
End DoDot:4
if $PIECE(S,"^",3)=1
QUIT
+26 ;
+27 ; Test if record matches selection criteria
+28 ; (only needed if not all groups selected)
+29 IF 'ALLGRP
Begin DoDot:4
+30 SET SELECTED=0
+31 IF '$DATA(RMPRSEL(NPGRP))
QUIT
+32 IF DETAIL="G"
SET SELECTED=1
QUIT
+33 IF $ORDER(RMPRSEL(NPGRP,""))="*"
SET SELECTED=1
QUIT
+34 IF '$DATA(RMPRSEL(NPGRP,NPLIN))
QUIT
+35 IF DETAIL="L"
SET SELECTED=1
QUIT
+36 IF $ORDER(RMPRSEL(NPGRP,NPLIN,""))="*"
SET SELECTED=1
QUIT
+37 IF '$DATA(RMPRSEL(NPGRP,NPLIN,HCPCIEN))
QUIT
+38 SET SELECTED=1
+39 QUIT
End DoDot:4
IF 'SELECTED
SET $PIECE(^TMP($JOB,RMPRNAM,"Z",HCPCIEN),"^",3)=1
QUIT
+40 SET RD=ENDT+1
+41 SET RD=$ORDER(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD),-1)
if RD=""
QUIT
SET RIEN=$ORDER(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD,""),-1)
Begin DoDot:4
+42 SET HCPC=RH
SET S=^RMPR(661.9,RIEN,0)
+43 SET QOH=+$PIECE(S,"^",8)
if 'QOH
QUIT
+44 SET COST=$PIECE(S,"^",9)
+45 SET ITEM=IEN1
+46 SET RS=$ORDER(^RMPR(661.11,"C",HCPC_"-"_ITEM,0))
if RS=""
QUIT
+47 SET SOURCE=$PIECE($GET(^RMPR(661.11,RS,0)),U,5)
+48 SET HCPCREF=HCPC
SET $PIECE(HCPCREF,"/",2)=HCPCIEN
+49 SET S=$GET(^TMP($JOB,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM))
+50 IF SOURCE="C"
Begin DoDot:5
+51 SET $PIECE(S,"^",9)=QOH+$PIECE(S,"^",9)
+52 SET $PIECE(S,"^",11)=COST+$PIECE(S,"^",11)
+53 QUIT
End DoDot:5
+54 IF '$TEST
Begin DoDot:5
+55 SET $PIECE(S,"^",8)=QOH+$PIECE(S,"^",8)
+56 SET $PIECE(S,"^",10)=COST+$PIECE(S,"^",10)
+57 QUIT
End DoDot:5
+58 SET ^TMP($JOB,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM)=S
+59 QUIT
End DoDot:4
+60 QUIT
End DoDot:3
+61 QUIT
End DoDot:2
End DoDot:1
+62 QUIT
+63 ;
+64 ; return item text string given HCPC and ITEM IENs to 661.11
+65 ; if null ITEMIEN passed the just return the HCPC short name text
GETITEM(HCPCIEN,ITEMIEN) ;
+1 NEW STR,ITEMTXT
+2 SET ITEMTXT=""
+3 IF ITEMIEN=""
Begin DoDot:1
+4 SET STR=$GET(^RMPR(661.1,HCPCIEN,0))
+5 SET ITEMTXT=$PIECE(STR,"^",2)
+6 QUIT
End DoDot:1
GOTO GETITEMX
+7 SET HCPC=$PIECE($GET(^RMPR(661.1,HCPCIEN,0)),U,1)
+8 SET STR=$GET(^RMPR(661.11,"C",HCPC_"-"_ITEMIEN,0))
+9 IF STR=""
Begin DoDot:1
+10 SET ITEMTXT=$PIECE(^RMPR(661.1,HCPCIEN,0),"^",2)
+11 QUIT
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET ITEMTXT=$PIECE(STR,"^",1)
+14 QUIT
End DoDot:1
+15 if ITEMTXT=""
SET ITEMTXT="ITEM "_ITEMIEN
GETITEMX QUIT ITEMTXT
+1 ;
+2 ; return NPPD line text from line code (New lines only)
NPLIN(CODE) ;
+1 NEW I,S,LINTXT
+2 SET LINTXT=""
+3 FOR I=1:1
SET S=$PIECE($TEXT(DES+I^RMPRN62),";;",2)
if $EXTRACT(S,1,3)="END"
QUIT
Begin DoDot:1
+4 IF $PIECE(S,";",1)=CODE
SET LINTXT=$PIECE(S,";",2)
+5 QUIT
End DoDot:1
if LINTXT'=""
QUIT
+6 QUIT LINTXT
