RMPRPIX5 ;HINCIO/ODJ- PIP LOCATION FILE 661.5 API ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** CRE - Create a new 661.5 Stock Location record
;
; Inputs:
; RMPR - an array consisting of...
; RMPR("NAME") - Location name (.01 field)
; RMPR("STATION") - Station ien (fld 2 ptr ^DIC(4,)
; RMPR("ADDRESS") - Location address (fld 3, can be null)
; RMPR("STATUS") - A - Active, I - Inactive (fld 4)
; RMPR("STATUS DATE") - Date (Fileman) of any status change
; (fld 5)
; RMPR("USER") - ien of User creating location
; (fld 6, ptr ^VA(200,)
;
; Outputs:
; RMPR("IEN") - the ien of the created 661.5 record
; RMPRCRE - if non 0 there was an error creating the record
;
CRE(RMPR) ;
N RMPRCRE,RMPRFDA,RMPRIEN,RMPRMSG
S RMPRCRE=0
S RMPRFDA(661.5,"+1,",.01)=RMPR("NAME")
S RMPRFDA(661.5,"+1,",2)=RMPR("STATION")
S RMPRFDA(661.5,"+1,",3)=RMPR("ADDRESS")
S RMPRFDA(661.5,"+1,",4)=RMPR("STATUS")
S RMPRFDA(661.5,"+1,",5)=RMPR("STATUS DATE")
S RMPRFDA(661.5,"+1,",6)=RMPR("USER")
D UPDATE^DIE("S","RMPRFDA","RMPRIEN","RMPRMSG")
I $D(RMPRMSG) S RMPRCRE=1 G CREX
S RMPR("IEN")=RMPRIEN(1)
CREX Q RMPRCRE
;
;***** GET - read in a 661.5 Stock Location record
;
; Inputs:
; must pass either...
;
; RMPR("IEN") - the ien (661.5 ptr) of the desired record
;
; or, if the ien is unknown...
;
; RMPR("STATION") - the Station ien (fld 2, ptr ^DIC(4,)
; RMPR("NAME") - the Location name (.01 field)
;
; Outputs:
; RMPR - an array consisting of (all external values)...
; RMPR("IEN") - 661.5 record's ien if none input
; RMPR("NAME") - Location name (.01 field)
; RMPR("STATION") - Station name (fld 2)
; RMPR("ADDRESS") - Location address (fld 3, can be null)
; RMPR("STATUS") - ACTIVE or INACTIVE (fld 4)
; RMPR("STATUS DATE") - Date of any status change
; (fld 5)
; RMPR("USER") - Name of User creating location
; (fld 6)
;
; RMPRRET - 0 if no errors, else non 0
; 1 - RMPR("IEN") and RMPR("STATION") inputs are null
; 2 - RMPR("IEN") and RMPR("NAME") inputs are null
; 3 - no ien for input RMPR("STATION") and RMPR("NAME")
; 4 - error on the Fileman read
;
GET(RMPR) ;
N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP
S RMPRRET=0
I $G(RMPR("IEN"))="" D
. I $G(RMPR("STATION"))="" S RMPRRET=1 Q
. I $G(RMPR("NAME"))="" S RMPRRET=2 Q
. S RMPR("IEN")=$O(^RMPR(661.5,"XSL",RMPR("STATION"),RMPR("NAME"),""))
. I RMPR("IEN")="" S RMPRRET=3 Q
. Q
I RMPRRET G GETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.5,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRRET=4 G GETX
S RMPR("USER")=RMPROUP(661.5,RMPRIEN,6)
S RMPR("STATION")=RMPROUP(661.5,RMPRIEN,2)
S RMPR("ADDRESS")=RMPROUP(661.5,RMPRIEN,3)
S RMPR("STATUS")=RMPROUP(661.5,RMPRIEN,4)
S RMPR("STATUS DATE")=RMPROUP(661.5,RMPRIEN,5)
S RMPR("NAME")=RMPROUP(661.5,RMPRIEN,.01)
GETX Q RMPRRET
;
;***** UPD - Update existing Stock Location rec (661.5)
; Inputs:
; RMPR5("IEN") - mandatory; the ien of the 661.5 rec. to modify
; see subscripts for CRE above for the other elements that can
; be set in the RMPR5 input array. You should only create these
; elements if they differ in value from an existing rec.
; Use only internal values.
;
; Outputs:
; RMPRERR - 0 - no problems
; 1 - FM returned an error from its update
;
UPD(RMPR5) ;
N RMPRFDA,RMPRFME,RMPRERR,X,Y,DA,RMPRI
S RMPRERR=0
S RMPRI=RMPR5("IEN")_","
S:$D(RMPR5("NAME")) RMPRFDA(661.5,RMPRI,.01)=RMPR5("NAME")
S:$D(RMPR5("STATION")) RMPRFDA(661.5,RMPRI,2)=RMPR5("STATION")
S:$D(RMPR5("ADDRESS")) RMPRFDA(661.5,RMPRI,3)=RMPR5("ADDRESS")
S:$D(RMPR5("STATUS")) RMPRFDA(661.5,RMPRI,4)=RMPR5("STATUS")
S:$D(RMPR5("STATUS DATE")) RMPRFDA(661.5,RMPRI,5)=RMPR5("STATUS DATE")
S:$D(RMPR5("USER")) RMPRFDA(661.5,RMPRI,6)=RMPR5("USER")
D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
UPDX Q RMPRERR
;
;***** ISACT - Test if Location active or inactive
;
; Inputs:
; RMPR5("IEN") - mandatory: ien of Location rec.
;
; Outputs:
; RMPRACT - 1 if location active, else 0
;
ISACT(RMPR5) ;
N RMPRFDI,RMPRI,RMPRFME,X,Y,DA,RMPRACT
S RMPRACT=0
S RMPRI=RMPR5("IEN")_","
D GETS^DIQ(661.5,RMPRI,"4","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) G ISACTX
I RMPRFDI(661.5,RMPRI,4,"I")="A" S RMPRACT=1
ISACTX Q RMPRACT
;
;***** ETOI - Convert external form of 661.5 rec to internal vals.
;
; Inputs:
; RMPR5("IEN") - mandatory; ien of Location rec.
;
; Outputs:
; RMPR5I - output array whose subscripts defined as for CRE above
; RMPRERR - 0 if no problems, +ve if FM returned an error
;
ETOI(RMPR5,RMPR5I) ;
N RMPRI,RMPRFDI,RMPRFME,RMPRERR,X,Y,DA
S RMPRERR=0
S RMPRI=RMPR5("IEN")_","
D GETS^DIQ(661.5,RMPRI,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G ETOIX
S RMPR5I("IEN")=RMPR5("IEN")
S RMPR5I("STATION")=RMPRFDI(661.5,RMPRI,2,"I")
S RMPR5I("NAME")=RMPRFDI(661.5,RMPRI,.01,"I")
S RMPR5I("ADDRESS")=RMPRFDI(661.5,RMPRI,3,"I")
S RMPR5I("STATUS")=RMPRFDI(661.5,RMPRI,4,"I")
S RMPR5I("STATUS DATE")=RMPRFDI(661.5,RMPRI,5,"I")
S RMPR5I("USER")=RMPRFDI(661.5,RMPRI,6,"I")
ETOIX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX5 5574 printed Dec 13, 2024@02:36:36 Page 2
RMPRPIX5 ;HINCIO/ODJ- PIP LOCATION FILE 661.5 API ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** CRE - Create a new 661.5 Stock Location record
+5 ;
+6 ; Inputs:
+7 ; RMPR - an array consisting of...
+8 ; RMPR("NAME") - Location name (.01 field)
+9 ; RMPR("STATION") - Station ien (fld 2 ptr ^DIC(4,)
+10 ; RMPR("ADDRESS") - Location address (fld 3, can be null)
+11 ; RMPR("STATUS") - A - Active, I - Inactive (fld 4)
+12 ; RMPR("STATUS DATE") - Date (Fileman) of any status change
+13 ; (fld 5)
+14 ; RMPR("USER") - ien of User creating location
+15 ; (fld 6, ptr ^VA(200,)
+16 ;
+17 ; Outputs:
+18 ; RMPR("IEN") - the ien of the created 661.5 record
+19 ; RMPRCRE - if non 0 there was an error creating the record
+20 ;
CRE(RMPR) ;
+1 NEW RMPRCRE,RMPRFDA,RMPRIEN,RMPRMSG
+2 SET RMPRCRE=0
+3 SET RMPRFDA(661.5,"+1,",.01)=RMPR("NAME")
+4 SET RMPRFDA(661.5,"+1,",2)=RMPR("STATION")
+5 SET RMPRFDA(661.5,"+1,",3)=RMPR("ADDRESS")
+6 SET RMPRFDA(661.5,"+1,",4)=RMPR("STATUS")
+7 SET RMPRFDA(661.5,"+1,",5)=RMPR("STATUS DATE")
+8 SET RMPRFDA(661.5,"+1,",6)=RMPR("USER")
+9 DO UPDATE^DIE("S","RMPRFDA","RMPRIEN","RMPRMSG")
+10 IF $DATA(RMPRMSG)
SET RMPRCRE=1
GOTO CREX
+11 SET RMPR("IEN")=RMPRIEN(1)
CREX QUIT RMPRCRE
+1 ;
+2 ;***** GET - read in a 661.5 Stock Location record
+3 ;
+4 ; Inputs:
+5 ; must pass either...
+6 ;
+7 ; RMPR("IEN") - the ien (661.5 ptr) of the desired record
+8 ;
+9 ; or, if the ien is unknown...
+10 ;
+11 ; RMPR("STATION") - the Station ien (fld 2, ptr ^DIC(4,)
+12 ; RMPR("NAME") - the Location name (.01 field)
+13 ;
+14 ; Outputs:
+15 ; RMPR - an array consisting of (all external values)...
+16 ; RMPR("IEN") - 661.5 record's ien if none input
+17 ; RMPR("NAME") - Location name (.01 field)
+18 ; RMPR("STATION") - Station name (fld 2)
+19 ; RMPR("ADDRESS") - Location address (fld 3, can be null)
+20 ; RMPR("STATUS") - ACTIVE or INACTIVE (fld 4)
+21 ; RMPR("STATUS DATE") - Date of any status change
+22 ; (fld 5)
+23 ; RMPR("USER") - Name of User creating location
+24 ; (fld 6)
+25 ;
+26 ; RMPRRET - 0 if no errors, else non 0
+27 ; 1 - RMPR("IEN") and RMPR("STATION") inputs are null
+28 ; 2 - RMPR("IEN") and RMPR("NAME") inputs are null
+29 ; 3 - no ien for input RMPR("STATION") and RMPR("NAME")
+30 ; 4 - error on the Fileman read
+31 ;
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("STATION"))=""
SET RMPRRET=1
QUIT
+5 IF $GET(RMPR("NAME"))=""
SET RMPRRET=2
QUIT
+6 SET RMPR("IEN")=$ORDER(^RMPR(661.5,"XSL",RMPR("STATION"),RMPR("NAME"),""))
+7 IF RMPR("IEN")=""
SET RMPRRET=3
QUIT
+8 QUIT
End DoDot:1
+9 IF RMPRRET
GOTO GETX
+10 SET RMPRIEN=RMPR("IEN")_","
+11 DO GETS^DIQ(661.5,RMPRIEN,"*","","RMPROUP","RMPRFME")
+12 IF $DATA(RMPRFME)
SET RMPRRET=4
GOTO GETX
+13 SET RMPR("USER")=RMPROUP(661.5,RMPRIEN,6)
+14 SET RMPR("STATION")=RMPROUP(661.5,RMPRIEN,2)
+15 SET RMPR("ADDRESS")=RMPROUP(661.5,RMPRIEN,3)
+16 SET RMPR("STATUS")=RMPROUP(661.5,RMPRIEN,4)
+17 SET RMPR("STATUS DATE")=RMPROUP(661.5,RMPRIEN,5)
+18 SET RMPR("NAME")=RMPROUP(661.5,RMPRIEN,.01)
GETX QUIT RMPRRET
+1 ;
+2 ;***** UPD - Update existing Stock Location rec (661.5)
+3 ; Inputs:
+4 ; RMPR5("IEN") - mandatory; the ien of the 661.5 rec. to modify
+5 ; see subscripts for CRE above for the other elements that can
+6 ; be set in the RMPR5 input array. You should only create these
+7 ; elements if they differ in value from an existing rec.
+8 ; Use only internal values.
+9 ;
+10 ; Outputs:
+11 ; RMPRERR - 0 - no problems
+12 ; 1 - FM returned an error from its update
+13 ;
UPD(RMPR5) ;
+1 NEW RMPRFDA,RMPRFME,RMPRERR,X,Y,DA,RMPRI
+2 SET RMPRERR=0
+3 SET RMPRI=RMPR5("IEN")_","
+4 if $DATA(RMPR5("NAME"))
SET RMPRFDA(661.5,RMPRI,.01)=RMPR5("NAME")
+5 if $DATA(RMPR5("STATION"))
SET RMPRFDA(661.5,RMPRI,2)=RMPR5("STATION")
+6 if $DATA(RMPR5("ADDRESS"))
SET RMPRFDA(661.5,RMPRI,3)=RMPR5("ADDRESS")
+7 if $DATA(RMPR5("STATUS"))
SET RMPRFDA(661.5,RMPRI,4)=RMPR5("STATUS")
+8 if $DATA(RMPR5("STATUS DATE"))
SET RMPRFDA(661.5,RMPRI,5)=RMPR5("STATUS DATE")
+9 if $DATA(RMPR5("USER"))
SET RMPRFDA(661.5,RMPRI,6)=RMPR5("USER")
+10 if $DATA(RMPRFDA)
DO FILE^DIE("","RMPRFDA","RMPRFME")
+11 IF $DATA(RMPRFME)
SET RMPRERR=1
UPDX QUIT RMPRERR
+1 ;
+2 ;***** ISACT - Test if Location active or inactive
+3 ;
+4 ; Inputs:
+5 ; RMPR5("IEN") - mandatory: ien of Location rec.
+6 ;
+7 ; Outputs:
+8 ; RMPRACT - 1 if location active, else 0
+9 ;
ISACT(RMPR5) ;
+1 NEW RMPRFDI,RMPRI,RMPRFME,X,Y,DA,RMPRACT
+2 SET RMPRACT=0
+3 SET RMPRI=RMPR5("IEN")_","
+4 DO GETS^DIQ(661.5,RMPRI,"4","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
GOTO ISACTX
+6 IF RMPRFDI(661.5,RMPRI,4,"I")="A"
SET RMPRACT=1
ISACTX QUIT RMPRACT
+1 ;
+2 ;***** ETOI - Convert external form of 661.5 rec to internal vals.
+3 ;
+4 ; Inputs:
+5 ; RMPR5("IEN") - mandatory; ien of Location rec.
+6 ;
+7 ; Outputs:
+8 ; RMPR5I - output array whose subscripts defined as for CRE above
+9 ; RMPRERR - 0 if no problems, +ve if FM returned an error
+10 ;
ETOI(RMPR5,RMPR5I) ;
+1 NEW RMPRI,RMPRFDI,RMPRFME,RMPRERR,X,Y,DA
+2 SET RMPRERR=0
+3 SET RMPRI=RMPR5("IEN")_","
+4 DO GETS^DIQ(661.5,RMPRI,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO ETOIX
+6 SET RMPR5I("IEN")=RMPR5("IEN")
+7 SET RMPR5I("STATION")=RMPRFDI(661.5,RMPRI,2,"I")
+8 SET RMPR5I("NAME")=RMPRFDI(661.5,RMPRI,.01,"I")
+9 SET RMPR5I("ADDRESS")=RMPRFDI(661.5,RMPRI,3,"I")
+10 SET RMPR5I("STATUS")=RMPRFDI(661.5,RMPRI,4,"I")
+11 SET RMPR5I("STATUS DATE")=RMPRFDI(661.5,RMPRI,5,"I")
+12 SET RMPR5I("USER")=RMPRFDI(661.5,RMPRI,6,"I")
ETOIX QUIT RMPRERR
