VIAAEAD.m

VIAAEAD ;ALB/CR - RTLS Multiple RPCs for Engineering ;5/4/16 10:08am

 ;;1.0;RTLS;**3**;April 22, 2013;Build 20

 ;

 Q

 ; Access to file #6914 covered by IA #5913

 ; Access to file #6911 covered by IA #5914

 ; Access to file #6928 covered by IA #5915

 ; Access to file #6917 covered by IA #5916

 ; Access to file #6914.1 covered by IA #5917

 ; Access to file #6912 covered by IA #5918

 ; Access to file #6910 covered by IA #5920

 ;

EQMVUPD(RETSTA,AEMSID,ROOMNUM,TMSTMP) ; Equipment move into AEMS

 ; RPC [VIAA ENG ASSET MOVE]

 ;

 ; When equipment moves to a new location this function updates the

 ; following fields in file 6914:

 ; LOCATION (24)

 ; PHYSICAL INVENTORY DATE (23)

 ; 

 ; Input:

 ;   RETSTA is the name of the return array

 ;   AEMSID is equipment ID (IEN in 6914)

 ;   ROOMNUM is the room number for the location the equipment was

 ;   moved to

 ;   TMSTMP is timestamp in ISO format but time is optional

 ; Output:

 ;   "1^update successful" if update succeeds, otherwise

 ;   "-###^" concatenated with a failure message, where '###' is a 3-digit code

 ;

 I $G(AEMSID)="" S RETSTA(0)="-400^AEMS IEN not specified for look up in the EQUIPMENT INV. file, #6914" Q

 I '$D(^ENG(6914,"EE",AEMSID)) S RETSTA(0)="-404^AEMS IEN "_AEMSID_" was not found in the EQUIPMENT INV. file, #6914" Q

 I $G(ROOMNUM)="" S RETSTA(0)="-400^Room Number not specified for look up in the ENG SPACE file, #6928" Q

 I '$D(^ENG("SP","B",ROOMNUM)) S RETSTA(0)="-404^Room number "_ROOMNUM_" not found in the ENG SPACE file, #6928" Q

 I $G(TMSTMP)="" S RETSTA(0)="-400^Time Stamp of equipment move not specified" Q

 N FDA,ERR,RECCT,ROOMIEN

 K ^TMP("VIAADUP",$J)

 S RECCT=0

 ; if the room number is a duplicate in file #6928, reject the move and inform RTLS

 S ROOMIEN=0 F  S ROOMIEN=$O(^ENG("SP","B",ROOMNUM,ROOMIEN)) Q:'ROOMIEN  S ^TMP("VIAADUP",$J,ROOMIEN)="",RECCT=$G(RECCT)+1

 I $D(^TMP("VIAADUP",$J))&(RECCT>1) D  Q

 . S RETSTA(0)="-409^Move Failed - Duplicate Room Number ("_ROOMNUM_") Detected."

 . K ^TMP("VIAADUP",$J)

 ;

 ; convert timestamp from ISO format to FileMan internal format

 S TMSTMP=$$ISO2FM(TMSTMP)

 I TMSTMP=-1 S RETSTA(0)="-400^Time Stamp not valid" Q

 S AEMSID=$O(^ENG(6914,"EE",AEMSID,""))

 S ROOMIEN=+$O(^ENG("SP","B",ROOMNUM,""))

 ;

 S FDA(6914,AEMSID_",",23)=TMSTMP

 S FDA(6914,AEMSID_",",24)=ROOMIEN

 D UPDATE^DIE(,"FDA",,"ERR")

 I $D(ERR) S RETSTA(0)="-500^Update of EQUIPMENT INV. file, #6914, failed" Q

 S RETSTA(0)="1^Update of EQUIPMENT INV. file, #6914, successful"

 Q

 ;

