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 ---[H[J[2J[HVIAAEAD 13286 printed Dec 13, 2024@02:33:10 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
+8 ; return info for a single space/location
+9 IF DATAID'="ALL"
Begin DoDot:1
+10 DO GETSPCD1(DATAID)
End DoDot:1
QUIT
+11 ;
+12 ; return info for all spaces/locations
+13 ; location description
NEW LOCDESC
+14 SET LOCDESC=""
+15 FOR
SET LOCDESC=$ORDER(^ENG("SP","B",LOCDESC))
if LOCDESC=""
QUIT
Begin DoDot:1
+16 DO GETSPCD2(LOCDESC)
End DoDot:1
+17 IF RECCT=0
SET ^TMP(RNS,$JOB,0)="-404^No data found"
+18 SET RETSTA=$NAME(^TMP(RNS,$JOB))
+19 QUIT
+20 ;
GETSPCD1(LOCID) ; get data for one location
+1 NEW DATA,LOCDESC
+2 IF +LOCID=0
SET ^TMP(RNS,$JOB,0)="-404^"_LOCID_" is not a valid Location ID in the ENG SPACE file, #6928"
QUIT
+3 SET LOCDESC=$PIECE(^ENG("SP",LOCID,0),U,1)
+4 SET DATA=LOCID_U_LOCDESC
+5 SET RECCT=RECCT+1
+6 SET ^TMP(RNS,$JOB,RECCT,0)=DATA
+7 SET RETSTA=$NAME(^TMP(RNS,$JOB))
+8 QUIT
+9 ;
GETSPCD2(LOCDESC) ; get data for all locations
+1 NEW DATA,LOCIEN
+2 SET LOCIEN=$ORDER(^ENG("SP","B",LOCDESC,""))
+3 SET DATA=LOCIEN_U_LOCDESC
+4 SET RECCT=RECCT+1
+5 SET ^TMP(RNS,$JOB,RECCT,0)=DATA
+6 SET RETSTA=$NAME(^TMP(RNS,$JOB))
+7 QUIT
+8 ;
GETNEENS(RETSTA,AEMSID,NUMBER) ; Get a number of AEMSID's
+1 ;
+2 SET AEMSID=$GET(AEMSID)
+3 SET NUMBER=$GET(NUMBER,50)
+4 IF NUMBER'=+NUMBER
SET RETSTA="Number must be numeric"
QUIT
+5 SET RNS="VIAAENR"
SET REQDATA="EQUIPMENT"
+6 KILL ^TMP(RNS,$JOB)
+7 SET RECCT=0
+8 FOR
SET AEMSID=$ORDER(^ENG(6914,"EE",AEMSID))
if AEMSID=""
QUIT
if RECCT=NUMBER
QUIT
Begin DoDot:1
+9 SET RECCT=RECCT+1
+10 SET ^TMP(RNS,$JOB,RECCT,0)=AEMSID
End DoDot:1
+11 IF RECCT=0
SET ^TMP(RNS,$JOB,0)="-404^No data found"
+12 SET RETSTA=$NAME(^TMP(RNS,$JOB))
+13 QUIT
+14 ;
EQSEED(RETSTA,AEMSID,LOCID,TMSTMP) ; RPC to save an equipment move into AEMS
+1 ; When equipment moves to a new location
+2 ; this function updates the following fields in file 6914:
+3 ; LOCATION
+4 ;
+5 ; RETSTA is the name of the return array
+6 ; AEMSID is equipment ID (IEN in 6914)
+7 ; LOCID is the identity of the location at which the equipment is arriving
+8 ; TMSTMP is timestamp in ISO format
+9 ;
+10 SET RETSTA=1
+11 IF $GET(AEMSID)=""
SET RETSTA="-400^AEMS ID "_AEMSID_" not specified for EQUIPMENT INV. file, #6914"
QUIT
+12 IF $GET(LOCID)=""
SET RETSTA="-400^Location ID not specified for ENG SPACE file, #6928"
QUIT
+13 IF $GET(TMSTMP)=""
SET RETSTA="-400^timestamp not specified"
QUIT
+14 IF '$DATA(^ENG(6914,"EE",AEMSID))
SET RETSTA="-404^"_AEMSID_" AEMS IEN was not found in the EQUIPMENT INV. file, #6914"
QUIT
+15 NEW FDA,ERR
+16 ; convert timestamp from ISO format to FileMan internal format
+17 SET TMSTMP=$$ISO2FM(TMSTMP)
+18 SET AEMSID=$ORDER(^ENG(6914,"EE",AEMSID,""))
+19 ; need to establish LOCID format
+20 SET FDA(6914,AEMSID_",",23)=TMSTMP
+21 SET FDA(6914,AEMSID_",",24)=LOCID
+22 DO UPDATE^DIE(,"FDA",,"ERR")
+23 IF $DATA(ERR)
SET RETSTA="-500^update failed"
QUIT
+24 SET RETSTA="1^update successful"
+25 QUIT
+26 ;
ISO2FM(TMSTMP) ; External date to FM date
+1 ; incoming format yyyy-mm-dd<space>hh:MM:ss
+2 ; e.g. 2012-02-07 09:08:06
+3 NEW D,P,DTTM,DTTT
+4 SET D="-"
SET P="."
+5 ; first convert incoming date to an HL7 format
+6 SET DTTT=$PIECE(TMSTMP,D,4)
+7 SET DTTM=$TRANSLATE($PIECE(TMSTMP,D,1,3),":- ")
+8 SET $PIECE(DTTM,D,2)=$EXTRACT(10000+DTTT,2,5)
+9 ; then convert HL7 date to FM date
+10 SET DTTM=$$HL7TFM^XLFDT(DTTM)
+11 QUIT DTTM
+12 ;
FM2ISO(DATE) ; convert FM date to ISO date
+1 NEW DTTM,D,P,C
+2 SET C=":"
SET D="-"
SET P="."
+3 SET DATE=$$FMTHL7^XLFDT(DATE)
+4 SET DTTM=$EXTRACT(DATE,1,4)_D_$EXTRACT(DATE,5,6)_D_$EXTRACT(DATE,7,8)
+5 SET DTTM=DTTM_"T"
+6 SET DTTM=DTTM_$EXTRACT(DATE,9,10)_C_$EXTRACT(DATE,11,12)_C_$EXTRACT(DATE,13,14)_P_"000"
+7 SET DTTM=DTTM_D_$EXTRACT(DATE,16,17)_C_$EXTRACT(DATE,18,19)
+8 QUIT DTTM
+9 ;
SYN(CATEG) ; get all synonyms for a given category in a piece of equipment
+1 NEW I,COUNT,RECDEL,SYNON
+2 ; record delimiter
SET RECDEL="|"
+3 ;
+4 SET COUNT=+$PIECE($GET(^ENG(6911,CATEG,1,0)),U,4)
+5 ; no synonyms found
IF $GET(COUNT)=0!($GET(COUNT)=1)
SET CATDET2=""
QUIT CATDET2
+6 FOR I=2:1:COUNT
Begin DoDot:1
+7 SET SYNON=$GET(SYNON)_RECDEL_$PIECE($GET(^ENG(6911,CATEG,1,I,0)),U)
End DoDot:1
+8 ; remaining category synonyms
SET CATDET2=SYNON
+9 QUIT CATDET2
