- 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))
- 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))