RTLSDTEX(RETSTA,REQDATA,DATAID) ; Extract AEMS-RTLS DATA

 ; RPC [VIAA ENG GET DATA]

 ; 

 ; This RPC allows retrieval of one or all entries from the following

 ; files:

 ;   EQUIPMENT INV. (6914)

 ;   EQUIPMENT CATEGORY (6911)

 ;   ENG SPACE (6928) 

 ;  

 ; Input:

 ;   RETSTA is the name of the return array

 ;   REQDATA identifies the type of data that is required

 ;     "EQUIPMENT" for equipment

 ;     "CATEGORY" for categories

 ;     "LOCATION" for locations

 ;   DATAID identifies which data is to be returned for REQDATA

 ;     "ALL" for all data for a given REQDATA

 ;     AEMSID for individual equipment item

 ;     CATID for an individual category

 ;     LOCID (IEN) for an individual location

 ; Output:

 ;   Global ^TMP("VIAA"_REQDATA,$J)

 ;     Contains data for REQDATA and DATAID,

 ;     (if REQDATA="EQUIPMENT" and DATAID="ALL" 

 ;      then just AEMSIDs are returned)

 ;     otherwise

 ;     "-###^" concatenated with reason for failure message, where 

 ;     '###' is a 3-digit code

 ;

 ;

 N RNS

 S RNS="VIAA"_REQDATA

 I $G(REQDATA)="" S RNS="VIAAEQUIPMENT",^TMP(RNS,$J,0)="-400^REQDATA parameter not specified" D EX1 Q

 I $G(DATAID)="" S ^TMP(RNS,$J,0)="-400^DATA ID parameter not specified" D EX1 Q

 ;

 I ("^EQUIPMENT^CATEGORY^LOCATION^"'[("^"_REQDATA_"^")) D  Q

 . S ^TMP(RNS,$J,0)="-400^REQDATA parameter not recognized" D EX1

 ;

 ; scan appropriate file and save data in ^TMP

 K ^TMP(RNS,$J)

 I REQDATA="EQUIPMENT" D GETEQPD(REQDATA,DATAID)

 I REQDATA="CATEGORY" D GETCATD(REQDATA,DATAID)

 I REQDATA="LOCATION" D GETSPCD(REQDATA,DATAID)

 ; 

EX1 S RETSTA=$S($D(^TMP(RNS,$J)):$NA(^TMP(RNS,$J)),RETSTA'="":RETSTA,1:"-404^No data found")

 Q

 ;

GETEQPD(REQDATA,DATAID) ; get equipment data

 ;

 ; check that asset is on file if info for single asset requested

 I DATAID'="ALL",'$D(^ENG(6914,"EE",DATAID)) D  Q

 . S ^TMP(RNS,$J,0)="-404^AEMS IEN "_DATAID_" was not found in the EQUIPMENT INV. file, #6914"

 ;

 N RECCT

 S RECCT=0

 ; return info for a single asset

 I DATAID'="ALL" D  Q

 . D GETEQPD1(DATAID)

 ;

 ; return info for all assets 'IN USE'

 N AEMSID

 S AEMSID=""

 F  S AEMSID=$O(^ENG(6914,"EE",AEMSID)) Q:AEMSID=""  D

 . S EIEN=$O(^ENG(6914,"EE",AEMSID,""))

 . I $$GET1^DIQ(6914,EIEN,20,"I")'=1 Q

 . S RECCT=RECCT+1

 . S ^TMP(RNS,$J,RECCT,0)=AEMSID

 I RECCT=0 S ^TMP(RNS,$J,0)="-404^No data found"

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETEQPD1(AEMSID) ; get data for one item

 ;

 N EIEN,LOCID,MODEL,MANUF,CATDET,CATDET2,CATEG,SERNO,USESTAT,VALUE

 N ENTDAT,MOVDAT,EQNAM,CMRDESC,CMRPTR,SERVICE,CSTKNO,CSTKDESC,CSTKIEN

 N ACQDATE,CMRNAM,PASYST,DATA,FSYNON,DISPDATE

 N PURCHORD,RESPSHOP,TYPENTRY,SITEID,DEFSITE

 ;

 S EIEN=$O(^ENG(6914,"EE",AEMSID,"")) ; equipment IEN

 S LOCID=$$GET1^DIQ(6914,EIEN,24)     ; location

 S MANUF=$$GET1^DIQ(6914,EIEN,1)      ; manufacturer

 S PASYST=$$GET1^DIQ(6914,EIEN,2)     ; parent system

 S EQNAM=$$GET1^DIQ(6914,EIEN,3)      ; mfgr. equipment name

 S MODEL=$$GET1^DIQ(6914,EIEN,4)      ; model

 S SERNO=$$GET1^DIQ(6914,EIEN,5)      ; serial number

 ;

 ; use category IEN to get cat desc and first record of the synonym

 S CATEG=$$GET1^DIQ(6914,EIEN,6,"I")  ; equipment category ien

 I $G(CATEG)="" S CATDET="^" ; category does not exist in entry

 ; get category description and first synonym

 I CATEG]"" D

 . S CATDESC=$P($G(^ENG(6911,CATEG,0)),U)

 . S FSYNON=$P($G(^ENG(6911,CATEG,1,1,0)),U)

 . S CATDET=CATDESC_U_FSYNON

 . ; get the rest of synonyms (if any)

 . S CATDET2=$$SYN(CATEG)

 . S CATDET=CATDET_CATDET2 ; category description and all synonyms

 . I CATDET2="" S CATDET=CATDET_"" ; no synonym found

 ;

 S TYPENTRY=$$GET1^DIQ(6914,EIEN,7)    ; type of entry

 S PURCHORD=$$GET1^DIQ(6914,EIEN,11)   ; purchase order #

 S VALUE=$$GET1^DIQ(6914,EIEN,12)      ; asset value

 S ACQDATE=$$GET1^DIQ(6914,EIEN,13,"I")    ; acquisition date

 ;

 ; get category stock # and brief description

 S CSTKNO=$$GET1^DIQ(6914,EIEN,18)

 I $G(CSTKNO)="" S CSTKDESC=""

 I CSTKNO]"" D

 . S CSTKIEN=+$O(^ENCSN(6917,"B",CSTKNO,""))

 . S CSTKDESC=$$GET1^DIQ(6917,CSTKIEN,2,"E")

 ;

 S CMRPTR=$$GET1^DIQ(6914,EIEN,19,"I")          ; cmr pointer

 S CMRNAM=$$GET1^DIQ(6914.1,CMRPTR,.01)         ; cmr name

 I CMRPTR>0 S CMRDESC=$P($G(^ENG(6914.1,CMRPTR,0)),U,8)  ; brief description

 I '$D(CMRDESC) S CMRDESC=""

 S USESTAT=$$GET1^DIQ(6914,EIEN,20)        ; use status

 S SERVICE=$$GET1^DIQ(6914,EIEN,21)        ; service pointer

 S ENTDAT=$$GET1^DIQ(6914,EIEN,.6,"I") ; date asset entered in AEMS

 S MOVDAT=$$GET1^DIQ(6914,EIEN,23,"I") ; physical inventory date

 S RESPSHOP=$$GET1^DIQ(6914.04,"1,"_EIEN_",",.01) ; responsible shop

 S SITEID=$$GET1^DIQ(6914,EIEN,60)       ; station number for eqmt

 S DEFSITE=$$GET1^DIQ(6910,1,1,"I")      ; default station number

 S DISPDATE=$$GET1^DIQ(6914,EIEN,22,"I") ; disposition date

 S DATA=AEMSID_U_LOCID_U_MODEL_U_MANUF_U_CATDET_U_USESTAT

 S DATA=DATA_U_SERNO_U_VALUE_U_ENTDAT_U_MOVDAT_U_EQNAM_U_CMRDESC_U_CMRNAM ; added CMRNAM per VA change 9/23/13

 S DATA=DATA_U_SERVICE_U_CSTKNO_U_CSTKDESC_U_PASYST_U_TYPENTRY

 S DATA=DATA_U_PURCHORD_U_ACQDATE_U_RESPSHOP_U_SITEID_U_DEFSITE_U_DISPDATE

 S RECCT=RECCT+1

 S ^TMP(RNS,$J,RECCT,0)=DATA

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETCATD(REQDATA,DATAID) ; retrieve AEMS category data from file 6911

 ;

 ; if name is longer than 30 characters, use special handling

 N RECCT

 S RECCT=0

 I $L(DATAID)>30 D  Q

 . N DATAID1,EIEN

 . S DATAID1=$E(DATAID,1,30)

 . I '$D(^ENG(6911,"B",DATAID1)) S ^TMP(RNS,$J,0)="-404^"_DATAID_" was not found in the EQUIPMENT CATEGORY file, #6911" Q

 . F EIEN=0:0 S EIEN=$O(^ENG(6911,"B",DATAID1,EIEN)) Q:'EIEN  I $P(^ENG(6911,EIEN,0),"^",1)=DATAID S ^TMP(RNS,$J,RECCT+1,0)=EIEN_"^"_$P(^ENG(6911,EIEN,0),"^",1)

 ;

 ; check that asset is on file if info for single asset requested

 I DATAID'="ALL",'$D(^ENG(6911,"B",DATAID)) D  Q

 . S ^TMP(RNS,$J,0)="-404^"_DATAID_" is not a recognized category in the EQUIPMENT CATEGORY file, #6911"

 ;

 ; return info for a single category

 I DATAID'="ALL" D  Q

 . D GETCATD1(DATAID)

 ;

 ; return info for all categories

 N CATID

 F CATID=0:0 S CATID=$O(^ENG(6911,CATID)) Q:'CATID  D

 . S RECCT=RECCT+1

 . S CATDESC=$P($G(^ENG(6911,CATID,0)),U,1) ; category description

 . S DATA=CATID_U_CATDESC

 . S ^TMP(RNS,$J,RECCT,0)=CATID_U_CATDESC

 I RECCT=0 S ^TMP(RNS,$J,0)="-404^No data found"

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETCATD1(CATID) ; get data for one category

 N CIEN,DATA,CATDESC

 I '$D(^ENG(6911,"B",CATID)) S ^TMP(RNS,$J,0)="-404^"_CATID_" was not found in the EQUIPMENT CATEGORY file, #6911" Q

 S CIEN=$O(^ENG(6911,"B",CATID,""))

 S CATDESC=$P($G(^ENG(6911,CIEN,0)),U,1) ; category description

 S DATA=CIEN_U_CATDESC

 S RECCT=RECCT+1

 S ^TMP(RNS,$J,RECCT,0)=DATA

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETSPCD(REQDATA,DATAID) ; retrieve AEMS space/location data from file 6928

 ;

 ; check asset is on file if info for single space/location requested

 I DATAID'="ALL",'$D(^ENG("SP",DATAID)) D  Q

 . S ^TMP(RNS,$J,0)="-404^"_DATAID_" is not a recognized location in the ENG SPACE file, #6928"

 ;

 N RECCT

 S RECCT=0

 ; return info for a single space/location

 I DATAID'="ALL" D  Q

 . D GETSPCD1(DATAID)

 ;

 ; return info for all spaces/locations

 N LOCDESC ; location description

 S LOCDESC=""

 F  S LOCDESC=$O(^ENG("SP","B",LOCDESC)) Q:LOCDESC=""  D

 . D GETSPCD2(LOCDESC)

 I RECCT=0 S ^TMP(RNS,$J,0)="-404^No data found"

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETSPCD1(LOCID) ; get data for one location

 N DATA,LOCDESC

 I +LOCID=0 S ^TMP(RNS,$J,0)="-404^"_LOCID_" is not a valid Location ID in the ENG SPACE file, #6928" Q

 S LOCDESC=$P(^ENG("SP",LOCID,0),U,1)

 S DATA=LOCID_U_LOCDESC

 S RECCT=RECCT+1

 S ^TMP(RNS,$J,RECCT,0)=DATA

 S RETSTA=$NA(^TMP(RNS,$J))

 Q 

 ;

