source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCHS0.m@ 1538

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

initial load of FOIAVistA 6/30/08 version
File size: 3.7 KB
Line 
1DVBCHS0 ;ALB/JRP - C & P EXTRACT FOR HEALTH SUMMARY;11-JAN-95
2 ;;2.7;AMIE;;Apr 10, 1995
3HSCP(PATPTR,INVBEGDT,INVENDDT,OUTCODE,ARRAY) ;MAIN ENTRY POINT
4 ;INPUT : PATPTR - Pointer to PATIENT file (#2)
5 ; INVBEGDT - Beginning date in inverse FileMan format
6 ; - Defaults to one year before today
7 ; INVENDDT - Ending date in inverse FileMan format
8 ; - Defaults to today
9 ; OUTCODE - Flag indicating which optional nodes to return
10 ; 0 = Do not return any optional nodes
11 ; 1 = Node 1 should also be returned
12 ; 2 = Node 2 should also be returned
13 ; 3 = Nodes 1 & 2 should also be returned (default)
14 ; ARRAY - Where to store output (full global reference)
15 ; - Defaults to ^TMP("DVBC",$J)
16 ;
17 ;OUTPUT : None
18 ; ARRAY(InvExDt,Type,0) = Code ^ DATE OF EXAM [.06]
19 ; ^ EXAM TYPE [.03] ^ EXAMINING PHYSICIAN [.07]
20 ; ^ PRIORITY OF EXAM [396.3;9]
21 ; --> ARRAY(InvExDt,Type,1) = ROUTING LOCATION [396.3;24]
22 ; ^ OWNER DOMAIN [396.3;28] ^ TRANSFERRED OUT TO [62]
23 ; --> ARRAY(InvExDt,Type,2) = REQUEST STATUS [396.3;17]
24 ; ^ APPROVED BY [396.3;25] ^ APPROVAL DATE/TIME [396.3;26]
25 ; ARRAY(InvExDt,Type,"RES",0) = Number of lines in EXAM RESULTS
26 ; ARRAY(InvExDt,Type,"RES",X) = Line X of EXAM RESULTS [70]
27 ;
28 ; Subscripts:
29 ; InvExDt - Inverse FileMan date of DATE OF EXAM [.06]
30 ; Type - Poiner value of EXAM TYPE [.03]
31 ;
32 ; Code used as follows:
33 ; 1 = Exam was performed locally
34 ; 2 = Exam was performed by another facility
35 ; 3 = Exam was performed locally for another facility
36 ;
37 ; All dates will be in the FileMan format
38 ;
39 ; With the exception of dates, 'N/A' (not applicable) and 'UNKNOWN'
40 ; will be used for field values when appropriate
41 ;
42 ; Optional nodes are marked by an arrow (-->)
43 ;
44 ;NOTES : Output array will be initialized (KILLed)
45 ; : Information for an exam is only returned when
46 ; 1. The exam status is COMPLETED
47 ; 2. The status of the request containing the exam is
48 ; a) RELEASED TO RO, NOT PRINTED
49 ; b) COMPLETED, PRINTED BY RO
50 ; c) COMPLETED, TRANSFERRED OUT
51 ;
52 ;
53 ;CHECK INPUT/SET DEFAULTS
54 Q:('$D(^DPT((+$G(PATPTR)),0)))
55 S INVBEGDT=+$G(INVBEGDT)
56 S:('INVBEGDT) INVBEGDT=9999999-(DT-10000)
57 S INVENDDT=+$G(INVENDDT)
58 S:('INVENDDT) INVENDDT=9999999-DT
59 S OUTCODE=$G(OUTCODE)
60 S:((OUTCODE="")!(OUTCODE>3)!(OUTCODE<0)) OUTCODE=3
61 S:($G(ARRAY)="") ARRAY="^TMP(""DVBC"",$J)"
62 ;KILL OUTPUT ARRAY
63 K @ARRAY
64 ;DECLARE VARIABLES
65 N BEGDATE,ENDDATE,TYPEPTR,EXAMPTR,TMP,NODE0
66 ;CONVERT INVERSE DATES TO NORMAL DATES
67 S BEGDATE=9999999-INVBEGDT
68 S ENDDATE=9999999-INVENDDT
69 ;NO EXAMS ON FILE
70 Q:('$D(^DVB(396.4,"APS",PATPTR)))
71 ;LOOK FOR COMPLETED EXAMS
72 S TYPEPTR=0
73 F S TYPEPTR=+$O(^DVB(396.4,"APS",PATPTR,TYPEPTR)) Q:('TYPEPTR) D
74 .S EXAMPTR=0
75 .F S EXAMPTR=+$O(^DVB(396.4,"APS",PATPTR,TYPEPTR,"C",EXAMPTR)) Q:('EXAMPTR) D
76 ..;GET ZERO NODE OF EXAM
77 ..S NODE0=$G(^DVB(396.4,EXAMPTR,0))
78 ..;MAKE SURE EXAM IS WITHIN DATE RANGE
79 ..S TMP=+$P(NODE0,"^",6)
80 ..Q:(('TMP)!(TMP<BEGDATE)!(TMP>ENDDATE))
81 ..;MAKE SURE REQUEST CONTAINING EXAM HAS BEEN RELEASED
82 ..S TMP=+$P(NODE0,"^",2)
83 ..Q:('TMP)
84 ..S TMP=$P($G(^DVB(396.3,TMP,0)),"^",18)
85 ..Q:((TMP'="C")&(TMP'="R")&(TMP'="CT"))
86 ..;SET NODE ZERO OF OUTPUT
87 ..D OUT0^DVBCHS1(EXAMPTR,ARRAY)
88 ..;SET NODE 'RES' OF OUTPUT
89 ..D OUTRES^DVBCHS1(EXAMPTR,ARRAY)
90 ..Q:('OUTCODE)
91 ..;SET NODE ONE OF OUTPUT (OPTIONAL)
92 ..D:((OUTCODE=1)!(OUTCODE=3)) OUT1^DVBCHS2(EXAMPTR,ARRAY)
93 ..;SET NODE TWO OF OUTPUT (OPTIONAL)
94 ..D:((OUTCODE=2)!(OUTCODE=3)) OUT2^DVBCHS2(EXAMPTR,ARRAY)
95 Q
Note: See TracBrowser for help on using the repository browser.