source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUPD1.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1VAQUPD1 ;ALB/JRP - DATA LOOKUP ROUTINES;8-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3TRNEXT(TRANPTR,ROOT) ;RECREATE ALL EXTRACTION ARRAYS FOR A TRANSACTION
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
5 ; ROOT - Where to store the information (full global reference)
6 ; Defaluts to ^TMP("VAQ",$J)
7 ;OUTPUT : 0 - Success
8 ; -1^Error_Text - Error
9 ;NOTES : Segments returning Extraction Arrays will be stored in
10 ; ROOT(Segment_Abbreviation,"VALUE",File,Field,Sequence_Number)
11 ; ROOT(Segment_Abbreviation,"ID",File,Field,Sequence_Number)
12 ; Segments returning Display Arrays will be stored in
13 ; ROOT(Segment_Abbreviation,"DISPLAY",Line_Number)
14 ; : Deletion of the outupt array before calling this routine
15 ; is the responsiblity of the calling application.
16 ;
17 ;CHECK INPUT
18 S TRANPTR=+$G(TRANPTR)
19 Q:('TRANPTR) "-1^Pointer to VAQ - TRANSACTION file not passed"
20 Q:('$D(^VAT(394.61,TRANPTR))) "-1^Transaction did not exist"
21 S ROOT=$G(ROOT)
22 S:(ROOT="") ROOT="^TMP(""VAQ"","_$J_")"
23 ;DECLARE VARIABLES
24 N LOOP,SEGABB,ERROR,X,TRANSEG,SEG,TMP,Y,TMPROOT
25 Q:('$D(^VAT(394.61,TRANPTR,"SEG"))) "-1^Transaction did not contain any data segments"
26 S ERROR=0
27 S TRANSEG=0
28 ;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
29 F LOOP=0:0 D Q:((ERROR)!('TRANSEG))
30 .S TRANSEG=$O(^VAT(394.61,TRANPTR,"SEG",TRANSEG))
31 .Q:('TRANSEG)
32 .S SEG=+$G(^VAT(394.61,TRANPTR,"SEG",TRANSEG,0))
33 .Q:('SEG)
34 .;GET SEGMENT ABBREVIATION
35 .S SEGABB=$P($G(^VAT(394.71,SEG,0)),"^",2)
36 .Q:(SEGABB="")
37 .;MAKE SEGMENT ABBREVIATION NEXT SUBSCRIPT IN ROOT
38 .S TMP=$P(ROOT,"(",1)
39 .S X=$P(ROOT,"(",2)
40 .S Y=$P(X,")",1)
41 .S:(Y="") TMPROOT=TMP_"("_$C(34)_SEGABB_$C(34)_")"
42 .S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEGABB_$C(34)_")"
43 .S X=$$SEGEXT(TRANPTR,SEG,TMPROOT)
44 Q 0
45SEGEXT(TRANPTR,SEGPTR,ROOT) ;MOVE SEGMENT IN DATA FILE TO EXTRACTION ARRAY
46 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
47 ; SEGPTR - Pointer to VAQ - DATA SEGMENT file
48 ; ROOT - Where to store the information (full global reference)
49 ;OUTPUT : 0 - Success
50 ; -1^Error_Text - Error
51 ;
52 ;CHECK INPUT
53 Q:('$D(^VAT(394.61,+$G(TRANPTR),0))) "-1^Valid pointer to VAQ - TRANSACTION file not passed"
54 Q:('$D(^VAT(394.71,+$G(SEGPTR),0))) "-1^Valid pointer to VAQ - DATA SEGMENT file not passed"
55 Q:('$D(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR))) "-1^Transaction does not contain wanted information"
56 ;DECLARE VARIABLES
57 N DSPRDY,FILE,FIELD,SEQ,VALUE,ID,LOOP,TMP,DATAIFN
58 ;DETERMINE IF DATA SEGMENT IS DISPLAY READY
59 S DATAIFN=$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR,""))
60 Q:(DATAIFN="") "-1^Transaction does not contain wanted information"
61 S DSPRDY=$D(^VAT(394.62,"A-DISPLAY",TRANPTR,SEGPTR))
62 ;DISPLAY READY
63 I DSPRDY D Q 0
64 .S SEQ=0
65 .F S SEQ=$O(^VAT(394.62,DATAIFN,"DSP",SEQ)) Q:(SEQ="") D
66 ..S @ROOT@("DISPLAY",SEQ,0)=$G(^VAT(394.62,DATAIFN,"DSP",SEQ,0))
67 ;NOT DISPLAY READY - MOVE INFO TO AN EXTRACTION ARRAY
68 S DATAIFN=""
69 F S DATAIFN=$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR,DATAIFN)) Q:(DATAIFN="") D
70 .S TMP=$G(^VAT(394.62,DATAIFN,0))
71 .S FILE=$P(TMP,"^",3)
72 .Q:(FILE="")
73 .S FIELD=$P(TMP,"^",4)
74 .Q:(FIELD="")
75 .S SEQ=$G(^VAT(394.62,DATAIFN,"SQNCE"))
76 .Q:(SEQ="")
77 .S VALUE=$G(^VAT(394.62,DATAIFN,"VAL"))
78 .S ID=$G(^VAT(394.62,DATAIFN,"IDNT1"))
79 .S @ROOT@("ID",FILE,FIELD,SEQ)=ID
80 .S @ROOT@("VALUE",FILE,FIELD,SEQ)=VALUE
81 Q 0
Note: See TracBrowser for help on using the repository browser.