source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIM0.m@ 1751

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3 ; **********
4 ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
5 ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
6 ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
7 ; **********
8 ;
9HEADER(SCREEN,ARRAY,OFFSET) ;SCREEN HEADER
10 ;INPUT : SCREEN - Screen number
11 ; ARRAY - Where to store header (full global reference)
12 ; OFFSET - Where to start adding lines
13 ; Input also includes all DG* variables required to build
14 ; the screen header.
15 ;OUTPUT : n - Number of lines in display
16 ; -1^Error_text - Error
17 ;
18 ;This module is based on HD^DGMTSCU
19 ;
20 ;CHECK INPUT
21 Q:('$D(SCREEN)) "-1^Screen number not passed"
22 Q:('$D(ARRAY)) "-1^Reference to output array not passed"
23 Q:('$D(OFFSET)) "-1^Offset not passed"
24 ;DECLARE VARIABLES
25 N TMP,INFO,Y,LINES
26 S LINES=OFFSET
27 S TMP=$G(DGMTSC(SCREEN))
28 Q:(TMP="") "-1^Could not determine header information"
29 S INFO="----- "_$P(TMP,";",2)_" -----"
30 S TMP=((80-$L(INFO))\2)+1
31 S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
32 S OFFSET=OFFSET+1
33 S @ARRAY@("DISPLAY",OFFSET,0)=""
34 S OFFSET=OFFSET+1
35 Q (OFFSET-LINES)
36 ;
37TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
38 ;INPUT : ARRAY - Where to store title (full global reference)
39 ; OFFSET - Where to start adding lines
40 ; Input also includes all DG* variables required to build
41 ; the screen header.
42 ;OUTPUT : n - Number of lines in display
43 ; -1^Error_text - Error
44 ;
45 ;This module is based on HD^DGMTSCU
46 ;
47 ;CHECK INPUT
48 Q:('$D(ARRAY)) "-1^Reference to output array not passed"
49 Q:('$D(OFFSET)) "-1^Offset not passed"
50 ;DECLARE VARIABLES
51 N TMP,INFO,Y,LINES
52 S LINES=OFFSET
53 S INFO=$$REPEAT^VAQUTL1("-",79)
54 S TMP="< Means Test Data >"
55 S Y=((80-$L(TMP))\2)+1
56 S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
57 S @ARRAY@("DISPLAY",OFFSET,0)=INFO
58 S OFFSET=OFFSET+1
59 S @ARRAY@("DISPLAY",OFFSET,0)=""
60 S OFFSET=OFFSET+1
61 S INFO="ANNUAL INCOME FOR "
62 S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") S INFO=INFO_Y
63 S Y=((80-$L(INFO))\2)+1
64 S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
65 S @ARRAY@("DISPLAY",OFFSET,0)=INFO
66 S OFFSET=OFFSET+1
67 S TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
68 S INFO="MEANS TEST DONE ON "_TMP
69 S Y=((80-$L(INFO))\2)+1
70 S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
71 S @ARRAY@("DISPLAY",OFFSET,0)=INFO
72 S OFFSET=OFFSET+1
73 S @ARRAY@("DISPLAY",OFFSET,0)=""
74 S OFFSET=OFFSET+1
75 Q (OFFSET-LINES)
76 ;
77ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
78 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
79 ; ARRAY - Where to store information (full global reference)
80 ; OFFSET - Line segment started on
81 ; REASON - Reason for error (optional)
82 ;OUTPUT : n - Number of lines in display
83 ; -1^Error_text - Error
84 ;NOTES : If TRAN>0
85 ; Encryption is based on the transaction
86 ; Else
87 ; Encryption is based ont the parameter file
88 ;
89 ;CHECK INPUT
90 S TRAN=+$G(TRAN)
91 I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
92 Q:('$D(ARRAY)) "-1^Reference to output array not passed"
93 Q:('$D(OFFSET)) "-1^Offset not passed"
94 S REASON=$G(REASON)
95 ;DECLARE VARIABLES
96 N TMP,INFO,Y,LINES
97 S LINES=OFFSET
98 ;DELETE WHAT HAS BEEN ADDED
99 S Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
100 Q:(Y) Y
101 ;CREATE ERROR SEGMENT
102 S INFO=$$REPEAT^VAQUTL1("-",79)
103 S TMP="< Means Test Data >"
104 S Y=((80-$L(TMP))\2)+1
105 S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
106 S @ARRAY@("DISPLAY",OFFSET,0)=INFO
107 S OFFSET=OFFSET+1
108 S @ARRAY@("DISPLAY",OFFSET,0)=""
109 S OFFSET=OFFSET+1
110 S TMP="Unable to extract Means Test data"
111 S Y=((80-$L(TMP))\2)+1
112 S INFO=$$INSERT^VAQUTL1(TMP,"",Y)
113 S @ARRAY@("DISPLAY",OFFSET,0)=INFO
114 S OFFSET=OFFSET+1
115 I (REASON'="") D
116 .S REASON="("_REASON_")"
117 .S Y=((80-$L(REASON))\2)+1
118 .S INFO=$$INSERT^VAQUTL1(REASON,"",Y)
119 .S @ARRAY@("DISPLAY",OFFSET,0)=INFO
120 .S OFFSET=OFFSET+1
121 F Y=1:1:2 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
122 ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
123 S:(TRAN) TMP=$$TRANENC^VAQUTL3(TRAN,0)
124 S:('TRAN) TMP=$$NCRYPTON^VAQUTL2(0)
125 S:(TMP) TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
126 Q (OFFSET-LINES)
Note: See TracBrowser for help on using the repository browser.