GETSPCD2(LOCDESC) ; get data for all locations

 N DATA,LOCIEN

 S LOCIEN=$O(^ENG("SP","B",LOCDESC,""))

 S DATA=LOCIEN_U_LOCDESC

 S RECCT=RECCT+1

 S ^TMP(RNS,$J,RECCT,0)=DATA

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

GETNEENS(RETSTA,AEMSID,NUMBER) ; Get a number of AEMSID's

 ;

 S AEMSID=$G(AEMSID)

 S NUMBER=$G(NUMBER,50)

 I NUMBER'=+NUMBER S RETSTA="Number must be numeric" Q

 S RNS="VIAAENR",REQDATA="EQUIPMENT"

 K ^TMP(RNS,$J)

 S RECCT=0

 F  S AEMSID=$O(^ENG(6914,"EE",AEMSID)) Q:AEMSID=""  Q:RECCT=NUMBER  D

 . S RECCT=RECCT+1

 . S ^TMP(RNS,$J,RECCT,0)=AEMSID

 I RECCT=0 S ^TMP(RNS,$J,0)="-404^No data found"

 S RETSTA=$NA(^TMP(RNS,$J))

 Q

 ;

EQSEED(RETSTA,AEMSID,LOCID,TMSTMP) ; RPC to save an equipment move into AEMS

 ; When equipment moves to a new location

 ; this function updates the following fields in file 6914:

 ; LOCATION

 ; 

 ; RETSTA is the name of the return array

 ; AEMSID is equipment ID (IEN in 6914)

 ; LOCID is the identity of the location at which the equipment is arriving

 ; TMSTMP is timestamp in ISO format

 ;

 S RETSTA=1

 I $G(AEMSID)="" S RETSTA="-400^AEMS ID "_AEMSID_" not specified for EQUIPMENT INV. file, #6914" Q

 I $G(LOCID)="" S RETSTA="-400^Location ID not specified for ENG SPACE file, #6928" Q

 I $G(TMSTMP)="" S RETSTA="-400^timestamp not specified" Q

 I '$D(^ENG(6914,"EE",AEMSID)) S RETSTA="-404^"_AEMSID_" AEMS IEN was not found in the EQUIPMENT INV. file, #6914" Q

 N FDA,ERR

 ; convert timestamp from ISO format to FileMan internal format

 S TMSTMP=$$ISO2FM(TMSTMP)

 S AEMSID=$O(^ENG(6914,"EE",AEMSID,""))

 ; need to establish LOCID format

 S FDA(6914,AEMSID_",",23)=TMSTMP

 S FDA(6914,AEMSID_",",24)=LOCID

 D UPDATE^DIE(,"FDA",,"ERR")

 I $D(ERR) S RETSTA="-500^update failed" Q

 S RETSTA="1^update successful"

 Q

 ;

