HMPEF ;SLC/MKB,ASMR/BL,RRB,JD,SRG,CK - Serve VistA operational data as JSON via RPC;Aug 29, 2016 20:06:27
 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2,3**;May 15, 2016;Build 15
 ;Per VA Directive 6402, this routine should not be modified.
 ;
 ; DE2818 - SQA findings. Newed L42 and L44 in LOC+1.  RRB - 10/30/2015
 ;
 ; DE6652 - JD - 9/1/16: Removed code behind synching sign-symptom domain for operational data.
 ;                       SIGNS tag.
 ;
 ; ^SC references - IA 10040, HOSPITAL LOCATION file (#44)
 ; ^DIC(42) references - IA #10039, WARD LOCATION file
 
Q
 
;
 ; The following variables can not be newed or killed because they are used
 ; from upstream by scope (NOT as input parameters):
 ;      HMPBATCH, HMPFADOM, HMPFLDON, HMPFZTSK, HMPMETA, HMPSTMP, LEX("LIST", and ZTQUEUED.
GET(HMP,FILTER) ; -- Return search results as JSON in @HMP@(n)
 ; RPC = HMP GET OPERATIONAL DATA
 ; where FILTER("domain")  = name of desired data type (see $$TAG)
 ;       FILTER("limit")   = maximum number of items to return [opt]
 ;       FILTER("start")   = ien to start search from          [opt]
 ;       FILTER("id")      = single item id to return          [opt]
 ;
 ; HMPLAST - last record processed
 
HMPSYS,TYPE,HMPMAX,HMPI,HMPID,HMPERR,HMPTN,HMPLAST,HMPCNT,HMPFINI
 
HMP=$NA(^TMP("HMP",$J)),HMPI=0 @HMP
 
HMPSYS=$$SYS^HMPUTILS ;DE4463 - CK - 4/22/2016
 ;
 ; parse & validate input parameters
 
TYPE=$P($G(FILTER("domain")),"#";,TYPE=$$LOW^XLFSTR(TYPE)
 
HMPMAX=+$G(FILTER("limit")),HMPCNT=0
 
HMPLAST=+$G(FILTER("start"))
 
HMPID=$G(FILTER("id"))
 
;
 
^TMP($J,"HMP ERROR")
 
;
 ; extract data
 
TYPE="" HMPERR="Missing or invalid reference type" GTQ
 
; *** convert code below to use $$HANDLE^XUSRB4 for zero node in ^XTMP, IA 4770***
 
I $D(ZTQUEUEDHMP=$NA(^XTMP(HMPBATCH,HMPFZTSK,FILTER("domain"))) @HMP
 
TYPE="new",$L($T(EN^HMPEFX)) EN^HMPEFX(HMPID,HMPMAXQ
 S 
HMPTN=$$TAG(TYPEQ:'$L(HMPTN)  ;D ERR(2) Q
 
@HMPTN
 
;
GTQ ; add item count and terminating characters
 
ERROR I $D(^TMP($J,"HMP ERROR"))>0 BUILDERR(.ERRORERROR(1)=ERROR(1)_"}"
 
+$G(FILTER("noHead"))=1 D  Q
 
.@HMP@("total")=+$G(HMPI)
 .
@HMP@("last")=HMPLAST
 
.@HMP@("finished")=+$G(HMPFINI)
 .
I $L($G(ERROR(1)))>1 @HMP@("error")=ERROR(1)
 
'$D(@HMP)!'$G(HMPID  Q
 
.'$D(^TMP($J,"HMP ERROR")) @HMP@(1)="""data"":{""totalItems"":0,""items"":[]}}" Q
 
.@HMP@(1)="""data"":{""totalItems"":0,""items"":[]},"
 
.@HMP@(2)=ERROR
 
;
 
I $D(@HMP),$G(HMPID
 
@HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""updated"":"""_$$HL7NOW_""",""currentItemCount"":"_HMPI
 
S:$G(HMPCNT) @HMP@(.5)=@HMP@(.5)_",""totalItems"":"_HMPCNT
 
S:$G(HMPLAST) @HMP@(.5)=@HMP@(.5)_",""last"":"_HMPLAST
 
@HMP@(.5)=@HMP@(.5)_",""items"":["
 
HMPI=HMPI+1,@HMP@(HMPI)=$S($D(^TMP($J,"HMP ERROR"))>0:"]}",1:"]}}")
 
I $D(^TMP($J,"HMP ERROR"))>0 HMPI=HMPI+1,@HMP@(HMPI,.3)="," @HMP@(HMPI)=ERROR ;S HMPI=HMPI+1,@HMP@(HMPI)="}"
 
^TMP($J,"HMP ERROR")
 
Q
 
;
BUILDERR(RESULT) ;  error array
 
CNT,COUNT,DOM,DOMCNT,ERRMSG,ERROR,FIELD,MESSAGE,MSG,MSGCNT,T,TEMP
 
COUNT=$G(^TMP($J,"HMP ERROR","# of Errors"))
 
MESSAGE="A mumps error occurred when extracting data. A total of "_COUNT_" occurred.\n\r"
 
CNT=1,ERROR("error","message","\",CNT)="A mumps error occurred when extracting patient data. A total of "_COUNT_" occurred.\n\r"
 
MSGCNT=0 F  S MSGCNT=$O(^TMP($J,"HMP ERROR","ERROR MESSAGE",MSGCNT)) Q:MSGCNT'>0  D
 
CNT=CNT+1,MESSAGE=MESSAGE_$G(^TMP($J,"HMP ERROR","ERROR MESSAGE",MSGCNT))_"\n\r"
 
RESULT(1)="""error"":{""message"":"_""""_MESSAGE_""""_"}"
 
Q
 
;
TAG(X) ; -- linetag for reference domain X
 
Y="HMP",X=$G(X)
 
; default = HMP Object (various types)
 
X="location"      Y="LOC"
 
X="pt-select"     Y="PAT"
 
X="person"        Y="NP"
 
X="user"          Y="NP"
 
X="labgroup"      Y="LABGRP"
 
X="labpanel"      Y="LABPNL"
 
X["orderable"     Y="OI"
 
X["schedule"      Y="SCHEDULE"
 
X["route"         Y="ROUTE"
 
X["quick"         Y="QO"
 
X="displayGroup"  Y="ODG"
 
X["asu-"          Y="ASU"
 
X["doc-"          Y="ASU"
 
X="immunization"    Y="IMMTYPE"
 
X="allergy-list"         Y="ALLTYPE"
 ;I X="problem-list"        S Y="PROB"
 
X="vital-type"      Y="VTYPE"
 
X="vital-qualifier"  Y="VQUAL"
 
X="vital-category"   Y="VCAT"
 
X["clioterm"      Y="MDTERMS"
 
Y
 
;
ERR(X,VAL) ;  return error message
 
MSG  MSG="Error"
 
X=2  MSG="Domain type '"_$G(VAL)_"' not recognized"
 
X=3  MSG="UID '"_$G(VAL)_"' not found"
 
X=99 MSG="Unknown request"
 
MSG
 
;
ERRMSG(X,VAL) ; -- return error message
 
Y="A MUMPS error occurred while extracting "_X_" data"
 
S:$G(VALY=Y_", ien "_VAL
 
Y
 
;
ERRQ ; -- Quit on error
 
Q
 
;
HL7NOW() ; -- Return current time in HL7 format
 
Q $$FMTHL7^HMPSTMP($$NOW^XLFDT)  ; DE5016
 ;
ALL() ;
 
"location;patient;person;orderable;schedule;route;quick;displayGroup;asu-class;asu-rule;asu-role;doc-action;doc-status;clioterm;immunization;allergy-list;sign-symptom;vital-type;vital-qualifier;vital-category"
 ;
ADD(ITEM) ; -- add ITEM to @HMP@(HMPI)
 
HMPY,HMPERR
 
I $G(HMPSTMP)]"" @ITEM@("stampTime")=HMPSTMP ; US6734
 
E  S @ITEM@("stampTime")=$$EN^HMPSTMP("NOW"; DE2616 - must add stampTime to receive OPD freshness update from ADHOC^HMPUTIL1
 
ENCODE^HMPJSON(ITEM,"HMPY","HMPERR")
 
I $D(HMPERRD  ;return ERRor instead of ITEM
 
HMPTMP,HMPTXT,HMPITM
 
HMPITM=@ITEM HMPY
 
HMPTXT(1)="Problem encoding json output."
 
SETERROR^HMPUTILS(.HMPTMP,.HMPERR,.HMPTXT,.HMPITM)
 . 
HMPERR ENCODE^HMPJSON("HMPTMP","HMPY","HMPERR")
 
I $D(HMPYD
 
Q:'$D(@ITEM@("uid"))
 . 
I $G(HMPMETAADD^HMPMETA($P(HMPFADOM,"#"),@ITEM@("uid"),HMPSTMPQ:HMPMETA=1  ;US6734,US11019
 
HMPI COMMA(HMPI)
 . 
;I HMPI,'$G(FILTER("noHead")) D COMMA(HMPI)
 
HMPI=HMPI+1 @HMP@(HMPI)=HMPY
 
Q
 
;
COMMA(I) ; -- add comma between items
 
I $D(ZTQUEUEDQ
 N 
J=+$O(@HMP@(I,"A"),-1) ;last sub-node for item I
 
J=J+1,@HMP@(I,J)=","
 
Q
 
;
TOTAL(ROOT) ; -- Return total #items in @ROOT@(n)
 
Q $P($G(@ROOT@(0)),U,4)
 
;
TEST(TYPE,ID,IN) ; -- test GET, write results to screen
 
OUT,IDX
 
U="^"
 
IN("domain")=$G(TYPE)
 
S:$D(IDIN("id")=ID
 
GET(.OUT,.IN)
 
;
 
IDX=OUT
 
F  S IDX=$Q(@IDXQ:IDX'?1"^TMP(""HMP"","1.N.E  Q:+$P(IDX,",",2)'=$J  W !,@IDX
 
Q
 
;
 ; ** Reference file searches, using FILTER("parameter")
 ;
PAT ;Patients
 
DFN,PAT,HMPPOPD
 
HMPPOPD=1
 
HMPCNT=$$TOTAL("^DPT")
 
I $G(HMPIDDFN=+HMPID LKUP^HMPDJ00 Q
 N 
ERRMSG ERRMSG="A mumps error occurred while extracting patients."
 
DFN=+$G(HMPLASTF  S DFN=$O(^DPT(DFN)) Q:'(DFN>0)  D  I HMPMAX>0,HMPI'<HMPMAX Q  ;DE4496 19 August 2016
 
N $ES,$ET
 
S $ET="D ERRHDLR^HMPDERRH"
 
I $P($G(^DPT(DFN,0)),U)="" LOGDPT^HMPLOG(DFNQ  ;DE4496 19 August 2016
 
ERRMSG=$$ERRMSG("Patient",DFN)
 . 
PAT LKUP^HMPDJ00
 . 
HMPLAST=DFN
 
'(DFN>0) HMPFINI=1  ;DE4496 19 August 2016
 
Q
LOC ; Hospital Location (#44) and Ward Location (#42)  /DE2818
 
LOC^HMPEF1(.HMPFINI,.HMPFLDON,$G(HMPMETA))
 
Q
 
;
ACTWRD(IEN) ;Boolean TRUE if active WARD LOCATION
 ; IEN - IEN in file 42
 
D0=IEN WIN^DGPMDDCF 'X  ; SRG: need DBIA
 ;
ACTLOC(LOC) ;Boolean TRUE if active hospital location
 ; ^SC - IA 10040
 
D0,+$G(^SC(LOC,"OOS")) 0                ; screen out OOS entry
 
D0=+$G(^SC(LOC,42)) D0 WIN^DGPMDDCF 'X  ; chk out of svc wards
 
X=$G(^SC(LOC,"I")) +X=0 1                 ; no inactivate date
 
DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) 0  ; chk reactivate date
 
1                                             ; must still be active
 ;
NP ;New Persons
 
NP^HMPEF1
 
Q
 
;
KEYS(IEN) ;user's keys
 
HMPKEY,IENS,X,CNT
 
GETS^DIQ(200,IEN_",","51*","IE","HMPKEY"CNT=0
 
IENS="" F  S IENS=$O(HMPKEY(200.051,IENS)) Q:IENS=""  D
 
X=$G(HMPKEY(200.051,IENS,.01,"E")),CNT=CNT+1
 . 
USER("vistaKeys",CNT,"name")=X
 
X=$G(HMPKEY(200.051,IENS,3,"I"))
 . 
S:X USER("vistaKeys",CNT,"reviewDate")=$$JSONDT^HMPUTILS(X)
 
Q
 
;
ODG ;
 
ADDODG^HMPCORD4
 
Q
 
;
OI ;
 
OI^HMPCORD4("PS^RAP^LRT")
 
Q
 
;
PROB ;get problem list OPD store
 
PROB^HMPEF1(.HMPFINI,LEX)
 
Q
 
;
QO ;
 
QO^HMPCORD4
 
Q
 
;
SCHEDULE ;
 
RESULT
 
ADDSCH^HMPCORD4
 
Q
 
;
ROUTE ;
 
RESULT
 
ADDROUTE^HMPCORD4
 
Q
 
;
HMP ; HMP Objects
 
IEN
 
HMPCNT=$$TOTAL("^HMP(800000.11)")
 
I $L(HMPIDD  Q
 
HMPID=+HMPID IEN=HMPID
 
E  S IEN=+$O(^HMP(800000.11,"B",HMPID,0))
 . 
ERRMSG=$$ERRMSG("HMP Object",IEN)
 . 
D:IEN HMP1^HMPDJ02(800000.11,IEN)
 
IEN=+$G(HMPLASTF  S IEN=$O(^HMP(800000.11,"C",TYPE,IEN)) Q:IEN<1  D  I HMPMAX>0,HMPI'<HMPMAX Q
 
ERRMSG=$$ERRMSG("HMP Object",IEN)
 . 
HMP1^HMPDJ02(800000.11,IENHMPLAST=IEN
 
IEN<1 HMPFINI=1
 
Q
 
;
SOURCE(SRC) ;
 
X=""
 
SRC["SC("        X="clinic"
 
SRC["DPT("       X="patient"
 
SRC["DIC(42"     X="ward"
 
SRC["SCTM"       X="pcmm"
 
SRC["OR(100.21"  X="cprs"
 
SRC["DIC(45.7"   X="specialty"
 
SRC["VA(200"     X="provider"
 
SRC["PXRM(810.4" X="pxrm"
 
X
 
;
ASU ; ASU files
 
X,RTN X=$P($G(TYPE),"-",2)
 
RTN=$$UP^XLFSTR(X)_"^HMPEASU"
 
X'="",$L($T(@RTN)) @RTN
 
Q
 
;
MDTERMS ; CP Terminology
 
D:$L($T(TERM^HMPMDUTL)) TERM^HMPMDUTL
 
Q
LABGRP ;
 
SHWCUMR2^HMPELAB
 
Q
LABPNL ;
 
SHWORPNL^HMPELAB
 
Q
 
;
 ;DE2818, changed reference to ^VA(201) to a FileMan call
ISPROXY(IEN) ; Boolean function, is NEW PERSON entry an APPLICATION PROXY?
 
APP,HMPMSG,HMPUCLS,T,V
 
; APP - returned value
 ; HMPUCLS - user class array
 ; HMPMSG - FileMan message array
 ;
 
GETS^DIQ(200,IEN_",","9.5*","E","HMPUCLS","HMPMSG")  ; get external format
 
APP=0,T="APPLICATION PROXY",V="HMPUCLS"
 ; search returned array for value equal to T
 
F  S V=$Q(@VQ:V=""!APP  S:@V=T APP=1
 
APP
 
;
IMMTYPE ;immunization types
 
IMMTYPE^HMPCORD5
 
Q
 
;
ALLTYPE ;allergy-list types
 ;BL;REMOVE FROM ODS
 ;D ALLTYPE^HMPCORD5
 
Q
 
;
VTYPE ;vital types
 
VTYPE^HMPCORD5
 
Q
 
;
VQUAL ;vital qualifiers
 
VQUAL^HMPCORD5
 
Q
 
;
VCAT ;vital categories
 
VCAT^HMPCORD5
 
Q
 
;
FILENAME ; text of filenames for search treeview
 ;;VA Allergies File
 ;;VA Allergies File (Synonyms)  SPACER ONLY - NOT DISPLAYED
 ;;National Drug File - Generic Drug Name
 ;;National Drug file - Trade Name
 ;;Local Drug File
 ;;Local Drug File (Synonyms)  SPACER ONLY - NOT DISPLAYED
 ;;Drug Ingredients File
 ;;VA Drug Class File
 ;;