source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQCON95.m@ 1000

VAQCON95 ;ALB/JRP - MESSAGE CONSTRUCTION;20-APR-93
 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PHA10 ;BUILD PHARMACY DATA BLOCK FOR 1.0 MESSAGE
 ;  DECLARATIONS DONE IN $$DATA10^VAQCON97
 S SEGABB="PDX*MPL"
 ;LONG FORMAT NOT PRESENT - SWITCH TO SHORT FORMAT (SAME INFO)
 S:('$D(@ROOT@(SEGABB))) SEGABB="PDX*MPS"
 ;PHARMACY DATA NOT PRESENT - PLACE NULLS INTO MESSAGE
 I ('$D(@ROOT@(SEGABB))) D NULLS Q
 ;PLACE NARRATIVE INTO MESSAGE
 S FILE=55
 S FIELD=1
 S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,0))
 S INFO="PHA"_"^"_FILE_"^"_FIELD_"^"_VALUE
 S:('MESSNUM) @ARRAY@(LINE)=INFO
 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 S LINE=LINE+1
 ;PLACE ALERGIES & REACTIONS INTO MESSAGE (STORE IN 2.55;.01)
 S FILE=120.8
 S FIELD=.02
 S INFO="PHA"_"^"_(2.55)_"^"_(.01)
 S SEQ=""
 F  S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ)) Q:(SEQ="")  D
 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
 .I (($L(INFO)+$L(VALUE)+$L(FIELD)+1)>239) D
 ..S:('MESSNUM) @ARRAY@(LINE)=INFO
 ..S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 ..S LINE=LINE+1
 ..S INFO="PHA"_"^"_(2.55)_"^"_(.01)
 .S INFO=INFO_"^"_VALUE
 S:('MESSNUM) @ARRAY@(LINE)=INFO
 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 S LINE=LINE+1
 ;STORE NULL VALUES FOR 2.57;.01
 S INFO="PHA"_"^"_(2.57)_"^"_(.01)
 S:('MESSNUM) @ARRAY@(LINE)=INFO
 S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 S LINE=LINE+1
 ;PLACE DISABILITIES INTO MESSAGE
 ;ASSUMES THAT ALL SEQUENCES IN THE SUBFILE ARE THE SAME
 S FILE=2.04
 S SEQFIELD=.01
 S SEQ=""
 S INFO="PHA"_"^"_FILE_"^"_".01;2;3"
 F  S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="")  D
 .S INFO="PHA"_"^"_FILE_"^"_".01;2;3"
 .F FIELD=.01,2,3 D
 ..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
 ..S INFO=INFO_"^"_VALUE
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 .S LINE=LINE+1
 ;STORE NULL DISABILITIES (IF NEEDED)
 I ($L(INFO,"^")<4) D
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 .S LINE=LINE+1
 ;NO PRESCRIPTION INFORMATION - STORE NULLS
 I ('$D(@ROOT@(SEGABB,"VALUE",52,.01))) D NULLRX Q
 ;STORE PRESCRIPTION INFORMATION
 ;ASSUMES ALL PRESCRIPTION INFO HAVE SAME SEQUENCE
 S FILE=52
 S SEQFIELD=.01
 S SEQ=""
 F  S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,SEQFIELD,SEQ)) Q:(SEQ="")  D
 .;GET RX#
 .S FIELD=.01
 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
 .Q:(VALUE="")
 .S INFO="PHA"_"^"_FILE_"^"_FIELD_"^"_VALUE
 .;GET REST OF PRESCRIPTION INFO
 .F  S FIELD=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD)) Q:(FIELD="")  D
 ..S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
 ..;CONVERT DATES TO 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 X=INFO
 ...S INFO="PHA"_"^"_(52)_"^"_(.01)_"^"_($P(X,"^",4))
 ..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
 ;STORE REFILL INFORMATION
 S FILE=52.1
 S FIELD=.01
 S SEQ=""
 F  S SEQ=$O(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ)) Q:(SEQ="")  D
 .;GET RX
 .S TMP=$G(@ROOT@(SEGABB,"ID",FILE,FIELD,SEQ))
 .Q:(TMP="")
 .;SPECIAL CASE DATA LINE
 .S INFO="PHA"_"^"_FILE_"^"_FIELD_"~"_TMP
 .S VALUE=$G(@ROOT@(SEGABB,"VALUE",FILE,FIELD,SEQ))
 .;CONVERT DATE TO FILEMAN FORMAT
 .S:(VALUE'="") VALUE=$$DATE^VAQUTL99(VALUE)
 .S INFO=INFO_"^"_VALUE
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 .S LINE=LINE+1
 Q
NULLS ;NO PRESCRIPTION INFO (STORE NULLS)
 ;PATIENT INFO
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(RXPAT+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .S TMP=$TR(TMP,";","^")
 .S TMP=$TR(TMP,",",";")
 .S INFO="PHA"_"^"_TMP
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 .S LINE=LINE+1
NULLRX ;PRESCRIPTION INFO
 F SEQ=1:1 D  Q:('SEQ)
 .S TMP=$P($T(PROFILE+SEQ^VAQDBII1),";;",2)
 .I (TMP="") S SEQ=0 Q
 .S TMP=$TR(TMP,";","^")
 .S TMP=$TR(TMP,",",";")
 .;.01 MUST BE FIRST FIELD FOR FILE 52
 .I ($P(TMP,"^",1)=52) D
 ..S X=$P(TMP,"^",2)
 ..S:($P(X,";",1)'=".01") X=".01;"_X
 ..S $P(TMP,"^",2)=X
 .S INFO="PHA"_"^"_TMP
 .S:('MESSNUM) @ARRAY@(LINE)=INFO
 .S:(MESSNUM) X=$$ADDLINE^VAQCON1(INFO,MESSNUM,LINE)
 .S LINE=LINE+1
 Q