ISO2FM(TMSTMP) ; External date to FM date

 ; incoming format yyyy-mm-dd<space>hh:MM:ss

 ; e.g. 2012-02-07 09:08:06

 N D,P,DTTM,DTTT

 S D="-",P="."

 ; first convert incoming date to an HL7 format

 S DTTT=$P(TMSTMP,D,4)

 S DTTM=$TR($P(TMSTMP,D,1,3),":- ")

 S $P(DTTM,D,2)=$E(10000+DTTT,2,5)

 ; then convert HL7 date to FM date

 S DTTM=$$HL7TFM^XLFDT(DTTM)

 Q DTTM

 ;

FM2ISO(DATE) ; convert FM date to ISO date

 N DTTM,D,P,C

 S C=":",D="-",P="."

 S DATE=$$FMTHL7^XLFDT(DATE)

 S DTTM=$E(DATE,1,4)_D_$E(DATE,5,6)_D_$E(DATE,7,8)

 S DTTM=DTTM_"T"

 S DTTM=DTTM_$E(DATE,9,10)_C_$E(DATE,11,12)_C_$E(DATE,13,14)_P_"000"

 S DTTM=DTTM_D_$E(DATE,16,17)_C_$E(DATE,18,19)

 Q DTTM

 ;

SYN(CATEG) ; get all synonyms for a given category in a piece of equipment

 N I,COUNT,RECDEL,SYNON

 S RECDEL="|" ; record delimiter

 ;

 S COUNT=+$P($G(^ENG(6911,CATEG,1,0)),U,4)

 I $G(COUNT)=0!($G(COUNT)=1) S CATDET2="" Q CATDET2  ; no synonyms found

 F I=2:1:COUNT D

 . S SYNON=$G(SYNON)_RECDEL_$P($G(^ENG(6911,CATEG,1,I,0)),U)

 S CATDET2=SYNON ; remaining category synonyms

 Q CATDET2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VIAAEAD   13286     printed  Apr 23, 2025@18:47:42                                                                                                                                                                                                    Page 2

