SCDXFU12 ;ALB/JRP - ACRP TRANSMISSION MANAGEMENT FILE UTILS;08-JUL-97
;;5.3;Scheduling;**128**;AUG 13, 1993
;
PTR4MID(MID) ;Find entry in ACRP Transmission History file (#409.77) for
; a given HL7 Message Control ID
;
;Input : MID - HL7 Message Control ID for the transmitted encounter
;Output : HistPtr ^ XmitPtr
; HistPtr = Pointer to ACRP Transmission History file
; XmitPtr = Pointer to related Transmitted Outpatient
; Encounter file (#409.73) entry
; 0 - Entry not found (bad input)
;
;Check input
S MID=$G(MID)
Q:(MID="") 0
;Declare variables
N HISTPTR,XMITPTR
;Find entry in history file
S HISTPTR=+$O(^SD(409.77,"AMID",MID,0))
;Bad x-ref entry
Q:('$D(^SD(409.77,HISTPTR,0))) 0
;Get pointer to transmission file (.01 field of history file)
S XMITPTR=+$G(^SD(409.77,HISTPTR,0))
;Done
Q HISTPTR_"^"_XMITPTR
;
PTRS4BID(BID,ARRAY) ;Find all entries in ACRP Transmission History file
; (#409.77) for a given HL7 Batch Control ID
;
;Input : BID - HL7 Batch Control ID for the transmitted encounters
; ARRAY - Array to place output into (full global reference)
; - Defaults to ^TMP("SCDXFU12",$J,"PTRS4BID")
;Output : X - Number of entries found
; ARRAY(HistPtr) = XmitPtr
; HistPtr = Pointer to ACRP Transmission History file
; XmitPtr = Pointer to related Transmitted Outpatient
; Encounter file (#409.73) entry
;Notes : It is the responsibility of the calling procedure to
; initialize (i.e. KILL) the output array
; : Zero (0) will be returned if no entries are found (bad input)
;
;Check input
S BID=$G(BID)
Q:(BID="") 0
S ARRAY=$G(ARRAY)
S:(ARRAY="") ARRAY=$NA(^TMP("SCDXFU12",$J,"PTRS4BID"))
;Declare variables
N HISTPTR,XMITPTR,COUNT
;Find/count entries in history file
S COUNT=0
S HISTPTR=0
F S HISTPTR=+$O(^SD(409.77,"ABID",BID,HISTPTR)) Q:('HISTPTR) D
.;Bad x-ref entry (ignore)
.Q:('$D(^SD(409.77,HISTPTR,0)))
.;Get pointer to transmission file (.01 field of history file)
.S XMITPTR=+$G(^SD(409.77,HISTPTR,0))
.;Put into output array
.S @ARRAY@(HISTPTR)=XMITPTR
.;Increment counter
.S COUNT=COUNT+1
;Done
Q COUNT
;
ACKMID(MID,ACKDATE,ACKCODE) ;Store/update acknowledgement information
; for entry in ACRP Transmission History file (#409.77) with given
; HL7 Message Control ID
;
;Input : MID - HL7 Message Control ID for transmitted encounters
; ACKDATE - Date/time of acknowledgement (value for field #21)
; - Pass in FileMan format
; - Defaults to current date/time (NOW)
; ACKCODE - Acknowledgemnt code (value for field #22)
; - A = Accepted R = Rejected E = Error
; - Defaults to E (Error)
;Output : None
;
;Check input
S MID=$G(MID)
Q:(MID="")
S ACKDATE=+$G(ACKDATE)
S:('ACKDATE) ACKDATE=$$NOW^XLFDT()
S ACKCODE=$TR($G(ACKCODE),"are","ARE")
S:(ACKCODE="") ACKCODE="E"
S:($L(ACKCODE)>1) ACKCODE="E"
S:("ARE"'[ACKCODE) ACKCODE="E"
;Declare variables
N HISTPTR
;Find entry in history file - quit if none found
S HISTPTR=+$$PTR4MID(MID)
Q:('HISTPTR)
;Store/update ack data
D ACKHIST^SCDXFU10(HISTPTR,ACKDATE,ACKCODE)
;Done
Q
;
ACKBID(BID,ACKDATE,ACKCODE) ;Store/update acknowledgement information
; for all entries in ACRP Transmission History file (#409.77) for
; given HL7 Batch Control ID
;
;Input : BID - HL7 Batch Control ID for transmitted encounters
; ACKDATE - Date/time of acknowledgement (value for field #21)
; - Pass in FileMan format
; - Defaults to current date/time (NOW)
; ACKCODE - Acknowledgemnt code (value for field #22)
; - A = Accepted R = Rejected E = Error
; - Defaults to E (Error)
;Output : None
;
;Check input
S BID=$G(BID)
Q:(BID="")
S ACKDATE=+$G(ACKDATE)
S:('ACKDATE) ACKDATE=$$NOW^XLFDT()
S ACKCODE=$TR($G(ACKCODE),"are","ARE")
S:(ACKCODE="") ACKCODE="E"
S:($L(ACKCODE)>1) ACKCODE="E"
S:("ARE"'[ACKCODE) ACKCODE="E"
;Declare variables
N HISTARR,HISTPTR
S HISTARR=$NA(^TMP("SCDXFU12",$J,"ACKBID"))
K @HISTARR
;Find entries in history file - quit if none found
Q:('$$PTRS4BID(BID,HISTARR))
;Loop through list of entries and store/update ack data
S HISTPTR=0
F S HISTPTR=+$O(@HISTARR@(HISTPTR)) Q:('HISTPTR) D ACKHIST^SCDXFU10(HISTPTR,ACKDATE,ACKCODE)
;Done - clean up and quit
K @HISTARR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXFU12 4606 printed Dec 13, 2024@02:39:13 Page 2
SCDXFU12 ;ALB/JRP - ACRP TRANSMISSION MANAGEMENT FILE UTILS;08-JUL-97
+1 ;;5.3;Scheduling;**128**;AUG 13, 1993
+2 ;
PTR4MID(MID) ;Find entry in ACRP Transmission History file (#409.77) for
+1 ; a given HL7 Message Control ID
+2 ;
+3 ;Input : MID - HL7 Message Control ID for the transmitted encounter
+4 ;Output : HistPtr ^ XmitPtr
+5 ; HistPtr = Pointer to ACRP Transmission History file
+6 ; XmitPtr = Pointer to related Transmitted Outpatient
+7 ; Encounter file (#409.73) entry
+8 ; 0 - Entry not found (bad input)
+9 ;
+10 ;Check input
+11 SET MID=$GET(MID)
+12 if (MID="")
QUIT 0
+13 ;Declare variables
+14 NEW HISTPTR,XMITPTR
+15 ;Find entry in history file
+16 SET HISTPTR=+$ORDER(^SD(409.77,"AMID",MID,0))
+17 ;Bad x-ref entry
+18 if ('$DATA(^SD(409.77,HISTPTR,0)))
QUIT 0
+19 ;Get pointer to transmission file (.01 field of history file)
+20 SET XMITPTR=+$GET(^SD(409.77,HISTPTR,0))
+21 ;Done
+22 QUIT HISTPTR_"^"_XMITPTR
+23 ;
PTRS4BID(BID,ARRAY) ;Find all entries in ACRP Transmission History file
+1 ; (#409.77) for a given HL7 Batch Control ID
+2 ;
+3 ;Input : BID - HL7 Batch Control ID for the transmitted encounters
+4 ; ARRAY - Array to place output into (full global reference)
+5 ; - Defaults to ^TMP("SCDXFU12",$J,"PTRS4BID")
+6 ;Output : X - Number of entries found
+7 ; ARRAY(HistPtr) = XmitPtr
+8 ; HistPtr = Pointer to ACRP Transmission History file
+9 ; XmitPtr = Pointer to related Transmitted Outpatient
+10 ; Encounter file (#409.73) entry
+11 ;Notes : It is the responsibility of the calling procedure to
+12 ; initialize (i.e. KILL) the output array
+13 ; : Zero (0) will be returned if no entries are found (bad input)
+14 ;
+15 ;Check input
+16 SET BID=$GET(BID)
+17 if (BID="")
QUIT 0
+18 SET ARRAY=$GET(ARRAY)
+19 if (ARRAY="")
SET ARRAY=$NAME(^TMP("SCDXFU12",$JOB,"PTRS4BID"))
+20 ;Declare variables
+21 NEW HISTPTR,XMITPTR,COUNT
+22 ;Find/count entries in history file
+23 SET COUNT=0
+24 SET HISTPTR=0
+25 FOR
SET HISTPTR=+$ORDER(^SD(409.77,"ABID",BID,HISTPTR))
if ('HISTPTR)
QUIT
Begin DoDot:1
+26 ;Bad x-ref entry (ignore)
+27 if ('$DATA(^SD(409.77,HISTPTR,0)))
QUIT
+28 ;Get pointer to transmission file (.01 field of history file)
+29 SET XMITPTR=+$GET(^SD(409.77,HISTPTR,0))
+30 ;Put into output array
+31 SET @ARRAY@(HISTPTR)=XMITPTR
+32 ;Increment counter
+33 SET COUNT=COUNT+1
End DoDot:1
+34 ;Done
+35 QUIT COUNT
+36 ;
ACKMID(MID,ACKDATE,ACKCODE) ;Store/update acknowledgement information
+1 ; for entry in ACRP Transmission History file (#409.77) with given
+2 ; HL7 Message Control ID
+3 ;
+4 ;Input : MID - HL7 Message Control ID for transmitted encounters
+5 ; ACKDATE - Date/time of acknowledgement (value for field #21)
+6 ; - Pass in FileMan format
+7 ; - Defaults to current date/time (NOW)
+8 ; ACKCODE - Acknowledgemnt code (value for field #22)
+9 ; - A = Accepted R = Rejected E = Error
+10 ; - Defaults to E (Error)
+11 ;Output : None
+12 ;
+13 ;Check input
+14 SET MID=$GET(MID)
+15 if (MID="")
QUIT
+16 SET ACKDATE=+$GET(ACKDATE)
+17 if ('ACKDATE)
SET ACKDATE=$$NOW^XLFDT()
+18 SET ACKCODE=$TRANSLATE($GET(ACKCODE),"are","ARE")
+19 if (ACKCODE="")
SET ACKCODE="E"
+20 if ($LENGTH(ACKCODE)>1)
SET ACKCODE="E"
+21 if ("ARE"'[ACKCODE)
SET ACKCODE="E"
+22 ;Declare variables
+23 NEW HISTPTR
+24 ;Find entry in history file - quit if none found
+25 SET HISTPTR=+$$PTR4MID(MID)
+26 if ('HISTPTR)
QUIT
+27 ;Store/update ack data
+28 DO ACKHIST^SCDXFU10(HISTPTR,ACKDATE,ACKCODE)
+29 ;Done
+30 QUIT
+31 ;
ACKBID(BID,ACKDATE,ACKCODE) ;Store/update acknowledgement information
+1 ; for all entries in ACRP Transmission History file (#409.77) for
+2 ; given HL7 Batch Control ID
+3 ;
+4 ;Input : BID - HL7 Batch Control ID for transmitted encounters
+5 ; ACKDATE - Date/time of acknowledgement (value for field #21)
+6 ; - Pass in FileMan format
+7 ; - Defaults to current date/time (NOW)
+8 ; ACKCODE - Acknowledgemnt code (value for field #22)
+9 ; - A = Accepted R = Rejected E = Error
+10 ; - Defaults to E (Error)
+11 ;Output : None
+12 ;
+13 ;Check input
+14 SET BID=$GET(BID)
+15 if (BID="")
QUIT
+16 SET ACKDATE=+$GET(ACKDATE)
+17 if ('ACKDATE)
SET ACKDATE=$$NOW^XLFDT()
+18 SET ACKCODE=$TRANSLATE($GET(ACKCODE),"are","ARE")
+19 if (ACKCODE="")
SET ACKCODE="E"
+20 if ($LENGTH(ACKCODE)>1)
SET ACKCODE="E"
+21 if ("ARE"'[ACKCODE)
SET ACKCODE="E"
+22 ;Declare variables
+23 NEW HISTARR,HISTPTR
+24 SET HISTARR=$NAME(^TMP("SCDXFU12",$JOB,"ACKBID"))
+25 KILL @HISTARR
+26 ;Find entries in history file - quit if none found
+27 if ('$$PTRS4BID(BID,HISTARR))
QUIT
+28 ;Loop through list of entries and store/update ack data
+29 SET HISTPTR=0
+30 FOR
SET HISTPTR=+$ORDER(@HISTARR@(HISTPTR))
if ('HISTPTR)
QUIT
DO ACKHIST^SCDXFU10(HISTPTR,ACKDATE,ACKCODE)
+31 ;Done - clean up and quit
+32 KILL @HISTARR
+33 QUIT
