134 lines
4.3 KiB
Mathematica
134 lines
4.3 KiB
Mathematica
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
|