RMPRPIX7 ;HINCIO/ODJ - PIP CURRENT INVENTORY FILE 661.7 APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; CRE - create a new 661.7 record
CRE(RMPR617,RMPR6111) ;
N RMPRFDA,RMPRFME,RMPRRET,RMPRIENA,X,Y,DA
S RMPRRET=0
S RMPRFDA(661.7,"+1,",.01)=RMPR6111("HCPCS")
S RMPRFDA(661.7,"+1,",1)=RMPR617("DATE&TIME")
S RMPRFDA(661.7,"+1,",2)=RMPR617("SEQUENCE")
S RMPRFDA(661.7,"+1,",6)=RMPR617("QUANTITY")
S RMPRFDA(661.7,"+1,",7)=RMPR617("VALUE")
S RMPRFDA(661.7,"+1,",3)=RMPR6111("ITEM")
S RMPRFDA(661.7,"+1,",4)=RMPR6111("STATION")
S RMPRFDA(661.7,"+1,",5)=RMPR617("LOCATION")
S RMPRFDA(661.7,"+1,",8)=$G(RMPR617("UNIT"))
D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
I $D(RMPRFME) S RMPRRET=1
CREX Q RMPRRET
;
; UPD - Update existing record
UPD(RMPR617,RMPR6111) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
S RMPRERR=0
I $G(RMPR617("IEN"))="" S RMPRERR=1 G UPDX
I $D(RMPR617("QUANTITY")),RMPR617("QUANTITY")<1 S DA=RMPR617("IEN"),DIK="^RMPR(661.7," D ^DIK G UPDX
S RMPRIEN=RMPR617("IEN")_","
S:$D(RMPR6111("HCPCS")) RMPRFDA(661.7,RMPRIEN,.01)=RMPR6111("HCPCS")
S:$D(RMPR617("DATE&TIME")) RMPRFDA(661.7,RMPRIEN,1)=RMPR617("DATE&TIME")
S:$D(RMPR617("SEQUENCE")) RMPRFDA(661.7,RMPRIEN,2)=RMPR617("SEQUENCE")
S:$D(RMPR617("QUANTITY")) RMPRFDA(661.7,RMPRIEN,6)=RMPR617("QUANTITY")
S:$D(RMPR617("VALUE")) RMPRFDA(661.7,RMPRIEN,7)=RMPR617("VALUE")
S:$D(RMPR6111("ITEM")) RMPRFDA(661.7,RMPRIEN,3)=RMPR6111("ITEM")
S:$D(RMPR6111("STATION")) RMPRFDA(661.7,RMPRIEN,4)=RMPR6111("STATION")
S:$D(RMPR617("LOCATION")) RMPRFDA(661.7,RMPRIEN,5)=RMPR617("LOCATION")
S:$G(RMPR617("UNIT")) RMPRFDA(661.7,RMPRIEN,8)=RMPR617("UNIT")
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
UPDX Q RMPRERR
;
; DEL - Delete a record
DEL(RMPR617) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
S RMPRERR=0
I $G(RMPR617("IEN"))="" S RMPRERR=1 G UPDX
S RMPRIEN=RMPR617("IEN")_","
S RMPRFDA(661.7,RMPRIEN,.01)="@"
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
DELX Q RMPRERR
;
; GET - read in a 661.7 record
GET(RMPR) ;
N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
S RMPRRET=0
I $G(RMPR("IEN"))="" D
. I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
. I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
. S RMPRKEY("HCPCS")=RMPR("HCPCS")
. S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
. S RMPRERR=$$NEXT^RMPRPIXE(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
. I RMPRERR S RMPRRET=3 Q
. Q:'$D(RMPRKEY("SEQUENCE"))
. I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
. S RMPR("IEN")=RMPRKEY("IEN")
. Q
I RMPRRET G GETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.7,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRRET=5 G GETX
S RMPR("HCPCS")=RMPROUP(661.7,RMPRIEN,.01)
S RMPR("DATE&TIME")=RMPROUP(661.7,RMPRIEN,1)
S RMPR("SEQUENCE")=RMPROUP(661.7,RMPRIEN,2)
S RMPR("QUANTITY")=RMPROUP(661.7,RMPRIEN,6)
S RMPR("VALUE")=RMPROUP(661.7,RMPRIEN,7)
S RMPR("ITEM")=RMPROUP(661.7,RMPRIEN,3)
S RMPR("STATION")=RMPROUP(661.7,RMPRIEN,4)
S RMPR("LOCATION")=RMPROUP(661.7,RMPRIEN,5)
S RMPR("UNIT")=RMPROUP(661.7,RMPRIEN,8)
GETX Q RMPRRET
;
; ETOI - Convert external 661.7 record to internal form
ETOI(RMPRE,RMPRI) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPRE("IEN")_","
D GETS^DIQ(661.7,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G ETOIX
S RMPRI("IEN")=RMPRE("IEN")
S RMPRI("HCPCS")=RMPRFDI(661.7,RMPRIEN,.01,"I")
S RMPRI("DATE&TIME")=RMPRFDI(661.7,RMPRIEN,1,"I")
S RMPRI("ITEM")=RMPRFDI(661.7,RMPRIEN,3,"I")
S RMPRI("SEQUENCE")=RMPRFDI(661.7,RMPRIEN,2,"I")
S RMPRI("STATION")=RMPRFDI(661.7,RMPRIEN,4,"I")
S RMPRI("LOCATION")=RMPRFDI(661.7,RMPRIEN,5,"I")
S RMPRI("UNIT")=RMPRFDI(661.7,RMPRIEN,8,"I")
S RMPRI("QUANTITY")=RMPRFDI(661.7,RMPRIEN,6,"I")
S RMPRI("VALUE")=RMPRFDI(661.7,RMPRIEN,7,"I")
ETOIX Q RMPRERR
;
; RMUBA - read 661.7 records for total balance.
BAL(RMPR11) ;
N I,J,K,RS,RL,RH,RI,RD,RMB7,RM7
S RMUB=0
S RS=RMPR11("STATION")
S RL=RMPR11("LOCATION")
S RH=RMPR11("HCPCS")
S RI=RMPR11("ITEM")
F RD=0:0 S RD=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD)) Q:RD'>0 F I=0:0 S I=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD,1,I)) Q:I'>0 D
.Q:I'>0
.Q:'$D(^RMPR(661.7,I,0))
.S RM7=^RMPR(661.7,I,0)
.S RMB7=$P(RM7,U,7)
.S RMUB=RMUB+RMB7
Q RMUB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX7 4343 printed Dec 13, 2024@02:36:38 Page 2
RMPRPIX7 ;HINCIO/ODJ - PIP CURRENT INVENTORY FILE 661.7 APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; CRE - create a new 661.7 record
CRE(RMPR617,RMPR6111) ;
+1 NEW RMPRFDA,RMPRFME,RMPRRET,RMPRIENA,X,Y,DA
+2 SET RMPRRET=0
+3 SET RMPRFDA(661.7,"+1,",.01)=RMPR6111("HCPCS")
+4 SET RMPRFDA(661.7,"+1,",1)=RMPR617("DATE&TIME")
+5 SET RMPRFDA(661.7,"+1,",2)=RMPR617("SEQUENCE")
+6 SET RMPRFDA(661.7,"+1,",6)=RMPR617("QUANTITY")
+7 SET RMPRFDA(661.7,"+1,",7)=RMPR617("VALUE")
+8 SET RMPRFDA(661.7,"+1,",3)=RMPR6111("ITEM")
+9 SET RMPRFDA(661.7,"+1,",4)=RMPR6111("STATION")
+10 SET RMPRFDA(661.7,"+1,",5)=RMPR617("LOCATION")
+11 SET RMPRFDA(661.7,"+1,",8)=$GET(RMPR617("UNIT"))
+12 DO UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
+13 IF $DATA(RMPRFME)
SET RMPRRET=1
CREX QUIT RMPRRET
+1 ;
+2 ; UPD - Update existing record
UPD(RMPR617,RMPR6111) ;
+1 NEW RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR617("IEN"))=""
SET RMPRERR=1
GOTO UPDX
+4 IF $DATA(RMPR617("QUANTITY"))
IF RMPR617("QUANTITY")<1
SET DA=RMPR617("IEN")
SET DIK="^RMPR(661.7,"
DO ^DIK
GOTO UPDX
+5 SET RMPRIEN=RMPR617("IEN")_","
+6 if $DATA(RMPR6111("HCPCS"))
SET RMPRFDA(661.7,RMPRIEN,.01)=RMPR6111("HCPCS")
+7 if $DATA(RMPR617("DATE&TIME"))
SET RMPRFDA(661.7,RMPRIEN,1)=RMPR617("DATE&TIME")
+8 if $DATA(RMPR617("SEQUENCE"))
SET RMPRFDA(661.7,RMPRIEN,2)=RMPR617("SEQUENCE")
+9 if $DATA(RMPR617("QUANTITY"))
SET RMPRFDA(661.7,RMPRIEN,6)=RMPR617("QUANTITY")
+10 if $DATA(RMPR617("VALUE"))
SET RMPRFDA(661.7,RMPRIEN,7)=RMPR617("VALUE")
+11 if $DATA(RMPR6111("ITEM"))
SET RMPRFDA(661.7,RMPRIEN,3)=RMPR6111("ITEM")
+12 if $DATA(RMPR6111("STATION"))
SET RMPRFDA(661.7,RMPRIEN,4)=RMPR6111("STATION")
+13 if $DATA(RMPR617("LOCATION"))
SET RMPRFDA(661.7,RMPRIEN,5)=RMPR617("LOCATION")
+14 if $GET(RMPR617("UNIT"))
SET RMPRFDA(661.7,RMPRIEN,8)=RMPR617("UNIT")
+15 DO FILE^DIE("","RMPRFDA","RMPRFME")
+16 IF $DATA(RMPRFME)
SET RMPRERR=1
UPDX QUIT RMPRERR
+1 ;
+2 ; DEL - Delete a record
DEL(RMPR617) ;
+1 NEW RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR617("IEN"))=""
SET RMPRERR=1
GOTO UPDX
+4 SET RMPRIEN=RMPR617("IEN")_","
+5 SET RMPRFDA(661.7,RMPRIEN,.01)="@"
+6 DO FILE^DIE("","RMPRFDA","RMPRFME")
+7 IF $DATA(RMPRFME)
SET RMPRERR=1
DELX QUIT RMPRERR
+1 ;
+2 ; GET - read in a 661.7 record
GET(RMPR) ;
+1 NEW RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
+2 SET RMPRRET=0
+3 IF $GET(RMPR("IEN"))=""
Begin DoDot:1
+4 IF $GET(RMPR("HCPCS"))=""
SET RMPRRET=1
QUIT
+5 IF $GET(RMPR("DATE&TIME"))=""
SET RMPRRET=2
QUIT
+6 SET RMPRKEY("HCPCS")=RMPR("HCPCS")
+7 SET RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
+8 SET RMPRERR=$$NEXT^RMPRPIXE(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
+9 IF RMPRERR
SET RMPRRET=3
QUIT
+10 if '$DATA(RMPRKEY("SEQUENCE"))
QUIT
+11 IF RMPRKEY("SEQUENCE")'=1
SET RMPRRET=4
QUIT
+12 SET RMPR("IEN")=RMPRKEY("IEN")
+13 QUIT
End DoDot:1
+14 IF RMPRRET
GOTO GETX
+15 SET RMPRIEN=RMPR("IEN")_","
+16 DO GETS^DIQ(661.7,RMPRIEN,"*","","RMPROUP","RMPRFME")
+17 IF $DATA(RMPRFME)
SET RMPRRET=5
GOTO GETX
+18 SET RMPR("HCPCS")=RMPROUP(661.7,RMPRIEN,.01)
+19 SET RMPR("DATE&TIME")=RMPROUP(661.7,RMPRIEN,1)
+20 SET RMPR("SEQUENCE")=RMPROUP(661.7,RMPRIEN,2)
+21 SET RMPR("QUANTITY")=RMPROUP(661.7,RMPRIEN,6)
+22 SET RMPR("VALUE")=RMPROUP(661.7,RMPRIEN,7)
+23 SET RMPR("ITEM")=RMPROUP(661.7,RMPRIEN,3)
+24 SET RMPR("STATION")=RMPROUP(661.7,RMPRIEN,4)
+25 SET RMPR("LOCATION")=RMPROUP(661.7,RMPRIEN,5)
+26 SET RMPR("UNIT")=RMPROUP(661.7,RMPRIEN,8)
GETX QUIT RMPRRET
+1 ;
+2 ; ETOI - Convert external 661.7 record to internal form
ETOI(RMPRE,RMPRI) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPRE("IEN")_","
+4 DO GETS^DIQ(661.7,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO ETOIX
+6 SET RMPRI("IEN")=RMPRE("IEN")
+7 SET RMPRI("HCPCS")=RMPRFDI(661.7,RMPRIEN,.01,"I")
+8 SET RMPRI("DATE&TIME")=RMPRFDI(661.7,RMPRIEN,1,"I")
+9 SET RMPRI("ITEM")=RMPRFDI(661.7,RMPRIEN,3,"I")
+10 SET RMPRI("SEQUENCE")=RMPRFDI(661.7,RMPRIEN,2,"I")
+11 SET RMPRI("STATION")=RMPRFDI(661.7,RMPRIEN,4,"I")
+12 SET RMPRI("LOCATION")=RMPRFDI(661.7,RMPRIEN,5,"I")
+13 SET RMPRI("UNIT")=RMPRFDI(661.7,RMPRIEN,8,"I")
+14 SET RMPRI("QUANTITY")=RMPRFDI(661.7,RMPRIEN,6,"I")
+15 SET RMPRI("VALUE")=RMPRFDI(661.7,RMPRIEN,7,"I")
ETOIX QUIT RMPRERR
+1 ;
+2 ; RMUBA - read 661.7 records for total balance.
BAL(RMPR11) ;
+1 NEW I,J,K,RS,RL,RH,RI,RD,RMB7,RM7
+2 SET RMUB=0
+3 SET RS=RMPR11("STATION")
+4 SET RL=RMPR11("LOCATION")
+5 SET RH=RMPR11("HCPCS")
+6 SET RI=RMPR11("ITEM")
+7 FOR RD=0:0
SET RD=$ORDER(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD))
if RD'>0
QUIT
FOR I=0:0
SET I=$ORDER(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD,1,I))
if I'>0
QUIT
Begin DoDot:1
+8 if I'>0
QUIT
+9 if '$DATA(^RMPR(661.7,I,0))
QUIT
+10 SET RM7=^RMPR(661.7,I,0)
+11 SET RMB7=$PIECE(RM7,U,7)
+12 SET RMUB=RMUB+RMB7
End DoDot:1
+13 QUIT RMUB
