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

HLCSQUE.m

Go to the documentation of this file. 
  1. HLCSQUE ;ALB/MFK HL7 UTILITY FUNCTIONS - 10/4/94 11AM ;05/08/2000  11:07 [ 04/02/2003   8:38 AM ]
  1.  ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
  1.  ;;1.6;HEALTH LEVEL SEVEN;**14,61,59**;Oct 13, 1995
  1. ENQUEUE(IEN,HLDIR) ;Assign a message for queue entry
  1.  ; INPUT: IEN  - Internal Entry Number for file 870 - HL7 QUEUE
  1.  ;        HLDIR  - Direction of queue (IN/OUT)
  1.  ; OUTPUT: BEG - Location in the queue to stuff the message
  1.  ;        -1   - Error
  1.  ; NOTE: All the locks have been commented out.
  1.  N FRONT,BACK,DIC,DA,X,BP,FP,REC,DINUM,ENTRY,Y,RETURN,BPOINTER
  1.  N FPOINTER,HLCNT
  1.  ;  Make sure required variables were given
  1.  S IEN=$G(IEN)
  1.  Q:(IEN="") "-1^Queue not given"
  1.  I +IEN<1 S IEN=$O(^HLCS(870,"B",IEN,""))
  1.  Q:(IEN="") "-1^Invalid queue"
  1.  S HLDIR=$G(HLDIR)
  1.  S HLDIR=$S(HLDIR="1":"IN",HLDIR=2:"OUT",1:HLDIR)
  1.  I HLDIR'="IN",(HLDIR'="OUT") Q "-1^Invalid Direction"
  1.  I HLDIR="IN" S HLDIR=1,BPOINTER="IN QUEUE BACK POINTER",FPOINTER="IN QUEUE FRONT POINTER"
  1.  I HLDIR="OUT" S HLDIR=2,BPOINTER="OUT QUEUE BACK POINTER",FPOINTER="OUT QUEUE FRONT POINTER"
  1.  F  L +^HLCS(870,IEN,FPOINTER):1 Q:$T  H 1
  1.  S FRONT=$G(^HLCS(870,IEN,FPOINTER))
  1.  L -^HLCS(870,IEN,FPOINTER)
  1.  D DELETE^HLCSQUE1(IEN,HLDIR,FRONT)
  1.  F  L +^HLCS(870,IEN,BPOINTER):1 Q:$T  H 1
  1.  S BACK=$G(^HLCS(870,IEN,BPOINTER))
  1.  ; Set up DICN call
  1.  S DIC="^HLCS(870,"_IEN_","_HLDIR_","
  1.  S ENTRY=HLDIR+18
  1.  S DIC(0)="LNX",DA(1)=IEN,DIC("P")=$P(^DD(870,ENTRY,0),"^",2)
  1.  S (DINUM,X)=BACK+1
  1.  ;  Create Record
  1.  K DD,DO
  1.  F  L +^HLCS(870,IEN,HLDIR):1 Q:$T  H 1
  1.  F HLCNT=0:1 D  Q:Y>0  H HLCNT
  1.  . D FILE^DICN
  1.  S REC=$P(Y,"^",1)
  1.  ;  Set the 'status' to 'S' for stub
  1.  S $P(^HLCS(870,IEN,HLDIR,REC,0),"^",2)="S"
  1.  S ^HLCS(870,IEN,BPOINTER)=BACK+1
  1.  ;  Put queue pointers back
  1.  S RETURN=IEN_"^"_REC
  1. EXIT1 ;  Unlock and return results
  1.  L -^HLCS(870,IEN,HLDIR)
  1.  L -^HLCS(870,IEN,BPOINTER)
  1.  K IEN,HLDIR
  1.  Q RETURN
  1. DEQUEUE(IEN,HLDIR) ;Release the next message from the queue
  1.  N MSG,RETURN,FRONT,FP,BACK,POINTER
  1.  S IEN=$G(IEN)
  1.  Q:(IEN="") "-1^Queue not given"
  1.  I +IEN<1 S IEN=$O(^HLCS(870,"B",IEN,""))
  1.  Q:(IEN="") "-1^Invalid queue"
  1.  S HLDIR=$G(HLDIR)
  1.  S HLDIR=$S(HLDIR="1":"IN",HLDIR=2:"OUT",1:HLDIR)
  1.  I HLDIR'="IN",(HLDIR'="OUT") Q "-1^Invalid Direction"
  1.  I HLDIR="IN" S HLDIR=1,POINTER="IN QUEUE FRONT POINTER"
  1.  I HLDIR="OUT" S HLDIR=2,POINTER="OUT QUEUE FRONT POINTER"
  1.  F  L +^HLCS(870,IEN,POINTER):1 Q:$T  H 1
  1.  S FRONT=$G(^HLCS(870,IEN,POINTER))
  1.  L -^HLCS(870,IEN,POINTER)
  1.  D DELETE^HLCSQUE1(IEN,HLDIR,FRONT)
  1.  ;If queue empty or "Stub" record don't dequeue
  1.  F  L +^HLCS(870,IEN,HLDIR,FRONT+1,0):1 Q:$T  H 1
  1.  I '$D(^HLCS(870,IEN,HLDIR,FRONT+1,0)) S RETURN="-1^NO NEXT RECORD" G EXIT2
  1.  I ($P($G(^HLCS(870,IEN,HLDIR,FRONT+1,0)),"^",2)'="P") S RETURN="-1^STUB" G EXIT2
  1.  ; for status "P"
  1.  S ^HLCS(870,IEN,POINTER)=FRONT+1
  1.  S RETURN=IEN_"^"_(FRONT+1)
  1.  ;  Return success
  1. EXIT2 ;
  1.  L -^HLCS(870,IEN,HLDIR,FRONT+1,0)
  1.  L -^HLCS(870,IEN,POINTER)
  1.  Q RETURN
  1. CLEARQUE(IEN,HLDIR) ;Empty an entire queue
  1.  ; IEN - Entry number for queue - can be name from "B" X-ref
  1.  ; HLDIR - Can be "IN", "OUT", 1 or 2.
  1.  ; output: 0 for success
  1.  ;        -1^error for error
  1.  N MSG,X,ERR,FP,BP
  1.  ;NOTE: this is not needed to initialize a queue
  1.  ; enqueue will set up (?) a new queue
  1.  ;  Make sure that required variables exist
  1.  S IEN=$G(IEN)
  1.  Q:(IEN="") "-1^Internal Entry Number missing"
  1.  I +IEN<1 S IEN=$O(^HLCS(870,"B",IEN,""))
  1.  Q:(IEN="") "-1^Invalid IEN"
  1.  ;  Convert direction to a number
  1.  S HLDIR=$G(HLDIR)
  1.  Q:(HLDIR'="IN")&(HLDIR'="OUT")&(HLDIR'=1)&(HLDIR'=2) "-1^Invalid direction"
  1.  S HLDIR=$S(HLDIR="IN":1,HLDIR="OUT":2,HLDIR=2:2,1:1)
  1.  ;  If in queue, set front pointer to 6, out pointer gets set to 8
  1.  I HLDIR=1 S FP="IN QUEUE FRONT POINTER",BP="IN QUEUE BACK POINTER"
  1.  I HLDIR=2 S FP="OUT QUEUE FRONT POINTER",BP="OUT QUEUE BACK POINTER"
  1.  S MSG=0
  1.  W !
  1.  ;  Loop through and delete messages
  1.  F  S MSG=$O(^HLCS(870,IEN,HLDIR,MSG)) Q:(MSG'>0)  D
  1.  .S ERR=$$DELMSG^HLCSQUE1(IEN,HLDIR,MSG) W "."
  1.  .I ERR W ERR,!
  1.  ;  Clear front and back pointers
  1.  S ^HLCS(870,IEN,FP)=0
  1.  S ^HLCS(870,IEN,BP)=0
  1.  ;K IEN,HLDIR
  1.  Q 0
  1.  ;
  1. PUSH(HLDOUT0,HLDOUT1) ;-- Place message back on queue
  1.  ;  INPUT - HLDOUT0 IEN of file 870
  1.  ;          HLDOUT1 IEN of Out Multiple
  1.  ;  OUTPUT- NONE
  1.  ;
  1.  ;-- exit if not vaild variables
  1.  I 'HLDOUT0!'HLDOUT1 G PUSHQ
  1.  ;-- exit if global does not already exist
  1.  I '$D(^HLCS(870,HLDOUT0,"OUT QUEUE FRONT POINTER")) G PUSHQ
  1.  S ^HLCS(870,HLDOUT0,"OUT QUEUE FRONT POINTER")=(HLDOUT1-1)
  1. PUSHQ Q
  1.  ;