HMPHTTP.m

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 ---HMPHTTP   3650     printed  Feb 18, 2025@23:20:23                                                                                                                                                                                                     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