- 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 Feb 18, 2025@23:50: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)