Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSQJ

ABSPOSQJ.m

Go to the documentation of this file. 
  1. ABSPOSQJ ; IHS/FCS/DRS - subroutines of ABSPOSQ2 ;  
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1. SETSTAT(ABSBRXI,STAT)        D SETSTAT^ABSPOSU(STAT) Q
  1. TSTAMP(DA)         N DIE,DR,X S DIE=9002313.59,DR="7///NOW" D ^DIE Q
  1. NOW() N %,%H,%I,X D NOW^%DTC Q %
  1.  ; Query whether there are formatted claim packets ready
  1.  ; to send, or formatted response packets ready to be processed.
  1.  ; Call them without DIALOUT (or with DIALOUT=0) to check all DIALOUTs
  1.  ; Call with a specific DIALOUT to check only that DIALOUT
  1.  ; 
  1. ANY2SEND(DIALOUT) ;EP - from ABSPOS2D,ABSPOSQ3
  1.  ; are there any claims waiting to be sent?
  1.  ; also called from POKE^ABSPOSUD
  1.  ; I called with an DIALOUT, look for just that DIALOUT
  1.  ; Return TRUE (=DIALOUT) if there are, FALSE if there aren't
  1.  ; Also:  Return false if this DIALOUT is currently in an ERROR WAIT
  1.  ; state.
  1.  ;
  1.  ; If called without a DIALOUT:  scan all DIALOUTs and return the
  1.  ;   first one that has some waiting to send.  FALSE if none nowhere.
  1.  ;
  1.  N RET
  1.  I '$G(DIALOUT) G ANY2SA
  1.  I '$O(^ABSPECX("POS",DIALOUT,"C","")) Q 0 ; none waiting to be sent
  1.  ; Yes, there are some to be set for this DIALOUT
  1.  I '$$EWAIT55(DIALOUT,"FLAGGED") Q DIALOUT ; no error condition
  1.  I $$EWAIT55(DIALOUT,"EXPIRED") D  Q DIALOUT ; okay, it's time to retry
  1.  . D LOG^ABSPOSL($T(+0)_" - ERROR WAIT expired, time to retry on dial out #"_DIALOUT)
  1.  ; Yes, some to be sent, but we're in error wait retry.
  1.  ; Make sure the individual claims are marked.  (this is to catch any
  1.  ;  newly arrived claims destined for the DIALOUT with prior comms 
  1.  ;  problems)
  1.  D MARKWAIT(DIALOUT)
  1.  Q 0
  1.  ;
  1. ANY2SA ; DIALOUT not given, so look for any DIALOUTs that need work
  1.  N SET,RET S (SET,RET)=0
  1.  F  S SET=$O(^ABSP(9002313.55,SET)) Q:'SET  I $$ANY2SEND(SET) S RET=SET Q
  1.  Q RET
  1.  ;
  1.  ; EWAIT55  manages ERROR WAIT condition on a DIALOUT
  1. EWAIT55(DEST,OPER) ;EP - ABSPOSQ3
  1.  L +^ABSP(9002313.55,DEST):300
  1.  I $Q N RET S RET=$$EWAIT55A
  1.  E  D EWAIT55A()
  1.  L -^ABSP(9002313.55,DEST)
  1.  Q:$Q RET Q
  1. EWAIT55A() ; given DEST, OPER
  1.  N X S X=$G(^ABSP(9002313.55,DEST,"ERROR WAIT"))
  1.  ;
  1.  ; $$EWAIT55(DEST,"FLAGGED")
  1.  ;       returns TRUE (=expiration time) if it's in ERROR WAIT state
  1.  ;       returns FALSE (=0) if it's not
  1.  I OPER="FLAGGED" Q $P(X,U) ; is it flagged?
  1.  ;
  1.  ; $$EWAIT55(DEST,"EXPIRED") returns TRUE if the ERROR WAIT state
  1.  ;   has expired (or if it's not even flagged)
  1.  I OPER="EXPIRED" Q $$NOW'<$P(X,U) ; has it expired?
  1.  ;
  1.  ; $$EWAIT55(DEST,"INCREMENT") bumps ERROR WAIT to next increment
  1.  ; $$EWAIT55(DEST,"RESET") resets it to its first increment
  1.  I OPER="INCREMENT"!(OPER="RESET") D  Q
  1.  . L +^ABSP(9002313.55,DEST):300
  1.  . N FIRST S FIRST=('$P(X,U))!(OPER="RESET") ; the first time through?
  1.  . I 'FIRST,$$NOW<$P(X,U) Q  ;hasn't reached the time yet - do not incr.
  1.  . I '$P(X,U,2) S $P(X,U,2)=30 ; base time
  1.  . I '$P(X,U,3) S $P(X,U,3)=1.2 ; multiplier
  1.  . I '$P(X,U,4) S $P(X,U,4)=30*60 ; max wait time
  1.  . I '$P(X,U,5)!FIRST S $P(X,U,5)=$P(X,U,2) ; current wait time (either init
  1.  . E  S $P(X,U,5)=$P(X,U,5)*$P(X,U,3) ;      or multiply)
  1.  . S $P(X,U,5)=$P(X,U,5)\1
  1.  . S:$P(X,U,5)>$P(X,U,4) $P(X,U,5)=$P(X,U,4) ; apply max if needed
  1.  . S $P(X,U)=$$TADDNOWS^ABSPOSUD($P(X,U,5)) ; set retry time
  1.  . S ^ABSP(9002313.55,DEST,"ERROR WAIT")=X ; store updated data
  1.  . L -^ABSP(9002313.55,DEST)
  1.  . I FIRST,OPER'="INCREMENT" D
  1.  . . D MARKWAIT(DEST) ; change claims' status from 50 to 51
  1.  . E  D
  1.  . . D INCRWAIT(DEST) ; stamp claims with new time of retry
  1.  . N DIALOUT S DIALOUT=DEST ; variable needed by TASKAT^ABSPOSQ2
  1.  . D TASKAT^ABSPOSQ2($P(^ABSP(9002313.55,DIALOUT,"ERROR WAIT"),U)) ; program will run again upon expiry
  1.  ;
  1.  ; $$EWAIT55(DEST,"CLEAR") clears the error wait condition
  1.  I OPER="CLEAR" D  Q
  1.  . S $P(X,U)="",$P(X,U,5)="" ; clear retry time, current wait time
  1.  . S ^ABSP(9002313.55,DEST,"ERROR WAIT")=X
  1.  . ; claims are okay in state 51; don't need to requeue them
  1.  ;
  1.  D IMPOSS^ABSPOSUE("P","TI","Bad arg OPER="_OPER,,"EWAIT55A",$T(+0))
  1.  Q
  1.  ;
  1.  ; When an err condition is first established:  DO MARKWAIT
  1.  ;     It takes the affected claims from code 50 and resets to 51
  1.  ;     This is done in two places:
  1.  ;     1. When an err condition is first detected.
  1.  ;     2. When a new claim packet comes along and discovers
  1.  ;        a pre-existing error condition.
  1.  ;
  1.  ; When an err condition persists and a retry is scheduled: DO INCRWAIT
  1.  ;     This marks all the affected claims with the retry time.
  1.  ;
  1.  ;      
  1. MARKWAIT(DEST)     ; Put status 50 claims into wait state because of this DEST
  1.  ; having comms problems.
  1.  ; The packets are in @ROOT@(PACKET), PACKET is pointer to 9002313.02
  1.  ; The claims are in ^ABSPT("AE",PACKET,*)
  1.  ; The claims are in ^ABSPT("AD",50,*), too
  1.  ; You want to check ONLY the code 50's!  I you do it by going 
  1.  ; through the "AE" index, and it's a long delay, and you have
  1.  ; hundreds of claims backed up, this gets to be too expensive.
  1.  N TIME S TIME=$P(^ABSP(9002313.55,DEST,"ERROR WAIT"),U)
  1.  N IEN59 S IEN59=""
  1.  F  S IEN59=$O(^ABSPT("AD",50,IEN59)) Q:'IEN59  D
  1.  . N PACKET S PACKET=$P(^ABSPT(IEN59,0),U,4)
  1.  . I $D(^ABSPECX("POS",DEST,"C",PACKET)) D
  1.  . . D SETSTAT(IEN59,51) ; takes care of LOCK, last update, etc.!
  1.  . . ; and mark the claim with useful data for the Listmanager screen
  1.  . . S $P(^ABSPT(IEN59,8),U,1,2)=TIME_U_DEST
  1.  Q
  1. INCRWAIT(DEST)  ; Stamp all the waiting claims for this DIALOUT (DEST)
  1.  ; with the scheduled retry time.
  1.  ; This will induce the Listman display to update its display, too,
  1.  ; when the Listman job sees that the LAST UPDATE time in .59 
  1.  ; has changed.
  1.  N TIME S TIME=$P(^ABSP(9002313.55,DEST,"ERROR WAIT"),U)
  1.  N PACKET S PACKET=""
  1.  F  S PACKET=$O(^ABSPECX("POS",DEST,"C",PACKET)) Q:PACKET=""  D
  1.  . N IEN59 S IEN59=""
  1.  . F  S IEN59=$O(^ABSPT("AE",PACKET,IEN59)) Q:IEN59=""  D
  1.  . . S $P(^ABSPT(IEN59,8),U,1,2)=TIME_U_DEST
  1.  . . D TSTAMP(IEN59)
  1.  . F  S IEN59=$O(^ABSPT("AER",PACKET,IEN59)) Q:IEN59=""  D
  1.  . . S $P(^ABSPT(IEN59,8),U,1,2)=TIME_U_DEST
  1.  . . D TSTAMP(IEN59)
  1.  Q