RMPRPIX3 ;HINCIO/ODJ - FILE 661.63 APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; Create patient issue transaction record (661.63)
CRE(RMPR60,RMPR6,RMPR11) ;
N RMPRERR,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
S RMPRERR=0
S RMPRFDA(661.63,"+1,",.01)=RMPR6("IEN")
S RMPRFDA(661.63,"+1,",2)=RMPR60("IEN")
S RMPRFDA(661.63,"+1,",3)=$G(RMPR60("661.2PTR"))
S RMPRFDA(661.63,"+1,",4)=$G(RMPR11("HCPCS"))
S RMPRFDA(661.63,"+1,",5)=$G(RMPR11("ITEM"))
S RMPRFDA(661.63,"+1,",6)=$G(RMPR60("DATE&TIME"))
S RMPRFDA(661.63,"+1,",7)=$G(RMPR11("STATION"))
S RMPRFDA(661.63,"+1,",8)=$G(RMPR6("LOCATION"))
S RMPRFDA(661.63,"+1,",9)=$G(RMPR6("VENDOR"))
S RMPRFDA(661.63,"+1,",10)=$G(RMPR60("COST"))
S RMPRFDA(661.63,"+1,",11)=$G(RMPR60("UNIT"))
S RMPRFDA(661.63,"+1,",12)=$G(RMPR60("QUANTITY"))
D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
I $D(RMPRFME) S RMPRERR=99 G CREX
CREX Q RMPRERR
;
UPD(RMPR60,RMPR63,RMPR11) ;
;update file #661.63, cost and quantity
N RMDAT,RI
S RMPRERR=0
I '$G(RMPR63("IEN")) S RMPRERR=1 G UPDX
S RI=RMPR63("IEN")
S RMDAT(661.63,RI_",",12)=RMPR60("QUANTITY")
S RMDAT(661.63,RI_",",10)=RMPR60("COST")
D FILE^DIE("K","RMDAT","RMERR")
I $D(RMERR) S RMPRERR=1
UPDX Q RMPRERR
;
; Delete patient issue transaction record
DEL(RMPR6) ;
N RMPRERR,RMPRFDA,RMPRIEN,RMPRFME
S RMPRERR=0
S RMPRIEN=$O(^RMPR(661.63,"B",RMPR6("IEN"),""))_","
S RMPRFDA(661.63,RMPRIEN,.01)="@"
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=99
DELX Q RMPRERR
;
; Update all fields of patient issue transaction record
UPALL(RMPR60,RMPR63,RMPR11) ;
N RMPRERR,RMPRFDA,RMPRIEN,RMPRFME
S RMPRERR=0
I '$G(RMPR63("IEN")) S RMPRERR=1 G UPALLX
S RI=RMPR63("IEN")
S:$D(RMPR11("HCPCS")) RMDAT(661.63,RI_",",4)=RMPR11("HCPCS")
S:$D(RMPR11("ITEM")) RMDAT(661.63,RI_",",5)=RMPR11("ITEM")
S:$D(RMPR60("DATE&TIME")) RMDAT(661.63,RI_",",6)=RMPR60("DATE&TIME")
S:$D(RMPR60("LOCATION")) RMDAT(661.63,RI_",",8)=RMPR60("LOCATION")
S RMDAT(661.63,RI_",",9)=RMPR60("VENDOR")
S RMDAT(661.63,RI_",",10)=RMPR60("COST")
S RMDAT(661.63,RI_",",11)=RMPR60("UNIT")
S RMDAT(661.63,RI_",",12)=RMPR60("QUANTITY")
D FILE^DIE("K","RMDAT","RMERR")
UPALLX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX3 2231 printed Oct 16, 2024@18:37:13 Page 2
RMPRPIX3 ;HINCIO/ODJ - FILE 661.63 APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; Create patient issue transaction record (661.63)
CRE(RMPR60,RMPR6,RMPR11) ;
+1 NEW RMPRERR,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
+2 SET RMPRERR=0
+3 SET RMPRFDA(661.63,"+1,",.01)=RMPR6("IEN")
+4 SET RMPRFDA(661.63,"+1,",2)=RMPR60("IEN")
+5 SET RMPRFDA(661.63,"+1,",3)=$GET(RMPR60("661.2PTR"))
+6 SET RMPRFDA(661.63,"+1,",4)=$GET(RMPR11("HCPCS"))
+7 SET RMPRFDA(661.63,"+1,",5)=$GET(RMPR11("ITEM"))
+8 SET RMPRFDA(661.63,"+1,",6)=$GET(RMPR60("DATE&TIME"))
+9 SET RMPRFDA(661.63,"+1,",7)=$GET(RMPR11("STATION"))
+10 SET RMPRFDA(661.63,"+1,",8)=$GET(RMPR6("LOCATION"))
+11 SET RMPRFDA(661.63,"+1,",9)=$GET(RMPR6("VENDOR"))
+12 SET RMPRFDA(661.63,"+1,",10)=$GET(RMPR60("COST"))
+13 SET RMPRFDA(661.63,"+1,",11)=$GET(RMPR60("UNIT"))
+14 SET RMPRFDA(661.63,"+1,",12)=$GET(RMPR60("QUANTITY"))
+15 DO UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
+16 IF $DATA(RMPRFME)
SET RMPRERR=99
GOTO CREX
CREX QUIT RMPRERR
+1 ;
UPD(RMPR60,RMPR63,RMPR11) ;
+1 ;update file #661.63, cost and quantity
+2 NEW RMDAT,RI
+3 SET RMPRERR=0
+4 IF '$GET(RMPR63("IEN"))
SET RMPRERR=1
GOTO UPDX
+5 SET RI=RMPR63("IEN")
+6 SET RMDAT(661.63,RI_",",12)=RMPR60("QUANTITY")
+7 SET RMDAT(661.63,RI_",",10)=RMPR60("COST")
+8 DO FILE^DIE("K","RMDAT","RMERR")
+9 IF $DATA(RMERR)
SET RMPRERR=1
UPDX QUIT RMPRERR
+1 ;
+2 ; Delete patient issue transaction record
DEL(RMPR6) ;
+1 NEW RMPRERR,RMPRFDA,RMPRIEN,RMPRFME
+2 SET RMPRERR=0
+3 SET RMPRIEN=$ORDER(^RMPR(661.63,"B",RMPR6("IEN"),""))_","
+4 SET RMPRFDA(661.63,RMPRIEN,.01)="@"
+5 DO FILE^DIE("","RMPRFDA","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=99
DELX QUIT RMPRERR
+1 ;
+2 ; Update all fields of patient issue transaction record
UPALL(RMPR60,RMPR63,RMPR11) ;
+1 NEW RMPRERR,RMPRFDA,RMPRIEN,RMPRFME
+2 SET RMPRERR=0
+3 IF '$GET(RMPR63("IEN"))
SET RMPRERR=1
GOTO UPALLX
+4 SET RI=RMPR63("IEN")
+5 if $DATA(RMPR11("HCPCS"))
SET RMDAT(661.63,RI_",",4)=RMPR11("HCPCS")
+6 if $DATA(RMPR11("ITEM"))
SET RMDAT(661.63,RI_",",5)=RMPR11("ITEM")
+7 if $DATA(RMPR60("DATE&TIME"))
SET RMDAT(661.63,RI_",",6)=RMPR60("DATE&TIME")
+8 if $DATA(RMPR60("LOCATION"))
SET RMDAT(661.63,RI_",",8)=RMPR60("LOCATION")
+9 SET RMDAT(661.63,RI_",",9)=RMPR60("VENDOR")
+10 SET RMDAT(661.63,RI_",",10)=RMPR60("COST")
+11 SET RMDAT(661.63,RI_",",11)=RMPR60("UNIT")
+12 SET RMDAT(661.63,RI_",",12)=RMPR60("QUANTITY")
+13 DO FILE^DIE("K","RMDAT","RMERR")
UPALLX QUIT RMPRERR
