PXVWICE ;ISP/LMT - ICE interface main routine ;Jun 06, 2019@07:59:57
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
; Thanks to George Lilly for developing (and sharing) his prototype of the interface of VistA and ICE;
; it was instrumental in the development of this production version.
;
; TODO:
; - Create national Clinical Reminders and update Build Logic
; in PX ICE MESSAGE entries that call into GETREM^PXVWVMR
; to use national reminders.
; - Add code to SELECT^ORWPC to check if ICE cache has been validated today;
; and if not, task job to validate cache, and if necessary update cache
;
;
RPC(PXRETURN,DFN,PXCHKCACHE,PXASYNC) ; Entry point for RPC
;
; Returns ICE recommendations
;
;Input:
; DFN - Patient (#2) IEN
; PXCHKCACHE - Use cached results, if available? 1=Yes; 0=No (default: 1)
; PXASYNC - Call ICE asynchronously? 1=Yes; 0=No; Handle; (default: 0)
; (See EN tag below for more info on asynchronous functionality).
;
;Returns:
; If Unsuccessful:
; 0) = X^Error Message
; Note: X can be one of the following values:
; 0: Cache is in middle of being built; check back later
; -1: Invalid input
; -2: Could not make SOAP call (e.g., URL not populated in 920.75, etc.)
; -3: HTTP call returned unsuccessful status code (i.e., Server returned status code other than 200)
; -4: Unable to process incoming message from ICE
; -5: Error during asynchronous process.
; -6: Interface is down/disabled
; n) = If SOAP call was unsuccessful, this will be the message returned by the ICE server.
;
; If Successful:
; 0) = 1 ^ Number of Lines
; n) = GRP ^ Vaccine Group Name ^ Group/CVX Code Recommended ^ Group/CVX Display Name ^ Earliest Recommended Date ^
; Overdue Date ^ Recommend Code ^ Recommend Display Name ^ Doses Remaining
; 1: GRP
; 2: Vaccine Group Name - This is the vaccine group for this recommendation
; 3: Group/CVX Code Recommended - Vaccine or vaccine group recommended.
; If a specific vaccine is recommended, this will be the CVX code, in the format C:CVX_Code.
; More commonly, this will be populated with the vaccine group, in the format G:Group_Name
; 4: Group/CVX Display Name - Display Name for CVX/Group in piece #3.
; 5: Recommended Date
; 6: Overdue Date
; 7: Earliest Date
; 8: Recommend Code (currently either RECOMMENDED, FUTURE_RECOMMENDED, CONDITIONALLY_RECOMMENDED, or NOT_RECOMMENDED)
; 9: Recommend Display Name
; 10: Doses Remaining
; n) = RSN ^ Reason Code ^ Reason Display Name
; Note: This is the reason(s) for the recommendation above.
; 1: RSN
; 2: Reason Code
; 3: Reason Display Name
; n) = HIST ^ V Immunization IEN ^ Immunization Name ^ Administered CVX Code ^ Admin date/time ^ Dose Number ^
; Component CVX Code ^ CVX Display Name ^ Validity Code ^ Validity Display Name
; 1: HIST
; 2: V Immunization IEN (#9000010.11 IEN)
; 3: Immunization Name (#9999999.14, #.01)
; 4: Administered CVX Code (#9999999.14, #.03)
; 5: Admin date/time
; 6: Dose Number
; 7: Component CVX Code (for combination vaccines, this can defer from the CVX administered)
; 8: CVX Display Name
; 9: Validity Code
; 10: Validity Display Name
; n) = HISTRSN ^ Reason Code ^ Reason Display Name
; Note: This is the reason(s) why the vaccine is valid, invalid or accepted.
; 1: HISTRSN
; 2: Reason Code
; 3: Reason Display Name
;
N PXCNT,PXI,PXICEWEB,PXJ,PXK
;
S PXRETURN=$NA(^TMP("PXICERPC",$J))
K ^TMP("PXICERPC",$J)
;
D EN(.PXICEWEB,$G(DFN),$G(PXCHKCACHE),$G(PXASYNC))
;
S PXCNT=0
;
S ^TMP("PXICERPC",$J,0)=$G(^TMP("PXICEWEB",$J,0))
;
; If Unsuccessful
I $P(^TMP("PXICERPC",$J,0),U,1)<1 D Q
. M ^TMP("PXICERPC",$J)=^TMP("PXICEWEB",$J)
;
; If Successful, flatten output
S PXI=0
F S PXI=$O(^TMP("PXICEWEB",$J,PXI)) Q:PXI="" D
. S PXCNT=PXCNT+1
. S ^TMP("PXICERPC",$J,PXCNT)="GRP^"_PXI_U_$G(^TMP("PXICEWEB",$J,PXI))
. ;
. S PXJ=""
. F S PXJ=$O(^TMP("PXICEWEB",$J,PXI,"REASON",PXJ)) Q:PXJ="" D
. . S PXCNT=PXCNT+1
. . S ^TMP("PXICERPC",$J,PXCNT)="RSN^"_$G(^TMP("PXICEWEB",$J,PXI,"REASON",PXJ))
. ;
. S PXJ=""
. F S PXJ=$O(^TMP("PXICEWEB",$J,PXI,"HISTORY",PXJ)) Q:PXJ="" D
. . S PXCNT=PXCNT+1
. . S ^TMP("PXICERPC",$J,PXCNT)="HIST^"_PXJ_U_$G(^TMP("PXICEWEB",$J,PXI,"HISTORY",PXJ))
. . ;
. . S PXK=""
. . F S PXK=$O(^TMP("PXICEWEB",$J,PXI,"HISTORY",PXJ,"REASON",PXK)) Q:PXK="" D
. . . S PXCNT=PXCNT+1
. . . S ^TMP("PXICERPC",$J,PXCNT)="HISTRSN^"_$G(^TMP("PXICEWEB",$J,PXI,"HISTORY",PXJ,"REASON",PXK))
;
S $P(^TMP("PXICERPC",$J,0),U,2)=PXCNT
;
K ^TMP("PXICEWEB",$J)
;
Q
;
;
EN(PXRETURN,DFN,PXCHKCACHE,PXASYNC) ; Entry point for API
;
; Returns ICE recommendations
;
;Input:
; DFN - Patient (#2) IEN
; PXCHKCACHE - Use cached results, if available? 1=Yes; 0=No; (default: 1)
; PXASYNC - Call ICE asynchronously? 1=Yes; 0=No; Handle; (default: 0)
; When calling ICE asynchronously, first pass "1" as the PXASYNC argument.
; If cached results are available (AND PXCHKCACHE is set to 1),
; we will return them immediately.
; If cached results are not available (OR PXCHKCACHE is set to 0),
; we will task a job to call ICE, and return a handle to the calling
; process. This handle should be passed in as the PXASYNC paramater
; on future calls. The calling process should keep checking back to see
; if the ICE task completed. On these subsequent calls, the same arguments
; should be passed in as the original call, except that in the subsequent
; calls, the PXASYNC argument should be the "handle" returned in the original
; call.
;
;
;Returns:
;
; If called asynchronously (i.e., PXASYNC>0) AND a background task was queued (or is still running):
; @PXRETURN@(0)=0^Handle
; This "Handle" is a number >1 and should be passed in on future calls.
;
; If Unsuccessful:
; @PXRETURN@(0)=X^Error Message
; Note: X can be one of the following values:
; -1: Invalid input
; -2: Could not make SOAP call (e.g., URL not populated in 920.75, etc.)
; -3: HTTP call returned unsuccessful status code (i.e., Server returned status code other than 200)
; -4: Unable to process incoming message from ICE
; -5: Error during asynchronous process.
; -6: Interface is down/disabled
; @PXRETURN@(n)=If SOAP call was unsuccessful, this will be the message returned by the ICE server.
;
; If Successful:
; @PXRETURN@(0)=1
; @PXRETURN@(VaccineGroup)=Group/CVX Code Recommended ^ Group/CVX Display Name ^ Recommended Date ^ Overdue Date ^
; Earliest Date ^ Recommend Code ^ Recommend Display Name ^ Doses Remaining
; @PXRETURN@(VaccineGroup,"REASON",n)=Reason Code ^ Reason Display Name
; @PXRETURN@(VaccineGroup,"HISTORY",V_Imm_IEN)=Immunization Name ^ Administered CVX Code ^ Admin date/time ^
; Dose Number ^ Component CVX Code ^ CVX Display Name ^
; Validity Code ^ Validity Display Name
; @PXRETURN@(VaccineGroup,"HISTORY",V_Imm_IEN,"REASON",n)=Reason Code ^ Reason Display Name
;
N PXCACHESTAT,PXCNT,PXDESC,PXHANDLE,PXRTN,PXSTALL,PXTASK,PXURL,PXVARS,PXVOTH
;
S PXRETURN=$NA(^TMP("PXICEWEB",$J))
K ^TMP("PXICEWEB",$J)
K ^TMP("PXVWMSG",$J)
S PXCNT=0
;
; TODO - if ICE is down, should we allow to return from cache if available?
; currently, if disabled, we dont check cache; but if unavailable, we check
I $$CHKSTAT^PXVWSTAT()=0 D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-6^ICE interface is disabled"
;
I $G(PXCHKCACHE)'?1(1"0",1"1") S PXCHKCACHE=1
I $G(PXASYNC)="" S PXASYNC=0
I PXASYNC>1 S PXHANDLE="PXVWICETMP-"_PXASYNC
;
I '$G(DFN) D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-1^Missing DFN parameter"
S PXURL=$$GETURL()
I PXURL="" D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-2^Unable to determine default ICE server"
;
; Check asynchronous background task and quit
I PXASYNC>1 D Q
. D ASYNC(PXHANDLE,DFN,PXASYNC,PXCNT)
. D LOGSTAT^PXVWSTAT(DFN)
;
; if synchronous, call ICE in this process
I 'PXASYNC D CALLICE
;
; if asynchronous, call ICE in tasked process. Return handle to caller.
I PXASYNC D
. ;
. ; Before tasking background process, check cache. If cache is
. ; valid, return from cache and no need to task background job.
. I PXCHKCACHE,$$EXIST^PXVWCCH(DFN) D Q:$G(PXCACHESTAT)=1
. . D BLDVMR^PXVWVMR(DFN)
. . I '$D(^TMP("PXVWMSG",$J)) D Q
. . . S ^TMP("PXICEWEB",$J,PXCNT)="-2^Unable to generate outbound VMR message"
. . . S PXCACHESTAT=1
. . S PXCACHESTAT=$$CHKCACHE(DFN,0)
. . K ^TMP("PXVWMSG",$J)
. ;
. I '$$CHKSTAT^PXVWSTAT() D Q
. . S ^TMP("PXICEWEB",$J,PXCNT)="-6^ICE interface is down"
. ;
. ; Task process to call ICE
. S PXHANDLE=$$HANDLE(DFN)
. S PXRTN="CALLICE^PXVWICE"
. S PXDESC="PCE Call ICE Engine (Immunizations)"
. S PXVARS="PXCHKCACHE;PXURL;DFN;PXHANDLE"
. S PXVOTH("ZTDTH")=$H
. S PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVARS,.PXVOTH)
. ;
. I $G(PXTASK)>0 D
. . S ^XTMP(PXHANDLE,"STATUS")=0_U_PXTASK
. . S ^TMP("PXICEWEB",$J,PXCNT)="0^"_$P(PXHANDLE,"-",2)
. ;
. I $G(PXTASK)=-1 D
. . S ^TMP("PXICEWEB",$J,PXCNT)="-5^Error tasking asynchronous process."
. . K ^XTMP(PXHANDLE)
;
D LOGSTAT^PXVWSTAT(DFN)
;
K ^TMP("PXVWMSG",$J)
;
Q
;
;
CHKCACHE(DFN,PXSTALL) ;Check Cache for DFN
;
; Requires vMR to already be created in ^TMP("PXVWMSG",$J)
;
N PXCACHESTAT,PXI
;
S PXCACHESTAT=$$STAT^PXVWCCH(DFN)
;
I $G(PXSTALL),PXCACHESTAT=2 D
. F PXI=1:1:40 D Q:PXCACHESTAT'=2
. . H .5
. . S PXCACHESTAT=$$STAT^PXVWCCH(DFN)
;
I PXCACHESTAT'=1 Q PXCACHESTAT
;
D LOAD^PXVWCCH(DFN)
;
Q PXCACHESTAT
;
;
ASYNC(PXHANDLE,DFN,PXASYNC,PXCNT) ;Check asynchronous background task
;
N PXDT
;
I '$D(^XTMP(PXHANDLE)) D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-5^Error during asynchronous process."
;
I $P($G(^XTMP(PXHANDLE,1)),U,1)'=DFN D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-5^Error during asynchronous process. DFN does not match."
;
S PXDT=$P($G(^XTMP(PXHANDLE,"DT")),U,1)
I 'PXDT D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-5^Error during asynchronous process."
; if background task is running for more than 2 min, return error
I $$HDIFF^XLFDT($H,PXDT,2)>120 D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-5^Error during asynchronous process. Process timed out."
;
; background task completed.
I $P($G(^XTMP(PXHANDLE,"STATUS")),U,1)=1 D Q
. M ^TMP("PXICEWEB",$J)=^XTMP(PXHANDLE,"ICE")
. K ^XTMP(PXHANDLE)
;
; background task is still running
I $P($G(^XTMP(PXHANDLE,"STATUS")),U,1)=0 D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="0^"_PXASYNC
;
Q
;
;
CALLICE ;
;
; ZEXCEPT: PXCHKCACHE,PXURL,DFN,PXHANDLE,ZTQUEUED,ZTREQ
;
N PXCACHESTAT,PXCNT,PXNOW
;
S ZTREQ="@"
K ^TMP("PXICEWEB",$J)
K ^TMP("PXVWMSG",$J)
S PXNOW=$$NOW^XLFDT
S PXCNT=0
;
D BLDVMR^PXVWVMR(DFN)
;
I '$D(^TMP("PXVWMSG",$J)) D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-2^Unable to generate outbound VMR message"
. I $G(PXHANDLE)'="" D MOVERES(PXHANDLE)
;
; check cache
I PXCHKCACHE D Q:$G(PXCACHESTAT)=1
. S PXCACHESTAT=$$CHKCACHE(DFN,1) ;Check Cache for DFN
. I PXCACHESTAT=1 D
. . I $G(PXHANDLE)'="" D MOVERES(PXHANDLE)
. . K ^TMP("PXVWMSG",$J)
;
I '$$CHKSTAT^PXVWSTAT() D Q
. S ^TMP("PXICEWEB",$J,PXCNT)="-6^ICE interface is down"
. I $G(PXHANDLE)'="" D MOVERES(PXHANDLE)
;
; Set flag that cache is in middle of building
D BLDNG^PXVWCCH(DFN)
;
D EN^PXVWSOAP(PXURL) ; Call ICE
;
; if ICE call successfull, save output to cache
I $P($G(^TMP("PXICEWEB",$J,0)),U,1)=1 D SAVE^PXVWCCH(DFN,PXNOW)
;
; Clear flag that cache is in middle of building
D CLRBLDNG^PXVWCCH(DFN)
;
; if this is a background task, save output to XTMP
I $G(PXHANDLE)'="" D MOVERES(PXHANDLE)
;
K ^TMP("PXVWMSG",$J)
;
Q
;
;
MOVERES(PXHANDLE) ;
M ^XTMP(PXHANDLE,"ICE")=^TMP("PXICEWEB",$J)
S ^XTMP(PXHANDLE,"STATUS")=1
K ^TMP("PXICEWEB",$J)
Q
;
;
HANDLE(DFN) ;Return a unique handle into ^XTMP
;
N PXHANDLE,PXI,PXSUCCESS
;
S PXI=$R(9999)+2
S PXHANDLE="PXVWICETMP-"_PXI
F D Q:$G(PXSUCCESS)
. S PXSUCCESS=$$HANDLE2(PXHANDLE,DFN)
. I $G(PXSUCCESS) Q
. S PXI=PXI+1
. S PXHANDLE="PXVWICETMP-"_PXI
;
Q PXHANDLE
;
HANDLE2(PXHANDLE,DFN) ;
;
I $D(^XTMP(PXHANDLE)) Q 0
;
L +^XTMP(PXHANDLE):DILOCKTM
I '$T Q 0
;
I $D(^XTMP(PXHANDLE)) L -^XTMP(PXHANDLE) Q 0
;
S ^XTMP(PXHANDLE,0)=DT_".24^"_DT
S ^XTMP(PXHANDLE,1)=DFN
S ^XTMP(PXHANDLE,"STATUS")=0
S ^XTMP(PXHANDLE,"DT")=$H
;
L -^XTMP(PXHANDLE)
;
Q 1
;
;
GETURL() ; Get ICE Server URL
;
N PXIEN,PXTMP
;
S PXIEN=$$GET^XPAR("ALL","PX ICE WEB DEFAULT SERVER")
; If the value has not been set, then see if there is only one
I 'PXIEN D
. S PXTMP=$O(^PXV(920.75,0))
. I $O(^PXV(920.75,PXTMP))'>0 S PXIEN=PXTMP
I 'PXIEN Q ""
Q $$GET1^DIQ(920.75,PXIEN,8)
;
;
TESTICE() ; Test ICE Interface
; Returns:
; 1 - Success
; 0 - Fail
;
N PXSUCCESS,PXURL
;
S PXURL=$$GETURL()
I PXURL="" Q 0
;
K ^TMP("PXICEWEB",$J)
K ^TMP("PXVWMSG",$J)
;
D TESTVMR^PXVWVMR
;
I '$D(^TMP("PXVWMSG",$J)) Q 0
;
D EN^PXVWSOAP(PXURL) ; Call ICE
;
S PXSUCCESS=0
I $P($G(^TMP("PXICEWEB",$J,0)),U,1)=1 S PXSUCCESS=1
;
K ^TMP("PXICEWEB",$J)
K ^TMP("PXVWMSG",$J)
;
Q PXSUCCESS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWICE 14197 printed Apr 09, 2024@21:31:18 Page 2
PXVWICE ;ISP/LMT - ICE interface main routine ;Jun 06, 2019@07:59:57
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ; Thanks to George Lilly for developing (and sharing) his prototype of the interface of VistA and ICE;
+4 ; it was instrumental in the development of this production version.
+5 ;
+6 ; TODO:
+7 ; - Create national Clinical Reminders and update Build Logic
+8 ; in PX ICE MESSAGE entries that call into GETREM^PXVWVMR
+9 ; to use national reminders.
+10 ; - Add code to SELECT^ORWPC to check if ICE cache has been validated today;
+11 ; and if not, task job to validate cache, and if necessary update cache
+12 ;
+13 ;
RPC(PXRETURN,DFN,PXCHKCACHE,PXASYNC) ; Entry point for RPC
+1 ;
+2 ; Returns ICE recommendations
+3 ;
+4 ;Input:
+5 ; DFN - Patient (#2) IEN
+6 ; PXCHKCACHE - Use cached results, if available? 1=Yes; 0=No (default: 1)
+7 ; PXASYNC - Call ICE asynchronously? 1=Yes; 0=No; Handle; (default: 0)
+8 ; (See EN tag below for more info on asynchronous functionality).
+9 ;
+10 ;Returns:
+11 ; If Unsuccessful:
+12 ; 0) = X^Error Message
+13 ; Note: X can be one of the following values:
+14 ; 0: Cache is in middle of being built; check back later
+15 ; -1: Invalid input
+16 ; -2: Could not make SOAP call (e.g., URL not populated in 920.75, etc.)
+17 ; -3: HTTP call returned unsuccessful status code (i.e., Server returned status code other than 200)
+18 ; -4: Unable to process incoming message from ICE
+19 ; -5: Error during asynchronous process.
+20 ; -6: Interface is down/disabled
+21 ; n) = If SOAP call was unsuccessful, this will be the message returned by the ICE server.
+22 ;
+23 ; If Successful:
+24 ; 0) = 1 ^ Number of Lines
+25 ; n) = GRP ^ Vaccine Group Name ^ Group/CVX Code Recommended ^ Group/CVX Display Name ^ Earliest Recommended Date ^
+26 ; Overdue Date ^ Recommend Code ^ Recommend Display Name ^ Doses Remaining
+27 ; 1: GRP
+28 ; 2: Vaccine Group Name - This is the vaccine group for this recommendation
+29 ; 3: Group/CVX Code Recommended - Vaccine or vaccine group recommended.
+30 ; If a specific vaccine is recommended, this will be the CVX code, in the format C:CVX_Code.
+31 ; More commonly, this will be populated with the vaccine group, in the format G:Group_Name
+32 ; 4: Group/CVX Display Name - Display Name for CVX/Group in piece #3.
+33 ; 5: Recommended Date
+34 ; 6: Overdue Date
+35 ; 7: Earliest Date
+36 ; 8: Recommend Code (currently either RECOMMENDED, FUTURE_RECOMMENDED, CONDITIONALLY_RECOMMENDED, or NOT_RECOMMENDED)
+37 ; 9: Recommend Display Name
+38 ; 10: Doses Remaining
+39 ; n) = RSN ^ Reason Code ^ Reason Display Name
+40 ; Note: This is the reason(s) for the recommendation above.
+41 ; 1: RSN
+42 ; 2: Reason Code
+43 ; 3: Reason Display Name
+44 ; n) = HIST ^ V Immunization IEN ^ Immunization Name ^ Administered CVX Code ^ Admin date/time ^ Dose Number ^
+45 ; Component CVX Code ^ CVX Display Name ^ Validity Code ^ Validity Display Name
+46 ; 1: HIST
+47 ; 2: V Immunization IEN (#9000010.11 IEN)
+48 ; 3: Immunization Name (#9999999.14, #.01)
+49 ; 4: Administered CVX Code (#9999999.14, #.03)
+50 ; 5: Admin date/time
+51 ; 6: Dose Number
+52 ; 7: Component CVX Code (for combination vaccines, this can defer from the CVX administered)
+53 ; 8: CVX Display Name
+54 ; 9: Validity Code
+55 ; 10: Validity Display Name
+56 ; n) = HISTRSN ^ Reason Code ^ Reason Display Name
+57 ; Note: This is the reason(s) why the vaccine is valid, invalid or accepted.
+58 ; 1: HISTRSN
+59 ; 2: Reason Code
+60 ; 3: Reason Display Name
+61 ;
+62 NEW PXCNT,PXI,PXICEWEB,PXJ,PXK
+63 ;
+64 SET PXRETURN=$NAME(^TMP("PXICERPC",$JOB))
+65 KILL ^TMP("PXICERPC",$JOB)
+66 ;
+67 DO EN(.PXICEWEB,$GET(DFN),$GET(PXCHKCACHE),$GET(PXASYNC))
+68 ;
+69 SET PXCNT=0
+70 ;
+71 SET ^TMP("PXICERPC",$JOB,0)=$GET(^TMP("PXICEWEB",$JOB,0))
+72 ;
+73 ; If Unsuccessful
+74 IF $PIECE(^TMP("PXICERPC",$JOB,0),U,1)<1
Begin DoDot:1
+75 MERGE ^TMP("PXICERPC",$JOB)=^TMP("PXICEWEB",$JOB)
End DoDot:1
QUIT
+76 ;
+77 ; If Successful, flatten output
+78 SET PXI=0
+79 FOR
SET PXI=$ORDER(^TMP("PXICEWEB",$JOB,PXI))
if PXI=""
QUIT
Begin DoDot:1
+80 SET PXCNT=PXCNT+1
+81 SET ^TMP("PXICERPC",$JOB,PXCNT)="GRP^"_PXI_U_$GET(^TMP("PXICEWEB",$JOB,PXI))
+82 ;
+83 SET PXJ=""
+84 FOR
SET PXJ=$ORDER(^TMP("PXICEWEB",$JOB,PXI,"REASON",PXJ))
if PXJ=""
QUIT
Begin DoDot:2
+85 SET PXCNT=PXCNT+1
+86 SET ^TMP("PXICERPC",$JOB,PXCNT)="RSN^"_$GET(^TMP("PXICEWEB",$JOB,PXI,"REASON",PXJ))
End DoDot:2
+87 ;
+88 SET PXJ=""
+89 FOR
SET PXJ=$ORDER(^TMP("PXICEWEB",$JOB,PXI,"HISTORY",PXJ))
if PXJ=""
QUIT
Begin DoDot:2
+90 SET PXCNT=PXCNT+1
+91 SET ^TMP("PXICERPC",$JOB,PXCNT)="HIST^"_PXJ_U_$GET(^TMP("PXICEWEB",$JOB,PXI,"HISTORY",PXJ))
+92 ;
+93 SET PXK=""
+94 FOR
SET PXK=$ORDER(^TMP("PXICEWEB",$JOB,PXI,"HISTORY",PXJ,"REASON",PXK))
if PXK=""
QUIT
Begin DoDot:3
+95 SET PXCNT=PXCNT+1
+96 SET ^TMP("PXICERPC",$JOB,PXCNT)="HISTRSN^"_$GET(^TMP("PXICEWEB",$JOB,PXI,"HISTORY",PXJ,"REASON",PXK))
End DoDot:3
End DoDot:2
End DoDot:1
+97 ;
+98 SET $PIECE(^TMP("PXICERPC",$JOB,0),U,2)=PXCNT
+99 ;
+100 KILL ^TMP("PXICEWEB",$JOB)
+101 ;
+102 QUIT
+103 ;
+104 ;
EN(PXRETURN,DFN,PXCHKCACHE,PXASYNC) ; Entry point for API
+1 ;
+2 ; Returns ICE recommendations
+3 ;
+4 ;Input:
+5 ; DFN - Patient (#2) IEN
+6 ; PXCHKCACHE - Use cached results, if available? 1=Yes; 0=No; (default: 1)
+7 ; PXASYNC - Call ICE asynchronously? 1=Yes; 0=No; Handle; (default: 0)
+8 ; When calling ICE asynchronously, first pass "1" as the PXASYNC argument.
+9 ; If cached results are available (AND PXCHKCACHE is set to 1),
+10 ; we will return them immediately.
+11 ; If cached results are not available (OR PXCHKCACHE is set to 0),
+12 ; we will task a job to call ICE, and return a handle to the calling
+13 ; process. This handle should be passed in as the PXASYNC paramater
+14 ; on future calls. The calling process should keep checking back to see
+15 ; if the ICE task completed. On these subsequent calls, the same arguments
+16 ; should be passed in as the original call, except that in the subsequent
+17 ; calls, the PXASYNC argument should be the "handle" returned in the original
+18 ; call.
+19 ;
+20 ;
+21 ;Returns:
+22 ;
+23 ; If called asynchronously (i.e., PXASYNC>0) AND a background task was queued (or is still running):
+24 ; @PXRETURN@(0)=0^Handle
+25 ; This "Handle" is a number >1 and should be passed in on future calls.
+26 ;
+27 ; If Unsuccessful:
+28 ; @PXRETURN@(0)=X^Error Message
+29 ; Note: X can be one of the following values:
+30 ; -1: Invalid input
+31 ; -2: Could not make SOAP call (e.g., URL not populated in 920.75, etc.)
+32 ; -3: HTTP call returned unsuccessful status code (i.e., Server returned status code other than 200)
+33 ; -4: Unable to process incoming message from ICE
+34 ; -5: Error during asynchronous process.
+35 ; -6: Interface is down/disabled
+36 ; @PXRETURN@(n)=If SOAP call was unsuccessful, this will be the message returned by the ICE server.
+37 ;
+38 ; If Successful:
+39 ; @PXRETURN@(0)=1
+40 ; @PXRETURN@(VaccineGroup)=Group/CVX Code Recommended ^ Group/CVX Display Name ^ Recommended Date ^ Overdue Date ^
+41 ; Earliest Date ^ Recommend Code ^ Recommend Display Name ^ Doses Remaining
+42 ; @PXRETURN@(VaccineGroup,"REASON",n)=Reason Code ^ Reason Display Name
+43 ; @PXRETURN@(VaccineGroup,"HISTORY",V_Imm_IEN)=Immunization Name ^ Administered CVX Code ^ Admin date/time ^
+44 ; Dose Number ^ Component CVX Code ^ CVX Display Name ^
+45 ; Validity Code ^ Validity Display Name
+46 ; @PXRETURN@(VaccineGroup,"HISTORY",V_Imm_IEN,"REASON",n)=Reason Code ^ Reason Display Name
+47 ;
+48 NEW PXCACHESTAT,PXCNT,PXDESC,PXHANDLE,PXRTN,PXSTALL,PXTASK,PXURL,PXVARS,PXVOTH
+49 ;
+50 SET PXRETURN=$NAME(^TMP("PXICEWEB",$JOB))
+51 KILL ^TMP("PXICEWEB",$JOB)
+52 KILL ^TMP("PXVWMSG",$JOB)
+53 SET PXCNT=0
+54 ;
+55 ; TODO - if ICE is down, should we allow to return from cache if available?
+56 ; currently, if disabled, we dont check cache; but if unavailable, we check
+57 IF $$CHKSTAT^PXVWSTAT()=0
Begin DoDot:1
+58 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-6^ICE interface is disabled"
End DoDot:1
QUIT
+59 ;
+60 IF $GET(PXCHKCACHE)'?1(1"0",1"1")
SET PXCHKCACHE=1
+61 IF $GET(PXASYNC)=""
SET PXASYNC=0
+62 IF PXASYNC>1
SET PXHANDLE="PXVWICETMP-"_PXASYNC
+63 ;
+64 IF '$GET(DFN)
Begin DoDot:1
+65 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-1^Missing DFN parameter"
End DoDot:1
QUIT
+66 SET PXURL=$$GETURL()
+67 IF PXURL=""
Begin DoDot:1
+68 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-2^Unable to determine default ICE server"
End DoDot:1
QUIT
+69 ;
+70 ; Check asynchronous background task and quit
+71 IF PXASYNC>1
Begin DoDot:1
+72 DO ASYNC(PXHANDLE,DFN,PXASYNC,PXCNT)
+73 DO LOGSTAT^PXVWSTAT(DFN)
End DoDot:1
QUIT
+74 ;
+75 ; if synchronous, call ICE in this process
+76 IF 'PXASYNC
DO CALLICE
+77 ;
+78 ; if asynchronous, call ICE in tasked process. Return handle to caller.
+79 IF PXASYNC
Begin DoDot:1
+80 ;
+81 ; Before tasking background process, check cache. If cache is
+82 ; valid, return from cache and no need to task background job.
+83 IF PXCHKCACHE
IF $$EXIST^PXVWCCH(DFN)
Begin DoDot:2
+84 DO BLDVMR^PXVWVMR(DFN)
+85 IF '$DATA(^TMP("PXVWMSG",$JOB))
Begin DoDot:3
+86 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-2^Unable to generate outbound VMR message"
+87 SET PXCACHESTAT=1
End DoDot:3
QUIT
+88 SET PXCACHESTAT=$$CHKCACHE(DFN,0)
+89 KILL ^TMP("PXVWMSG",$JOB)
End DoDot:2
if $GET(PXCACHESTAT)=1
QUIT
+90 ;
+91 IF '$$CHKSTAT^PXVWSTAT()
Begin DoDot:2
+92 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-6^ICE interface is down"
End DoDot:2
QUIT
+93 ;
+94 ; Task process to call ICE
+95 SET PXHANDLE=$$HANDLE(DFN)
+96 SET PXRTN="CALLICE^PXVWICE"
+97 SET PXDESC="PCE Call ICE Engine (Immunizations)"
+98 SET PXVARS="PXCHKCACHE;PXURL;DFN;PXHANDLE"
+99 SET PXVOTH("ZTDTH")=$HOROLOG
+100 SET PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,PXVARS,.PXVOTH)
+101 ;
+102 IF $GET(PXTASK)>0
Begin DoDot:2
+103 SET ^XTMP(PXHANDLE,"STATUS")=0_U_PXTASK
+104 SET ^TMP("PXICEWEB",$JOB,PXCNT)="0^"_$PIECE(PXHANDLE,"-",2)
End DoDot:2
+105 ;
+106 IF $GET(PXTASK)=-1
Begin DoDot:2
+107 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-5^Error tasking asynchronous process."
+108 KILL ^XTMP(PXHANDLE)
End DoDot:2
End DoDot:1
+109 ;
+110 DO LOGSTAT^PXVWSTAT(DFN)
+111 ;
+112 KILL ^TMP("PXVWMSG",$JOB)
+113 ;
+114 QUIT
+115 ;
+116 ;
CHKCACHE(DFN,PXSTALL) ;Check Cache for DFN
+1 ;
+2 ; Requires vMR to already be created in ^TMP("PXVWMSG",$J)
+3 ;
+4 NEW PXCACHESTAT,PXI
+5 ;
+6 SET PXCACHESTAT=$$STAT^PXVWCCH(DFN)
+7 ;
+8 IF $GET(PXSTALL)
IF PXCACHESTAT=2
Begin DoDot:1
+9 FOR PXI=1:1:40
Begin DoDot:2
+10 HANG .5
+11 SET PXCACHESTAT=$$STAT^PXVWCCH(DFN)
End DoDot:2
if PXCACHESTAT'=2
QUIT
End DoDot:1
+12 ;
+13 IF PXCACHESTAT'=1
QUIT PXCACHESTAT
+14 ;
+15 DO LOAD^PXVWCCH(DFN)
+16 ;
+17 QUIT PXCACHESTAT
+18 ;
+19 ;
ASYNC(PXHANDLE,DFN,PXASYNC,PXCNT) ;Check asynchronous background task
+1 ;
+2 NEW PXDT
+3 ;
+4 IF '$DATA(^XTMP(PXHANDLE))
Begin DoDot:1
+5 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-5^Error during asynchronous process."
End DoDot:1
QUIT
+6 ;
+7 IF $PIECE($GET(^XTMP(PXHANDLE,1)),U,1)'=DFN
Begin DoDot:1
+8 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-5^Error during asynchronous process. DFN does not match."
End DoDot:1
QUIT
+9 ;
+10 SET PXDT=$PIECE($GET(^XTMP(PXHANDLE,"DT")),U,1)
+11 IF 'PXDT
Begin DoDot:1
+12 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-5^Error during asynchronous process."
End DoDot:1
QUIT
+13 ; if background task is running for more than 2 min, return error
+14 IF $$HDIFF^XLFDT($HOROLOG,PXDT,2)>120
Begin DoDot:1
+15 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-5^Error during asynchronous process. Process timed out."
End DoDot:1
QUIT
+16 ;
+17 ; background task completed.
+18 IF $PIECE($GET(^XTMP(PXHANDLE,"STATUS")),U,1)=1
Begin DoDot:1
+19 MERGE ^TMP("PXICEWEB",$JOB)=^XTMP(PXHANDLE,"ICE")
+20 KILL ^XTMP(PXHANDLE)
End DoDot:1
QUIT
+21 ;
+22 ; background task is still running
+23 IF $PIECE($GET(^XTMP(PXHANDLE,"STATUS")),U,1)=0
Begin DoDot:1
+24 SET ^TMP("PXICEWEB",$JOB,PXCNT)="0^"_PXASYNC
End DoDot:1
QUIT
+25 ;
+26 QUIT
+27 ;
+28 ;
CALLICE ;
+1 ;
+2 ; ZEXCEPT: PXCHKCACHE,PXURL,DFN,PXHANDLE,ZTQUEUED,ZTREQ
+3 ;
+4 NEW PXCACHESTAT,PXCNT,PXNOW
+5 ;
+6 SET ZTREQ="@"
+7 KILL ^TMP("PXICEWEB",$JOB)
+8 KILL ^TMP("PXVWMSG",$JOB)
+9 SET PXNOW=$$NOW^XLFDT
+10 SET PXCNT=0
+11 ;
+12 DO BLDVMR^PXVWVMR(DFN)
+13 ;
+14 IF '$DATA(^TMP("PXVWMSG",$JOB))
Begin DoDot:1
+15 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-2^Unable to generate outbound VMR message"
+16 IF $GET(PXHANDLE)'=""
DO MOVERES(PXHANDLE)
End DoDot:1
QUIT
+17 ;
+18 ; check cache
+19 IF PXCHKCACHE
Begin DoDot:1
+20 ;Check Cache for DFN
SET PXCACHESTAT=$$CHKCACHE(DFN,1)
+21 IF PXCACHESTAT=1
Begin DoDot:2
+22 IF $GET(PXHANDLE)'=""
DO MOVERES(PXHANDLE)
+23 KILL ^TMP("PXVWMSG",$JOB)
End DoDot:2
End DoDot:1
if $GET(PXCACHESTAT)=1
QUIT
+24 ;
+25 IF '$$CHKSTAT^PXVWSTAT()
Begin DoDot:1
+26 SET ^TMP("PXICEWEB",$JOB,PXCNT)="-6^ICE interface is down"
+27 IF $GET(PXHANDLE)'=""
DO MOVERES(PXHANDLE)
End DoDot:1
QUIT
+28 ;
+29 ; Set flag that cache is in middle of building
+30 DO BLDNG^PXVWCCH(DFN)
+31 ;
+32 ; Call ICE
DO EN^PXVWSOAP(PXURL)
+33 ;
+34 ; if ICE call successfull, save output to cache
+35 IF $PIECE($GET(^TMP("PXICEWEB",$JOB,0)),U,1)=1
DO SAVE^PXVWCCH(DFN,PXNOW)
+36 ;
+37 ; Clear flag that cache is in middle of building
+38 DO CLRBLDNG^PXVWCCH(DFN)
+39 ;
+40 ; if this is a background task, save output to XTMP
+41 IF $GET(PXHANDLE)'=""
DO MOVERES(PXHANDLE)
+42 ;
+43 KILL ^TMP("PXVWMSG",$JOB)
+44 ;
+45 QUIT
+46 ;
+47 ;
MOVERES(PXHANDLE) ;
+1 MERGE ^XTMP(PXHANDLE,"ICE")=^TMP("PXICEWEB",$JOB)
+2 SET ^XTMP(PXHANDLE,"STATUS")=1
+3 KILL ^TMP("PXICEWEB",$JOB)
+4 QUIT
+5 ;
+6 ;
HANDLE(DFN) ;Return a unique handle into ^XTMP
+1 ;
+2 NEW PXHANDLE,PXI,PXSUCCESS
+3 ;
+4 SET PXI=$RANDOM(9999)+2
+5 SET PXHANDLE="PXVWICETMP-"_PXI
+6 FOR
Begin DoDot:1
+7 SET PXSUCCESS=$$HANDLE2(PXHANDLE,DFN)
+8 IF $GET(PXSUCCESS)
QUIT
+9 SET PXI=PXI+1
+10 SET PXHANDLE="PXVWICETMP-"_PXI
End DoDot:1
if $GET(PXSUCCESS)
QUIT
+11 ;
+12 QUIT PXHANDLE
+13 ;
HANDLE2(PXHANDLE,DFN) ;
+1 ;
+2 IF $DATA(^XTMP(PXHANDLE))
QUIT 0
+3 ;
+4 LOCK +^XTMP(PXHANDLE):DILOCKTM
+5 IF '$TEST
QUIT 0
+6 ;
+7 IF $DATA(^XTMP(PXHANDLE))
LOCK -^XTMP(PXHANDLE)
QUIT 0
+8 ;
+9 SET ^XTMP(PXHANDLE,0)=DT_".24^"_DT
+10 SET ^XTMP(PXHANDLE,1)=DFN
+11 SET ^XTMP(PXHANDLE,"STATUS")=0
+12 SET ^XTMP(PXHANDLE,"DT")=$HOROLOG
+13 ;
+14 LOCK -^XTMP(PXHANDLE)
+15 ;
+16 QUIT 1
+17 ;
+18 ;
GETURL() ; Get ICE Server URL
+1 ;
+2 NEW PXIEN,PXTMP
+3 ;
+4 SET PXIEN=$$GET^XPAR("ALL","PX ICE WEB DEFAULT SERVER")
+5 ; If the value has not been set, then see if there is only one
+6 IF 'PXIEN
Begin DoDot:1
+7 SET PXTMP=$ORDER(^PXV(920.75,0))
+8 IF $ORDER(^PXV(920.75,PXTMP))'>0
SET PXIEN=PXTMP
End DoDot:1
+9 IF 'PXIEN
QUIT ""
+10 QUIT $$GET1^DIQ(920.75,PXIEN,8)
+11 ;
+12 ;
TESTICE() ; Test ICE Interface
+1 ; Returns:
+2 ; 1 - Success
+3 ; 0 - Fail
+4 ;
+5 NEW PXSUCCESS,PXURL
+6 ;
+7 SET PXURL=$$GETURL()
+8 IF PXURL=""
QUIT 0
+9 ;
+10 KILL ^TMP("PXICEWEB",$JOB)
+11 KILL ^TMP("PXVWMSG",$JOB)
+12 ;
+13 DO TESTVMR^PXVWVMR
+14 ;
+15 IF '$DATA(^TMP("PXVWMSG",$JOB))
QUIT 0
+16 ;
+17 ; Call ICE
DO EN^PXVWSOAP(PXURL)
+18 ;
+19 SET PXSUCCESS=0
+20 IF $PIECE($GET(^TMP("PXICEWEB",$JOB,0)),U,1)=1
SET PXSUCCESS=1
+21 ;
+22 KILL ^TMP("PXICEWEB",$JOB)
+23 KILL ^TMP("PXVWMSG",$JOB)
+24 ;
+25 QUIT PXSUCCESS
