HLOUSR ;ALB/CJM/OAK/PIJ/RBN -ListManager Screen for viewing system status;12 JUN 1997 10:00 am ;02/28/2012
;;1.6;HEALTH LEVEL SEVEN;**126,130,134,137,138,139,146,147,153,158,163**;Oct 13, 1995;Build 3
;;Per VA Directive 6402, this routine should not be modified.
;
EN ;
;
N HLSCREEN,TESTOPEN,HLRFRSH,HLPARMS
D WAIT^DICD
D EN^VALM("HLO SYSTEM MONITOR")
Q
;
BRIEF ;
N COUNT,LINK,QUE,FROM,TIME,STATUS,TEMP,DIR,TODAY,LIST,LNKMSG,OS
S HLRFRSH="BRIEF^HLOUSR"
S (HLSCREEN,VALMSG)="Brief System Status"
S VALMCNT=16
;K @VALMAR
S OS=$$OS^%ZOSV
;
D CLEAN^VALM10
S VALMBG=1
S VALMBCK="R"
S VALMDDF("COL 1")="COL1^1^80^"
K VALMDDF("COL 2"),VALMDDF("COL 3"),VALMDDF("COL 4"),VALMDDF("COL 5")
D CHGCAP^VALM("COL 1"," Brief Operational Overview")
S @VALMAR@(1,0)="SYSTEM STATUS: "_$S($$CHKSTOP^HLOPROC:"STOPPED",1:"RUNNING")
S @VALMAR@(2,0)="PROCESS MANAGER: "_$S($$RUNNING:"RUNNING",1:"STOPPED")
;
;
I $$CHKSTOP^HLOPROC,OS'["VMS" S TESTOPEN("LISTENER")=""
S TIME=$P($G(TESTOPEN("LISTENER")),"^",2)
I TIME,$$FMDIFF^XLFDT($$NOW^XLFDT,TIME,2)<100 D
.S STATUS=+TESTOPEN("LISTENER")
E D
.;** P147 START CJM
.;is the Kernel listener running under the HLO process manager?
.S STATUS=$$KLISTEN
.;
.;if the Kernel listner is NOT running, might check the listener via the OPEN command. With loadbalancing, the IP address of the listener link sometimes fails, so also try 'loopback'.
.I 'STATUS,(OS["VMS")!('$$CHKSTOP^HLOPROC) D
..N IP,LINK
..S LINK=$P($G(^HLD(779.1,1,0)),"^",10)
..I LINK,$$GET^HLOTLNK(LINK,.LINK) D
...;ADD LOOPBACK FOR IPV6 - HL*1.6*163
...;$$CONVERT^XLFIPV(IP) API (ICR #5844)
...F IP=$$CONVERT^XLFIPV("127.0.0.1"),$$CONVERT^XLFIPV("0.0.0.0"),LINK("IP") D Q:STATUS
....N POP,IO,IOF,IOST
....D CALL^%ZISTCP(IP,LINK("PORT"),5)
....S STATUS='POP
....C:STATUS IO
.;
.S:(('STATUS)&('$$CHKSTOP^HLOPROC)) LNKMSG=$S(OS["VMS":" Please start the HLO VMS TCPIP SERVICE",1:"Please start the HLO Listener")
.;
.;** P147 END CJM
.;
.D:'STATUS CNTRL^VALM10(3,38,85,IOINHI,IOINORM)
.S TESTOPEN("LISTENER")=STATUS_"^"_$$NOW^XLFDT
;
S @VALMAR@(3,0)="STANDARD LISTENER: "_$S(STATUS:"RUNNING",1:"STOPPED ")_$G(LNKMSG)
;** P139 end **
;
S @VALMAR@(4,0)="TASKMAN: "_$S($$TM^%ZTLOAD:"RUNNING",1:"STOPPED")
;
S (LIST,LINK)=""
F S LINK=$O(^HLTMP("FAILING LINKS",LINK)) Q:LINK="" D I $L(LIST)>60 S LIST=LIST_",..." Q
.N TIME,QUE,LINKARY
.I $$GETLINK^HLOTLNK($P(LINK,":"),.LINKARY)
.S TIME=$G(^HLTMP("FAILING LINKS",LINK)) Q:TIME=""
.I '$G(LINKARY("SHUTDOWN")),TIME="" Q
.I '$G(LINKARY("SHUTDOWN")),($$HDIFF^XLFDT($H,TIME,2)<300) Q
.;;***patch HL*1.6*138 start
.S LIST=LIST_$S($L(LIST):", ",1:"")_LINK
.;;.S LIST=LIST_$S($L(LIST):", ",1:"")_$P(LINK,":")
.;; ***patch HL*1.6*138 end
S @VALMAR@(5,0)="DOWN LINKS: "_LIST
S @VALMAR@(6,0)="CLIENT LINK PROCESSES: "_+$G(^HLC("HL7 PROCESS COUNTS","RUNNING","OUTGOING CLIENT LINK"))
S @VALMAR@(7,0)="IN-FILER PROCESSES: "_+$G(^HLC("HL7 PROCESS COUNTS","RUNNING","INCOMING QUEUES"))
; ***patch HL*1.6*146 START - RBN ***
;S COUNT=0,LINK=""
;F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
;.S QUE=""
;.F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" D
;..S TEMP=$G(^HLC("QUEUECOUNT","OUT",LINK,QUE))
;..S:TEMP>0 COUNT=COUNT+TEMP
N CNTARRAY
S COUNT=$$OUT^HLOQUE(.CNTARRAY)
; ***patch HL*1.6*146 END - RBN ***
S @VALMAR@(8,0)="MESSAGES PENDING ON OUT QUEUES: "_$$RJ(+COUNT,7)_" ON SEQUENCE QUEUES: "_$$RJ(+$G(^HLC("QUEUECOUNT","SEQUENCE")),7)
S TEMP="STOPPED OUTGOING QUEUES: "
S COUNT=0,QUE=""
F S QUE=$O(^HLTMP("STOPPED QUEUES","OUT",QUE)) Q:QUE="" S COUNT=COUNT+1 Q:COUNT>4 S:COUNT=1 TEMP=TEMP_QUE S:"23"[COUNT TEMP=TEMP_"; "_QUE S:COUNT=4 TEMP=TEMP_" ..."
S @VALMAR@(9,0)=TEMP
; ***patch HL*1.6*146 START - RBN ***
;S COUNT=0,QUE=""
;F S QUE=$O(^HLC("QUEUECOUNT","IN",QUE)) Q:QUE="" D
;.S FROM=""
;.F S FROM=$O(^HLC("QUEUECOUNT","IN",QUE,FROM)) Q:FROM="" D
;..S TEMP=$G(^HLC("QUEUECOUNT","IN",QUE,FROM))
;..S:TEMP>0 COUNT=COUNT+TEMP
S COUNT=0
K CNTARRAY
S COUNT=$$IN^HLOQUE(.CNTARRAY)
; ***patch HL*1.6*146 END - RBN ***
S @VALMAR@(10,0)="MESSAGES PENDING ON APPLICATIONS: "_$$RJ(+COUNT,7)
S TEMP="STOPPED INCOMING QUEUES: "
S COUNT=0,QUE=""
F S QUE=$O(^HLTMP("STOPPED QUEUES","IN",QUE)) Q:QUE="" S COUNT=COUNT+1 Q:COUNT>4 S:COUNT=1 TEMP=TEMP_QUE S:"23"[COUNT TEMP=TEMP_"; "_QUE S:COUNT=4 TEMP=TEMP_" ..."
S @VALMAR@(11,0)=TEMP
S @VALMAR@(12,0)="FILE 777 RECORD COUNT: "_$$RJ($P($G(^HLTMP("FILE 777 RECORD COUNT")),"^"),10)_" --> as of "_$$FMTE^XLFDT($P($G(^HLTMP("FILE 777 RECORD COUNT")),"^",2))
S @VALMAR@(13,0)="FILE 778 RECORD COUNT: "_$$RJ($P($G(^HLTMP("FILE 778 RECORD COUNT")),"^"),10)_" --> as of "_$$FMTE^XLFDT($P($G(^HLTMP("FILE 778 RECORD COUNT")),"^",2))
S TODAY=$$DT^XLFDT
S @VALMAR@(14,0)="MESSAGES SENT TODAY: "_$$RJ($$ADD("OUT"),10)
S @VALMAR@(15,0)="MESSAGES RECEIVED TODAY: "_$$RJ($$ADD("IN"),10)
S @VALMAR@(16,0)="MESSAGE ERRORS TODAY: "_$$RJ($$ADD("EOUT")+$$ADD("EIN"),10)
Q
;
ADD(DIR) ;
N RAP,SAP,TIME,TOTAL,TYPE
S TOTAL=0
S TIME=TODAY-.0001
F S TIME=$O(^HLSTATS(DIR,"HOURLY",TIME)) Q:'TIME Q:((TIME\1)>TODAY) D
.S SAP=""
.F S SAP=$O(^HLSTATS(DIR,"HOURLY",TIME,SAP)) Q:SAP="" D
..Q:SAP="ACCEPT ACK"
..S RAP=""
..F S RAP=$O(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP)) Q:RAP="" D
...S TYPE=""
...F S TYPE=$O(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP,TYPE)) Q:TYPE="" D
....S TOTAL=TOTAL+$G(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP,TYPE))
Q TOTAL
;
HELP ;
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;
D CLEAN^VALM10
D CLEAR^VALM1
Q
;
EXPND ;
Q
;
PROCS ;
S HLRFRSH="PROCS^HLOUSR"
;K @VALMAR
D CLEAN^VALM10
S VALMCNT=0
S VALMBCK="R"
S VALMDDF("COL 1")="COL 1^1^34^"
S VALMDDF("COL 2")="COL 2^35^10^MIN^H"
S VALMDDF("COL 3")="COL 3^47^10^MAX^H"
S VALMDDF("COL 4")="COL 4^59^10^#RUNNING^H"
S VALMDDF("COL 5")="COL 5^71^10^#QUEUED^IOBON"
D CHGCAP^VALM("COL 1"," Process Type")
N IEN
S IEN=0
F S IEN=$O(^HLD(779.3,"C",1,IEN)) Q:'IEN D
.N PROC
.Q:'$$GETPROC^HLOPROC1(IEN,.PROC)
.Q:PROC("NAME")="VMS TCP LISTENER"
.S VALMCNT=VALMCNT+1
.S @VALMAR@(VALMCNT,0)=$$LJ(PROC("NAME"),30)_$$RJ(PROC("MINIMUM"),6)_$$RJ(PROC("MAXIMUM"),12)_$$RJ(+$G(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC("NAME"))),14)_$$RJ(+$G(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC("NAME"))),12)
S VALMCNT=VALMCNT+1,@VALMAR@(VALMCNT,0)=""
S IEN=""
F S IEN=$O(^HLTMP("HL7 RUNNING PROCESSES",IEN)) Q:IEN="" D
.N NODE
.S NODE=$G(^HLTMP("HL7 RUNNING PROCESSES",IEN))
.Q:NODE=""
.S VALMCNT=VALMCNT+1
.S @VALMAR@(VALMCNT,0)="$J: "_$$LJ(IEN,9)_" ->"_$$CJ($P(NODE,"^",3),28)_"<- started at "_$$HTE^XLFDT($P(NODE,"^"))
Q
;
INQUEUE ;
N FROM
D CLEAN^VALM10
;K @VALMAR
S HLRFRSH="INQUEUE^HLOUSR"
S (HLSCREEN,VALMSG)="Incoming Queues ('!' = stopped queues)"
S VALMCNT=0
S VALMBCK="R"
S VALMDDF("COL 1")="COL 1^1^40^ From^H"
S VALMDDF("COL 2")="COL 2^45^20^Queue^H"
S VALMDDF("COL 3")="COL 3^70^10^Count^H"
K VALMDDF("COL 4"),VALMDDF("COL 5")
D CHGCAP^VALM("COL 1"," From")
S FROM=""
F S FROM=$O(^HLC("QUEUECOUNT","IN",FROM)) Q:FROM="" D
.N COUNT,QUE,SHOW
.S SHOW=$$LJ(FROM,40)_" "
.S QUE=""
.F S QUE=$O(^HLC("QUEUECOUNT","IN",FROM,QUE)) Q:QUE="" D
..S COUNT=$G(^HLC("QUEUECOUNT","IN",FROM,QUE))
..Q:COUNT<0
..S VALMCNT=VALMCNT+1
..S @VALMAR@(VALMCNT,0)=SHOW_$$LJ($S($$STOPPED^HLOQUE("IN",QUE):"!",1:"")_QUE,21)_" "_$$RJ(COUNT,10)
..S SHOW=$$LJ("",40)_" "
Q
VIEWLINK ;
N C,QUIT,LINK,LINKARY,TEMP
S (QUIT,C,LINK)=""
S VALMBCK="R"
;
;currently HL7 (Optimized) only does TCP
S LINK=$$ASKLINK
Q:LINK=""
Q:'$$GETLINK^HLOTLNK(LINK,.LINKARY)
S LINK=LINK_":"_LINKARY("PORT")
W !,"Hit any key to stop...",!
F D Q:QUIT
.N COUNT,QUE
.S (COUNT,QUE)=""
.F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" S TEMP=$G(^HLC("QUEUECOUNT","OUT",LINK,QUE)) S:TEMP>0 COUNT=COUNT+TEMP
.W $C(13)," ",$C(13),"MESSAGES PENDING TRANSMISSION: ",IOBON,$$RJ(+COUNT,10),IOBOFF
.R *C:1 I $T S QUIT=1
Q
;
CJ(STRING,LEN) ;
Q $$CJ^XLFSTR($E(STRING,1,LEN),LEN)
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR($E(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
Q $$RJ^XLFSTR($E(STRING,1,LEN),LEN)
;
RUNNING() ;Process Manager running?
N RUNNING
L +^HLTMP("PROCESS MANAGER"):0
S RUNNING='$T
I 'RUNNING L -^HLTMP("PROCESS MANAGER")
Q RUNNING
;
TESTLINK ;
N LINKNAME,OK,PORT,LINK
S VALMBCK="R"
S LINKNAME=$$ASKLINK
Q:LINKNAME=""
;**P138 START
S PORT=$$ASKPORT^HLOUSRA(LINKNAME)
Q:'PORT
S LINK=LINKNAME_":"_PORT
;S OK=$$IFOPEN^HLOUSR1(LINKNAME)
W !,"Testing...." ;P158
S OK=$$IFOPEN^HLOUSR1(LINK)
;** P138 END
I OK W !,LINK_" IS operational..."
E W !,LINK_" is NOT operational..."
W !,"Hit any key to continue..."
R *C:DTIME
Q
;
ASKLINK() ;
N DIC,TCP,X,Y,DTOUT,DUOUT
S DIC=870
S DIC(0)="AEMNQ"
S TCP=$O(^HLCS(869.1,"B","TCP",0))
S DIC("A")="Select a TCP link:"
S DIC("S")="I $P(^(0),U,3)=TCP"
D FULL^VALM1
D ^DIC
I +Y'=-1,'$D(DTOUT),'$D(DUOUT) Q $P(Y,"^",2)
Q ""
;
STOP ;
I '$$ASKYESNO^HLOUSR2("Are you SURE that you want to stop sending and receiving messages","NO") S VALMBCK="" Q
;
D STOPHL7^HLOPROC1
S VALMBCK="R",VALMSG="HL7 (Optimized) has been stopped...."
H 5
D @HLRFRSH
;D:HLSCREEN="Brief System Status" BRIEF^HLOUSR
;D:HLSCREEN="Running Processes" PROCS^HLOUSR
Q
;
UPDMODE ;realtime
Q:'$L(HLRFRSH)
N TOP,BOTTOM,DX,DY,IOTM,IOBM,LINE,OLD,OLDCNT
S OLDCNT=VALMCNT
W !!!!!,IOINHI,"Hit any key to escape realtime display mode...",IOINORM
S IOTM=20,IOBM=23 W @IOSTBM
S TOP=VALMBG
S BOTTOM=TOP+20
F LINE=TOP:1:BOTTOM D
.I LINE>VALMCNT S @VALMAR@(LINE,0)=$$LJ(" ",80) Q
.S @VALMAR@(LINE,0)=$$LJ($G(@VALMAR@(LINE,0)),80)
F LINE=TOP:1:BOTTOM D
.S OLD(LINE)=$G(@VALMAR@(LINE,0))
F LINE=17:1:BOTTOM D
.S DX=50,DY=22 X IOXY W !
.D WRITE^VALM10(LINE)
D F R *C:4 Q:$T D
.D @HLRFRSH
.;**START PATCH 138**
.S OLDCNT=VALMCNT
.;**END PATCH 138**
.F LINE=TOP:1:BOTTOM D
..I LINE>VALMCNT S @VALMAR@(LINE,0)=$$LJ(" ",80) Q
..S @VALMAR@(LINE,0)=$$LJ($G(@VALMAR@(LINE,0)),80)
.S VALMCNT=BOTTOM
.F LINE=TOP:1:BOTTOM IF OLD(LINE)'=$G(@VALMAR@(LINE,0)) D
..S OLD(LINE)=$G(@VALMAR@(LINE,0))
..S DX=50,DY=22 X IOXY W !
..D WRITE^VALM10(LINE)
;**START PATCH 138**
S VALMCNT=OLDCNT
I VALMCNT<VALMBG S VALMBG=VALMCNT
;**END PATCH 138**
S VALMBCK="R"
Q
;
EDITSITE ;
;edit HLO System Parameters
N DR,DA,DIE
S DA=$O(^HLD(779.1,0))
Q:'DA
S DIE="^HLD(779.1,"
S DR="[HLO EDIT SYSTEM PARAMETERS]"
D ^DIE
Q
;
LOGALL ;
N ON,CHANGE,DATA
;Will turn on/off logging of all errors
S ON=$G(^HLTMP("LOG ALL ERRORS"))
W !!,"Logging of all HLO errors is turned ",$S(ON:"ON",1:"OFF"),"."
W !!,"Logging of all HLO errors, including READ and WRITE errors, should be turned",!,"on only for short periods for troubleshooting purposes.",!
S CHANGE=$$ASKYESNO^HLOUSR2("Do you want logging of all HLO errors turned "_$S(ON:"OFF",1:"ON"),$S(ON:"YES",1:"NO"))
Q:'CHANGE
S ON='ON
S ^HLTMP("LOG ALL ERRORS")=ON
W !,"Logging of all HLO errors is turned ",$S(ON:"ON",1:"OFF"),"."
Q
;
KLISTEN() ;
;checks if the Kernel multi-listener is running
N DOLLARJ,FOUND
S DOLLARJ=""
S FOUND=0
F S DOLLARJ=$O(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)) Q:DOLLARJ="" I $P($G(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",3)["TASKMAN MULTI-LISTENER" S FOUND=1 Q
Q FOUND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOUSR 11641 printed Oct 16, 2024@18:00:05 Page 2
HLOUSR ;ALB/CJM/OAK/PIJ/RBN -ListManager Screen for viewing system status;12 JUN 1997 10:00 am ;02/28/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,134,137,138,139,146,147,153,158,163**;Oct 13, 1995;Build 3
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ;
+1 ;
+2 NEW HLSCREEN,TESTOPEN,HLRFRSH,HLPARMS
+3 DO WAIT^DICD
+4 DO EN^VALM("HLO SYSTEM MONITOR")
+5 QUIT
+6 ;
BRIEF ;
+1 NEW COUNT,LINK,QUE,FROM,TIME,STATUS,TEMP,DIR,TODAY,LIST,LNKMSG,OS
+2 SET HLRFRSH="BRIEF^HLOUSR"
+3 SET (HLSCREEN,VALMSG)="Brief System Status"
+4 SET VALMCNT=16
+5 ;K @VALMAR
+6 SET OS=$$OS^%ZOSV
+7 ;
+8 DO CLEAN^VALM10
+9 SET VALMBG=1
+10 SET VALMBCK="R"
+11 SET VALMDDF("COL 1")="COL1^1^80^"
+12 KILL VALMDDF("COL 2"),VALMDDF("COL 3"),VALMDDF("COL 4"),VALMDDF("COL 5")
+13 DO CHGCAP^VALM("COL 1"," Brief Operational Overview")
+14 SET @VALMAR@(1,0)="SYSTEM STATUS: "_$SELECT($$CHKSTOP^HLOPROC:"STOPPED",1:"RUNNING")
+15 SET @VALMAR@(2,0)="PROCESS MANAGER: "_$SELECT($$RUNNING:"RUNNING",1:"STOPPED")
+16 ;
+17 ;
+18 IF $$CHKSTOP^HLOPROC
IF OS'["VMS"
SET TESTOPEN("LISTENER")=""
+19 SET TIME=$PIECE($GET(TESTOPEN("LISTENER")),"^",2)
+20 IF TIME
IF $$FMDIFF^XLFDT($$NOW^XLFDT,TIME,2)<100
Begin DoDot:1
+21 SET STATUS=+TESTOPEN("LISTENER")
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 ;** P147 START CJM
+24 ;is the Kernel listener running under the HLO process manager?
+25 SET STATUS=$$KLISTEN
+26 ;
+27 ;if the Kernel listner is NOT running, might check the listener via the OPEN command. With loadbalancing, the IP address of the listener link sometimes fails, so also try 'loopback'.
+28 IF 'STATUS
IF (OS["VMS")!('$$CHKSTOP^HLOPROC)
Begin DoDot:2
+29 NEW IP,LINK
+30 SET LINK=$PIECE($GET(^HLD(779.1,1,0)),"^",10)
+31 IF LINK
IF $$GET^HLOTLNK(LINK,.LINK)
Begin DoDot:3
+32 ;ADD LOOPBACK FOR IPV6 - HL*1.6*163
+33 ;$$CONVERT^XLFIPV(IP) API (ICR #5844)
+34 FOR IP=$$CONVERT^XLFIPV("127.0.0.1"),$$CONVERT^XLFIPV("0.0.0.0"),LINK("IP")
Begin DoDot:4
+35 NEW POP,IO,IOF,IOST
+36 DO CALL^%ZISTCP(IP,LINK("PORT"),5)
+37 SET STATUS='POP
+38 if STATUS
CLOSE IO
End DoDot:4
if STATUS
QUIT
End DoDot:3
End DoDot:2
+39 ;
+40 if (('STATUS)&('$$CHKSTOP^HLOPROC))
SET LNKMSG=$SELECT(OS["VMS":" Please start the HLO VMS TCPIP SERVICE",1:"Please start the HLO Listener")
+41 ;
+42 ;** P147 END CJM
+43 ;
+44 if 'STATUS
DO CNTRL^VALM10(3,38,85,IOINHI,IOINORM)
+45 SET TESTOPEN("LISTENER")=STATUS_"^"_$$NOW^XLFDT
End DoDot:1
+46 ;
+47 SET @VALMAR@(3,0)="STANDARD LISTENER: "_$SELECT(STATUS:"RUNNING",1:"STOPPED ")_$GET(LNKMSG)
+48 ;** P139 end **
+49 ;
+50 SET @VALMAR@(4,0)="TASKMAN: "_$SELECT($$TM^%ZTLOAD:"RUNNING",1:"STOPPED")
+51 ;
+52 SET (LIST,LINK)=""
+53 FOR
SET LINK=$ORDER(^HLTMP("FAILING LINKS",LINK))
if LINK=""
QUIT
Begin DoDot:1
+54 NEW TIME,QUE,LINKARY
+55 IF $$GETLINK^HLOTLNK($PIECE(LINK,":"),.LINKARY)
+56 SET TIME=$GET(^HLTMP("FAILING LINKS",LINK))
if TIME=""
QUIT
+57 IF '$GET(LINKARY("SHUTDOWN"))
IF TIME=""
QUIT
+58 IF '$GET(LINKARY("SHUTDOWN"))
IF ($$HDIFF^XLFDT($HOROLOG,TIME,2)<300)
QUIT
+59 ;;***patch HL*1.6*138 start
+60 SET LIST=LIST_$SELECT($LENGTH(LIST):", ",1:"")_LINK
+61 ;;.S LIST=LIST_$S($L(LIST):", ",1:"")_$P(LINK,":")
+62 ;; ***patch HL*1.6*138 end
End DoDot:1
IF $LENGTH(LIST)>60
SET LIST=LIST_",..."
QUIT
+63 SET @VALMAR@(5,0)="DOWN LINKS: "_LIST
+64 SET @VALMAR@(6,0)="CLIENT LINK PROCESSES: "_+$GET(^HLC("HL7 PROCESS COUNTS","RUNNING","OUTGOING CLIENT LINK"))
+65 SET @VALMAR@(7,0)="IN-FILER PROCESSES: "_+$GET(^HLC("HL7 PROCESS COUNTS","RUNNING","INCOMING QUEUES"))
+66 ; ***patch HL*1.6*146 START - RBN ***
+67 ;S COUNT=0,LINK=""
+68 ;F S LINK=$O(^HLC("QUEUECOUNT","OUT",LINK)) Q:LINK="" D
+69 ;.S QUE=""
+70 ;.F S QUE=$O(^HLC("QUEUECOUNT","OUT",LINK,QUE)) Q:QUE="" D
+71 ;..S TEMP=$G(^HLC("QUEUECOUNT","OUT",LINK,QUE))
+72 ;..S:TEMP>0 COUNT=COUNT+TEMP
+73 NEW CNTARRAY
+74 SET COUNT=$$OUT^HLOQUE(.CNTARRAY)
+75 ; ***patch HL*1.6*146 END - RBN ***
+76 SET @VALMAR@(8,0)="MESSAGES PENDING ON OUT QUEUES: "_$$RJ(+COUNT,7)_" ON SEQUENCE QUEUES: "_$$RJ(+$GET(^HLC("QUEUECOUNT","SEQUENCE")),7)
+77 SET TEMP="STOPPED OUTGOING QUEUES: "
+78 SET COUNT=0
SET QUE=""
+79 FOR
SET QUE=$ORDER(^HLTMP("STOPPED QUEUES","OUT",QUE))
if QUE=""
QUIT
SET COUNT=COUNT+1
if COUNT>4
QUIT
if COUNT=1
SET TEMP=TEMP_QUE
if "23"[COUNT
SET TEMP=TEMP_"; "_QUE
if COUNT=4
SET TEMP=TEMP_" ..."
+80 SET @VALMAR@(9,0)=TEMP
+81 ; ***patch HL*1.6*146 START - RBN ***
+82 ;S COUNT=0,QUE=""
+83 ;F S QUE=$O(^HLC("QUEUECOUNT","IN",QUE)) Q:QUE="" D
+84 ;.S FROM=""
+85 ;.F S FROM=$O(^HLC("QUEUECOUNT","IN",QUE,FROM)) Q:FROM="" D
+86 ;..S TEMP=$G(^HLC("QUEUECOUNT","IN",QUE,FROM))
+87 ;..S:TEMP>0 COUNT=COUNT+TEMP
+88 SET COUNT=0
+89 KILL CNTARRAY
+90 SET COUNT=$$IN^HLOQUE(.CNTARRAY)
+91 ; ***patch HL*1.6*146 END - RBN ***
+92 SET @VALMAR@(10,0)="MESSAGES PENDING ON APPLICATIONS: "_$$RJ(+COUNT,7)
+93 SET TEMP="STOPPED INCOMING QUEUES: "
+94 SET COUNT=0
SET QUE=""
+95 FOR
SET QUE=$ORDER(^HLTMP("STOPPED QUEUES","IN",QUE))
if QUE=""
QUIT
SET COUNT=COUNT+1
if COUNT>4
QUIT
if COUNT=1
SET TEMP=TEMP_QUE
if "23"[COUNT
SET TEMP=TEMP_"; "_QUE
if COUNT=4
SET TEMP=TEMP_" ..."
+96 SET @VALMAR@(11,0)=TEMP
+97 SET @VALMAR@(12,0)="FILE 777 RECORD COUNT: "_$$RJ($PIECE($GET(^HLTMP("FILE 777 RECORD COUNT")),"^"),10)_" --> as of "_$$FMTE^XLFDT($PIECE($GET(^HLTMP("FILE 777 RECORD COUNT")),"^",2))
+98 SET @VALMAR@(13,0)="FILE 778 RECORD COUNT: "_$$RJ($PIECE($GET(^HLTMP("FILE 778 RECORD COUNT")),"^"),10)_" --> as of "_$$FMTE^XLFDT($PIECE($GET(^HLTMP("FILE 778 RECORD COUNT")),"^",2))
+99 SET TODAY=$$DT^XLFDT
+100 SET @VALMAR@(14,0)="MESSAGES SENT TODAY: "_$$RJ($$ADD("OUT"),10)
+101 SET @VALMAR@(15,0)="MESSAGES RECEIVED TODAY: "_$$RJ($$ADD("IN"),10)
+102 SET @VALMAR@(16,0)="MESSAGE ERRORS TODAY: "_$$RJ($$ADD("EOUT")+$$ADD("EIN"),10)
+103 QUIT
+104 ;
ADD(DIR) ;
+1 NEW RAP,SAP,TIME,TOTAL,TYPE
+2 SET TOTAL=0
+3 SET TIME=TODAY-.0001
+4 FOR
SET TIME=$ORDER(^HLSTATS(DIR,"HOURLY",TIME))
if 'TIME
QUIT
if ((TIME\1)>TODAY)
QUIT
Begin DoDot:1
+5 SET SAP=""
+6 FOR
SET SAP=$ORDER(^HLSTATS(DIR,"HOURLY",TIME,SAP))
if SAP=""
QUIT
Begin DoDot:2
+7 if SAP="ACCEPT ACK"
QUIT
+8 SET RAP=""
+9 FOR
SET RAP=$ORDER(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP))
if RAP=""
QUIT
Begin DoDot:3
+10 SET TYPE=""
+11 FOR
SET TYPE=$ORDER(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP,TYPE))
if TYPE=""
QUIT
Begin DoDot:4
+12 SET TOTAL=TOTAL+$GET(^HLSTATS(DIR,"HOURLY",TIME,SAP,RAP,TYPE))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT TOTAL
+14 ;
HELP ;
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
EXPND ;
+1 QUIT
+2 ;
PROCS ;
+1 SET HLRFRSH="PROCS^HLOUSR"
+2 ;K @VALMAR
+3 DO CLEAN^VALM10
+4 SET VALMCNT=0
+5 SET VALMBCK="R"
+6 SET VALMDDF("COL 1")="COL 1^1^34^"
+7 SET VALMDDF("COL 2")="COL 2^35^10^MIN^H"
+8 SET VALMDDF("COL 3")="COL 3^47^10^MAX^H"
+9 SET VALMDDF("COL 4")="COL 4^59^10^#RUNNING^H"
+10 SET VALMDDF("COL 5")="COL 5^71^10^#QUEUED^IOBON"
+11 DO CHGCAP^VALM("COL 1"," Process Type")
+12 NEW IEN
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^HLD(779.3,"C",1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+15 NEW PROC
+16 if '$$GETPROC^HLOPROC1(IEN,.PROC)
QUIT
+17 if PROC("NAME")="VMS TCP LISTENER"
QUIT
+18 SET VALMCNT=VALMCNT+1
+19 SET @VALMAR@(VALMCNT,0)=$$LJ(PROC("NAME"),30)_$$RJ(PROC("MINIMUM"),6)_$$RJ(PROC("MAXIMUM"),12)_$$RJ(+$GET(^HLC("HL7 PROCESS COUNTS","RUNNING",PROC("NAME"))),14)_$$RJ(+$GET(^HLC("HL7 PROCESS COUNTS","QUEUED",PROC("NAME"))),12)
End DoDot:1
+20 SET VALMCNT=VALMCNT+1
SET @VALMAR@(VALMCNT,0)=""
+21 SET IEN=""
+22 FOR
SET IEN=$ORDER(^HLTMP("HL7 RUNNING PROCESSES",IEN))
if IEN=""
QUIT
Begin DoDot:1
+23 NEW NODE
+24 SET NODE=$GET(^HLTMP("HL7 RUNNING PROCESSES",IEN))
+25 if NODE=""
QUIT
+26 SET VALMCNT=VALMCNT+1
+27 SET @VALMAR@(VALMCNT,0)="$J: "_$$LJ(IEN,9)_" ->"_$$CJ($PIECE(NODE,"^",3),28)_"<- started at "_$$HTE^XLFDT($PIECE(NODE,"^"))
End DoDot:1
+28 QUIT
+29 ;
INQUEUE ;
+1 NEW FROM
+2 DO CLEAN^VALM10
+3 ;K @VALMAR
+4 SET HLRFRSH="INQUEUE^HLOUSR"
+5 SET (HLSCREEN,VALMSG)="Incoming Queues ('!' = stopped queues)"
+6 SET VALMCNT=0
+7 SET VALMBCK="R"
+8 SET VALMDDF("COL 1")="COL 1^1^40^ From^H"
+9 SET VALMDDF("COL 2")="COL 2^45^20^Queue^H"
+10 SET VALMDDF("COL 3")="COL 3^70^10^Count^H"
+11 KILL VALMDDF("COL 4"),VALMDDF("COL 5")
+12 DO CHGCAP^VALM("COL 1"," From")
+13 SET FROM=""
+14 FOR
SET FROM=$ORDER(^HLC("QUEUECOUNT","IN",FROM))
if FROM=""
QUIT
Begin DoDot:1
+15 NEW COUNT,QUE,SHOW
+16 SET SHOW=$$LJ(FROM,40)_" "
+17 SET QUE=""
+18 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","IN",FROM,QUE))
if QUE=""
QUIT
Begin DoDot:2
+19 SET COUNT=$GET(^HLC("QUEUECOUNT","IN",FROM,QUE))
+20 if COUNT<0
QUIT
+21 SET VALMCNT=VALMCNT+1
+22 SET @VALMAR@(VALMCNT,0)=SHOW_$$LJ($SELECT($$STOPPED^HLOQUE("IN",QUE):"!",1:"")_QUE,21)_" "_$$RJ(COUNT,10)
+23 SET SHOW=$$LJ("",40)_" "
End DoDot:2
End DoDot:1
+24 QUIT
VIEWLINK ;
+1 NEW C,QUIT,LINK,LINKARY,TEMP
+2 SET (QUIT,C,LINK)=""
+3 SET VALMBCK="R"
+4 ;
+5 ;currently HL7 (Optimized) only does TCP
+6 SET LINK=$$ASKLINK
+7 if LINK=""
QUIT
+8 if '$$GETLINK^HLOTLNK(LINK,.LINKARY)
QUIT
+9 SET LINK=LINK_":"_LINKARY("PORT")
+10 WRITE !,"Hit any key to stop...",!
+11 FOR
Begin DoDot:1
+12 NEW COUNT,QUE
+13 SET (COUNT,QUE)=""
+14 FOR
SET QUE=$ORDER(^HLC("QUEUECOUNT","OUT",LINK,QUE))
if QUE=""
QUIT
SET TEMP=$GET(^HLC("QUEUECOUNT","OUT",LINK,QUE))
if TEMP>0
SET COUNT=COUNT+TEMP
+15 WRITE $CHAR(13)," ",$CHAR(13),"MESSAGES PENDING TRANSMISSION: ",IOBON,$$RJ(+COUNT,10),IOBOFF
+16 READ *C:1
IF $TEST
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+17 QUIT
+18 ;
CJ(STRING,LEN) ;
+1 QUIT $$CJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
RJ(STRING,LEN) ;
+1 QUIT $$RJ^XLFSTR($EXTRACT(STRING,1,LEN),LEN)
+2 ;
RUNNING() ;Process Manager running?
+1 NEW RUNNING
+2 LOCK +^HLTMP("PROCESS MANAGER"):0
+3 SET RUNNING='$TEST
+4 IF 'RUNNING
LOCK -^HLTMP("PROCESS MANAGER")
+5 QUIT RUNNING
+6 ;
TESTLINK ;
+1 NEW LINKNAME,OK,PORT,LINK
+2 SET VALMBCK="R"
+3 SET LINKNAME=$$ASKLINK
+4 if LINKNAME=""
QUIT
+5 ;**P138 START
+6 SET PORT=$$ASKPORT^HLOUSRA(LINKNAME)
+7 if 'PORT
QUIT
+8 SET LINK=LINKNAME_":"_PORT
+9 ;S OK=$$IFOPEN^HLOUSR1(LINKNAME)
+10 ;P158
WRITE !,"Testing...."
+11 SET OK=$$IFOPEN^HLOUSR1(LINK)
+12 ;** P138 END
+13 IF OK
WRITE !,LINK_" IS operational..."
+14 IF '$TEST
WRITE !,LINK_" is NOT operational..."
+15 WRITE !,"Hit any key to continue..."
+16 READ *C:DTIME
+17 QUIT
+18 ;
ASKLINK() ;
+1 NEW DIC,TCP,X,Y,DTOUT,DUOUT
+2 SET DIC=870
+3 SET DIC(0)="AEMNQ"
+4 SET TCP=$ORDER(^HLCS(869.1,"B","TCP",0))
+5 SET DIC("A")="Select a TCP link:"
+6 SET DIC("S")="I $P(^(0),U,3)=TCP"
+7 DO FULL^VALM1
+8 DO ^DIC
+9 IF +Y'=-1
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
QUIT $PIECE(Y,"^",2)
+10 QUIT ""
+11 ;
STOP ;
+1 IF '$$ASKYESNO^HLOUSR2("Are you SURE that you want to stop sending and receiving messages","NO")
SET VALMBCK=""
QUIT
+2 ;
+3 DO STOPHL7^HLOPROC1
+4 SET VALMBCK="R"
SET VALMSG="HL7 (Optimized) has been stopped...."
+5 HANG 5
+6 DO @HLRFRSH
+7 ;D:HLSCREEN="Brief System Status" BRIEF^HLOUSR
+8 ;D:HLSCREEN="Running Processes" PROCS^HLOUSR
+9 QUIT
+10 ;
UPDMODE ;realtime
+1 if '$LENGTH(HLRFRSH)
QUIT
+2 NEW TOP,BOTTOM,DX,DY,IOTM,IOBM,LINE,OLD,OLDCNT
+3 SET OLDCNT=VALMCNT
+4 WRITE !!!!!,IOINHI,"Hit any key to escape realtime display mode...",IOINORM
+5 SET IOTM=20
SET IOBM=23
WRITE @IOSTBM
+6 SET TOP=VALMBG
+7 SET BOTTOM=TOP+20
+8 FOR LINE=TOP:1:BOTTOM
Begin DoDot:1
+9 IF LINE>VALMCNT
SET @VALMAR@(LINE,0)=$$LJ(" ",80)
QUIT
+10 SET @VALMAR@(LINE,0)=$$LJ($GET(@VALMAR@(LINE,0)),80)
End DoDot:1
+11 FOR LINE=TOP:1:BOTTOM
Begin DoDot:1
+12 SET OLD(LINE)=$GET(@VALMAR@(LINE,0))
End DoDot:1
+13 FOR LINE=17:1:BOTTOM
Begin DoDot:1
+14 SET DX=50
SET DY=22
XECUTE IOXY
WRITE !
+15 DO WRITE^VALM10(LINE)
End DoDot:1
+16 Begin DoDot:1
+17 DO @HLRFRSH
+18 ;**START PATCH 138**
+19 SET OLDCNT=VALMCNT
+20 ;**END PATCH 138**
+21 FOR LINE=TOP:1:BOTTOM
Begin DoDot:2
+22 IF LINE>VALMCNT
SET @VALMAR@(LINE,0)=$$LJ(" ",80)
QUIT
+23 SET @VALMAR@(LINE,0)=$$LJ($GET(@VALMAR@(LINE,0)),80)
End DoDot:2
+24 SET VALMCNT=BOTTOM
+25 FOR LINE=TOP:1:BOTTOM
IF OLD(LINE)'=$GET(@VALMAR@(LINE,0))
Begin DoDot:2
+26 SET OLD(LINE)=$GET(@VALMAR@(LINE,0))
+27 SET DX=50
SET DY=22
XECUTE IOXY
WRITE !
+28 DO WRITE^VALM10(LINE)
End DoDot:2
End DoDot:1
FOR
READ *C:4
if $TEST
QUIT
Begin DoDot:1
End DoDot:1
+29 ;**START PATCH 138**
+30 SET VALMCNT=OLDCNT
+31 IF VALMCNT<VALMBG
SET VALMBG=VALMCNT
+32 ;**END PATCH 138**
+33 SET VALMBCK="R"
+34 QUIT
+35 ;
EDITSITE ;
+1 ;edit HLO System Parameters
+2 NEW DR,DA,DIE
+3 SET DA=$ORDER(^HLD(779.1,0))
+4 if 'DA
QUIT
+5 SET DIE="^HLD(779.1,"
+6 SET DR="[HLO EDIT SYSTEM PARAMETERS]"
+7 DO ^DIE
+8 QUIT
+9 ;
LOGALL ;
+1 NEW ON,CHANGE,DATA
+2 ;Will turn on/off logging of all errors
+3 SET ON=$GET(^HLTMP("LOG ALL ERRORS"))
+4 WRITE !!,"Logging of all HLO errors is turned ",$SELECT(ON:"ON",1:"OFF"),"."
+5 WRITE !!,"Logging of all HLO errors, including READ and WRITE errors, should be turned",!,"on only for short periods for troubleshooting purposes.",!
+6 SET CHANGE=$$ASKYESNO^HLOUSR2("Do you want logging of all HLO errors turned "_$SELECT(ON:"OFF",1:"ON"),$SELECT(ON:"YES",1:"NO"))
+7 if 'CHANGE
QUIT
+8 SET ON='ON
+9 SET ^HLTMP("LOG ALL ERRORS")=ON
+10 WRITE !,"Logging of all HLO errors is turned ",$SELECT(ON:"ON",1:"OFF"),"."
+11 QUIT
+12 ;
KLISTEN() ;
+1 ;checks if the Kernel multi-listener is running
+2 NEW DOLLARJ,FOUND
+3 SET DOLLARJ=""
+4 SET FOUND=0
+5 FOR
SET DOLLARJ=$ORDER(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ))
if DOLLARJ=""
QUIT
IF $PIECE($GET(^HLTMP("HL7 RUNNING PROCESSES",DOLLARJ)),"^",3)["TASKMAN MULTI-LISTENER"
SET FOUND=1
QUIT
+6 QUIT FOUND
