source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON7.m@ 1000

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1VAQCON7 ;ALB/JRP - MESSAGE CONSTRUCTION;13-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3DATA(TRANPTR,SEGABB,DATARR,MESSNUM,ARRAY,OFFSET) ;CONSTRUCT DATA BLOCK
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
5 ; SEGABB - Segment abbreviation for segment
6 ; DATARR - Location of Extraction Array (full global reference)
7 ; MESSNUM - Message number to place block into
8 ; (if 0, block will be placed in ARRAY)
9 ; ARRAY - Array to store block in (full global reference)
10 ; OFFSET - Where to begin placing information (defaults to 0)
11 ;OUTPUT : N - Number of lines in block
12 ; -1^Error_Text - Error
13 ;NOTES : If MESSNUM=0, then the block will be placed into
14 ; ARRAY(LineNumber)=Line_of_info
15 ; If MESSNUM>0 then the block will be placed into
16 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
17 ;
18 ;CHECK INPUT
19 S TRANPTR=+$G(TRANPTR)
20 Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
21 Q:($G(SEGABB)="") "-1^Did not pass segment abbreviation"
22 Q:($G(DATARR)="") "-1^Did not pass location of Extraction Array"
23 S MESSNUM=+$G(MESSNUM)
24 I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number of reference to array"
25 I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
26 S OFFSET=+$G(OFFSET)
27 ;DECLARE VARIABLES
28 N TMP,LINE,ID,FILE,FIELD,SEQ,NCRYPTON,X
29 S LINE=OFFSET
30 ;DETERMINE IF ENCRYPTION WAS TURNED ON
31 S NCRYPTON=$$TRANENC^VAQUTL3(TRANPTR,0)
32 ;LINE 1
33 S TMP="$DATA"
34 S:('MESSNUM) @ARRAY@(LINE)=TMP
35 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
36 S LINE=LINE+1
37 ;LINE 2
38 S TMP=SEGABB
39 S:('MESSNUM) @ARRAY@(LINE)=TMP
40 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
41 S LINE=LINE+1
42 ;LOOP THROUGH EACH FILE
43 S FILE=""
44 F S FILE=$O(@DATARR@("VALUE",FILE)) Q:(FILE="") D
45 .;LOOP THROUGH EACH FIELD
46 .S FIELD=""
47 .F S FIELD=$O(@DATARR@("VALUE",FILE,FIELD)) Q:(FIELD="") D
48 ..;COUNT NUMBER OF VALUES (IF MORE THAN ONE)
49 ..S SEQ=1
50 ..I (+$O(@DATARR@("VALUE",FILE,FIELD,0))) D
51 ...S SEQ=0
52 ...S X=""
53 ...F S X=$O(@DATARR@("VALUE",FILE,FIELD,X)) Q:(X="") S SEQ=SEQ+1
54 ..;STORE NON-REPEATED INFO
55 ..;DETERMINE IF FIELD WAS ENCRYPTED
56 ..S X=0
57 ..S:(NCRYPTON) X=+$$NCRPFLD^VAQUTL2(FILE,FIELD)
58 ..S TMP=X_"^"_FILE_"^"_FIELD_"^"_SEQ
59 ..S:('MESSNUM) @ARRAY@(LINE)=TMP
60 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
61 ..S LINE=LINE+1
62 ..;LOOP THROUGH EACH VALUE
63 ..S SEQ=""
64 ..F S SEQ=$O(@DATARR@("VALUE",FILE,FIELD,SEQ)) Q:(SEQ="") D
65 ...S TMP=$G(@DATARR@("VALUE",FILE,FIELD,SEQ))
66 ...S:('MESSNUM) @ARRAY@(LINE)=TMP
67 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
68 ...S LINE=LINE+1
69 ...S TMP=$G(@DATARR@("ID",FILE,FIELD,SEQ))
70 ...S:('MESSNUM) @ARRAY@(LINE)=TMP
71 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
72 ...S LINE=LINE+1
73 ;LINE Z
74 S TMP="$$DATA"
75 S:('MESSNUM) @ARRAY@(LINE)=TMP
76 S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
77 S LINE=LINE+1
78 Q (LINE-OFFSET)
Note: See TracBrowser for help on using the repository browser.