Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQCON99

VAQCON99.m

Go to the documentation of this file.
  1. VAQCON99 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. HEAD10(TRANPTR,MESSNUM,ARRAY,OFFSET) ;BUILD HEADER BLOCK FOR VERSION 1.0
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
  1. ; MESSNUM - Message number to place block into
  1. ; (if 0, block will be placed in ARRAY)
  1. ; ARRAY - Array to store block in (full global reference)
  1. ; OFFSET - Where to begin placing (default to 0)
  1. ;OUTPUT : N - Number of lines in block
  1. ; -1^Error_Text - Error
  1. ;NOTES : If MESSNUM=0, then block will be placed into
  1. ; ARRAY(LineNumber)=Line_of_info
  1. ; If MESSNUM>0 then the block will be placed into
  1. ; ^XMB(3.9,MESSNUM,2,LineNumber,0)=Line_of_info
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:(('TRANPTR)!('$D(^VAT(394.61,TRANPTR)))) "-1^Did not pass a valid pointer to VAQ - TRANSACTION file"
  1. S MESSNUM=+$G(MESSNUM)
  1. I (('MESSNUM)&($G(ARRAY)="")) Q "-1^Did not pass message number or reference to array"
  1. I (MESSNUM) Q:('$D(^XMB(3.9,MESSNUM))) "-1^Valid message number not passed"
  1. S OFFSET=+$G(OFFSET)
  1. ;DECLARE VARIABLES
  1. N LINE,TYPE,STATUS,PARENT,RQSTNUM,NAME,SSN,DOB,PID,RQSTDUZ,RQSTNAME
  1. N RQSTSITE,CODE10,STAT10,ATHRDUZ,ATHRNAME,ATHRSITE,DOMAIN,CLAIM
  1. N DATETIME,COMMENT,TMP,X
  1. S LINE=OFFSET
  1. S CLAIM=""
  1. S CODE10=101
  1. S COMMENT=""
  1. S RQSTDUZ=""
  1. S ATHRDUZ=""
  1. ;GET STATUS & TYPE
  1. S TMP=$$STATYPE^VAQCON1(TRANPTR)
  1. Q:($P(TMP,"^",1)="-1") TMP
  1. S STATUS=$P(TMP,"^",1)
  1. S TYPE=$P(TMP,"^",2)
  1. Q:(TYPE="REC") "-1^Transaction is being received, not transmitted"
  1. ;SET 1.0 STATUS
  1. S STAT10=0
  1. S:(STATUS="VAQ-AMBIG") STAT10=11
  1. S:(STATUS="VAQ-NTFND") STAT10=12
  1. S:(STATUS="VAQ-REJ") STAT10=13
  1. S:(STATUS="VAQ-RQACK") STAT10=19
  1. S:(STATUS="VAQ-RQST") STAT10=10
  1. S:(STATUS="VAQ-RSLT") STAT10=15
  1. S:(STATUS="VAQ-UNSOL") STAT10=16
  1. Q:((STATUS="VAQ-RTRNS")!(STATUS="VAQ-UNACK")) "-1^Version 1.0 does not have an equivalent message"
  1. Q:((STATUS="VAQ-AUTO")!(STATUS="VAQ-PROC")!(STATUS="VAQ-TUNSL")) "-1^Message not required"
  1. Q:('STAT10) "-1^Could not determine 1.0 status"
  1. ;GET PARENT PDX NUMBER
  1. S:(TYPE="REQ") PARENT=+$G(^VAT(394.61,TRANPTR,0))
  1. S:((TYPE="RES")!(TYPE="ACK")) PARENT=+$P($G(^VAT(394.61,TRANPTR,0)),"^",6)
  1. S:(TYPE="UNS") PARENT=""
  1. Q:('$D(PARENT)) "-1^Could not determine 1.0 parent PDX number"
  1. ;GET NAME,SSN,DOB,PID
  1. S TMP=$G(^VAT(394.61,TRANPTR,"QRY"))
  1. Q:(TMP?1."^") "-1^Patient information not contained in VAQ - TRANSACTION file"
  1. S NAME=$P(TMP,"^",1)
  1. S SSN=$P(TMP,"^",2)
  1. S DOB=$P(TMP,"^",3)
  1. S PID=$P(TMP,"^",4)
  1. Q:((NAME="")!(SSN="")) "-1^Transaction did not contain patient's name or SSN"
  1. ;GET REQUESTER'S NAME
  1. S RQSTNAME=""
  1. S RQSTNAME=$P($G(^VAT(394.61,TRANPTR,"RQST1")),"^",2)
  1. S:(TYPE="UNS") RQSTNAME="UNSOLICITED"
  1. S:((RQSTNAME="")&(TYPE="REQ")) RQSTNAME=$P($G(^VA(200,(+$G(DUZ)),0)),"^",1)
  1. Q:((RQSTNAME="")&(TYPE="REQ")) "-1^Could not determine name of requestor"
  1. ;GET REQUESTING DUZ
  1. I (TYPE="REQ") D
  1. .S RQSTDUZ=+$O(^VA(200,"B",RQSTNAME,""))
  1. .S:('RQSTDUZ) RQSTDUZ=$G(DUZ)
  1. ;GET DATE TIME (FILEMAN FORMAT)
  1. S TMP=$$NOW^VAQUTL99(1)
  1. S:(TYPE="ACK") TMP=+$G(^VAT(394.61,TRANPTR,"RQST1"))
  1. S DATETIME=TMP
  1. Q:($P(DATETIME,"^",1)="-1") DATETIME
  1. ;GET REQUESTING SITE NUMBER
  1. S RQSTSITE=""
  1. I ((TYPE="REQ")!(TYPE="UNS")) D Q:(RQSTSITE="") "-1^Could not determine current site number"
  1. .S TMP=+$O(^VAT(394.81,0))
  1. .Q:('TMP)
  1. .S X=+$G(^DIC(4,+$G(^VAT(394.81,TMP,0)),99))
  1. .Q:('X)
  1. .S RQSTSITE=X
  1. I (TYPE="RES") D
  1. .S TMP=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",1)
  1. .S:(TMP'="") RQSTSITE=$O(^DIC(4,"B",TMP,""))
  1. ;GET REQUEST NUMBER
  1. S:(TYPE="REQ") RQSTNUM=PARENT
  1. S:((TYPE="UNS")!(TYPE="ACK")) RQSTNUM=""
  1. S:(TYPE="RES") RQSTNUM=+$G(^VAT(394.61,TRANPTR,0))
  1. Q:('$D(RQSTNUM)) "-1^Could not determine 1.0 PDX request number"
  1. ;GET AUTHORIZING NAME
  1. S ATHRNAME=""
  1. S ATHRNAME=$P($G(^VAT(394.61,TRANPTR,"ATHR1")),"^",2)
  1. S:((ATHRNAME="")&((TYPE="UNS")!(TYPE="RES"))) ATHRNAME=$P($G(^VA(200,(+$G(DUZ)),0)),"^",1)
  1. Q:((ATHRNAME="")&((TYPE="UNS")!(TYPE="RES"))) "-1^Could not determine name of authorizer"
  1. ;GET AUTHORIZING DUZ
  1. I ((TYPE="RES")!(TYPE="UNS")) D
  1. .S ATHRDUZ=+$O(^VA(200,"B",ATHRNAME,""))
  1. .S:('ATHRDUZ) ATHRDUZ=$G(DUZ)
  1. ;GET AUTHORIZING SITE NUMBER
  1. S ATHRSITE=""
  1. I ((TYPE="RES")!(TYPE="UNS")) D Q:(ATHRSITE="") "-1^Could not determine current site number"
  1. .S TMP=+$O(^VAT(394.81,0))
  1. .Q:('TMP)
  1. .S X=+$G(^DIC(4,+$G(^VAT(394.81,TMP,0)),99))
  1. .Q:('X)
  1. .S ATHRSITE=X
  1. I (TYPE="REQ") D
  1. .S TMP=$P($G(^VAT(394.61,TRANPTR,"ATHR2")),"^",1)
  1. .S:(TMP'="") ATHRSITE=$O(^DIC(4,"B",TMP,""))
  1. ;SET REMOTE DUZs TO PERSON'S NAME
  1. S:((TYPE="ACK")!(TYPE="RES")) RQSTDUZ=RQSTNAME
  1. ;MOVE TO CONTINUATION ROUTINE
  1. D HEAD10^VAQCON98
  1. Q (LINE-OFFSET)