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