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

HMPEQLM.m

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