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