Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIX7

RMPRPIX7.m

Go to the documentation of this file.
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