source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON98.m@ 1804

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