source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1VAQDBIM ;ALB/JRP - MEANS TEST EXTRACTION;1-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**38**;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 ;
9EXTRACT(TRAN,DFN,ARRAY,OFFSET) ;EXTRACT MEANS TEST (DISPLAY READY)
10 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
11 ; DFN - Pointer to patient in PATIENT file
12 ; ARRAY - Where to store information (full global reference)
13 ; OFFSET - Where to start adding lines (defaults to 0)
14 ;OUTPUT : n - Number of lines in display
15 ; -1^Error_text - Error
16 ;NOTE : If TRAN is passed
17 ; The patient pointer of the transaction will be used
18 ; Encryption will be based on the transaction
19 ; If DFN is passed
20 ; Encryption will be based on the site parameter
21 ; : Pointer to transaction takes precedence over DFN ... if
22 ; TRAN>0 the DFN will be based on the transaction
23 ;
24 ;This module is not based on any single DGMTSC* routine. Setting
25 ;up of information required to extract Means Test information was
26 ;drawn from several routines/utilitities.
27 ;
28 ;CHECK INPUT
29 S TRAN=+$G(TRAN)
30 S DFN=+$G(DFN)
31 Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
32 I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
33 I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
34 Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
35 Q:($G(ARRAY)="") "-1^Did not pass output array"
36 S OFFSET=+$G(OFFSET)
37 ;DECLARE VARIABLES
38 N DGMTDT,DGMTSC,DGVPRI,DGVINI,DGVIRI,DGMTPAR,DGERR,DGFL,DGDEP
39 N DGMTYPT,DGMTI,LINES,TMP,VAQMT
40 ;SAVE STARTING OFFSET
41 S LINES=OFFSET
42 ;SET MEANS TEST TYPE
43 S DGMTYPT=1
44 ;GET DATE OF LAST MEANS TEST
45 S VAQMT=$$LST^DGMTU(DFN)
46 S DGMTI=$P(VAQMT,U,1),DGMTDT=$P(VAQMT,U,2)
47 Q:(DGMTDT="") $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Could not determine date of last Means Test")
48 ;SET UP MEANS TEST VARIABLES
49 D SETUP^DGMTSCU
50 Q:(DGERR) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Unable to set up Means Test variables")
51 ;PUT IN TITLE
52 S TMP=$$TITLE^VAQDBIM0(ARRAY,OFFSET)
53 Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
54 S OFFSET=OFFSET+TMP
55 ;EXTRACT SCREEN 1
56 S TMP=$$XTRCT1^VAQDBIM1(DFN,ARRAY,OFFSET)
57 Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
58 S OFFSET=OFFSET+TMP
59 F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
60 ;EXTRACT SCREEN 2
61 S TMP=$$XTRCT2^VAQDBIM2(DFN,ARRAY,OFFSET)
62 Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
63 S OFFSET=OFFSET+TMP
64 F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
65 ;EXTRACT SCREEN 3
66 S TMP=$$XTRCT3^VAQDBIM3(DFN,ARRAY,OFFSET)
67 Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
68 S OFFSET=OFFSET+TMP
69 F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
70 ;EXTRACT SCREEN 4
71 S TMP=$$XTRCT4^VAQDBIM4(DFN,ARRAY,OFFSET)
72 Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
73 S OFFSET=OFFSET+TMP
74 F TMP=1:1:2 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
75 ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
76 S:(TRAN) TMP=$$TRANENC^VAQUTL3(TRAN,0)
77 S:('TRAN) TMP=$$NCRYPTON^VAQUTL2(0)
78 S:(TMP) TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
79 ;RETURN NUMBER OF LINES IN DISPLAY
80 Q (OFFSET-LINES)
Note: See TracBrowser for help on using the repository browser.