source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUTL92.m@ 1420

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1VAQUTL92 ;ALB/JFP,JRP - PDX TRANSACTION Lookup ;01-SEPT-93
2 ;;1.5;PATIENT DATA EXCHANGE;**6,36**;NOV 17, 1993
3 ;
4TRNDATA(TRNPTR) ; -- Returns nodes in transaction file in local array NODE
5 ; INPUT: TRNPTR = Pointer to VAQ - TRANSACTION FILE
6 ; OUTPUT: 0 = Success
7 ; see variable =
8 ; -1^Reason = Bad input
9 ;
10 ; NOTE: Do KILLTRN to kill off variables created in this
11 ; function.
12 ;
13 Q:'(+$G(TRNPTR)) "-^Did not pass pointer to transaction file"
14 ; -- Declare variables
15 K NODE
16 N ND,Y
17 ; -- Main
18 F ND=0,"QRY","ATHR1","ATHR2","RQST1","RQST2" D
19 .S NODE(ND)=$G(^VAT(394.61,+TRNPTR,ND))
20 ; -- Define variables
21ZERO ; -- ZERO node
22 S VAQTRN=$P(NODE(0),U,1)
23 S VAQCSTAT=$P(NODE(0),U,2)
24 S VAQPTPTR=$P(NODE(0),U,3)
25 S VAQSENP=$P(NODE(0),U,4)
26 S VAQRSTAT=$P(NODE(0),U,5)
27QRY ; -- QRY node
28 S VAQPTNM=$P(NODE("QRY"),U,1)
29 S VAQISSN=$P(NODE("QRY"),U,2)
30 S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
31 S VAQIDOB=$P(NODE("QRY"),U,3)
32 S VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
33 S VAQPTID=$P(NODE("QRY"),U,4)
34RQST1 ; -- RQST1 node
35 S Y=$P(NODE("RQST1"),U,1) X ^DD("DD") S VAQRDT=Y
36 S VAQRPER=$P(NODE("RQST1"),U,2) ; person requesting
37RQST2 ; -- RQST2 node
38 S VAQRSITE=$P(NODE("RQST2"),U,1)
39 S VAQRDOM=$P(NODE("RQST2"),U,2)
40ATHR1 ; -- ATHR1 node
41 S Y=$P(NODE("ATHR1"),U,1) X ^DD("DD") S VAQADT=Y
42 S VAQAPER=$P(NODE("ATHR1"),U,2) ; person who released
43ATHR2 ; -- ATHR2 node
44 S VAQASITE=$P(NODE("ATHR2"),U,1)
45 S VAQADOM=$P(NODE("ATHR2"),U,2)
46 ; -- Clean up
47 K NODE
48 ; -- Success
49 Q 0
50 ;
51KILLTRN ; -- Kills variables created in TRNDATA
52 K VAQTRN,VAQCSTAT,VAQPTPTR,VAQSENP,VAQRSTAT
53 K VAQPTNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQPTID
54 K VAQRDT,VAQRPER
55 K VAQADT,VAQAPER
56 K VAQASITE,VAQADOM
57 K VAQRSITE,VAQRDOM
58 QUIT
59 ;
60RLSEPAT(TRANPTR) ;GET INFO ON PATIENT RELEASED BY REMOTE FACILITY
61 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file (#394.61)
62 ;OUTPUT : name^ssn^dob - Success
63 ; name = Name of patient at remote facility
64 ; ssn = Social security number of patient at remote facility
65 ; (internal format -> without dashes)
66 ; dob = Date of birth of patient at remote facility
67 ; (internal format -> FileMan)
68 ; "" - Error (no info found or bad input)
69 ;
70 ;CHECK INPUT
71 Q:('$D(^VAT(394.61,(+$G(TRANPTR)),0))) ""
72 ;DECLARE VARIABLES
73 N TMP,SEGPTR,FIELD,DATAPTR,NAME,SSN,DOB,FOUND
74 ;CHECK CURRENT STATUS - MAKE SURE DATA WAS RELEASED
75 S TMP=$P($$STATYPE^VAQCON1(TRANPTR,1),"^",1)
76 Q:((TMP'="VAQ-UNSOL")&(TMP'="VAQ-RSLT")) ""
77 ;GET POINTER TO PDX*MIN SEGMENT
78 S SEGPTR=+$O(^VAT(394.71,"C","PDX*MIN",0))
79 Q:('SEGPTR) ""
80 ;INITIALIZE OUTPUT VARIABLES
81 S (NAME,SSN,DOB)=""
82 ;FIND INFO IN DATA FILE
83 S (DATAPTR,FOUND)=0
84 F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRANPTR,SEGPTR,DATAPTR)) Q:('DATAPTR) D Q:(FOUND=3)
85 .;VERIFY CORRECTNESS OF X-REF
86 .Q:((+$G(^VAT(394.62,DATAPTR,"TRNS")))'=TRANPTR)
87 .S TMP=$G(^VAT(394.62,DATAPTR,0))
88 .Q:((+$P(TMP,"^",2))'=SEGPTR)
89 .Q:((+$P(TMP,"^",5)))
90 .;SEE IF ENTRY IS FOR NAME OR SSN OR DOB
91 .Q:((+$P(TMP,"^",3))='2)
92 .S FIELD=+$P(TMP,"^",4)
93 .Q:((FIELD'=.01)&(FIELD'=.03)&(FIELD'=.09))
94 .;ONLY ACCEPT FOR SEQUENCE NUMBER 0
95 .Q:(+$G(^VAT(394.62,DATAPTR,"SQNCE")))
96 .;GET VALUE, SET APPROPRIATE VARIABLE, AND INCREMENT FOUND COUNT
97 .S TMP=$G(^VAT(394.62,DATAPTR,"VAL"))
98 .I (FIELD=.01) S NAME=TMP,FOUND=FOUND+1 Q
99 .I (FIELD=.03) S DOB=$$DATE^VAQUTL99(TMP) S:(DOB="-1") DOB="" S FOUND=FOUND+1 Q
100 .I (FIELD=.09) S SSN=$TR(TMP,"-",""),FOUND=FOUND+1 Q
101 ;RETURN RESULTS
102 Q NAME_"^"_SSN_"^"_DOB
Note: See TracBrowser for help on using the repository browser.