HMPEQLM ;SLC/MJK,ASMR/RRB - Event Queue Manager;30-JUN-2014
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; -- main entry point for HMPM EVT QUE MGR
N HMPSRV,HMPCSTRM,HMPDOM,HMPFIL,HMPWAIT,HMPDFN,HMPLIM
;
D DFLTS
;
S HMPSRV=$$GETSRV($G(HMPSRV))
Q:$G(HMPSRV)<1
;
S:$G(HMPDOM)="" HMPDOM="ALL"
S:$G(HMPFIL)="" HMPFIL="A"
D EN^VALM("HMPM EVT QUE MGR")
Q
;
HDR ; -- header code
N X,SRV0,SRVNM,LASTUP,REPEAT,FILLER K VALMHDR
S $P(FILLER," ",80)=" "
S SRV0=$G(^HMP(800000,+$G(HMPSRV),0))
S SRVNM=$P(SRV0,"^"),LASTUP=$P(SRV0,"^",2),REPEAT=$P(SRV0,"^",4)
S X=" Server: "_SRVNM_$E(FILLER,1,30-$L(SRVNM))_"Last Update: "_LASTUP
S:REPEAT X=X_" x"_REPEAT
S VALMHDR(1)=X
S X=$E(FILLER,1,44)_"End of Queue: "
S X=X_$S(HMPCSTRM]"":$P(HMPCSTRM,"~",3)_"-"_$G(^XTMP(HMPCSTRM,"last")),1:"n/a")
S VALMHDR(2)=X
S VALMHDR(3)=" Last Stream: "_HMPCSTRM
S X="Event Filters: "
S X=X_"State="_$S(HMPFIL="A":"All",HMPFIL="W":"Waiting",1:"Processed")
S X=X_" Domain="_HMPDOM_$S(HMPDOM="ALL"!(HMPDOM["sync"):"",1:$S($G(^XTMP("HMP-off",HMPDOM)):" (stopped)",1:" (active)"))
S X=X_" Max="_HMPLIM
S X=X_$S($G(HMPDFN):" Patient="_HMPDFN,1:"")
S VALMHDR(4)=X
Q
;
INIT ; -- init variables and list array
S:'$G(HMPLIM) HMPLIM=$$LIMIT
D BUILD
D HDR
D MSG
Q
;
BUILD ; -- build list
N SEQ,SEQNODE,X,PARAMS,HMPEVTS,HMPCNT
S HMPEVTS=$NA(^TMP("HMPM EVT QUE MGR",$J))
K @HMPEVTS
;
S PARAMS("server")=HMPSRV
S PARAMS("domain")=HMPDOM
S PARAMS("filter")=HMPFIL
S PARAMS("dfn")=$G(HMPDFN)
S PARAMS("max")=HMPLIM
;
D EVTS^HMPEQ(HMPEVTS,.PARAMS)
S HMPCSTRM=$G(@HMPEVTS@("stream"),"**** No Stream Found ****")
;
S HMPWAIT=0
D KILL
S (VALMCNT,HMPCNT)=0
S HMPI=0 F S HMPI=$O(@HMPEVTS@("events",HMPI)) Q:'HMPI D
. S SEQNODE=$G(@HMPEVTS@("events",HMPI,"node"))
. S SEQ=$G(@HMPEVTS@("events",HMPI,"sequence"))
. S HMPCNT=HMPCNT+1
. S X=""
. S X=$$SETFLD^VALM1($J(HMPCNT,3),X,"ID")
. I '$P(SEQNODE,"^",6) S HMPWAIT=1,X=$$SETFLD^VALM1("*",X,"STATE")
. S X=$$SETFLD^VALM1($J(SEQ,5),X,"SEQ")
. S X=$$SETFLD^VALM1(SEQNODE,X,"NODE")
. D SET(X,SEQNODE)
;
I VALMCNT=0 D NOROWS^HMPEQ("No events to display for specified criteria")
K VALMBG
S VALMBG=1
K @HMPEVTS
Q
;
SET(X,IDX) ; -- set the ListMan array and indexes
K VALMCNT
S VALMCNT=VALMCNT+1
S @VALMAR@(VALMCNT,0)=X
S @VALMAR@("IDX",VALMCNT,HMPCNT)=IDX
S @VALMAR@("ENTRY",HMPCNT)=IDX
Q
;
KILL ; -- kill off build data
K @VALMAR
; clean up video control data
D KILL^VALM10()
Q
;
MSG ; -- set default message
K VALMSG
S VALMSG=$S(HMPWAIT:" * waiting to be processed",1:"")
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
; -- save user criteria fro 7 days
Q:'$G(DUZ)
N NODE,X
S NODE="HMPM EVT QUE MGR"
K ^DISV(DUZ,NODE)
F X="HMPSRV","HMPDOM","HMPFIL","HMPDFN","HMPLIM" I $G(@X)]"" S ^DISV(DUZ,NODE,X)=@X
Q
;
DFLTS ; -- get user defaults
Q:'$G(DUZ)
N NODE,X
S NODE="HMPM EVT QUE MGR"
Q:'$D(^DISV(DUZ,NODE))
S X=0 F S X=$O(^DISV(DUZ,NODE,X)) Q:X="" S @X=^(X)
Q
;
EXPND ; -- expand code
Q
;
REFRESH ; -- refresh display
; protocol: HMPM EVT QUE REFRESH
D WAIT^DICD
D BUILD
D HDR
D MSG
S VALMBCK="R"
Q
;
CS ; -- change server
; protocol: HMPM EVT QUE CHANGE SERVER
D FULL^VALM1
N SRV
S SRV=$$GETSRV^HMPDJFSM()
I +SRV>0 S HMPSRV=+SRV
D REFRESH
Q
;
CD ; -- change domain
; protocol: HMPM EVT QUE CHANGE DOMAIN
N DIR,Y,X,DOMAINS,I,LIST,Y
D FULL^VALM1
D EVNTYPS^HMPDJFSM(.LIST)
S I=0 F S I=$O(LIST(I)) Q:'I S Y(LIST(I))=""
F X="syncNoop","syncDomain","syncError","syncStart","syncDone" S Y(X)=""
S X="",I=0
F S X=$O(Y(X)) Q:X="" S I=I+1 S DOMAINS(I)=X
S DOMAINS(999)="ALL"
S X="S^"
S I=0 F S I=$O(DOMAINS(I)) Q:I="" S X=X_I_":"_$G(DOMAINS(I))_";"
S DIR(0)=X
S DIR("A")="Select Domain"
S DIR("B")="ALL"
D ^DIR
I +Y>0 S HMPDOM=$G(DOMAINS(+Y))
D REFRESH
Q
;
LIMIT() ; -- get freshness events display limit
; -- set high testing in order to see many event types
Q $S($$PROD^XUPROD():10,1:200)
;
FILTER ; -- allows user to filter list
; protocol: HMPM EVT QUE FILTER
N DIR,Y,X
D FULL^VALM1
S X="S^"
S X=X_"A:All events;"
S X=X_"P:Processed events;"
S X=X_"W:Waiting to be processed events"
S DIR(0)=X
S DIR("A")="Select Event State"
S DIR("B")="All events"
D ^DIR
I Y="P" S HMPFIL=Y
I Y="W" S HMPFIL=Y
I Y="A" S HMPFIL=Y
D REFRESH
Q
;
SELPT ; select patient
; protocol" HMPM EVT QUE SELECT PATIENT
D FULL^VALM1
N Y,DIC
S DIC="^DPT("
S DIC(0)="AEMQ"
D ^DIC
S HMPDFN=$S(+Y>0:+Y,1:"")
D REFRESH
Q
;
CM ; change max
; protocol: HMPM EVT QUE CHANGE MAX LISTED
D FULL^VALM1
N DIR
S DIR(0)="N^10:1000:0"
S DIR("B")=$$LIMIT
S DIR("A")="Set Limit: "
D ^DIR
I +Y>0 S HMPLIM=+Y
D REFRESH
Q
;
DETAIL ; -- detailed display
; protocol: HMPM EVT QUE DISPLAY DETAILS
N HMPI,VALMY,HMPDASH,POST,DOMAIN,HMPREF,HMPDATA
S $P(HMPDASH,"=",80)=""
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"OS")
S HMPI=+$O(VALMY(""))
I HMPI>0 D
. S HMPREF="HMPDATA"
. S POST=$G(@VALMAR@("ENTRY",HMPI))
. W !!,HMPDASH
. W !!,"Posted Event Data: ",POST
. I $P(POST,"^",5) D
. . K HMPDATA
. . S HMPDATA(1,"label")="Added To Stream"
. . S HMPDATA(1,"value")=$$GETIME($P(HMPCSTRM,"~",3),$P(POST,"^",5))
. . D RENDER
. ;
. I $P(POST,"^",6) D
. . K HMPDATA
. . S HMPDATA(1,"label")="Processed Time"
. . S HMPDATA(1,"value")=$$GETIME($P(HMPCSTRM,"~",3),$P(POST,"^",6))
. . I $P(POST,"^",6)<$P(POST,"^",5) D
. . . S HMPDATA(2,"label")=""
. . . S HMPDATA(2,"value")=" - time before 'add' time means processed on a different date"
. . D RENDER
. ;
. ; -- domain info parsing and display
. S DOMAIN=$P(POST,"^",2)
. ;
. I +POST D PAT(HMPREF,+POST),RENDER
. I 'POST,DOMAIN="patient"!(DOMAIN="pt-select") D PAT(HMPREF,+$P(POST,"^",3)),RENDER
. ;
. I DOMAIN="med"!(DOMAIN="order") D MED(HMPREF,+$P(POST,"^",3)),RENDER
. I DOMAIN="consult" D CONSULT(HMPREF,+$P(POST,"^",3)),RENDER
. ; -- TODO: Need to understand HL7-type messages parsed in XQOR^HMPEVNT
. ;I DOMAIN="document" D TIU(+$P(POST,"^",3))
. ;I DOMAIN="lab" D LAB()
. ;I DOMAIN="image" D IMAGE()
. ;
. I DOMAIN="visit" D
. . N IEN
. . S IEN=$P(POST,"^",3)
. . I $E(IEN)="H" D ADM(HMPREF,+$E(IEN,2,999)),RENDER Q
. . D VISIT(HMPREF,+IEN),RENDER
. ;
. I DOMAIN="appointment" D APPT(HMPREF,$P(POST,"^",3)),RENDER
. ;
. I DOMAIN="user" D USER(HMPREF,+$P(POST,"^",3)),RENDER
. ;
. I DOMAIN="roster" D ROSTER(HMPREF,+$P(POST,"^",3)),RENDER
. ;
. ; -- HMP PATIENT OBJECT (#800000.1) domains
. I DOMAIN="auxiliary" D AUX(HMPREF,+$P(POST,"^",3)),RENDER
. I DOMAIN="diagnosis" D DIAG(HMPREF,+$P(POST,"^",3)),RENDER
. I DOMAIN="roadtrip" D ROAD(HMPREF,+$P(POST,"^",3)),RENDER
. I DOMAIN="task" D TASK(HMPREF,+$P(POST,"^",3)),RENDER
. ;
. W !!,HMPDASH
. D PAUSE^VALM1
;
K VALMBCK
S VALMBCK="R"
Q
;
GETIME(DATE,SECS) ; -- get time
N X
S X=$$FMTH^XLFDT(DATE),$P(X,",",2)=SECS
Q $P($$HTE^XLFDT(X,"S"),"@",2)
;
PAT(HMPZ,DFN) ; -- get patient info
N VA,HMPY,VAROOT
S VAROOT="HMPY"
D DEM^VADPT
K @HMPZ
S @HMPZ@(1,"label")="Patient Short ID"
S @HMPZ@(1,"value")=$G(VA("BID"))
Q
;
MED(HMPZ,ORDER) ; -- display order info
N IEN,ORDABLE,CNT
K @HMPZ
S (CNT,IEN)=0
F S IEN=$O(^OR(100,+$G(ORDER),.1,IEN)) Q:'IEN S ORDABLE=+$G(^(IEN,0)) D
. S CNT=CNT+1
. S @HMPZ@(CNT,"label")="Orderable"
. S @HMPZ@(CNT,"value")=$P($G(^ORD(101.43,ORDABLE,0)),"^")
Q
;
TIU(HMPZ,IEN) ; -- get TIU document type
K @HMPZ
S @HMPZ@(1,"label")="Document Type"
S @HMPZ@(1,"value")=$$GET1^DIQ(8925.1,+$$GET1^DIQ(8925,IEN_",",.01)_",",.01)
Q
;
USER(HMPZ,IEN) ; -- get user name
K @HMPZ
S @HMPZ@(1,"label")="User"
S @HMPZ@(1,"value")=$$GET1^DIQ(200,IEN_",",.01)
Q
;
ROSTER(HMPZ,IEN) ; -- get roster name
K @HMPZ
S @HMPZ@(1,"label")="Roster"
S @HMPZ@(1,"value")=$$GET1^DIQ(800001.2,IEN_",",.01)
Q
;
; -- TODO: is this real or just a dev anomaly
AUX(HMPZ,IEN) ; -- get auxiliary uid
K @HMPZ
S @HMPZ@(1,"label")="Auxiliary UID"
S @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
Q
;
; -- TODO: is this real or just a dev anomaly
DIAG(HMPZ,IEN) ; -- get diagnosis uid
K @HMPZ
S @HMPZ@(1,"label")="Diagnosis UID"
S @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
Q
;
; -- TODO: is this real or just a dev anomaly
ROAD(HMPZ,IEN) ; -- get roadtrip uid
K @HMPZ
S @HMPZ@(1,"label")="Road Trip UID"
S @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
Q
;
TASK(HMPZ,IEN) ; -- get task uid
K @HMPZ
S @HMPZ@(1,"label")="Task UID"
S @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
Q
;
CONSULT(HMPZ,IEN) ; -- get consult date
K @HMPZ
S @HMPZ@(1,"label")="Consult Date/Time"
S @HMPZ@(1,"value")=$$GET1^DIQ(123,IEN_",",.01)
Q
;
VISIT(HMPZ,IEN) ; -- get visit date/time
K @HMPZ
S @HMPZ@(1,"label")="Visit date/time"
S @HMPZ@(1,"value")=$$GET1^DIQ(9000010,IEN_",",.01)
Q
;
ADM(HMPZ,IEN) ; -- get admission date/time
K @HMPZ
S @HMPZ@(1,"label")="Admission date/time"
S @HMPZ@(1,"value")=$$GET1^DIQ(405,IEN_",",.01)
Q
;
APPT(HMPZ,MAP) ; -- get appointment data/time and clinic
N IENS
S IENS=+$P(MAP,";",3)_","_+$P(MAP,";",2)_","
K @HMPZ
S @HMPZ@(1,"label")="Appointment date/time"
S @HMPZ@(1,"value")=$$GET1^DIQ(2.98,IENS,.001)
S @HMPZ@(2,"label")="Clinic"
S @HMPZ@(2,"value")=$$GET1^DIQ(2.98,IENS,.01)
Q
;
RENDER ; -- write info
N I
S I=0 F S I=$O(HMPDATA(I)) Q:'I W !," o ",$G(HMPDATA(I,"label")),": ",$G(HMPDATA(I,"value"))
Q
;
SHOWHMPN ; -- show HMP global nodes
; protocol: HMPM EVT QUE SHOW TEMP GLOBALS
D FULL^VALM1
D EN^HMPEQLM2($G(HMPSRV))
D REFRESH
Q
;
FSHRPT ; -- show overall freshness report
; protocol: HMPM EVT QUE FRESHNESS REPORT
D FULL^VALM1
D EN^HMPEQLM1($G(HMPSRV))
D REFRESH
Q
;
EMERSTOP ; -- stop freshness
; protocol: HMPM EVT QUE EMERGENCY STOP (not distributed)
D FULL^VALM1
;D EMERSTOP^HMPDJFSM
D REFRESH
Q
;
RSTRTFR ; -- re-start freshness
; protocol: HMPM EVT QUE RESTART FRESHNESS (not distributed)
D FULL^VALM1
;D RSTRTFR^HMPDJFSM
D REFRESH
Q
;
GETSRV(DFLT) ; Return the IEN for the server to monitor
N DIC,Y
S DIC="^HMP(800000,",DIC(0)="AEMQ",DIC("A")="Select HMP server instance: "
I $G(DFLT) S DIC("B")=$P($G(^HMP(800000,$G(DFLT),0)),"^")
D ^DIC
Q +Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPEQLM 10626 printed Oct 16, 2024@17:54:37 Page 2
HMPEQLM ;SLC/MJK,ASMR/RRB - Event Queue Manager;30-JUN-2014
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; -- main entry point for HMPM EVT QUE MGR
+1 NEW HMPSRV,HMPCSTRM,HMPDOM,HMPFIL,HMPWAIT,HMPDFN,HMPLIM
+2 ;
+3 DO DFLTS
+4 ;
+5 SET HMPSRV=$$GETSRV($GET(HMPSRV))
+6 if $GET(HMPSRV)<1
QUIT
+7 ;
+8 if $GET(HMPDOM)=""
SET HMPDOM="ALL"
+9 if $GET(HMPFIL)=""
SET HMPFIL="A"
+10 DO EN^VALM("HMPM EVT QUE MGR")
+11 QUIT
+12 ;
HDR ; -- header code
+1 NEW X,SRV0,SRVNM,LASTUP,REPEAT,FILLER
KILL VALMHDR
+2 SET $PIECE(FILLER," ",80)=" "
+3 SET SRV0=$GET(^HMP(800000,+$GET(HMPSRV),0))
+4 SET SRVNM=$PIECE(SRV0,"^")
SET LASTUP=$PIECE(SRV0,"^",2)
SET REPEAT=$PIECE(SRV0,"^",4)
+5 SET X=" Server: "_SRVNM_$EXTRACT(FILLER,1,30-$LENGTH(SRVNM))_"Last Update: "_LASTUP
+6 if REPEAT
SET X=X_" x"_REPEAT
+7 SET VALMHDR(1)=X
+8 SET X=$EXTRACT(FILLER,1,44)_"End of Queue: "
+9 SET X=X_$SELECT(HMPCSTRM]"":$PIECE(HMPCSTRM,"~",3)_"-"_$GET(^XTMP(HMPCSTRM,"last")),1:"n/a")
+10 SET VALMHDR(2)=X
+11 SET VALMHDR(3)=" Last Stream: "_HMPCSTRM
+12 SET X="Event Filters: "
+13 SET X=X_"State="_$SELECT(HMPFIL="A":"All",HMPFIL="W":"Waiting",1:"Processed")
+14 SET X=X_" Domain="_HMPDOM_$SELECT(HMPDOM="ALL"!(HMPDOM["sync"):"",1:$SELECT($GET(^XTMP("HMP-off",HMPDOM)):" (stopped)",1:" (active)"))
+15 SET X=X_" Max="_HMPLIM
+16 SET X=X_$SELECT($GET(HMPDFN):" Patient="_HMPDFN,1:"")
+17 SET VALMHDR(4)=X
+18 QUIT
+19 ;
INIT ; -- init variables and list array
+1 if '$GET(HMPLIM)
SET HMPLIM=$$LIMIT
+2 DO BUILD
+3 DO HDR
+4 DO MSG
+5 QUIT
+6 ;
BUILD ; -- build list
+1 NEW SEQ,SEQNODE,X,PARAMS,HMPEVTS,HMPCNT
+2 SET HMPEVTS=$NAME(^TMP("HMPM EVT QUE MGR",$JOB))
+3 KILL @HMPEVTS
+4 ;
+5 SET PARAMS("server")=HMPSRV
+6 SET PARAMS("domain")=HMPDOM
+7 SET PARAMS("filter")=HMPFIL
+8 SET PARAMS("dfn")=$GET(HMPDFN)
+9 SET PARAMS("max")=HMPLIM
+10 ;
+11 DO EVTS^HMPEQ(HMPEVTS,.PARAMS)
+12 SET HMPCSTRM=$GET(@HMPEVTS@("stream"),"**** No Stream Found ****")
+13 ;
+14 SET HMPWAIT=0
+15 DO KILL
+16 SET (VALMCNT,HMPCNT)=0
+17 SET HMPI=0
FOR
SET HMPI=$ORDER(@HMPEVTS@("events",HMPI))
if 'HMPI
QUIT
Begin DoDot:1
+18 SET SEQNODE=$GET(@HMPEVTS@("events",HMPI,"node"))
+19 SET SEQ=$GET(@HMPEVTS@("events",HMPI,"sequence"))
+20 SET HMPCNT=HMPCNT+1
+21 SET X=""
+22 SET X=$$SETFLD^VALM1($JUSTIFY(HMPCNT,3),X,"ID")
+23 IF '$PIECE(SEQNODE,"^",6)
SET HMPWAIT=1
SET X=$$SETFLD^VALM1("*",X,"STATE")
+24 SET X=$$SETFLD^VALM1($JUSTIFY(SEQ,5),X,"SEQ")
+25 SET X=$$SETFLD^VALM1(SEQNODE,X,"NODE")
+26 DO SET(X,SEQNODE)
End DoDot:1
+27 ;
+28 IF VALMCNT=0
DO NOROWS^HMPEQ("No events to display for specified criteria")
+29 KILL VALMBG
+30 SET VALMBG=1
+31 KILL @HMPEVTS
+32 QUIT
+33 ;
SET(X,IDX) ; -- set the ListMan array and indexes
+1 KILL VALMCNT
+2 SET VALMCNT=VALMCNT+1
+3 SET @VALMAR@(VALMCNT,0)=X
+4 SET @VALMAR@("IDX",VALMCNT,HMPCNT)=IDX
+5 SET @VALMAR@("ENTRY",HMPCNT)=IDX
+6 QUIT
+7 ;
KILL ; -- kill off build data
+1 KILL @VALMAR
+2 ; clean up video control data
+3 DO KILL^VALM10()
+4 QUIT
+5 ;
MSG ; -- set default message
+1 KILL VALMSG
+2 SET VALMSG=$SELECT(HMPWAIT:" * waiting to be processed",1:"")
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 ; -- save user criteria fro 7 days
+2 if '$GET(DUZ)
QUIT
+3 NEW NODE,X
+4 SET NODE="HMPM EVT QUE MGR"
+5 KILL ^DISV(DUZ,NODE)
+6 FOR X="HMPSRV","HMPDOM","HMPFIL","HMPDFN","HMPLIM"
IF $GET(@X)]""
SET ^DISV(DUZ,NODE,X)=@X
+7 QUIT
+8 ;
DFLTS ; -- get user defaults
+1 if '$GET(DUZ)
QUIT
+2 NEW NODE,X
+3 SET NODE="HMPM EVT QUE MGR"
+4 if '$DATA(^DISV(DUZ,NODE))
QUIT
+5 SET X=0
FOR
SET X=$ORDER(^DISV(DUZ,NODE,X))
if X=""
QUIT
SET @X=^(X)
+6 QUIT
+7 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
REFRESH ; -- refresh display
+1 ; protocol: HMPM EVT QUE REFRESH
+2 DO WAIT^DICD
+3 DO BUILD
+4 DO HDR
+5 DO MSG
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
CS ; -- change server
+1 ; protocol: HMPM EVT QUE CHANGE SERVER
+2 DO FULL^VALM1
+3 NEW SRV
+4 SET SRV=$$GETSRV^HMPDJFSM()
+5 IF +SRV>0
SET HMPSRV=+SRV
+6 DO REFRESH
+7 QUIT
+8 ;
CD ; -- change domain
+1 ; protocol: HMPM EVT QUE CHANGE DOMAIN
+2 NEW DIR,Y,X,DOMAINS,I,LIST,Y
+3 DO FULL^VALM1
+4 DO EVNTYPS^HMPDJFSM(.LIST)
+5 SET I=0
FOR
SET I=$ORDER(LIST(I))
if 'I
QUIT
SET Y(LIST(I))=""
+6 FOR X="syncNoop","syncDomain","syncError","syncStart","syncDone"
SET Y(X)=""
+7 SET X=""
SET I=0
+8 FOR
SET X=$ORDER(Y(X))
if X=""
QUIT
SET I=I+1
SET DOMAINS(I)=X
+9 SET DOMAINS(999)="ALL"
+10 SET X="S^"
+11 SET I=0
FOR
SET I=$ORDER(DOMAINS(I))
if I=""
QUIT
SET X=X_I_":"_$GET(DOMAINS(I))_";"
+12 SET DIR(0)=X
+13 SET DIR("A")="Select Domain"
+14 SET DIR("B")="ALL"
+15 DO ^DIR
+16 IF +Y>0
SET HMPDOM=$GET(DOMAINS(+Y))
+17 DO REFRESH
+18 QUIT
+19 ;
LIMIT() ; -- get freshness events display limit
+1 ; -- set high testing in order to see many event types
+2 QUIT $SELECT($$PROD^XUPROD():10,1:200)
+3 ;
FILTER ; -- allows user to filter list
+1 ; protocol: HMPM EVT QUE FILTER
+2 NEW DIR,Y,X
+3 DO FULL^VALM1
+4 SET X="S^"
+5 SET X=X_"A:All events;"
+6 SET X=X_"P:Processed events;"
+7 SET X=X_"W:Waiting to be processed events"
+8 SET DIR(0)=X
+9 SET DIR("A")="Select Event State"
+10 SET DIR("B")="All events"
+11 DO ^DIR
+12 IF Y="P"
SET HMPFIL=Y
+13 IF Y="W"
SET HMPFIL=Y
+14 IF Y="A"
SET HMPFIL=Y
+15 DO REFRESH
+16 QUIT
+17 ;
SELPT ; select patient
+1 ; protocol" HMPM EVT QUE SELECT PATIENT
+2 DO FULL^VALM1
+3 NEW Y,DIC
+4 SET DIC="^DPT("
+5 SET DIC(0)="AEMQ"
+6 DO ^DIC
+7 SET HMPDFN=$SELECT(+Y>0:+Y,1:"")
+8 DO REFRESH
+9 QUIT
+10 ;
CM ; change max
+1 ; protocol: HMPM EVT QUE CHANGE MAX LISTED
+2 DO FULL^VALM1
+3 NEW DIR
+4 SET DIR(0)="N^10:1000:0"
+5 SET DIR("B")=$$LIMIT
+6 SET DIR("A")="Set Limit: "
+7 DO ^DIR
+8 IF +Y>0
SET HMPLIM=+Y
+9 DO REFRESH
+10 QUIT
+11 ;
DETAIL ; -- detailed display
+1 ; protocol: HMPM EVT QUE DISPLAY DETAILS
+2 NEW HMPI,VALMY,HMPDASH,POST,DOMAIN,HMPREF,HMPDATA
+3 SET $PIECE(HMPDASH,"=",80)=""
+4 DO FULL^VALM1
+5 DO EN^VALM2(XQORNOD(0),"OS")
+6 SET HMPI=+$ORDER(VALMY(""))
+7 IF HMPI>0
Begin DoDot:1
+8 SET HMPREF="HMPDATA"
+9 SET POST=$GET(@VALMAR@("ENTRY",HMPI))
+10 WRITE !!,HMPDASH
+11 WRITE !!,"Posted Event Data: ",POST
+12 IF $PIECE(POST,"^",5)
Begin DoDot:2
+13 KILL HMPDATA
+14 SET HMPDATA(1,"label")="Added To Stream"
+15 SET HMPDATA(1,"value")=$$GETIME($PIECE(HMPCSTRM,"~",3),$PIECE(POST,"^",5))
+16 DO RENDER
End DoDot:2
+17 ;
+18 IF $PIECE(POST,"^",6)
Begin DoDot:2
+19 KILL HMPDATA
+20 SET HMPDATA(1,"label")="Processed Time"
+21 SET HMPDATA(1,"value")=$$GETIME($PIECE(HMPCSTRM,"~",3),$PIECE(POST,"^",6))
+22 IF $PIECE(POST,"^",6)<$PIECE(POST,"^",5)
Begin DoDot:3
+23 SET HMPDATA(2,"label")=""
+24 SET HMPDATA(2,"value")=" - time before 'add' time means processed on a different date"
End DoDot:3
+25 DO RENDER
End DoDot:2
+26 ;
+27 ; -- domain info parsing and display
+28 SET DOMAIN=$PIECE(POST,"^",2)
+29 ;
+30 IF +POST
DO PAT(HMPREF,+POST)
DO RENDER
+31 IF 'POST
IF DOMAIN="patient"!(DOMAIN="pt-select")
DO PAT(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+32 ;
+33 IF DOMAIN="med"!(DOMAIN="order")
DO MED(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+34 IF DOMAIN="consult"
DO CONSULT(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+35 ; -- TODO: Need to understand HL7-type messages parsed in XQOR^HMPEVNT
+36 ;I DOMAIN="document" D TIU(+$P(POST,"^",3))
+37 ;I DOMAIN="lab" D LAB()
+38 ;I DOMAIN="image" D IMAGE()
+39 ;
+40 IF DOMAIN="visit"
Begin DoDot:2
+41 NEW IEN
+42 SET IEN=$PIECE(POST,"^",3)
+43 IF $EXTRACT(IEN)="H"
DO ADM(HMPREF,+$EXTRACT(IEN,2,999))
DO RENDER
QUIT
+44 DO VISIT(HMPREF,+IEN)
DO RENDER
End DoDot:2
+45 ;
+46 IF DOMAIN="appointment"
DO APPT(HMPREF,$PIECE(POST,"^",3))
DO RENDER
+47 ;
+48 IF DOMAIN="user"
DO USER(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+49 ;
+50 IF DOMAIN="roster"
DO ROSTER(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+51 ;
+52 ; -- HMP PATIENT OBJECT (#800000.1) domains
+53 IF DOMAIN="auxiliary"
DO AUX(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+54 IF DOMAIN="diagnosis"
DO DIAG(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+55 IF DOMAIN="roadtrip"
DO ROAD(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+56 IF DOMAIN="task"
DO TASK(HMPREF,+$PIECE(POST,"^",3))
DO RENDER
+57 ;
+58 WRITE !!,HMPDASH
+59 DO PAUSE^VALM1
End DoDot:1
+60 ;
+61 KILL VALMBCK
+62 SET VALMBCK="R"
+63 QUIT
+64 ;
GETIME(DATE,SECS) ; -- get time
+1 NEW X
+2 SET X=$$FMTH^XLFDT(DATE)
SET $PIECE(X,",",2)=SECS
+3 QUIT $PIECE($$HTE^XLFDT(X,"S"),"@",2)
+4 ;
PAT(HMPZ,DFN) ; -- get patient info
+1 NEW VA,HMPY,VAROOT
+2 SET VAROOT="HMPY"
+3 DO DEM^VADPT
+4 KILL @HMPZ
+5 SET @HMPZ@(1,"label")="Patient Short ID"
+6 SET @HMPZ@(1,"value")=$GET(VA("BID"))
+7 QUIT
+8 ;
MED(HMPZ,ORDER) ; -- display order info
+1 NEW IEN,ORDABLE,CNT
+2 KILL @HMPZ
+3 SET (CNT,IEN)=0
+4 FOR
SET IEN=$ORDER(^OR(100,+$GET(ORDER),.1,IEN))
if 'IEN
QUIT
SET ORDABLE=+$GET(^(IEN,0))
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET @HMPZ@(CNT,"label")="Orderable"
+7 SET @HMPZ@(CNT,"value")=$PIECE($GET(^ORD(101.43,ORDABLE,0)),"^")
End DoDot:1
+8 QUIT
+9 ;
TIU(HMPZ,IEN) ; -- get TIU document type
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Document Type"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(8925.1,+$$GET1^DIQ(8925,IEN_",",.01)_",",.01)
+4 QUIT
+5 ;
USER(HMPZ,IEN) ; -- get user name
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="User"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(200,IEN_",",.01)
+4 QUIT
+5 ;
ROSTER(HMPZ,IEN) ; -- get roster name
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Roster"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(800001.2,IEN_",",.01)
+4 QUIT
+5 ;
+6 ; -- TODO: is this real or just a dev anomaly
AUX(HMPZ,IEN) ; -- get auxiliary uid
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Auxiliary UID"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
+4 QUIT
+5 ;
+6 ; -- TODO: is this real or just a dev anomaly
DIAG(HMPZ,IEN) ; -- get diagnosis uid
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Diagnosis UID"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
+4 QUIT
+5 ;
+6 ; -- TODO: is this real or just a dev anomaly
ROAD(HMPZ,IEN) ; -- get roadtrip uid
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Road Trip UID"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
+4 QUIT
+5 ;
TASK(HMPZ,IEN) ; -- get task uid
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Task UID"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(800000.1,IEN_",",.01)
+4 QUIT
+5 ;
CONSULT(HMPZ,IEN) ; -- get consult date
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Consult Date/Time"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(123,IEN_",",.01)
+4 QUIT
+5 ;
VISIT(HMPZ,IEN) ; -- get visit date/time
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Visit date/time"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(9000010,IEN_",",.01)
+4 QUIT
+5 ;
ADM(HMPZ,IEN) ; -- get admission date/time
+1 KILL @HMPZ
+2 SET @HMPZ@(1,"label")="Admission date/time"
+3 SET @HMPZ@(1,"value")=$$GET1^DIQ(405,IEN_",",.01)
+4 QUIT
+5 ;
APPT(HMPZ,MAP) ; -- get appointment data/time and clinic
+1 NEW IENS
+2 SET IENS=+$PIECE(MAP,";",3)_","_+$PIECE(MAP,";",2)_","
+3 KILL @HMPZ
+4 SET @HMPZ@(1,"label")="Appointment date/time"
+5 SET @HMPZ@(1,"value")=$$GET1^DIQ(2.98,IENS,.001)
+6 SET @HMPZ@(2,"label")="Clinic"
+7 SET @HMPZ@(2,"value")=$$GET1^DIQ(2.98,IENS,.01)
+8 QUIT
+9 ;
RENDER ; -- write info
+1 NEW I
+2 SET I=0
FOR
SET I=$ORDER(HMPDATA(I))
if 'I
QUIT
WRITE !," o ",$GET(HMPDATA(I,"label")),": ",$GET(HMPDATA(I,"value"))
+3 QUIT
+4 ;
SHOWHMPN ; -- show HMP global nodes
+1 ; protocol: HMPM EVT QUE SHOW TEMP GLOBALS
+2 DO FULL^VALM1
+3 DO EN^HMPEQLM2($GET(HMPSRV))
+4 DO REFRESH
+5 QUIT
+6 ;
FSHRPT ; -- show overall freshness report
+1 ; protocol: HMPM EVT QUE FRESHNESS REPORT
+2 DO FULL^VALM1
+3 DO EN^HMPEQLM1($GET(HMPSRV))
+4 DO REFRESH
+5 QUIT
+6 ;
EMERSTOP ; -- stop freshness
+1 ; protocol: HMPM EVT QUE EMERGENCY STOP (not distributed)
+2 DO FULL^VALM1
+3 ;D EMERSTOP^HMPDJFSM
+4 DO REFRESH
+5 QUIT
+6 ;
RSTRTFR ; -- re-start freshness
+1 ; protocol: HMPM EVT QUE RESTART FRESHNESS (not distributed)
+2 DO FULL^VALM1
+3 ;D RSTRTFR^HMPDJFSM
+4 DO REFRESH
+5 QUIT
+6 ;
GETSRV(DFLT) ; Return the IEN for the server to monitor
+1 NEW DIC,Y
+2 SET DIC="^HMP(800000,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select HMP server instance: "
+3 IF $GET(DFLT)
SET DIC("B")=$PIECE($GET(^HMP(800000,$GET(DFLT),0)),"^")
+4 DO ^DIC
+5 QUIT +Y
+6 ;