VIAAEAD   ;ALB/CR - RTLS Multiple RPCs for Engineering ;5/4/16 10:08am

 +1       ;;1.0;RTLS;**3**;April 22, 2013;Build 20

 +2       ;

 +3        QUIT 

 +4       ; Access to file #6914 covered by IA #5913

 +5       ; Access to file #6911 covered by IA #5914

 +6       ; Access to file #6928 covered by IA #5915

 +7       ; Access to file #6917 covered by IA #5916

 +8       ; Access to file #6914.1 covered by IA #5917

 +9       ; Access to file #6912 covered by IA #5918

 +10      ; Access to file #6910 covered by IA #5920

 +11      ;

EQMVUPD(RETSTA,AEMSID,ROOMNUM,TMSTMP) ; Equipment move into AEMS

 +1       ; RPC [VIAA ENG ASSET MOVE]

 +2       ;

 +3       ; When equipment moves to a new location this function updates the

 +4       ; following fields in file 6914:

 +5       ; LOCATION (24)

 +6       ; PHYSICAL INVENTORY DATE (23)

 +7       ; 

 +8       ; Input:

 +9       ;   RETSTA is the name of the return array

 +10      ;   AEMSID is equipment ID (IEN in 6914)

 +11      ;   ROOMNUM is the room number for the location the equipment was

 +12      ;   moved to

 +13      ;   TMSTMP is timestamp in ISO format but time is optional

 +14      ; Output:

 +15      ;   "1^update successful" if update succeeds, otherwise

 +16      ;   "-###^" concatenated with a failure message, where '###' is a 3-digit code

 +17      ;

 +18       IF $GET(AEMSID)=""

               SET RETSTA(0)="-400^AEMS IEN not specified for look up in the EQUIPMENT INV. file, #6914"

               QUIT 

 +19       IF '$DATA(^ENG(6914,"EE",AEMSID))

               SET RETSTA(0)="-404^AEMS IEN "_AEMSID_" was not found in the EQUIPMENT INV. file, #6914"

               QUIT 

 +20       IF $GET(ROOMNUM)=""

               SET RETSTA(0)="-400^Room Number not specified for look up in the ENG SPACE file, #6928"

               QUIT 

 +21       IF '$DATA(^ENG("SP","B",ROOMNUM))

               SET RETSTA(0)="-404^Room number "_ROOMNUM_" not found in the ENG SPACE file, #6928"

               QUIT 

 +22       IF $GET(TMSTMP)=""

               SET RETSTA(0)="-400^Time Stamp of equipment move not specified"

               QUIT 

 +23       NEW FDA,ERR,RECCT,ROOMIEN

 +24       KILL ^TMP("VIAADUP",$JOB)

 +25       SET RECCT=0

 +26      ; if the room number is a duplicate in file #6928, reject the move and inform RTLS

 +27       SET ROOMIEN=0

           FOR 

               SET ROOMIEN=$ORDER(^ENG("SP","B",ROOMNUM,ROOMIEN))

               if 'ROOMIEN

                   QUIT 

               SET ^TMP("VIAADUP",$JOB,ROOMIEN)=""

               SET RECCT=$GET(RECCT)+1

 +28       IF $DATA(^TMP("VIAADUP",$JOB))&(RECCT>1)

               Begin DoDot:1

 +29               SET RETSTA(0)="-409^Move Failed - Duplicate Room Number ("_ROOMNUM_") Detected."

 +30               KILL ^TMP("VIAADUP",$JOB)

               End DoDot:1

               QUIT 

 +31      ;

 +32      ; convert timestamp from ISO format to FileMan internal format

 +33       SET TMSTMP=$$ISO2FM(TMSTMP)

 +34       IF TMSTMP=-1

               SET RETSTA(0)="-400^Time Stamp not valid"

               QUIT 

 +35       SET AEMSID=$ORDER(^ENG(6914,"EE",AEMSID,""))

 +36       SET ROOMIEN=+$ORDER(^ENG("SP","B",ROOMNUM,""))

 +37      ;

 +38       SET FDA(6914,AEMSID_",",23)=TMSTMP

 +39       SET FDA(6914,AEMSID_",",24)=ROOMIEN

 +40       DO UPDATE^DIE(,"FDA",,"ERR")

 +41       IF $DATA(ERR)

               SET RETSTA(0)="-500^Update of EQUIPMENT INV. file, #6914, failed"

               QUIT 

 +42       SET RETSTA(0)="1^Update of EQUIPMENT INV. file, #6914, successful"

 +43       QUIT 

 +44      ;

