source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF777.m@ 1240

Last change on this file since 1240 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1HLOF777 ;ALB/CJM-HL7 - API'S for saving data to file 777 ;02/04/2004
2 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
3 ;
4SAVEMSG(HLMSTATE) ;
5 ;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.
6 ;Input:
7 ; HLMSTATE (pass by reference) - contains information about the message
8 ; These subscripts must be defined:
9 ; ("BATCH")=1 if batch, 0 otherwise
10 ; ("BODY")=ien file 777
11 ; ("UNSTORED LINES") - count of lines to be stored. The lines are stored at a lower subscript <message#>,<segment#>,<line#>
12 ;Output:
13 ; HLMSTATE("UNSTORED LINES")-set to 0
14 ;
15 ;if the record has not been created yet,then create it
16 I 'HLMSTATE("BODY"),'$$NEW(.HLMSTATE) Q 0
17 ;
18 ;any segments to store to disk?
19 Q:'HLMSTATE("UNSTORED LINES") HLMSTATE("BODY")
20 ;
21 I 'HLMSTATE("BATCH") D
22 .N ARY,SEG,LINE
23 .S ARY="^HLA("_HLMSTATE("BODY")_",1)"
24 .S SEG=0
25 .F S SEG=$O(HLMSTATE("UNSTORED LINES",1,SEG)) Q:'SEG D
26 ..S LINE=0
27 ..F S LINE=$O(HLMSTATE("UNSTORED LINES",1,SEG,LINE)) Q:'LINE S @ARY@(LINE,0)=HLMSTATE("UNSTORED LINES",1,SEG,LINE)
28 .;
29 I HLMSTATE("BATCH") D
30 .;NOTE: will not store any segments that come before the first MSH!
31 .N MSG S MSG=0
32 .F S MSG=$O(HLMSTATE("UNSTORED LINES",MSG)) Q:'MSG D
33 ..N ARY,SEG,LINE
34 ..S ARY="^HLA("_HLMSTATE("BODY")_",2,"_MSG_")"
35 ..;
36 ..;if starting a new message, add its 0 node. The message type and event are stored in HLMSTATE("UNSTORED LINES",MSG)
37 ..I '$D(@ARY@(0)) D
38 ...S @ARY@(0)=MSG_"^"_$G(HLMSTATE("UNSTORED LINES",MSG))
39 ...;
40 ...S ^HLA(HLMSTATE("BODY"),2,"B",MSG,MSG)=""
41 ..;
42 ..S SEG=0
43 ..F S SEG=$O(HLMSTATE("UNSTORED LINES",MSG,SEG)) Q:'SEG D
44 ...S LINE=0
45 ...F S LINE=$O(HLMSTATE("UNSTORED LINES",MSG,SEG,LINE)) Q:'LINE S @ARY@(1,LINE,0)=HLMSTATE("UNSTORED LINES",MSG,SEG,LINE)
46 ;
47 ;clear the cache
48 K HLMSTATE("UNSTORED LINES")
49 S HLMSTATE("UNSTORED LINES")=0
50 ;S:HLMSTATE("BATCH") HLMSTATE("BATCH","CURRENT MESSAGE")=0
51 Q HLMSTATE("BODY")
52 ;
53NEW(HLMSTATE) ;
54 ;This function creates a new entry in file 777.
55 ;Input:
56 ; HLMSTATE (required, pass by reference) These subscripts are expected:
57 ; "DIRECTION"
58 ; "DT/TM" (optional, $$NOW used as default)
59 ; "BATCH"
60 ; "HDR","ENCODING CHARACTERS"
61 ; "HDR","EVENT"
62 ; "HDR","FIELD SEPARATOR"
63 ; "HDR","MESSAGE TYPE"
64 ; "HDR","VERSION"
65 ;
66 ;Output - the function returns the ien of the newly created record
67 ;
68 N IEN,TIME,NODE
69 S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP^HLOF778A)
70 Q:'IEN 0
71 K ^HLA(IEN)
72 S HLMSTATE("DT/TM CREATED")=$S($G(HLMSTATE("DT/TM")):HLMSTATE("DT/TM"),1:$$NOW^XLFDT)
73 ;
74 S NODE=HLMSTATE("DT/TM CREATED")_"^"_HLMSTATE("BATCH")_"^^^"_$G(HLMSTATE("HDR","VERSION"))
75 I 'HLMSTATE("BATCH") S $P(NODE,"^",3)=HLMSTATE("HDR","MESSAGE TYPE"),$P(NODE,"^",4)=HLMSTATE("HDR","EVENT")
76 S $P(NODE,"^",20)=HLMSTATE("HDR","FIELD SEPARATOR")_HLMSTATE("HDR","ENCODING CHARACTERS")
77 S ^HLA(IEN,0)=NODE
78 ;
79 ;for incoming msgs, set the "B" xref later
80 S:HLMSTATE("DIRECTION")="OUT" ^HLA("B",HLMSTATE("DT/TM CREATED"),IEN)=""
81 ;
82 S HLMSTATE("BODY")=IEN
83 Q IEN
84 ;
85NEWIEN(DIR,TCP) ;
86 ;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.
87 ;Inputs:
88 ; DIR = "IN" or "OUT" (required)
89 ; TCP = 1,0 (optional)
90 ;Output - the function returns the next available ien. Several counters are used:
91 ; <"OUT">
92 ; <"IN","TCP">
93 ; <"IN","NOT TCP">
94 ;
95 N IEN,COUNTER
96 S:DIR="IN" COUNTER=$NA(^HLC("FILE777",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP")))
97 S:DIR="OUT" COUNTER=$NA(^HLC("FILE777",DIR))
98AGAIN ;
99 S IEN=$$INC^HLOSITE(COUNTER,1)
100 I IEN>100000000000 D
101 .L +@COUNTER:200
102 .I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1
103 .L -@COUNTER
104 I IEN>100000000000 G AGAIN
105 Q (IEN+$S(DIR="OUT":0,+$G(TCP):100000000000,1:200000000000))
Note: See TracBrowser for help on using the repository browser.