PSSHRQ2 ;WOIFO/AV,TS - Makes a request to PEPS and returns as Global ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**136,163,168,160**;9/30/97;Build 76
;
; @authors - Alex Vazquez, Tim Sabat
; @date - September 19, 2007
; @version - 1.0
;
QUIT
;;
IN(PSSBASE) ;
; @DESC Handles request/response to PEPS
;
; @RETURNS Nothing. Value stored in output global.
;
NEW PSS,PSSRESLT,PSSDOC,PSSXML,FDBFLG,PSSRBASE,PSSRBASX,PSSHRTMX,PSSHRTRT
; Cleanup output global
; KILL ^TMP($JOB,PSSBASE,"OUT") ; PO: commented as requested by Stan Brown on 6/4/09
;
; save "IN" nodes
S PSSHRTMX=0
K ^TMP($J,"SAVE","IN")
M ^TMP($J,"SAVE","IN")=^TMP($J,PSSBASE,"IN") S PSSRBASE=PSSBASE
;
;Check FDB status if an update is occurring
S FDBFLG=$$CHKSTAT^PSSDSFDB()
;If FDB update set global and quit
I FDBFLG S ^TMP($J,PSSBASE,"OUT",0)=FDBFLG GOTO END ;QUIT
;
; Validate input global
SET PSS("validationResult")=$$DRIVER^PSSHRVAL(PSSBASE)
IF PSS("validationResult")=0 DO
. ; Check if data written to global, set to 1 if data exist
. IF $DATA(^TMP($JOB,PSSBASE,"OUT")) SET ^TMP($JOB,PSSBASE,"OUT",0)=1
. ; If no data in output global , set to 0
. IF '$DATA(^TMP($JOB,PSSBASE,"OUT")) SET ^TMP($JOB,PSSBASE,"OUT",0)=0
. QUIT
; End call if no call to make
IF PSS("validationResult")=0 GOTO END ;QUIT
;
; Create XML request
SET PSSXML=$$BLDPREQ^PSSHREQ(PSSBASE)
; Send XML request to PEPS, receive handle to XML in return
;
RETRY ;Retry entry point if first connection attempt fails
SET PSSRESLT=$$PEPSPOST^PSSHTTP(.PSSDOC,PSSXML)
;
; If request unsuccessful go straight to error handling
IF +PSSRESLT=0 DO ALTERROR^PSSHRQ2O(PSSBASE)
;
; If request is successful parse response
; and put in results global object. Also set the last successful run time.
IF +PSSRESLT>0 DO OUT^PSSHRQ2O(PSSDOC,PSSBASE),SLASTRUN^PSSHRIT($$NOW^XLFDT())
;
I 'PSSHRTMX S PSSHRTRT=$P($G(^TMP($J,PSSRBASE,"OUT",0)),"^") I PSSHRTRT'=0,PSSHRTRT'=1 K ^TMP($J,PSSRBASE,"OUT",0) D SHG G RETRY
;
END ; re-store "IN" nodes
M ^TMP($J,PSSBASE,"IN")=^TMP($J,"SAVE","IN")
K ^TMP($J,"SAVE","IN")
S PSSRBASX=$P($G(^TMP($J,PSSRBASE,"OUT",0)),"^") I PSSRBASX'=-1,PSSRBASX'=0,PSSRBASX'=1 D
.K ^TMP($J,PSSRBASE,"OUT")
.S ^TMP($J,PSSRBASE,"OUT",0)="-1^An unexpected error has occurred."
I $P($G(^TMP($J,PSSRBASE,"OUT",0)),"^")'=-1 D CLEXP^PSSHRQ2O
QUIT
;;
;
SHG ;Hang before retry
S PSSHRTMX=1
I $E(PSSRBASE,1,4)'="PING"!($G(PSSMCHK)="CHECK") H 3 Q
H 30
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRQ2 2520 printed Oct 16, 2024@18:32:36 Page 2
PSSHRQ2 ;WOIFO/AV,TS - Makes a request to PEPS and returns as Global ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**136,163,168,160**;9/30/97;Build 76
+2 ;
+3 ; @authors - Alex Vazquez, Tim Sabat
+4 ; @date - September 19, 2007
+5 ; @version - 1.0
+6 ;
+7 QUIT
+8 ;;
IN(PSSBASE) ;
+1 ; @DESC Handles request/response to PEPS
+2 ;
+3 ; @RETURNS Nothing. Value stored in output global.
+4 ;
+5 NEW PSS,PSSRESLT,PSSDOC,PSSXML,FDBFLG,PSSRBASE,PSSRBASX,PSSHRTMX,PSSHRTRT
+6 ; Cleanup output global
+7 ; KILL ^TMP($JOB,PSSBASE,"OUT") ; PO: commented as requested by Stan Brown on 6/4/09
+8 ;
+9 ; save "IN" nodes
+10 SET PSSHRTMX=0
+11 KILL ^TMP($JOB,"SAVE","IN")
+12 MERGE ^TMP($JOB,"SAVE","IN")=^TMP($JOB,PSSBASE,"IN")
SET PSSRBASE=PSSBASE
+13 ;
+14 ;Check FDB status if an update is occurring
+15 SET FDBFLG=$$CHKSTAT^PSSDSFDB()
+16 ;If FDB update set global and quit
+17 ;QUIT
IF FDBFLG
SET ^TMP($JOB,PSSBASE,"OUT",0)=FDBFLG
GOTO END
+18 ;
+19 ; Validate input global
+20 SET PSS("validationResult")=$$DRIVER^PSSHRVAL(PSSBASE)
+21 IF PSS("validationResult")=0
Begin DoDot:1
+22 ; Check if data written to global, set to 1 if data exist
+23 IF $DATA(^TMP($JOB,PSSBASE,"OUT"))
SET ^TMP($JOB,PSSBASE,"OUT",0)=1
+24 ; If no data in output global , set to 0
+25 IF '$DATA(^TMP($JOB,PSSBASE,"OUT"))
SET ^TMP($JOB,PSSBASE,"OUT",0)=0
+26 QUIT
End DoDot:1
+27 ; End call if no call to make
+28 ;QUIT
IF PSS("validationResult")=0
GOTO END
+29 ;
+30 ; Create XML request
+31 SET PSSXML=$$BLDPREQ^PSSHREQ(PSSBASE)
+32 ; Send XML request to PEPS, receive handle to XML in return
+33 ;
RETRY ;Retry entry point if first connection attempt fails
+1 SET PSSRESLT=$$PEPSPOST^PSSHTTP(.PSSDOC,PSSXML)
+2 ;
+3 ; If request unsuccessful go straight to error handling
+4 IF +PSSRESLT=0
DO ALTERROR^PSSHRQ2O(PSSBASE)
+5 ;
+6 ; If request is successful parse response
+7 ; and put in results global object. Also set the last successful run time.
+8 IF +PSSRESLT>0
DO OUT^PSSHRQ2O(PSSDOC,PSSBASE)
DO SLASTRUN^PSSHRIT($$NOW^XLFDT())
+9 ;
+10 IF 'PSSHRTMX
SET PSSHRTRT=$PIECE($GET(^TMP($JOB,PSSRBASE,"OUT",0)),"^")
IF PSSHRTRT'=0
IF PSSHRTRT'=1
KILL ^TMP($JOB,PSSRBASE,"OUT",0)
DO SHG
GOTO RETRY
+11 ;
END ; re-store "IN" nodes
+1 MERGE ^TMP($JOB,PSSBASE,"IN")=^TMP($JOB,"SAVE","IN")
+2 KILL ^TMP($JOB,"SAVE","IN")
+3 SET PSSRBASX=$PIECE($GET(^TMP($JOB,PSSRBASE,"OUT",0)),"^")
IF PSSRBASX'=-1
IF PSSRBASX'=0
IF PSSRBASX'=1
Begin DoDot:1
+4 KILL ^TMP($JOB,PSSRBASE,"OUT")
+5 SET ^TMP($JOB,PSSRBASE,"OUT",0)="-1^An unexpected error has occurred."
End DoDot:1
+6 IF $PIECE($GET(^TMP($JOB,PSSRBASE,"OUT",0)),"^")'=-1
DO CLEXP^PSSHRQ2O
+7 QUIT
+8 ;;
+9 ;
SHG ;Hang before retry
+1 SET PSSHRTMX=1
+2 IF $EXTRACT(PSSRBASE,1,4)'="PING"!($GET(PSSMCHK)="CHECK")
HANG 3
QUIT
+3 HANG 30
+4 QUIT
