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

HMPMONL.m

Go to the documentation of this file.
  1. HMPMONL ;ASMR/BL, monitor library support ;Sep 24, 2016 03:07:36
  1. ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2,3**;April 14,2016;Build 15
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q ; no entry from top
  1. ;DE6526, DE6644 - routine refactored, 7 September 2016
  1. ;
  1. LASTREAM() ; extrinsic variable, last freshness stream entry for this server, expects HMPMNTR in symbol table
  1. N SRVRNM,STREAM
  1. S SRVRNM=$P(HMPMNTR("zero node"),U) ; SERVER field (#.01)
  1. ; last freshness stream entry, $C(1) collates after all numerics
  1. S STREAM=$O(^XTMP("HMPFS~"_SRVRNM_"~9"_$C(1)),-1)
  1. Q:$P(STREAM,"~")'="HMPFS" "" ; not a freshness stream, return null
  1. Q:$P(STREAM,"~",2)'=SRVRNM "" ; nothing for this server, return null
  1. Q STREAM ; return freshness stream
  1. ;
  1. SLOTS() ; extrinsic variable, check HMP EXTRACT RESOURCE entry in RESOURCE file (#3.54)
  1. N HMPOUT
  1. ;^DD(3.54,1,0)= AVAILABLE SLOTS
  1. D FIND^DIC(3.54,"",1,"BX","HMP EXTRACT RESOURCE","","","","","HMPOUT") ; B cross-ref., exact match
  1. Q $G(HMPOUT("DILIST","ID",1,1)) ; AVAILABLE SLOTS
  1. ;
  1. FRESHPRE() ; extrinsic variable, return ^XTMP freshness prefix, expects HMPMNTR in symbol table
  1. Q "HMPFX~"_$P(HMPMNTR("zero node"),U)_"~" ; ^XTMP prefix from node zero in file 800000
  1. ;
  1. HDR(TXT) ; function, create header with TXT on left
  1. N HDR,X,Y
  1. S X=$G(HMPMNTR("site name"))_":"_$G(HMPMNTR("site hash")) ; header
  1. S Y=$S($L(X)>1:X,1:"eHMP support") ; in case HMPMNTR array not present
  1. S HDR=$J(Y,$L(Y)\2+40) ; center site name and hash
  1. S Y=$G(TXT),$E(HDR,1,$L(Y))=Y ;put TXT on the left
  1. S Y=$$NOW^HMPMONL,$E(HDR,80-$L(Y),79)=Y ; $$NOW on the right
  1. Q HDR ; header line
  1. ;
  1. NOW() ;extrinsic variable, return now in ISO format
  1. N HL7DT S HL7DT=$$FMTHL7^HMPSTMP($$NOW^XLFDT)
  1. ; e.g. 2016-12-20 09:26:51
  1. Q $E(HL7DT,1,4)_"-"_$E(HL7DT,5,6)_"-"_$E(HL7DT,7,8)_" "_$E(HL7DT,9,10)_":"_$E(HL7DT,11,12)_":"_$E(HL7DT,13,14)
  1. ;
  1. CHKIOSL ; handle end of page
  1. Q:'((IOSL-4)>$Y) ; not at bottom, exit
  1. D RTRN2CON ; prompt for return to continue
  1. Q:HMPROMPT=U ; no formfeed if timeout or '^'escape
  1. D FORMFEED ; clear screen
  1. Q
  1. ;
  1. NOTYET ;
  1. W !!,"* This feature not yet implemented.*",! Q
  1. ;
  1. RTRN2CON ; return to continue prompt
  1. N DIR,DIROUT,DUOUT,X,Y
  1. ;skip line, give user a prompt to continue
  1. W ! S DIR(0)="EA",DIR("A")="Press ENTER to continue: " D ^DIR ; handle the prompe here
  1. ; exit if user enters '^', if timeout leave DTOUT in symbol table
  1. S:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) HMPROMPT=U ; exit eHMP monitor
  1. Q
  1. ;
  1. FORMFEED ; issue form feed
  1. W @IOF S $X=0 Q ; reset cursor and $X
  1. ;