- 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 Jan 18, 2025@02:55:09 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 ;