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