HMPHTTP ;SLC/MKB,ASMR/BL,RRB,CK - HTTP interface;Aug 29, 2016 20:06:27
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,3**;May 15, 2016;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; %ZTLOAD 10063
; DIR 10026
; VASITE 10112
; XLFCRC 3156
; XLFUTL 2622
; XPAR 2263
; XTHC10 5515
; XUPARAM 2541
Q
;
EN ; -- manage the background job
N ZTSK,STS
S ZTSK=+$G(^XTMP("HMP","ZTSK")),STS=$$STS
W !,?24,"--- HMP Patient Data Monitor ---"
W !!,"Task"_$S(ZTSK:" #"_ZTSK,1:"")_" is "_$P(STS,U,2)_".",!
;
I ZTSK,+STS=1!(+STS=2) D:$$STOP Q
. N X S X=$$ASKSTOP^%ZTLOAD(ZTSK)
. W !,$P(X,U,2),!
;
I $$START D
. W !!,"Starting HMP Patient Data Monitor ... " D QUE
. I $G(ZTSK) W "task #"_ZTSK_" started.",!
. E W !,"ERROR: task NOT created. Try again later.",!
. S ^XTMP("HMP","ZTSK")=$G(ZTSK)
Q
;
STS() ; -- get the status of ZTSK
D STAT^%ZTLOAD
N Y S Y=+$G(ZTSK(1))_U_$G(ZTSK(2))
Q Y
;
STOP() ; -- stop the task?
N X,Y,DIR
S DIR("A")="Do you want to stop the data monitor? ",DIR(0)="YA",DIR("B")="NO"
S DIR("?",1)="Enter YES to stop or cancel the data monitor; please restart ASAP!"
S DIR("?",3)="This job must be running in the background for AViVA to be notified"
S DIR("?")="when new patient data is available.",DIR("?",2)=" "
D ^DIR S:Y<1 Y=0
Q Y
;
START() ; -- [re]start the task?
N X,Y,DIR
S DIR(0)="YA",DIR("B")="YES"
S DIR("A")="Do you want to "_$S(STS:"re",1:"")_"start the data monitor? "
S DIR("?",1)="Enter YES to "_$S(STS:"re",1:"")_"start the HMP Patient Data Monitor."
S DIR("?",3)="This job must be running in the background for AViVA to be notified"
S DIR("?")="when new patient data is available.",DIR("?",2)=" "
D ^DIR S:Y<1 Y=0
Q Y
;
QUE ; -- create the background task: returns ZTSK
N IO,IOP,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSAVE,%ZIS
S %ZIS="0H",IOP="NULL" D ^%ZIS I POP W !,"Null Device Not Found" Q
S ZTDESC="HMP new data monitor for AViVA",ZTDTH=$H,ZTIO=""
S ZTRTN="POKE^HMPHTTP" K ZTSK
D ^%ZTLOAD
Q
;
POKE ; -- background job to poke the client when new data is available
; ^XTMP("HMP",DFN,TYPE,ID) = new data since last update
N DIV,ID,DFN,DATA,IOP,X,DA,TOKEN,NEW K ZTSTOP,ZTREQ
S IOP="NULL" D ^%ZIS
S ID=(+$H)+$P($H,",",2)
S DFN=0 F S DFN=$O(^XTMP("HMP",DFN)) Q:'(DFN>0) I $D(^(DFN))>9 D ;DE4496 19 August 2016
. L +^XTMP("HMP",DFN):5 Q:'$T ;try again next cycle
. K DATA M DATA=^XTMP("HMP",DFN)
. S X=$G(^XTMP("HMP",DFN)) K ^(DFN) S ^(DFN)=X ;clear list, keep subscription
. L -^XTMP("HMP",DFN)
. ; add to list for URL
. S DA=0 F S DA=$O(^HMP(800000,"ADFN",DFN,DA)) Q:DA<1 D
.. S TOKEN=DA_"~"_ID,NEW(TOKEN)=""
.. M ^XTMP("HMPX",TOKEN,DFN)=DATA
D SEND(.NEW)
I $$S^%ZTLOAD S ZTSTOP=1,ZTREQ="@" Q
D HANG S ZTREQ="" ;re-queue
Q
;
SEND(LIST) ; send each list ID to its URL
N SYS,ID,DA,URL,X
S SYS=$$SYS^HMPUTILS
; DIV=$P($$SITE^VASITE,U,3) ;station#
S ID="" F S ID=$O(LIST(ID)) Q:ID="" D
. S DA=+ID,URL=$G(^HMP(800000,DA,.1)) Q:URL=""
. S URL=URL_"?vistaId="_SYS_"&id="_ID
. S X=$$GETURL^XTHC10(URL,,"HMPX") ;I X>200 = ERROR
Q
;
HANG ; -- wait #seconds
N X S X=$$GET^XPAR("ALL","HMP TASK WAIT TIME") S:'X X=99
H X
Q
;
KILL ; -- kill/reset ^HMP(800000) for testing
K ^HMP(800000)
S ^HMP(800000,0)="HMP SUBSCRIPTION^800000^^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPHTTP 3650 printed Dec 13, 2024@01:54:01 Page 2
HMPHTTP ;SLC/MKB,ASMR/BL,RRB,CK - HTTP interface;Aug 29, 2016 20:06:27
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,3**;May 15, 2016;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; %ZTLOAD 10063
+7 ; DIR 10026
+8 ; VASITE 10112
+9 ; XLFCRC 3156
+10 ; XLFUTL 2622
+11 ; XPAR 2263
+12 ; XTHC10 5515
+13 ; XUPARAM 2541
+14 QUIT
+15 ;
EN ; -- manage the background job
+1 NEW ZTSK,STS
+2 SET ZTSK=+$GET(^XTMP("HMP","ZTSK"))
SET STS=$$STS
+3 WRITE !,?24,"--- HMP Patient Data Monitor ---"
+4 WRITE !!,"Task"_$SELECT(ZTSK:" #"_ZTSK,1:"")_" is "_$PIECE(STS,U,2)_".",!
+5 ;
+6 IF ZTSK
IF +STS=1!(+STS=2)
if $$STOP
Begin DoDot:1
+7 NEW X
SET X=$$ASKSTOP^%ZTLOAD(ZTSK)
+8 WRITE !,$PIECE(X,U,2),!
End DoDot:1
QUIT
+9 ;
+10 IF $$START
Begin DoDot:1
+11 WRITE !!,"Starting HMP Patient Data Monitor ... "
DO QUE
+12 IF $GET(ZTSK)
WRITE "task #"_ZTSK_" started.",!
+13 IF '$TEST
WRITE !,"ERROR: task NOT created. Try again later.",!
+14 SET ^XTMP("HMP","ZTSK")=$GET(ZTSK)
End DoDot:1
+15 QUIT
+16 ;
STS() ; -- get the status of ZTSK
+1 DO STAT^%ZTLOAD
+2 NEW Y
SET Y=+$GET(ZTSK(1))_U_$GET(ZTSK(2))
+3 QUIT Y
+4 ;
STOP() ; -- stop the task?
+1 NEW X,Y,DIR
+2 SET DIR("A")="Do you want to stop the data monitor? "
SET DIR(0)="YA"
SET DIR("B")="NO"
+3 SET DIR("?",1)="Enter YES to stop or cancel the data monitor; please restart ASAP!"
+4 SET DIR("?",3)="This job must be running in the background for AViVA to be notified"
+5 SET DIR("?")="when new patient data is available."
SET DIR("?",2)=" "
+6 DO ^DIR
if Y<1
SET Y=0
+7 QUIT Y
+8 ;
START() ; -- [re]start the task?
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("B")="YES"
+3 SET DIR("A")="Do you want to "_$SELECT(STS:"re",1:"")_"start the data monitor? "
+4 SET DIR("?",1)="Enter YES to "_$SELECT(STS:"re",1:"")_"start the HMP Patient Data Monitor."
+5 SET DIR("?",3)="This job must be running in the background for AViVA to be notified"
+6 SET DIR("?")="when new patient data is available."
SET DIR("?",2)=" "
+7 DO ^DIR
if Y<1
SET Y=0
+8 QUIT Y
+9 ;
QUE ; -- create the background task: returns ZTSK
+1 NEW IO,IOP,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSAVE,%ZIS
+2 SET %ZIS="0H"
SET IOP="NULL"
DO ^%ZIS
IF POP
WRITE !,"Null Device Not Found"
QUIT
+3 SET ZTDESC="HMP new data monitor for AViVA"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+4 SET ZTRTN="POKE^HMPHTTP"
KILL ZTSK
+5 DO ^%ZTLOAD
+6 QUIT
+7 ;
POKE ; -- background job to poke the client when new data is available
+1 ; ^XTMP("HMP",DFN,TYPE,ID) = new data since last update
+2 NEW DIV,ID,DFN,DATA,IOP,X,DA,TOKEN,NEW
KILL ZTSTOP,ZTREQ
+3 SET IOP="NULL"
DO ^%ZIS
+4 SET ID=(+$HOROLOG)+$PIECE($HOROLOG,",",2)
+5 ;DE4496 19 August 2016
SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("HMP",DFN))
if '(DFN>0)
QUIT
IF $DATA(^(DFN))>9
Begin DoDot:1
+6 ;try again next cycle
LOCK +^XTMP("HMP",DFN):5
if '$TEST
QUIT
+7 KILL DATA
MERGE DATA=^XTMP("HMP",DFN)
+8 ;clear list, keep subscription
SET X=$GET(^XTMP("HMP",DFN))
KILL ^(DFN)
SET ^(DFN)=X
+9 LOCK -^XTMP("HMP",DFN)
+10 ; add to list for URL
+11 SET DA=0
FOR
SET DA=$ORDER(^HMP(800000,"ADFN",DFN,DA))
if DA<1
QUIT
Begin DoDot:2
+12 SET TOKEN=DA_"~"_ID
SET NEW(TOKEN)=""
+13 MERGE ^XTMP("HMPX",TOKEN,DFN)=DATA
End DoDot:2
End DoDot:1
+14 DO SEND(.NEW)
+15 IF $$S^%ZTLOAD
SET ZTSTOP=1
SET ZTREQ="@"
QUIT
+16 ;re-queue
DO HANG
SET ZTREQ=""
+17 QUIT
+18 ;
SEND(LIST) ; send each list ID to its URL
+1 NEW SYS,ID,DA,URL,X
+2 SET SYS=$$SYS^HMPUTILS
+3 ; DIV=$P($$SITE^VASITE,U,3) ;station#
+4 SET ID=""
FOR
SET ID=$ORDER(LIST(ID))
if ID=""
QUIT
Begin DoDot:1
+5 SET DA=+ID
SET URL=$GET(^HMP(800000,DA,.1))
if URL=""
QUIT
+6 SET URL=URL_"?vistaId="_SYS_"&id="_ID
+7 ;I X>200 = ERROR
SET X=$$GETURL^XTHC10(URL,,"HMPX")
End DoDot:1
+8 QUIT
+9 ;
HANG ; -- wait #seconds
+1 NEW X
SET X=$$GET^XPAR("ALL","HMP TASK WAIT TIME")
if 'X
SET X=99
+2 HANG X
+3 QUIT
+4 ;
KILL ; -- kill/reset ^HMP(800000) for testing
+1 KILL ^HMP(800000)
+2 SET ^HMP(800000,0)="HMP SUBSCRIPTION^800000^^"
+3 QUIT
