VAQCON98 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
HEAD10 ;COTINUATION FOR BUILDING HEADER BLOCK OF VERSION 1.0
; DECLARATIONS TAKEN CARE OF IN $$HEAD10^VAQCON99
;GET RETURN ADDRESS
S DOMAIN=""
S X=0
S TMP=+$O(^VAT(394.81,0))
S:(TMP) X=+$P($G(^VAT(394.81,TMP,0)),"^",2)
S:(X) DOMAIN=$P($G(^DIC(4.2,X,0)),"^",1)
Q:(DOMAIN="") "-1^Could not determine current domain"
;GET COMMENT (IF NEEDED)
I ((TYPE="RES")!(TYPE="UNS")) D
.S TMP=0
.F S TMP=+$O(^VAT(394.61,TRANPTR,"CMNT",TMP)) Q:('TMP) D Q:(COMMENT'="")
..S COMMENT=$G(^VAT(394.61,TRANPTR,"CMNT",TMP,0))
..S:(COMMENT?1." ") COMMENT=""
..S COMMENT=$TR(COMMENT,";",",")
I (TYPE="ACK") D
.S X=$P($G(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
.S TMP=$P($$RES^VAQUTL99(X,SSN),"^",2)
.S COMMENT="Request requires user intervention"
.S:(TMP'="") COMMENT=COMMENT_" ("_TMP_")"
;BUILD VERSION 1.0 ACK
I (TYPE="ACK") D Q
.S TMP="ACK^"_PARENT_"^"_DATETIME_"^"_"^"_STAT10_"^"_COMMENT
.S:('MESSNUM) @ARRAY@(LINE)=TMP
.S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
.S LINE=LINE+1
;BUILD VERSION 1.0 HEADER
;LINE 1
S TMP=PARENT_"^"_NAME_"^"_SSN_"^"_CLAIM_"^"_DOB_"^"_PID_"^"_RQSTDUZ
S TMP=TMP_"^"_RQSTNAME_"^"_DATETIME_"^"_RQSTSITE_"^"_CODE10_"^"_STAT10
S TMP=TMP_"^"_RQSTNUM_"^"_ATHRDUZ_"^"_ATHRNAME_"^"_ATHRSITE
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
;LINE 2
S TMP=DOMAIN_"^"_COMMENT
S:('MESSNUM) @ARRAY@(LINE)=TMP
S:(MESSNUM) X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
S LINE=LINE+1
Q
;
MIN10 ;BUILD VERSION 1.0 MINIMUM DATA BLOCK
; DECLARATIONS TAKEN CARE OF IN $$DATA^VAQCON69
S SEGABB="PDX*MIN"
;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
I ('$D(@ROOT@(SEGABB))) D NULLS Q
S FILE=""
F S FILE=$O(@ROOT@(SEGABB,"VALUE",FILE)) Q:(FILE="") D
.S INFO="MIN"_"^"_FILE_"^"
.S FIELD=""
.F S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="") D
..S SEQ=0
..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
..;PUT DATES IN FILEMAN FORMAT
..I (VALUE'="") S:($P($G(^DD(FILE,FIELD,0)),"^",2)["D") VALUE=$$DATE^VAQUTL99(VALUE)
..I (($L(INFO)+$L(VALUE)+$L(FIELD)+2)>239) D
...S:('MESSNUM) @ARRAY@(LINE)=INFO
...S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
...S LINE=LINE+1
...S INFO="MIN"_"^"_FILE_"^"
..S X=$P(INFO,"^",3)
..S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
..S INFO=INFO_"^"_VALUE
.I ($P(INFO,"^",3)'="") D
..S:('MESSNUM) @ARRAY@(LINE)=INFO
..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
..S LINE=LINE+1
NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
F SEQ=1:1 D Q:('SEQ)
.S TMP=$P($T(MIN+SEQ^VAQDBII1),";;",2)
.I (TMP="") S SEQ=0 Q
.S FILE=$P(TMP,";",1)
.S FIELD=$P(TMP,";",2)
.F VALUE=1:1:$L(FIELD,",") D
..S TMP=$P(FIELD,",",VALUE)
..Q:($D(@ROOT@(SEGABB,"VALUE",FILE,TMP)))
..S INFO="MIN"_"^"_FILE_"^"_TMP
..S:('MESSNUM) @ARRAY@(LINE)=INFO
..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
..S LINE=LINE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON98 3043 printed Dec 13, 2024@02:24:55 Page 2
VAQCON98 ;ALB/JRP - MESSAGE CONSTRUCTION;14-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
HEAD10 ;COTINUATION FOR BUILDING HEADER BLOCK OF VERSION 1.0
+1 ; DECLARATIONS TAKEN CARE OF IN $$HEAD10^VAQCON99
+2 ;GET RETURN ADDRESS
+3 SET DOMAIN=""
+4 SET X=0
+5 SET TMP=+$ORDER(^VAT(394.81,0))
+6 if (TMP)
SET X=+$PIECE($GET(^VAT(394.81,TMP,0)),"^",2)
+7 if (X)
SET DOMAIN=$PIECE($GET(^DIC(4.2,X,0)),"^",1)
+8 if (DOMAIN="")
QUIT "-1^Could not determine current domain"
+9 ;GET COMMENT (IF NEEDED)
+10 IF ((TYPE="RES")!(TYPE="UNS"))
Begin DoDot:1
+11 SET TMP=0
+12 FOR
SET TMP=+$ORDER(^VAT(394.61,TRANPTR,"CMNT",TMP))
if ('TMP)
QUIT
Begin DoDot:2
+13 SET COMMENT=$GET(^VAT(394.61,TRANPTR,"CMNT",TMP,0))
+14 if (COMMENT?1." ")
SET COMMENT=""
+15 SET COMMENT=$TRANSLATE(COMMENT,";",",")
End DoDot:2
if (COMMENT'="")
QUIT
End DoDot:1
+16 IF (TYPE="ACK")
Begin DoDot:1
+17 SET X=$PIECE($GET(^VAT(394.61,TRANPTR,"RQST2")),"^",2)
+18 SET TMP=$PIECE($$RES^VAQUTL99(X,SSN),"^",2)
+19 SET COMMENT="Request requires user intervention"
+20 if (TMP'="")
SET COMMENT=COMMENT_" ("_TMP_")"
End DoDot:1
+21 ;BUILD VERSION 1.0 ACK
+22 IF (TYPE="ACK")
Begin DoDot:1
+23 SET TMP="ACK^"_PARENT_"^"_DATETIME_"^"_"^"_STAT10_"^"_COMMENT
+24 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+25 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+26 SET LINE=LINE+1
End DoDot:1
QUIT
+27 ;BUILD VERSION 1.0 HEADER
+28 ;LINE 1
+29 SET TMP=PARENT_"^"_NAME_"^"_SSN_"^"_CLAIM_"^"_DOB_"^"_PID_"^"_RQSTDUZ
+30 SET TMP=TMP_"^"_RQSTNAME_"^"_DATETIME_"^"_RQSTSITE_"^"_CODE10_"^"_STAT10
+31 SET TMP=TMP_"^"_RQSTNUM_"^"_ATHRDUZ_"^"_ATHRNAME_"^"_ATHRSITE
+32 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+33 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+34 SET LINE=LINE+1
+35 ;LINE 2
+36 SET TMP=DOMAIN_"^"_COMMENT
+37 if ('MESSNUM)
SET @ARRAY@(LINE)=TMP
+38 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(TMP,MESSNUM,LINE)
+39 SET LINE=LINE+1
+40 QUIT
+41 ;
MIN10 ;BUILD VERSION 1.0 MINIMUM DATA BLOCK
+1 ; DECLARATIONS TAKEN CARE OF IN $$DATA^VAQCON69
+2 SET SEGABB="PDX*MIN"
+3 ;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
+4 IF ('$DATA(@ROOT@(SEGABB)))
DO NULLS
QUIT
+5 SET FILE=""
+6 FOR
SET FILE=$ORDER(@ROOT@(SEGABB,"VALUE",FILE))
if (FILE="")
QUIT
Begin DoDot:1
+7 SET INFO="MIN"_"^"_FILE_"^"
+8 SET FIELD=""
+9 FOR
SET FIELD=$ORDER(@ROOT@(SEGABB,"VALUE",FILE,FIELD))
if (FIELD="")
QUIT
Begin DoDot:2
+10 SET SEQ=0
+11 SET VALUE=$GET(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
+12 ;PUT DATES IN FILEMAN FORMAT
+13 IF (VALUE'="")
if ($PIECE($GET(^DD(FILE,FIELD,0)),"^",2)["D")
SET VALUE=$$DATE^VAQUTL99(VALUE)
+14 IF (($LENGTH(INFO)+$LENGTH(VALUE)+$LENGTH(FIELD)+2)>239)
Begin DoDot:3
+15 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+16 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+17 SET LINE=LINE+1
+18 SET INFO="MIN"_"^"_FILE_"^"
End DoDot:3
+19 SET X=$PIECE(INFO,"^",3)
+20 SET $PIECE(INFO,"^",3)=$SELECT((X=""):FIELD,1:(X_";"_FIELD))
+21 SET INFO=INFO_"^"_VALUE
End DoDot:2
+22 IF ($PIECE(INFO,"^",3)'="")
Begin DoDot:2
+23 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+24 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+25 SET LINE=LINE+1
End DoDot:2
End DoDot:1
NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
+1 FOR SEQ=1:1
Begin DoDot:1
+2 SET TMP=$PIECE($TEXT(MIN+SEQ^VAQDBII1),";;",2)
+3 IF (TMP="")
SET SEQ=0
QUIT
+4 SET FILE=$PIECE(TMP,";",1)
+5 SET FIELD=$PIECE(TMP,";",2)
+6 FOR VALUE=1:1:$LENGTH(FIELD,",")
Begin DoDot:2
+7 SET TMP=$PIECE(FIELD,",",VALUE)
+8 if ($DATA(@ROOT@(SEGABB,"VALUE",FILE,TMP)))
QUIT
+9 SET INFO="MIN"_"^"_FILE_"^"_TMP
+10 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+11 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
+12 SET LINE=LINE+1
End DoDot:2
End DoDot:1
if ('SEQ)
QUIT
+13 QUIT
