- 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 Feb 18, 2025@23:25:41 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