- VIAAQUE ;ALB/CR - RTLS Queue General Utility ;5/04/16 10:00am
- ;;1.0;RTLS;**3**;April 22, 2013;Build 20
- ;
- Q
- ;
- ; create a task that can requeue itself and check file #6930
- ; every 3-6 minutes (180-360 seconds) or so
- ; =============== NOTICE ====================
- ; Per HPMO reference # OITIMB33554520, a waiver has been granted
- ; for the use of Cache ObjectScript along with standard MUMPS commands
- ;
- STR ; enter here to send a message right away if entries are found
- L +^VIAA(6930):5 Q:'$T ; we want just one job running
- N COUNT,DATA,ROOT
- I '$D(^VIAA(6930)) Q
- F COUNT=0:0 S COUNT=+$O(^VIAA(6930,COUNT)) Q:'COUNT D
- . S ROOT=$G(^VIAA(6930,COUNT,0))
- . ; get all 3 pieces for processing in Eng file
- . S DATA=$P(ROOT,U,1,3) ; take first 3 pieces at once
- . D MSG
- L -^VIAA(6930)
- ;
- ; -- if Mule is reachable, then call web service and deliver the
- ; -- entries. Otherwise, defer any action to the queue process.
- Q
- ;
- SEND ; come here to place the entries in the queue for the Mule service
- ;
- N ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTDTH
- I $D(^VIAA(6930)) D
- . S ZTDESC="Pending RTLS File Queue Transmission"
- . S ZTRTN="STR^VIAAQUE"
- . S ZTIO="NULL",ZTDTH=$H ; need the null device for HWSC call
- . S ZTSAVE("*")=""
- . D ^%ZTLOAD
- Q
- ;
- ; for transmission to Mule:
- ; if status = 500, we have to hold the entries for the next round
- ; of the queue; if status = 200, Mule has accepted the record and we
- ; can clean it from the file PENDING RTLS EVENTS (#6930)
- MSG N MSG,STATUS,XCODE
- ;
- S MSG="?siteID="_$P(DATA,U,1)_"&"_"fileNumber="_$P(DATA,U,2)_"&"_"IEN="_$P(DATA,U,3)
- S XCODE=$$XMIT(MSG)
- S STATUS=$S(XCODE=200:"OK",XCODE=500:"NOK",1:XCODE)
- I STATUS'="OK" Q
- D DEL^VIAATRI(COUNT) ; clear entry from file #6930
- Q
- ;
- XMIT(DATA) ; Transmit the RESTful request.
- ;
- N $ETRAP,$ESTACK,ERR,REST,XCODE,XOBREADR,XOBREAK,XOBSTAT
- S $ETRAP="D XERR^VIAAQUE"
- ;
- S XCODE=0
- S REST=$$GETREST^XOBWLIB("VIAA VISTA TRIGGER SERVICE","VIAA VISTA TRIGGER SERVER")
- S REST.Timeout=60
- I $$POST^XOBWLIB(REST,DATA,.ERR) D
- . S XOBSTAT=##class(%XML.TextReader).ParseStream(REST.HttpResponse.Data,.XOBREADR)
- . I ($$STATCHK^XOBWLIB(XOBSTAT,.ERR)) D
- .. S XOBREAK=0 F Q:XOBREAK!XOBREADR.EOF!'XOBREADR.Read() D
- ... I (XOBREADR.NodeType="element"),(XOBREADR.LocalName="code") D
- .... I XOBREADR.MoveToContent() D
- ..... S XCODE=XOBREADR.Value,XOBREAK=1
- Q XCODE
- ;
- XERR ; -- Error trap handler --
- ;
- S $ECODE=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAAQUE 2474 printed Feb 18, 2025@23:59:49 Page 2
- VIAAQUE ;ALB/CR - RTLS Queue General Utility ;5/04/16 10:00am
- +1 ;;1.0;RTLS;**3**;April 22, 2013;Build 20
- +2 ;
- +3 QUIT
- +4 ;
- +5 ; create a task that can requeue itself and check file #6930
- +6 ; every 3-6 minutes (180-360 seconds) or so
- +7 ; =============== NOTICE ====================
- +8 ; Per HPMO reference # OITIMB33554520, a waiver has been granted
- +9 ; for the use of Cache ObjectScript along with standard MUMPS commands
- +10 ;
- STR ; enter here to send a message right away if entries are found
- +1 ; we want just one job running
- LOCK +^VIAA(6930):5
- if '$TEST
- QUIT
- +2 NEW COUNT,DATA,ROOT
- +3 IF '$DATA(^VIAA(6930))
- QUIT
- +4 FOR COUNT=0:0
- SET COUNT=+$ORDER(^VIAA(6930,COUNT))
- if 'COUNT
- QUIT
- Begin DoDot:1
- +5 SET ROOT=$GET(^VIAA(6930,COUNT,0))
- +6 ; get all 3 pieces for processing in Eng file
- +7 ; take first 3 pieces at once
- SET DATA=$PIECE(ROOT,U,1,3)
- +8 DO MSG
- End DoDot:1
- +9 LOCK -^VIAA(6930)
- +10 ;
- +11 ; -- if Mule is reachable, then call web service and deliver the
- +12 ; -- entries. Otherwise, defer any action to the queue process.
- +13 QUIT
- +14 ;
- SEND ; come here to place the entries in the queue for the Mule service
- +1 ;
- +2 NEW ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTDTH
- +3 IF $DATA(^VIAA(6930))
- Begin DoDot:1
- +4 SET ZTDESC="Pending RTLS File Queue Transmission"
- +5 SET ZTRTN="STR^VIAAQUE"
- +6 ; need the null device for HWSC call
- SET ZTIO="NULL"
- SET ZTDTH=$HOROLOG
- +7 SET ZTSAVE("*")=""
- +8 DO ^%ZTLOAD
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ; for transmission to Mule:
- +12 ; if status = 500, we have to hold the entries for the next round
- +13 ; of the queue; if status = 200, Mule has accepted the record and we
- +14 ; can clean it from the file PENDING RTLS EVENTS (#6930)
- MSG NEW MSG,STATUS,XCODE
- +1 ;
- +2 SET MSG="?siteID="_$PIECE(DATA,U,1)_"&"_"fileNumber="_$PIECE(DATA,U,2)_"&"_"IEN="_$PIECE(DATA,U,3)
- +3 SET XCODE=$$XMIT(MSG)
- +4 SET STATUS=$SELECT(XCODE=200:"OK",XCODE=500:"NOK",1:XCODE)
- +5 IF STATUS'="OK"
- QUIT
- +6 ; clear entry from file #6930
- DO DEL^VIAATRI(COUNT)
- +7 QUIT
- +8 ;
- XMIT(DATA) ; Transmit the RESTful request.
- +1 ;
- +2 NEW $ETRAP,$ESTACK,ERR,REST,XCODE,XOBREADR,XOBREAK,XOBSTAT
- +3 SET $ETRAP="D XERR^VIAAQUE"
- +4 ;
- +5 SET XCODE=0
- +6 SET REST=$$GETREST^XOBWLIB("VIAA VISTA TRIGGER SERVICE","VIAA VISTA TRIGGER SERVER")
- +7 SET REST.Timeout=60
- +8 IF $$POST^XOBWLIB(REST,DATA,.ERR)
- Begin DoDot:1
- +9 SET XOBSTAT=##class(%XML.TextReader).ParseStream(REST.HttpResponse.Data,.XOBREADR)
- +10 IF ($$STATCHK^XOBWLIB(XOBSTAT,.ERR))
- Begin DoDot:2
- +11 SET XOBREAK=0
- FOR
- if XOBREAK!XOBREADR.EOF!'XOBREADR.Read()
- QUIT
- Begin DoDot:3
- +12 IF (XOBREADR.NodeType="element")
- IF (XOBREADR.LocalName="code")
- Begin DoDot:4
- +13 IF XOBREADR.MoveToContent()
- Begin DoDot:5
- +14 SET XCODE=XOBREADR.Value
- SET XOBREAK=1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT XCODE
- +16 ;
- XERR ; -- Error trap handler --
- +1 ;
- +2 SET $ECODE=""
- +3 QUIT