RTLSDTEX(RETSTA,REQDATA,DATAID) ; Extract AEMS-RTLS DATA

 +1       ; RPC [VIAA ENG GET DATA]

 +2       ; 

 +3       ; This RPC allows retrieval of one or all entries from the following

 +4       ; files:

 +5       ;   EQUIPMENT INV. (6914)

 +6       ;   EQUIPMENT CATEGORY (6911)

 +7       ;   ENG SPACE (6928) 

 +8       ;  

 +9       ; Input:

 +10      ;   RETSTA is the name of the return array

 +11      ;   REQDATA identifies the type of data that is required

 +12      ;     "EQUIPMENT" for equipment

 +13      ;     "CATEGORY" for categories

 +14      ;     "LOCATION" for locations

 +15      ;   DATAID identifies which data is to be returned for REQDATA

 +16      ;     "ALL" for all data for a given REQDATA

 +17      ;     AEMSID for individual equipment item

 +18      ;     CATID for an individual category

 +19      ;     LOCID (IEN) for an individual location

 +20      ; Output:

 +21      ;   Global ^TMP("VIAA"_REQDATA,$J)

 +22      ;     Contains data for REQDATA and DATAID,

 +23      ;     (if REQDATA="EQUIPMENT" and DATAID="ALL" 

 +24      ;      then just AEMSIDs are returned)

 +25      ;     otherwise

 +26      ;     "-###^" concatenated with reason for failure message, where 

 +27      ;     '###' is a 3-digit code

 +28      ;

 +29      ;

 +30       NEW RNS

 +31       SET RNS="VIAA"_REQDATA

 +32       IF $GET(REQDATA)=""

               SET RNS="VIAAEQUIPMENT"

               SET ^TMP(RNS,$JOB,0)="-400^REQDATA parameter not specified"

               DO EX1

               QUIT 

 +33       IF $GET(DATAID)=""

               SET ^TMP(RNS,$JOB,0)="-400^DATA ID parameter not specified"

               DO EX1

               QUIT 

 +34      ;

 +35       IF ("^EQUIPMENT^CATEGORY^LOCATION^"'[("^"_REQDATA_"^"))

               Begin DoDot:1

 +36               SET ^TMP(RNS,$JOB,0)="-400^REQDATA parameter not recognized"

                   DO EX1

               End DoDot:1

               QUIT 

 +37      ;

 +38      ; scan appropriate file and save data in ^TMP

 +39       KILL ^TMP(RNS,$JOB)

 +40       IF REQDATA="EQUIPMENT"

               DO GETEQPD(REQDATA,DATAID)

 +41       IF REQDATA="CATEGORY"

               DO GETCATD(REQDATA,DATAID)

 +42       IF REQDATA="LOCATION"

               DO GETSPCD(REQDATA,DATAID)

 +43      ; 

EX1        SET RETSTA=$SELECT($DATA(^TMP(RNS,$JOB)):$NAME(^TMP(RNS,$JOB)),RETSTA'="":RETSTA,1:"-404^No data found")

 +1        QUIT 

 +2       ;

GETEQPD(REQDATA,DATAID) ; get equipment data

 +1       ;

 +2       ; check that asset is on file if info for single asset requested

 +3        IF DATAID'="ALL"

               IF '$DATA(^ENG(6914,"EE",DATAID))

                   Begin DoDot:1

 +4                    SET ^TMP(RNS,$JOB,0)="-404^AEMS IEN "_DATAID_" was not found in the EQUIPMENT INV. file, #6914"

                   End DoDot:1

                   QUIT 

 +5       ;

 +6        NEW RECCT

 +7        SET RECCT=0

 +8       ; return info for a single asset

 +9        IF DATAID'="ALL"

               Begin DoDot:1

 +10               DO GETEQPD1(DATAID)

               End DoDot:1

               QUIT 

 +11      ;

 +12      ; return info for all assets 'IN USE'

 +13       NEW AEMSID

 +14       SET AEMSID=""

 +15       FOR 

               SET AEMSID=$ORDER(^ENG(6914,"EE",AEMSID))

               if AEMSID=""

                   QUIT 

               Begin DoDot:1

 +16               SET EIEN=$ORDER(^ENG(6914,"EE",AEMSID,""))

 +17               IF $$GET1^DIQ(6914,EIEN,20,"I")'=1

                       QUIT 

 +18               SET RECCT=RECCT+1

 +19               SET ^TMP(RNS,$JOB,RECCT,0)=AEMSID

               End DoDot:1

 +20       IF RECCT=0

               SET ^TMP(RNS,$JOB,0)="-404^No data found"

 +21       SET RETSTA=$NAME(^TMP(RNS,$JOB))

 +22       QUIT 

 +23      ;

GETEQPD1(AEMSID) ; get data for one item

 +1       ;

 +2        NEW EIEN,LOCID,MODEL,MANUF,CATDET,CATDET2,CATEG,SERNO,USESTAT,VALUE

 +3        NEW ENTDAT,MOVDAT,EQNAM,CMRDESC,CMRPTR,SERVICE,CSTKNO,CSTKDESC,CSTKIEN

 +4        NEW ACQDATE,CMRNAM,PASYST,DATA,FSYNON,DISPDATE

 +5        NEW PURCHORD,RESPSHOP,TYPENTRY,SITEID,DEFSITE

 +6       ;

 +7       ; equipment IEN

           SET EIEN=$ORDER(^ENG(6914,"EE",AEMSID,""))

 +8       ; location

           SET LOCID=$$GET1^DIQ(6914,EIEN,24)

 +9       ; manufacturer

           SET MANUF=$$GET1^DIQ(6914,EIEN,1)

 +10      ; parent system

           SET PASYST=$$GET1^DIQ(6914,EIEN,2)

 +11      ; mfgr. equipment name

           SET EQNAM=$$GET1^DIQ(6914,EIEN,3)

 +12      ; model

           SET MODEL=$$GET1^DIQ(6914,EIEN,4)

 +13      ; serial number

           SET SERNO=$$GET1^DIQ(6914,EIEN,5)

 +14      ;

 +15      ; use category IEN to get cat desc and first record of the synonym

 +16      ; equipment category ien

           SET CATEG=$$GET1^DIQ(6914,EIEN,6,"I")

 +17      ; category does not exist in entry

           IF $GET(CATEG)=""

               SET CATDET="^"

 +18      ; get category description and first synonym

 +19       IF CATEG]""

               Begin DoDot:1

 +20               SET CATDESC=$PIECE($GET(^ENG(6911,CATEG,0)),U)

 +21               SET FSYNON=$PIECE($GET(^ENG(6911,CATEG,1,1,0)),U)

 +22               SET CATDET=CATDESC_U_FSYNON

 +23      ; get the rest of synonyms (if any)

 +24               SET CATDET2=$$SYN(CATEG)

 +25      ; category description and all synonyms

                   SET CATDET=CATDET_CATDET2

 +26      ; no synonym found

                   IF CATDET2=""

                       SET CATDET=CATDET_""

               End DoDot:1

 +27      ;

 +28      ; type of entry

           SET TYPENTRY=$$GET1^DIQ(6914,EIEN,7)

 +29      ; purchase order #

           SET PURCHORD=$$GET1^DIQ(6914,EIEN,11)

 +30      ; asset value

           SET VALUE=$$GET1^DIQ(6914,EIEN,12)

 +31      ; acquisition date

           SET ACQDATE=$$GET1^DIQ(6914,EIEN,13,"I")

 +32      ;

 +33      ; get category stock # and brief description

 +34       SET CSTKNO=$$GET1^DIQ(6914,EIEN,18)

 +35       IF $GET(CSTKNO)=""

               SET CSTKDESC=""

 +36       IF CSTKNO]""

               Begin DoDot:1

 +37               SET CSTKIEN=+$ORDER(^ENCSN(6917,"B",CSTKNO,""))

 +38               SET CSTKDESC=$$GET1^DIQ(6917,CSTKIEN,2,"E")

               End DoDot:1

 +39      ;

 +40      ; cmr pointer

           SET CMRPTR=$$GET1^DIQ(6914,EIEN,19,"I")

 +41      ; cmr name

           SET CMRNAM=$$GET1^DIQ(6914.1,CMRPTR,.01)

 +42      ; brief description

           IF CMRPTR>0

               SET CMRDESC=$PIECE($GET(^ENG(6914.1,CMRPTR,0)),U,8)

 +43       IF '$DATA(CMRDESC)

               SET CMRDESC=""

 +44      ; use status

           SET USESTAT=$$GET1^DIQ(6914,EIEN,20)

 +45      ; service pointer

           SET SERVICE=$$GET1^DIQ(6914,EIEN,21)

 +46      ; date asset entered in AEMS

           SET ENTDAT=$$GET1^DIQ(6914,EIEN,.6,"I")

 +47      ; physical inventory date

           SET MOVDAT=$$GET1^DIQ(6914,EIEN,23,"I")

 +48      ; responsible shop

           SET RESPSHOP=$$GET1^DIQ(6914.04,"1,"_EIEN_",",.01)

 +49      ; station number for eqmt

           SET SITEID=$$GET1^DIQ(6914,EIEN,60)

 +50      ; default station number

           SET DEFSITE=$$GET1^DIQ(6910,1,1,"I")

 +51      ; disposition date

           SET DISPDATE=$$GET1^DIQ(6914,EIEN,22,"I")

 +52       SET DATA=AEMSID_U_LOCID_U_MODEL_U_MANUF_U_CATDET_U_USESTAT

 +53      ; added CMRNAM per VA change 9/23/13

           SET DATA=DATA_U_SERNO_U_VALUE_U_ENTDAT_U_MOVDAT_U_EQNAM_U_CMRDESC_U_CMRNAM

 +54       SET DATA=DATA_U_SERVICE_U_CSTKNO_U_CSTKDESC_U_PASYST_U_TYPENTRY

 +55       SET DATA=DATA_U_PURCHORD_U_ACQDATE_U_RESPSHOP_U_SITEID_U_DEFSITE_U_DISPDATE

 +56       SET RECCT=RECCT+1

 +57       SET ^TMP(RNS,$JOB,RECCT,0)=DATA

 +58       SET RETSTA=$NAME(^TMP(RNS,$JOB))

 +59       QUIT 

 +60      ;

