source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON99.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1VAQCON99 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3HEAD10(TRANPTR,MESSNUM,ARRAY,OFFSET) ;BUILD HEADER BLOCK FOR VERSION 1.0
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
5 ; MESSNUM - Message number to place block into
6 ; (if 0, block will be placed in ARRAY)
7 ; ARRAY - Array to store block in (full global reference)
8 ; OFFSET - Where to begin placing (default to 0)
9 ;OUTPUT : N - Number of lines in block
10 ; -1^Error_Text - Error
11 ;NOTES : If MESSNUM=0, then block will be placed into
12 ; ARRAY(LineNumber)=Line_of_info
13 ; If MESSNUM>0 then the block will be placed into
14 ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
15 ;
16 ;CHECK INPUT
17 S TRANPTR=+$G(TRANPTR)
18 Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
19 S MESSNUM=+$G(MESSNUM)
20 I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or reference to array"
21 I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
22 S OFFSET=+$G(OFFSET)
23 ;DECLARE VARIABLES
24 N LINE,TYPE,STATUS,PARENT,RQSTNUM,NAME,SSN,DOB,PID,RQSTDUZ,RQSTNAME
25 N RQSTSITE,CODE10,STAT10,ATHRDUZ,ATHRNAME,ATHRSITE,DOMAIN,CLAIM
26 N DATETIME,COMMENT,TMP,X
27 S LINE=OFFSET
28 S CLAIM=""
29 S CODE10=101
30 S COMMENT=""
31 S RQSTDUZ=""
32 S ATHRDUZ=""
33 ;GET STATUS & TYPE
34 S TMP=$$STATYPE^VAQCON1(TRANPTR)
35 Q:($P(TMP,"^",1)="-1") TMP
36 S STATUS=$P(TMP,"^",1)
37 S TYPE=$P(TMP,"^",2)
38 Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
39 ;SET 1.0 STATUS
40 S STAT10=0
41 S:(STATUS="VAQ-AMBIG") STAT10=11
42 S:(STATUS="VAQ-NTFND") STAT10=12
43 S:(STATUS="VAQ-REJ") STAT10=13
44 S:(STATUS="VAQ-RQACK") STAT10=19
45 S:(STATUS="VAQ-RQST") STAT10=10
46 S:(STATUS="VAQ-RSLT") STAT10=15
47 S:(STATUS="VAQ-UNSOL") STAT10=16
48 Q:((STATUS="VAQ-RTRNS")!(STATUS="VAQ-UNACK")) "-1^Version 1.0 does not have an equivalent message"
49 Q:((STATUS="VAQ-AUTO")!(STATUS="VAQ-PROC")!(STATUS="VAQ-TUNSL")) "-1^Message not required"
50 Q:('STAT10) "-1^Could not determine 1.0 status"
51 ;GET PARENT PDX NUMBER
52 S:(TYPE="REQ") PARENT=+$G(^VAT(394.61,TRANPTR,0))
53 S:((TYPE="RES")!(TYPE="ACK")) PARENT=+$P($G(^VAT(394.61,TRANPTR,0)),"^",6)
54 S:(TYPE="UNS") PARENT=""
55 Q:('$D(PARENT)) "-1^Could not determine 1.0 parent PDX number"
56 ;GET NAME,SSN,DOB,PID
57 S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
58 Q:(TMP?1."^") "-1^Patient information not contained in VAQ - TRANSACTION file"
59 S NAME=$P(TMP,"^",1)
60 S SSN=$P(TMP,"^",2)
61 S DOB=$P(TMP,"^",3)
62 S PID=$P(TMP,"^",4)
63 Q:((NAME="")!(SSN="")) "-1^Transaction did not contain patient's name or SSN"
64 ;GET REQUESTER'S NAME
65 S RQSTNAME=""
66 S RQSTNAME=$P($G(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
67 S:(TYPE="UNS") RQSTNAME="UNSOLICITED"
68 S:((RQSTNAME="")&(TYPE="REQ")) RQSTNAME=$P($G(^VA(200,(+$G(DUZ)),0)),"^",1)
69 Q:((RQSTNAME="")&(TYPE="REQ")) "-1^Could not determine name of requestor"
70 ;GET REQUESTING DUZ
71 I (TYPE="REQ") D
72 .S RQSTDUZ=+$O(^VA(200,"B",RQSTNAME,""))
73 .S:('RQSTDUZ) RQSTDUZ=$G(DUZ)
74 ;GET DATE TIME (FILEMAN FORMAT)
75 S TMP=$$NOW^VAQUTL99(1)
76 S:(TYPE="ACK") TMP=+$G(^VAT(394.61,TRANPTR,"RQST1"))
77 S DATETIME=TMP
78 Q:($P(DATETIME,"^",1)="-1") DATETIME
79 ;GET REQUESTING SITE NUMBER
80 S RQSTSITE=""
81 I ((TYPE="REQ")!(TYPE="UNS")) D Q:(RQSTSITE="") "-1^Could not determine current site number"
82 .S TMP=+$O(^VAT(394.81,0))
83 .Q:('TMP)
84 .S X=+$G(^DIC(4,+$G(^VAT(394.81,TMP,0)),99))
85 .Q:('X)
86 .S RQSTSITE=X
87 I (TYPE="RES") D
88 .S TMP=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",1)
89 .S:(TMP'="") RQSTSITE=$O(^DIC(4,"B",TMP,""))
90 ;GET REQUEST NUMBER
91 S:(TYPE="REQ") RQSTNUM=PARENT
92 S:((TYPE="UNS")!(TYPE="ACK")) RQSTNUM=""
93 S:(TYPE="RES") RQSTNUM=+$G(^VAT(394.61,TRANPTR,0))
94 Q:('$D(RQSTNUM)) "-1^Could not determine 1.0 PDX request number"
95 ;GET AUTHORIZING NAME
96 S ATHRNAME=""
97 S ATHRNAME=$P($G(^VAT(394.61,TRANPTR,"ATHR1")),"^",2)
98 S:((ATHRNAME="")&((TYPE="UNS")!(TYPE="RES"))) ATHRNAME=$P($G(^VA(200,(+$G(DUZ)),0)),"^",1)
99 Q:((ATHRNAME="")&((TYPE="UNS")!(TYPE="RES"))) "-1^Could not determine name of authorizer"
100 ;GET AUTHORIZING DUZ
101 I ((TYPE="RES")!(TYPE="UNS")) D
102 .S ATHRDUZ=+$O(^VA(200,"B",ATHRNAME,""))
103 .S:('ATHRDUZ) ATHRDUZ=$G(DUZ)
104 ;GET AUTHORIZING SITE NUMBER
105 S ATHRSITE=""
106 I ((TYPE="RES")!(TYPE="UNS")) D Q:(ATHRSITE="") "-1^Could not determine current site number"
107 .S TMP=+$O(^VAT(394.81,0))
108 .Q:('TMP)
109 .S X=+$G(^DIC(4,+$G(^VAT(394.81,TMP,0)),99))
110 .Q:('X)
111 .S ATHRSITE=X
112 I (TYPE="REQ") D
113 .S TMP=$P($G(^VAT(394.61,TRANPTR,"ATHR2")),"^",1)
114 .S:(TMP'="") ATHRSITE=$O(^DIC(4,"B",TMP,""))
115 ;SET REMOTE DUZs TO PERSON'S NAME
116 S:((TYPE="ACK")!(TYPE="RES")) RQSTDUZ=RQSTNAME
117 ;MOVE TO CONTINUATION ROUTINE
118 D HEAD10^VAQCON98
119 Q (LINE-OFFSET)
Note: See TracBrowser for help on using the repository browser.