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

ABSPOSQ3.m

Go to the documentation of this file. 
  1. ABSPOSQ3 ; IHS/FCS/DRS - tasked from ABSPOSQ2 ;     [ 09/12/2002  10:18 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,14**;JUN 01, 2001;Build 38
  1.  Q
  1.  ; 
  1.  ; Subroutines split away from ABSPOSQ3:
  1.  ;   EWAIT55^ABSPOSQJ(DIALOUT,OPERATION) - manage ERROR WAIT condition
  1.  ;   ANY2SEND^ABSPOSQJ(DIALOUT) - any claims waiting to be sent?
  1.  ;
  1. COMMS ; This is the entry point - usually by taskman call from ABSPOSQ2.
  1.  ; Given DIALOUT = pointer into 9002313.55
  1.  ; Transmit and receive as long as you have claims to be transmitted
  1.  ; The task manager sets up DIALOUT in the call from ABSPOSQ2.
  1.  ; When it's done with one DIALOUT, it looks around for others that
  1.  ; are in need of transmit, so you could end up doing lots of
  1.  ; transmissions in this one routine.
  1.  ;
  1.  ; Tell the world that we're up and running.
  1.  ;
  1.  ;BREAK
  1.  L +^ABSPECX("ABSPOSQ3","JOB",$J):0 I '$T D  Q
  1.  . D IMPOSS^ABSPOSUE("P","TI","can't obtain job-specific lock for $J="_$J_" ????",,"COMMS",$T(+0))
  1.  ;
  1.  ; Remark about ^ABSPECX("ABSPOSQ3","JOB",$J,...
  1.  ;    $$JOBCOUNT uses LOCKs to decide if they're running.
  1.  ;    If a job bombs, the global remains but the LOCK is gone.
  1.  ;    And that way, $$JOBCOUNT knows when to kill off such entries.
  1.  S ^ABSPECX("ABSPOSQ3","JOB",$J)=$H
  1.  S ^ABSPECX("ABSPOSQ3","JOB",$J,"DIALOUT")=DIALOUT
  1.  I $$JOBCOUNT>$$MAXJOBS H 2 I $$JOBCOUNT>$$MAXJOBS G ENDJOB99
  1.  ;
  1.  ; put in long delay here for testing stuff like cancel a claim
  1.  ;Don't forget to uncomment this later
  1.  ;I 0 H 300
  1.  ;
  1.  N ABSPECT2,ABSBPOSE
  1.  ;
  1.  ; You need a slot for logging
  1.  D INIT^ABSPOSL(.1)
  1.  D LOG^ABSPOSL("Sender/Receiver Job "_$J_" begins; DIALOUT="_DIALOUT)
  1.  D REMEMLOG(DIALOUT,$$GETSLOT^ABSPOSL)
  1.  ;
  1. AGAIN ; Loop back to here ; DIALOUT may have been changed since first entry
  1.  S ^ABSPECX("ABSPOSQ3","JOB",$J,"DIALOUT")=DIALOUT
  1.  ;I $$JOBCOUNT>$$MAXJOBS D  G ENDJOB  ; already enough of these running
  1.  ;. D LOG^ABSPOSL("Exceeded "_$$MAXJOBS_" sender/receiver jobs.")
  1.  ;
  1.  ;BREAK
  1.  I $$ANY2SEND^ABSPOSQJ(DIALOUT) D
  1.  . D TASK(60) ; start up proc. of responses right now, 
  1.  . ; so something's ready - 60 = seconds for ABSPOSQ4 to wait around
  1.  . ; for response packets to arrive
  1.  . S ABSBPOSE=$$TRANSMIT(DIALOUT) ; transmit / receive
  1.  E  S (ABSPECT2,ABSBPOSE)=0 ; none sent, no errors
  1.  ;
  1.  I ABSPECT2 D  ;if there were any complete transactions
  1.  . ; and someone hasn't already processed the responses,
  1.  . I $O(^ABSPECX("POS",DIALOUT,"R",0)) D TASK() ; start up resp. handl'g
  1.  ; 
  1.  ; I there were any errors returned by $$TRANSMIT
  1.  ;   Check for the simple one-transaction-per-call case and loop back
  1.  ;   if that's what happened.
  1.  ;
  1.  I ABSBPOSE=6999.30101,ABSPECT2>0 G AGAIN
  1.  ;
  1.  ; Else:
  1.  ; 1 Mark the DIAL OUT as being in an error state.
  1.  ; 2 Mark the POS WORKING claims as being in an error wait state (51)
  1.  ; 3 Schedule this program to run again after the wait period expires.
  1.  ;
  1.  I ABSBPOSE D
  1.  . ; one call to EWAIT55^ABSPOSQJ does it all
  1.  . ; if ABSPECT2 (i.e., any successful transactions), then reset
  1.  . ; to first increment - else bump up to next increment
  1.  . D EWAIT55^ABSPOSQJ(DIALOUT,$S(ABSPECT2:"RESET",1:"INCREMENT"))
  1.  . N X S X=$T(+0)_" - Increment ERROR WAIT on Dial Out `"_DIALOUT
  1.  . S X=X_" to "_$P(^ABSP(9002313.55,DIALOUT,"ERROR WAIT"),U)
  1.  . D LOG^ABSPOSL(X)
  1.  E  I $P($G(^ABSP(9002313.55,DIALOUT,"ERROR WAIT")),U) D
  1.  . ; No error, but should be clear the error on the dial-out?
  1.  . ; Case 1:  Yes, clear it if we had a successful transmit-receive.
  1.  . ; Case 2:  We had nothing to send, and there's no other active
  1.  . ;   transmit-receive jobs on this same dial-out trying to work.
  1.  . I ('$$OTHJOBS)!(ABSPECT2) D
  1.  . . D LOG^ABSPOSL($T(+0)_" - Clear ERROR WAIT - Dial Out #"_DIALOUT)
  1.  . . D EWAIT55^ABSPOSQJ(DIALOUT,"CLEAR")
  1.  ;
  1.  ; We finished with DIALOUT 
  1.  K ^ABSPECX("ABSPOSQ3","JOB",$J,"DIALOUT")
  1.  ; - any others to do, though?
  1.  ; Give it 10 seconds; more efficient than task managering again
  1.  H 10
  1. TOLOOP ;
  1.  ; Now that transmit is done for this DIALOUT, maybe there are others
  1.  ; we can help out with?
  1.  I '$$SHUTDOWN S DIALOUT=$$ANY2SEND^ABSPOSQJ I DIALOUT D  G AGAIN
  1.  . D LOG^ABSPOSL($T(+0)_" - $$ANY2SEND^ABSPOSQJ(DIALOUT)="_DIALOUT_": loop back")
  1.  ;
  1. ENDJOB ;
  1.  D LOG^ABSPOSL("Sender/Receiver Job "_$J_" ends")
  1.  D DONE^ABSPOSL
  1. ENDJOB99 ;EP
  1.  I '$D(^ABSPECX("ABSPOSQ3","JOB",$J)) D  ; impossible
  1.  . D IMPOSS^ABSPOSUE("P","TI","my job-defined locked node disappeared!!!  $J="_$J,,"ENDJOB99",$T(+0))
  1.  K ^ABSPECX("ABSPOSQ3","JOB",$J)
  1.  L -^ABSPECX("ABSPOSQ3","JOB",$J)
  1.  ;
  1.  Q
  1. OTHJOBS() ; any other transmit-receive jobs using DIALOUT?  returns count of
  1.  N A,R S (A,R)=0
  1.  F  S A=$O(^ABSPECX("ABSPOSQ3","JOB",A)) Q:'A  D
  1.  . I DIALOUT=$G(^ABSPECX("ABSPOSQ3","JOB",A,"DIALOUT")) S R=R+1
  1.  Q R
  1. TASK(Q4WAIT) ;EP - ABSPOS2D,ABSPOSQ4 ; start processing of responses
  1.  N X,Y,%DT
  1.  S X="N",%DT="ST" D ^%DT
  1.  D TASKAT(Y,$G(Q4WAIT))
  1.  Q
  1. TASKAT(ZTDTH,Q4WAIT) ; EP -
  1.  ;ZTDTH = time when you want EN^ABSPOSQ4 to run
  1.  ; called from TASK, above, normally
  1.  ; Q4WAIT true: it will wait that many seconds for responses to come in,
  1.  ; polling every few seconds.
  1.  ; Q4WAIT false: if there's none ready, it stops
  1.  N ZTRTN,ZTIO,ZTSAVE
  1.  S ZTRTN="EN^ABSPOSQ4",ZTIO=""
  1.  S ZTSAVE("DIALOUT")="" ; which entry in 9002313.55
  1.  I $G(Q4WAIT) S ZTSAVE("Q4WAIT")=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. TRANSMIT(DIALOUT) ; returns 0 if success, nonzero error code if failure
  1.  ; This does transmit/receive for ONLY the given DIALOUT
  1.  N ECODE,ERROR S ERROR=0
  1.  ; ERROR codes:   
  1.  ;  3xx - in (to be completed - routine names changed)
  1.  ; 69xx - in
  1.  ; 80xx - in
  1.  ;
  1.  ; Dialing and $$CONNECT moved into $$SEND
  1.  ; S ECODE=$$CONNECT(DIALOUT) ; connect to NDC (or other host)
  1.  ;
  1. TMIT1 S ECODE=$$SEND(DIALOUT) ; transmit and receive
  1.  ; in case the OPEN failed, wait about one transaction xmit time or so
  1.  I +ECODE=20999 H 10 H $R(5) G TMIT1 ; 
  1.  ; sets ABSPECT2=count
  1.  ;
  1.  D CLOSE^ABSPOSAB(DIALOUT)
  1.  D ADDSTAT^ABSPOSUD("D",1,1,"D",2,$G(ABSPECT2),"D",3,ECODE'=0)
  1.  ;
  1.  I ECODE=0 D  ; success
  1.  . D EWAIT55^ABSPOSQJ(DIALOUT,"CLEAR") ; clear any error indicators
  1.  E  D
  1.  . D EWAIT55^ABSPOSQJ(DIALOUT,"INCREMENT") ; init or incr err indicator
  1.  . N X S X="CLAIM - ERROR - "_ECODE_" - "
  1.  . S X=X_$P($G(^ABSPF(9002313.89,ECODE,0)),U,2)
  1.  . D LOG^ABSPOSL(X)
  1.  ;
  1.  Q $S(ECODE:6999_"."_ECODE,1:0)
  1.  ;
  1. NOW() N %,%H,%I,X D NOW^%DTC Q %
  1.  ;
  1.  ;
  1. SEND(DEST)         ;
  1.  S ABSPECT2=0
  1.  N RET S RET=$$SEND^ABSPOSAM(DEST)
  1.  I ABSPECT2 D
  1.  . N X S X=$T(+0)_" - Complete transactions: "_ABSPECT2
  1.  . D LOG^ABSPOSL(X)
  1.  I RET D
  1.  . I RET=20999 D  ; couldn't open device (not unusual)
  1.  . . ;
  1.  . E  D
  1.  . . N X S X=$T(+0)_" - Error code "_RET_" returned from $$SEND^ABSPOSAM"
  1.  . . D LOG^ABSPOSL(X)
  1.  Q RET
  1. ROOTREF(DEST)          Q "^ABSPECX(""POS"","_DEST_",""C"")"
  1. SETSTAT(ABSBRXI,STAT)        D SETSTAT^ABSPOSU(STAT) Q
  1. TSTAMP(DA)         N DIE,DR S DIE=9002313.59,DR="7///NOW" D ^DIE Q
  1. REMEMLOG(N,SLOT)   ; ^("LOG FILE") remembers current and past several log files
  1.  N X S X=$G(^ABSP(9002313.55,N,"LOG FILE"))
  1.  S X=SLOT_U_$P(X,U,1,9)
  1.  S ^ABSP(9002313.55,N,"LOG FILE")=X
  1.  Q
  1.  ;
  1.  ; = = = = = = = = = = UTILITIES = = = = = = = = = =
  1.  ; ^ABSPECX("ABSPOSQ3","JOB",$J) is set for each of these that's running
  1.  ;   and the node is also LOCKed.
  1.  ; ^TMP("ABSPOSQ3","SHUTDOWN") tells these to shut down.
  1.  ;  $$SHUTDOWN() to query, $$SHUTDOWN(N) to set it.
  1.  ;     >0 means shut down, =0 means enabled
  1.  ; ^TMP("ABSPOSQ3","MAX JOBS")=maximum # of these you want running
  1.  ;    May actually be greater than that, but excess ones will drop out.
  1.  ; $$MAXJOBS() to query, $$MAXJOBS(n) to set it.
  1.  ;
  1.  ; JOBCOUNT  tells you how many of these are running right now
  1.  ;
  1. JOBMON ; temporary, for use by direct mode debugging
  1.  F  W $$JOBCOUNT(1)," ",$P($H,",",2)," / " W:$X>60 ! H 1
  1.  Q
  1. JOBCOUNT(ECHO) ;EP
  1.  N N,X S N=0
  1.  S X="" F  S X=$O(^ABSPECX("ABSPOSQ3","JOB",X)) Q:X=""  D
  1.  .L +^ABSPECX("ABSPOSQ3","JOB",X):0
  1.  .I '$T S N=N+1 ; yes, it's really running
  1.  .E  D
  1.  ..I X=$J S N=N+1 ; it's us, we're that job, that's why LOCK succeeded
  1.  ..E  D  ; we got the lock, and we must unlock
  1.  ...I $G(ECHO) W "We're going to kill the entry for job ",X,!
  1.  ...K ^ABSPECX("ABSPOSQ3","JOB",X) ; it's not running, must've bombed
  1.  ..L -^ABSPECX("ABSPOSQ3","JOB",X)
  1.  Q N
  1.  ;
  1. LOCK(X) L +^TMP("ABSPOSQ3",X):300 Q $T
  1. UNLOCK(X) L -^TMP("ABSPOSQ3",X) Q
  1.  ;
  1. SHUTDOWN(N) ;EP - ABSPOS2A,ABSPOSAM
  1.  N RET,ROU,X
  1.  S ROU=$T(+0),X="SHUTDOWN"
  1.  F  Q:$$LOCK(X)  Q:'$$IMPOSS^ABSPOSUE("L","RIT","LOCK of SHUTDOWN flag",,"SHUTDOWN",$T(+0))  H 30
  1.  I $D(N) S ^TMP("ABSPOSQ3",$J,X)=N
  1.  S RET=+$G(^TMP("ABSPOSQ3",$J,X))
  1.  D UNLOCK(X)
  1.  Q:$Q RET Q
  1.  ;
  1. MAXJOBS(N) ;EP - ABSPOS2A
  1.  N RET,ROU,X S RET=0
  1.  S ROU=$T(+0),X="MAX JOBS"
  1.  I '$$LOCK(X) ;
  1.  I $D(N) S ^TMP("ABSPOSQ3",X)=N
  1.  S RET=$G(^TMP("ABSPOSQ3",X))
  1.  I 'RET S (RET,^TMP("ABSPOSQ3",X))=1 ; an arbitrary default for first timers
  1.  D UNLOCK(X)
  1.  Q:$Q RET Q