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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQCON96 3566 printed Apr 09, 2024@21:28:25 Page 2
VAQCON96 ;ALB/JRP - MESSAGE CONSTRUCTION;20-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAS10 ;BUILD MAS DATA BLOCK FOR 1.0 MESSAGE
+1 ; DECLARATIONS DONE IN $$DATA10^VAQCON97
+2 SET SEGABB="PDX*MAS"
+3 ;MAS DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
+4 IF ('$DATA(@ROOT@(SEGABB)))
DO NULLS
QUIT
+5 ;PLACE NON-MULTIPLE FIELDS INTO MESSAGE
+6 SET FILE=2
+7 SET INFO="MAS"_"^"_FILE_"^"
+8 SET FIELD=""
+9 FOR
SET FIELD=$ORDER(@ROOT@(SEGABB,"VALUE",FILE,FIELD))
if (FIELD="")
QUIT
Begin DoDot:1
+10 SET SEQ=0
+11 SET VALUE=$GET(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
+12 IF (VALUE'="")
if ($PIECE($GET(^DD(FILE,FIELD,0)),"^",2)["D")
SET VALUE=$$DATE^VAQUTL99(VALUE)
+13 IF (($LENGTH(INFO)+$LENGTH(VALUE)+$LENGTH(FIELD)+2)>239)
Begin DoDot:2
+14 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+15 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+16 SET LINE=LINE+1
+17 SET INFO="MAS"_"^"_FILE_"^"
End DoDot:2
+18 SET X=$PIECE(INFO,"^",3)
+19 SET $PIECE(INFO,"^",3)=$SELECT((X=""):FIELD,1:(X_";"_FIELD))
+20 SET INFO=INFO_"^"_VALUE
End DoDot:1
+21 IF ($PIECE(INFO,"^",3)'="")
Begin DoDot:1
+22 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+23 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+24 SET LINE=LINE+1
End DoDot:1
+25 ;PLACE MULTIPLE FIELDS FROM PATIENT FILE INTO MESSAGE
+26 ;ASSUMES THAT ALL SEQUENCES IN THE SUBFILE ARE THE SAME
+27 SET FILE=2
+28 FOR
SET FILE=$ORDER(@ROOT@(SEGABB,"VALUE",FILE))
if ((FILE'<3)!('FILE))
QUIT
Begin DoDot:1
+29 SET INFO="MAS"_"^"_FILE_"^"
+30 SET SEQFIELD=$ORDER(@ROOT@(SEGABB,"VALUE",FILE,""))
+31 if (SEQFIELD="")
QUIT
+32 SET SEQ=""
+33 FOR
SET SEQ=$ORDER(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ))
if (SEQ="")
QUIT
Begin DoDot:2
+34 SET FIELD=""
+35 FOR
SET FIELD=$ORDER(@ROOT@(SEGABB,"VALUE",FILE,FIELD))
if (FIELD="")
QUIT
Begin DoDot:3
+36 SET VALUE=$GET(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
+37 ;PUT DATES IN FILEMAN FORMAT
+38 IF (VALUE'="")
if ($PIECE($GET(^DD(FILE,FIELD,0)),"^",2)["D")
SET VALUE=$$DATE^VAQUTL99(VALUE)
+39 IF (($LENGTH(INFO)+$LENGTH(VALUE)+$LENGTH(FIELD)+2)>239)
Begin DoDot:4
+40 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+41 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+42 SET LINE=LINE+1
+43 SET INFO="MAS"_"^"_FILE_"^"
End DoDot:4
+44 SET X=$PIECE(INFO,"^",3)
+45 SET $PIECE(INFO,"^",3)=$SELECT((X=""):FIELD,1:(X_";"_FIELD))
+46 SET INFO=INFO_"^"_VALUE
End DoDot:3
+47 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+48 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
+49 SET LINE=LINE+1
+50 SET INFO="MAS"_"^"_FILE_"^"
End DoDot:2
End DoDot:1
NULLS ;CHECK FOR FIELDS THAT DIDN'T HAVE VALUES
+1 ;MAS FIELDS
+2 FOR SEQ=1:1
Begin DoDot:1
+3 SET TMP=$PIECE($TEXT(MAS+SEQ^VAQDBII1),";;",2)
+4 IF (TMP="")
SET SEQ=0
QUIT
+5 DO CHECK
End DoDot:1
if ('SEQ)
QUIT
+6 ;ELIGIBILITIES
+7 FOR SEQ=1:1
Begin DoDot:1
+8 SET TMP=$PIECE($TEXT(ELIG+SEQ^VAQDBII1),";;",2)
+9 IF (TMP="")
SET SEQ=0
QUIT
+10 DO CHECK
End DoDot:1
if ('SEQ)
QUIT
+11 ;DENTAL APPOINTMENTS
+12 FOR SEQ=1:1
Begin DoDot:1
+13 SET TMP=$PIECE($TEXT(DENTAL+SEQ^VAQDBII1),";;",2)
+14 IF (TMP="")
SET SEQ=0
QUIT
+15 DO CHECK
End DoDot:1
if ('SEQ)
QUIT
+16 ;APPOINTMENTS
+17 FOR SEQ=1:1
Begin DoDot:1
+18 SET TMP=$PIECE($TEXT(APPOINT+SEQ^VAQDBII1),";;",2)
+19 IF (TMP="")
SET SEQ=0
QUIT
+20 DO CHECK
End DoDot:1
if ('SEQ)
QUIT
+21 ;INSURANCE (NEED AT LEAST TWO)
+22 FOR SEQ=1:1
Begin DoDot:1
+23 SET TMP=$PIECE($TEXT(INSURE+SEQ^VAQDBII1),";;",2)
+24 IF (TMP="")
SET SEQ=0
QUIT
+25 SET FILE=$PIECE(TMP,";",1)
+26 SET FIELD=$PIECE(TMP,";",2)
+27 FOR VALUE=1:1:$LENGTH(FIELD,",")
Begin DoDot:2
+28 SET TMP=$PIECE(FIELD,",",VALUE)
+29 IF ('$DATA(@ROOT@(SEGABB,"VALUE",FILE,TMP,0)))
Begin DoDot:3
+30 SET INFO="MAS"_"^"_FILE_"^"_TMP
+31 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+32 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
+33 SET LINE=LINE+1
End DoDot:3
+34 if ($DATA(@ROOT@(SEGABB,"VALUE",FILE,TMP,1)))
QUIT
+35 SET INFO="MAS"_"^"_FILE_"^"_TMP
+36 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+37 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
+38 SET LINE=LINE+1
End DoDot:2
End DoDot:1
if ('SEQ)
QUIT
+39 QUIT
+40 ;
CHECK ;CHECK FOR FIELD EXISTANCE
+1 SET FILE=$PIECE(TMP,";",1)
+2 SET FIELD=$PIECE(TMP,";",2)
+3 FOR VALUE=1:1:$LENGTH(FIELD,",")
Begin DoDot:1
+4 SET TMP=$PIECE(FIELD,",",VALUE)
+5 if ($DATA(@ROOT@(SEGABB,"VALUE",FILE,TMP)))
QUIT
+6 SET INFO="MAS"_"^"_FILE_"^"_TMP
+7 if ('MESSNUM)
SET @ARRAY@(LINE)=INFO
+8 if (MESSNUM)
SET X=$$ADDLINE^VAQCON1(INFO,XMZ,LINE)
+9 SET LINE=LINE+1
End DoDot:1
+10 QUIT
