source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON96.m@ 628

VAQCON96 ;ALB/JRP - MESSAGE CONSTRUCTION;20-APR-93
 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAS10 ;BUILD MAS DATA BLOCK FOR 1.0 MESSAGE
 ;  DECLARATIONS DONE IN $$DATA10^VAQCON97
 S SEGABB="PDX*MAS"
 ;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
 I ('$D(@ROOT@(SEGABB))) D NULLS Q
 ;PLACE NON-MULTIPLE FIELDS INTO MESSAGE
 S FILE=2
 S INFO="MAS"_"^"_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))
 .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="MAS"_"^"_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
 ;PLACE MULTIPLE FIELDS FROM PATIENT FILE INTO MESSAGE
 ;ASSUMES THAT ALL SEQUENCES IN THE SUBFILE ARE THE SAME
 S FILE=2
 F  S FILE=$O(@ROOT@(SEGABB,"VALUE",FILE)) Q:((FILE'<3)!('FILE))  D
 .S INFO="MAS"_"^"_FILE_"^"
 .S SEQFIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,""))
 .Q:(SEQFIELD="")
 .S SEQ=""
 .F  S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="")  D
 ..S FIELD=""
 ..F  S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="")  D
 ...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="MAS"_"^"_FILE_"^"
 ...S X=$P(INFO,"^",3)
 ...S $P(INFO,"^",3)=$S((X=""):FIELD,1:(X_";"_FIELD))
 ...S INFO=INFO_"^"_VALUE
 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 ..S LINE=LINE+1
 ..S INFO="MAS"_"^"_FILE_"^"
NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
 ;MAS FIELDS
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(MAS+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .D CHECK
 ;ELIGIBILITIES
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(ELIG+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .D CHECK
 ;DENTAL APPOINTMENTS
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(DENTAL+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .D CHECK
 ;APPOINTMENTS
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(APPOINT+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .D CHECK
 ;INSURANCE (NEED AT LEAST TWO)
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(INSURE+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)
 ..I ('$D(@ROOT@(SEGABB,"VALUE",FILE,TMP,0))) D
 ...S INFO="MAS"_"^"_FILE_"^"_TMP
 ...S:('MESSNUM) @ARRAY@(LINE)=INFO
 ...S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
 ...S LINE=LINE+1
 ..Q:($D(@ROOT@(SEGABB,"VALUE",FILE,TMP,1)))
 ..S INFO="MAS"_"^"_FILE_"^"_TMP
 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
 ..S LINE=LINE+1
 Q
 ;
CHECK ;CHECK FOR FIELD EXISTANCE
 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="MAS"_"^"_FILE_"^"_TMP
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
 .S LINE=LINE+1
 Q