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