RMPR31U ;PHX/RFM-FUNCTIONS ;8/29/1994
;;3.0;PROSTHETICS;;Feb 09, 1996
ITM(X) ; Displays external name of an item
; X=Internal number from 661
S X=+X
I '$D(^RMPR(661,X,0)) Q "Item not Found"
S X=$P(^PRC(441,$P(^RMPR(661,X,0),U),0),U,2)
Q X
ITM1(X) ; Display # of an item
; X=Internal number from 661
S X=+X
I '$D(^RMPR(661,X,0)) Q "Item not Found"
S X=$P(^PRC(441,$P(^RMPR(661,X,0),U),0),U,1)
Q X
;
VEN(X) ; Displays external name of a vendor
; X=Internal number of vendor from 440
S X=+X
I '$D(^PRC(440,X,0)) Q "Vendor not found"
S X=$P(^PRC(440,X,0),U)
Q X
;
PAT(X) ; Displays name of Patient
N RX
S RX=X,X=$$NAMESSN^RMPRU(RX)
Q $P(X,U,1)
; X=Patient IEN
;S X=+X
;II'$D(^DPT(X,0)) Q "Patient not found"
;S X=$P(^DPT(X,0),U)
;Q X
;
EMP(X) ; Displays name of employee
; X=Internal number from 200
S X=+X
S X=$S($D(^VA(200,X,0)):$P(^(0),U),1:"")
Q X
;
ITEM(X) ; Displays name of item from 660
; X=IEN of record from 660
S X=+X
I '$D(^RMPR(660,X,0)) Q ""
I '$D(^RMPR(661,+$P(^RMPR(660,X,0),U,6),0)) Q ""
S X=$P(^PRC(441,$P(^RMPR(661,$P(^RMPR(660,X,0),U,6),0),U),0),U,2)
Q X
ITMN(X) ; Displays NUMBER of item from 660
; X=IEN of record from 660
S X=+X
I '$D(^RMPR(660,X,0)) Q ""
I '$D(^RMPR(661,+$P(^RMPR(660,X,0),U,6),0)) Q ""
S X=$P(^PRC(441,$P(^RMPR(661,$P(^RMPR(660,X,0),U,6),0),U),0),U,1)
Q X
SIG(X) ;Displays Printed signature bock from file 200
S X=+X
S X=$S($D(^VA(200,X,20)):$P(^(20),U,2),1:"")
Q X
STA(X) ;Displays Station Name from file Institution File
S X=+X
S X=$S($D(^DIC(4,X,0)):$P(^(0),U),1:"")
Q X
STAN(X) ;Displays Station Number from file Institution File
S X=+X
S X=$S($D(^DIC(4,X,99)):$P(^(99),U),1:"")
Q X
CODE(PZD,TYPE,SRC) ;GET ORTHOTIC OR RESTORATION CODE
;N RAM
I TYPE="X",SRC="R" S AMIS=$S(+$P(RMPRAM,U,2):"134",1:$P($G(^RMPR(663,+$P(PZD,U,8),0)),U,5))_U_$S($D(RMPRGEC):$P($G(^RMPR(663,+$P(PZD,U,8),0)),U),1:+$P(PZD,U,8))
I TYPE="X",SRC'="R" S AMIS=$S(+$P(RMPRAM,U,2):"138",1:$P($G(^RMPR(663,+$P(PZD,U,6),0)),U,5))_U_$S($D(RMPRGEC):$P($G(^RMPR(663,+$P(PZD,U,6),0)),U),1:+$P(PZD,U,6))
I TYPE'="X",SRC'="R" S AMIS=$S(+$P(RMPRAM,U,2):"138",1:$P($G(^RMPR(663,+$P(PZD,U,5),0)),U,5))_U_$S($D(RMPRGEC):$P($G(^RMPR(663,+$P(PZD,U,5),0)),U),1:+$P(PZD,U,5))
I TYPE'="X",SRC="R" S AMIS=$S(+$P(RMPRAM,U,2):"134",1:$P($G(^RMPR(663,+$P(PZD,U,7),0)),U,5))_U_$S($D(RMPRGEC):$P($G(^RMPR(663,+$P(PZD,U,7),0)),U),1:+$P(PZD,U,7))
I '$D(RMPRGEC),$G(RMPRE),RMPRE'=$P(AMIS,U,2) S AMIS=""
Q AMIS
BLD ;BUILD TMP GLOBAL FOR LAB/RESTORATION AMIS
N RI,RA,RT
F RI=132,133,135,136,137 F RT=0:0 S RT=$O(^RMPR(663,"E",RI,RT)) Q:RT'>0 I $D(^RMPR(663,RT,0)) S ^TMP($J,RI_U_$P(^RMPR(663,RT,0),U))="0^0^0^0^0^0^0^0^0"
F RA=134,138 F RI="01","02","03","04","05","06","07","08","09","10" S ^TMP($J,RA_U_RI)="0^0^0^0^0^0^0"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR31U 2866 printed Sep 23, 2025@20:08:44 Page 2
RMPR31U ;PHX/RFM-FUNCTIONS ;8/29/1994
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
ITM(X) ; Displays external name of an item
+1 ; X=Internal number from 661
+2 SET X=+X
+3 IF '$DATA(^RMPR(661,X,0))
QUIT "Item not Found"
+4 SET X=$PIECE(^PRC(441,$PIECE(^RMPR(661,X,0),U),0),U,2)
+5 QUIT X
ITM1(X) ; Display # of an item
+1 ; X=Internal number from 661
+2 SET X=+X
+3 IF '$DATA(^RMPR(661,X,0))
QUIT "Item not Found"
+4 SET X=$PIECE(^PRC(441,$PIECE(^RMPR(661,X,0),U),0),U,1)
+5 QUIT X
+6 ;
VEN(X) ; Displays external name of a vendor
+1 ; X=Internal number of vendor from 440
+2 SET X=+X
+3 IF '$DATA(^PRC(440,X,0))
QUIT "Vendor not found"
+4 SET X=$PIECE(^PRC(440,X,0),U)
+5 QUIT X
+6 ;
PAT(X) ; Displays name of Patient
+1 NEW RX
+2 SET RX=X
SET X=$$NAMESSN^RMPRU(RX)
+3 QUIT $PIECE(X,U,1)
+4 ; X=Patient IEN
+5 ;S X=+X
+6 ;II'$D(^DPT(X,0)) Q "Patient not found"
+7 ;S X=$P(^DPT(X,0),U)
+8 ;Q X
+9 ;
EMP(X) ; Displays name of employee
+1 ; X=Internal number from 200
+2 SET X=+X
+3 SET X=$SELECT($DATA(^VA(200,X,0)):$PIECE(^(0),U),1:"")
+4 QUIT X
+5 ;
ITEM(X) ; Displays name of item from 660
+1 ; X=IEN of record from 660
+2 SET X=+X
+3 IF '$DATA(^RMPR(660,X,0))
QUIT ""
+4 IF '$DATA(^RMPR(661,+$PIECE(^RMPR(660,X,0),U,6),0))
QUIT ""
+5 SET X=$PIECE(^PRC(441,$PIECE(^RMPR(661,$PIECE(^RMPR(660,X,0),U,6),0),U),0),U,2)
+6 QUIT X
ITMN(X) ; Displays NUMBER of item from 660
+1 ; X=IEN of record from 660
+2 SET X=+X
+3 IF '$DATA(^RMPR(660,X,0))
QUIT ""
+4 IF '$DATA(^RMPR(661,+$PIECE(^RMPR(660,X,0),U,6),0))
QUIT ""
+5 SET X=$PIECE(^PRC(441,$PIECE(^RMPR(661,$PIECE(^RMPR(660,X,0),U,6),0),U),0),U,1)
+6 QUIT X
SIG(X) ;Displays Printed signature bock from file 200
+1 SET X=+X
+2 SET X=$SELECT($DATA(^VA(200,X,20)):$PIECE(^(20),U,2),1:"")
+3 QUIT X
STA(X) ;Displays Station Name from file Institution File
+1 SET X=+X
+2 SET X=$SELECT($DATA(^DIC(4,X,0)):$PIECE(^(0),U),1:"")
+3 QUIT X
STAN(X) ;Displays Station Number from file Institution File
+1 SET X=+X
+2 SET X=$SELECT($DATA(^DIC(4,X,99)):$PIECE(^(99),U),1:"")
+3 QUIT X
CODE(PZD,TYPE,SRC) ;GET ORTHOTIC OR RESTORATION CODE
+1 ;N RAM
+2 IF TYPE="X"
IF SRC="R"
SET AMIS=$SELECT(+$PIECE(RMPRAM,U,2):"134",1:$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,8),0)),U,5))_U_$SELECT($DATA(RMPRGEC):$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,8),0)),U),1:+$PIECE(PZD,U,8))
+3 IF TYPE="X"
IF SRC'="R"
SET AMIS=$SELECT(+$PIECE(RMPRAM,U,2):"138",1:$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,6),0)),U,5))_U_$SELECT($DATA(RMPRGEC):$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,6),0)),U),1:+$PIECE(PZD,U,6))
+4 IF TYPE'="X"
IF SRC'="R"
SET AMIS=$SELECT(+$PIECE(RMPRAM,U,2):"138",1:$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,5),0)),U,5))_U_$SELECT($DATA(RMPRGEC):$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,5),0)),U),1:+$PIECE(PZD,U,5))
+5 IF TYPE'="X"
IF SRC="R"
SET AMIS=$SELECT(+$PIECE(RMPRAM,U,2):"134",1:$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,7),0)),U,5))_U_$SELECT($DATA(RMPRGEC):$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,7),0)),U),1:+$PIECE(PZD,U,7))
+6 IF '$DATA(RMPRGEC)
IF $GET(RMPRE)
IF RMPRE'=$PIECE(AMIS,U,2)
SET AMIS=""
+7 QUIT AMIS
BLD ;BUILD TMP GLOBAL FOR LAB/RESTORATION AMIS
+1 NEW RI,RA,RT
+2 FOR RI=132,133,135,136,137
FOR RT=0:0
SET RT=$ORDER(^RMPR(663,"E",RI,RT))
if RT'>0
QUIT
IF $DATA(^RMPR(663,RT,0))
SET ^TMP($JOB,RI_U_$PIECE(^RMPR(663,RT,0),U))="0^0^0^0^0^0^0^0^0"
+3 FOR RA=134,138
FOR RI="01","02","03","04","05","06","07","08","09","10"
SET ^TMP($JOB,RA_U_RI)="0^0^0^0^0^0^0"
+4 QUIT