GETCATD(REQDATA,DATAID) ; retrieve AEMS category data from file 6911

 +1       ;

 +2       ; if name is longer than 30 characters, use special handling

 +3        NEW RECCT

 +4        SET RECCT=0

 +5        IF $LENGTH(DATAID)>30

               Begin DoDot:1

 +6                NEW DATAID1,EIEN

 +7                SET DATAID1=$EXTRACT(DATAID,1,30)

 +8                IF '$DATA(^ENG(6911,"B",DATAID1))

                       SET ^TMP(RNS,$JOB,0)="-404^"_DATAID_" was not found in the EQUIPMENT CATEGORY file, #6911"

                       QUIT 

 +9                FOR EIEN=0:0

                       SET EIEN=$ORDER(^ENG(6911,"B",DATAID1,EIEN))

                       if 'EIEN

                           QUIT 

                       IF $PIECE(^ENG(6911,EIEN,0),"^",1)=DATAID

                           SET ^TMP(RNS,$JOB,RECCT+1,0)=EIEN_"^"_$PIECE(^ENG(6911,EIEN,0),"^",1)

               End DoDot:1

               QUIT 

 +10      ;

 +11      ; check that asset is on file if info for single asset requested

 +12       IF DATAID'="ALL"

               IF '$DATA(^ENG(6911,"B",DATAID))

                   Begin DoDot:1

 +13                   SET ^TMP(RNS,$JOB,0)="-404^"_DATAID_" is not a recognized category in the EQUIPMENT CATEGORY file, #6911"

                   End DoDot:1

                   QUIT 

 +14      ;

 +15      ; return info for a single category

 +16       IF DATAID'="ALL"

               Begin DoDot:1

 +17               DO GETCATD1(DATAID)

               End DoDot:1

               QUIT 

 +18      ;

 +19      ; return info for all categories

 +20       NEW CATID

 +21       FOR CATID=0:0

               SET CATID=$ORDER(^ENG(6911,CATID))

               if 'CATID

                   QUIT 

               Begin DoDot:1

 +22               SET RECCT=RECCT+1

 +23      ; category description

                   SET CATDESC=$PIECE($GET(^ENG(6911,CATID,0)),U,1)

 +24               SET DATA=CATID_U_CATDESC

 +25               SET ^TMP(RNS,$JOB,RECCT,0)=CATID_U_CATDESC

               End DoDot:1

 +26       IF RECCT=0

               SET ^TMP(RNS,$JOB,0)="-404^No data found"

 +27       SET RETSTA=$NAME(^TMP(RNS,$JOB))

 +28       QUIT 

 +29      ;

