HLOF777 ;ALB/CJM-HL7 - API'S for saving data to file 777 ;02/04/2004
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
;
SAVEMSG(HLMSTATE) ;
;If a record has not yet been created in file 777, then it will be created. Otherwise, it just stores the segments not yet stored.
;Input:
; HLMSTATE (pass by reference) - contains information about the message
; These subscripts must be defined:
; ("BATCH")=1 if batch, 0 otherwise
; ("BODY")=ien file 777
; ("UNSTORED LINES") - count of lines to be stored. The lines are stored at a lower subscript <message#>,<segment#>,<line#>
;Output:
; HLMSTATE("UNSTORED LINES")-set to 0
;
;if the record has not been created yet,then create it
I 'HLMSTATE("BODY"),'$$NEW(.HLMSTATE) Q 0
;
;any segments to store to disk?
Q:'HLMSTATE("UNSTORED LINES") HLMSTATE("BODY")
;
I 'HLMSTATE("BATCH") D
.N ARY,SEG,LINE
.S ARY="^HLA("_HLMSTATE("BODY")_",1)"
.S SEG=0
.F S SEG=$O(HLMSTATE("UNSTORED LINES",1,SEG)) Q:'SEG D
..S LINE=0
..F S LINE=$O(HLMSTATE("UNSTORED LINES",1,SEG,LINE)) Q:'LINE S @ARY@(LINE,0)=HLMSTATE("UNSTORED LINES",1,SEG,LINE)
.;
I HLMSTATE("BATCH") D
.;NOTE: will not store any segments that come before the first MSH!
.N MSG S MSG=0
.F S MSG=$O(HLMSTATE("UNSTORED LINES",MSG)) Q:'MSG D
..N ARY,SEG,LINE
..S ARY="^HLA("_HLMSTATE("BODY")_",2,"_MSG_")"
..;
..;if starting a new message, add its 0 node. The message type and event are stored in HLMSTATE("UNSTORED LINES",MSG)
..I '$D(@ARY@(0)) D
...S @ARY@(0)=MSG_"^"_$G(HLMSTATE("UNSTORED LINES",MSG))
...;
...S ^HLA(HLMSTATE("BODY"),2,"B",MSG,MSG)=""
..;
..S SEG=0
..F S SEG=$O(HLMSTATE("UNSTORED LINES",MSG,SEG)) Q:'SEG D
...S LINE=0
...F S LINE=$O(HLMSTATE("UNSTORED LINES",MSG,SEG,LINE)) Q:'LINE S @ARY@(1,LINE,0)=HLMSTATE("UNSTORED LINES",MSG,SEG,LINE)
;
;clear the cache
K HLMSTATE("UNSTORED LINES")
S HLMSTATE("UNSTORED LINES")=0
;S:HLMSTATE("BATCH") HLMSTATE("BATCH","CURRENT MESSAGE")=0
Q HLMSTATE("BODY")
;
NEW(HLMSTATE) ;
;This function creates a new entry in file 777.
;Input:
; HLMSTATE (required, pass by reference) These subscripts are expected:
; "DIRECTION"
; "DT/TM" (optional, $$NOW used as default)
; "BATCH"
; "HDR","ENCODING CHARACTERS"
; "HDR","EVENT"
; "HDR","FIELD SEPARATOR"
; "HDR","MESSAGE TYPE"
; "HDR","VERSION"
;
;Output - the function returns the ien of the newly created record
;
N IEN,TIME,NODE
S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP^HLOF778A)
Q:'IEN 0
K ^HLA(IEN)
S HLMSTATE("DT/TM CREATED")=$S($G(HLMSTATE("DT/TM")):HLMSTATE("DT/TM"),1:$$NOW^XLFDT)
;
S NODE=HLMSTATE("DT/TM CREATED")_"^"_HLMSTATE("BATCH")_"^^^"_$G(HLMSTATE("HDR","VERSION"))
I 'HLMSTATE("BATCH") S $P(NODE,"^",3)=HLMSTATE("HDR","MESSAGE TYPE"),$P(NODE,"^",4)=HLMSTATE("HDR","EVENT")
S $P(NODE,"^",20)=HLMSTATE("HDR","FIELD SEPARATOR")_HLMSTATE("HDR","ENCODING CHARACTERS")
S ^HLA(IEN,0)=NODE
;
;for incoming msgs, set the "B" xref later
S:HLMSTATE("DIRECTION")="OUT" ^HLA("B",HLMSTATE("DT/TM CREATED"),IEN)=""
;
S HLMSTATE("BODY")=IEN
Q IEN
;
NEWIEN(DIR,TCP) ;
;This function uses a counter to get the next available ien for file 777. There are 3 different counters, each assigned a specific number range, selected via the input parameters. It does not create a record.
;Inputs:
; DIR = "IN" or "OUT" (required)
; TCP = 1,0 (optional)
;Output - the function returns the next available ien. Several counters are used:
; <"OUT">
; <"IN","TCP">
; <"IN","NOT TCP">
;
N IEN,COUNTER
S:DIR="IN" COUNTER=$NA(^HLC("FILE777",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP")))
S:DIR="OUT" COUNTER=$NA(^HLC("FILE777",DIR))
AGAIN ;
S IEN=$$INC^HLOSITE(COUNTER,1)
I IEN>100000000000 D
.L +@COUNTER:200
.I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1
.L -@COUNTER
I IEN>100000000000 G AGAIN
Q (IEN+$S(DIR="OUT":0,+$G(TCP):100000000000,1:200000000000))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOF777 3989 printed Dec 13, 2024@01:58:42 Page 2
HLOF777 ;ALB/CJM-HL7 - API'S for saving data to file 777 ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 ;
SAVEMSG(HLMSTATE) ;
+1 ;If a record has not yet been created in file 777, then it will be created. Otherwise, it just stores the segments not yet stored.
+2 ;Input:
+3 ; HLMSTATE (pass by reference) - contains information about the message
+4 ; These subscripts must be defined:
+5 ; ("BATCH")=1 if batch, 0 otherwise
+6 ; ("BODY")=ien file 777
+7 ; ("UNSTORED LINES") - count of lines to be stored. The lines are stored at a lower subscript <message#>,<segment#>,<line#>
+8 ;Output:
+9 ; HLMSTATE("UNSTORED LINES")-set to 0
+10 ;
+11 ;if the record has not been created yet,then create it
+12 IF 'HLMSTATE("BODY")
IF '$$NEW(.HLMSTATE)
QUIT 0
+13 ;
+14 ;any segments to store to disk?
+15 if 'HLMSTATE("UNSTORED LINES")
QUIT HLMSTATE("BODY")
+16 ;
+17 IF 'HLMSTATE("BATCH")
Begin DoDot:1
+18 NEW ARY,SEG,LINE
+19 SET ARY="^HLA("_HLMSTATE("BODY")_",1)"
+20 SET SEG=0
+21 FOR
SET SEG=$ORDER(HLMSTATE("UNSTORED LINES",1,SEG))
if 'SEG
QUIT
Begin DoDot:2
+22 SET LINE=0
+23 FOR
SET LINE=$ORDER(HLMSTATE("UNSTORED LINES",1,SEG,LINE))
if 'LINE
QUIT
SET @ARY@(LINE,0)=HLMSTATE("UNSTORED LINES",1,SEG,LINE)
End DoDot:2
+24 ;
End DoDot:1
+25 IF HLMSTATE("BATCH")
Begin DoDot:1
+26 ;NOTE: will not store any segments that come before the first MSH!
+27 NEW MSG
SET MSG=0
+28 FOR
SET MSG=$ORDER(HLMSTATE("UNSTORED LINES",MSG))
if 'MSG
QUIT
Begin DoDot:2
+29 NEW ARY,SEG,LINE
+30 SET ARY="^HLA("_HLMSTATE("BODY")_",2,"_MSG_")"
+31 ;
+32 ;if starting a new message, add its 0 node. The message type and event are stored in HLMSTATE("UNSTORED LINES",MSG)
+33 IF '$DATA(@ARY@(0))
Begin DoDot:3
+34 SET @ARY@(0)=MSG_"^"_$GET(HLMSTATE("UNSTORED LINES",MSG))
+35 ;
+36 SET ^HLA(HLMSTATE("BODY"),2,"B",MSG,MSG)=""
End DoDot:3
+37 ;
+38 SET SEG=0
+39 FOR
SET SEG=$ORDER(HLMSTATE("UNSTORED LINES",MSG,SEG))
if 'SEG
QUIT
Begin DoDot:3
+40 SET LINE=0
+41 FOR
SET LINE=$ORDER(HLMSTATE("UNSTORED LINES",MSG,SEG,LINE))
if 'LINE
QUIT
SET @ARY@(1,LINE,0)=HLMSTATE("UNSTORED LINES",MSG,SEG,LINE)
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;
+43 ;clear the cache
+44 KILL HLMSTATE("UNSTORED LINES")
+45 SET HLMSTATE("UNSTORED LINES")=0
+46 ;S:HLMSTATE("BATCH") HLMSTATE("BATCH","CURRENT MESSAGE")=0
+47 QUIT HLMSTATE("BODY")
+48 ;
NEW(HLMSTATE) ;
+1 ;This function creates a new entry in file 777.
+2 ;Input:
+3 ; HLMSTATE (required, pass by reference) These subscripts are expected:
+4 ; "DIRECTION"
+5 ; "DT/TM" (optional, $$NOW used as default)
+6 ; "BATCH"
+7 ; "HDR","ENCODING CHARACTERS"
+8 ; "HDR","EVENT"
+9 ; "HDR","FIELD SEPARATOR"
+10 ; "HDR","MESSAGE TYPE"
+11 ; "HDR","VERSION"
+12 ;
+13 ;Output - the function returns the ien of the newly created record
+14 ;
+15 NEW IEN,TIME,NODE
+16 SET IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP^HLOF778A)
+17 if 'IEN
QUIT 0
+18 KILL ^HLA(IEN)
+19 SET HLMSTATE("DT/TM CREATED")=$SELECT($GET(HLMSTATE("DT/TM")):HLMSTATE("DT/TM"),1:$$NOW^XLFDT)
+20 ;
+21 SET NODE=HLMSTATE("DT/TM CREATED")_"^"_HLMSTATE("BATCH")_"^^^"_$GET(HLMSTATE("HDR","VERSION"))
+22 IF 'HLMSTATE("BATCH")
SET $PIECE(NODE,"^",3)=HLMSTATE("HDR","MESSAGE TYPE")
SET $PIECE(NODE,"^",4)=HLMSTATE("HDR","EVENT")
+23 SET $PIECE(NODE,"^",20)=HLMSTATE("HDR","FIELD SEPARATOR")_HLMSTATE("HDR","ENCODING CHARACTERS")
+24 SET ^HLA(IEN,0)=NODE
+25 ;
+26 ;for incoming msgs, set the "B" xref later
+27 if HLMSTATE("DIRECTION")="OUT"
SET ^HLA("B",HLMSTATE("DT/TM CREATED"),IEN)=""
+28 ;
+29 SET HLMSTATE("BODY")=IEN
+30 QUIT IEN
+31 ;
NEWIEN(DIR,TCP) ;
+1 ;This function uses a counter to get the next available ien for file 777. There are 3 different counters, each assigned a specific number range, selected via the input parameters. It does not create a record.
+2 ;Inputs:
+3 ; DIR = "IN" or "OUT" (required)
+4 ; TCP = 1,0 (optional)
+5 ;Output - the function returns the next available ien. Several counters are used:
+6 ; <"OUT">
+7 ; <"IN","TCP">
+8 ; <"IN","NOT TCP">
+9 ;
+10 NEW IEN,COUNTER
+11 if DIR="IN"
SET COUNTER=$NAME(^HLC("FILE777",DIR,$SELECT(+$GET(TCP):"TCP",1:"NOT TCP")))
+12 if DIR="OUT"
SET COUNTER=$NAME(^HLC("FILE777",DIR))
AGAIN ;
+1 SET IEN=$$INC^HLOSITE(COUNTER,1)
+2 IF IEN>100000000000
Begin DoDot:1
+3 LOCK +@COUNTER:200
+4 IF $TEST
IF @COUNTER>100000000000
SET @COUNTER=1
SET IEN=1
+5 LOCK -@COUNTER
End DoDot:1
+6 IF IEN>100000000000
GOTO AGAIN
+7 QUIT (IEN+$SELECT(DIR="OUT":0,+$GET(TCP):100000000000,1:200000000000))
