Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPEF

HMPEF.m

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