GETCATD1(CATID) ; get data for one category

 +1        NEW CIEN,DATA,CATDESC

 +2        IF '$DATA(^ENG(6911,"B",CATID))

               SET ^TMP(RNS,$JOB,0)="-404^"_CATID_" was not found in the EQUIPMENT CATEGORY file, #6911"

               QUIT 

 +3        SET CIEN=$ORDER(^ENG(6911,"B",CATID,""))

 +4       ; category description

           SET CATDESC=$PIECE($GET(^ENG(6911,CIEN,0)),U,1)

 +5        SET DATA=CIEN_U_CATDESC

 +6        SET RECCT=RECCT+1

 +7        SET ^TMP(RNS,$JOB,RECCT,0)=DATA

 +8        SET RETSTA=$NAME(^TMP(RNS,$JOB))

 +9        QUIT 

 +10      ;

GETSPCD(REQDATA,DATAID) ; retrieve AEMS space/location data from file 6928

 +1       ;

 +2       ; check asset is on file if info for single space/location requested

 +3        IF DATAID'="ALL"

               IF '$DATA(^ENG("SP",DATAID))

                   Begin DoDot:1

 +4                    SET ^TMP(RNS,$JOB,0)="-404^"_DATAID_" is not a recognized location in the ENG SPACE file, #6928"

                   End DoDot:1

                   QUIT 

 +5       ;

 +6        NEW RECCT

 +7        SET RECCT=0