| [623] | 1 | ORMBLDRA ; SLC/MKB - Build outgoing Radiology ORM msgs ;11/17/00 11:14
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**75,97,190,195**;Dec 17, 1997
|
|---|
| 3 | HL7DATE(DATE) ; -- FM -> HL7 format
|
|---|
| 4 | Q $$FMTHL7^XLFDT(DATE) ;**97
|
|---|
| 5 | ;
|
|---|
| 6 | PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
|
|---|
| 7 | Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
|
|---|
| 8 | ;
|
|---|
| 9 | EN ; -- Segments for new Radiology order
|
|---|
| 10 | N ORSEX,OI,START,IP,URG,ILOC,MODE,CATG,PREOP,PREG,MODS,CLHIST,PROV,QT,I,J,Z
|
|---|
| 11 | S OI=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
|
|---|
| 12 | S START=$P($G(^OR(100,IFN,0)),U,8),IP=$G(ORDIALOG($$PTR("YES/NO"),1))
|
|---|
| 13 | S URG=$P($G(^ORD(101.42,+$G(ORDIALOG($$PTR("URGENCY"),1)),0)),U,2)
|
|---|
| 14 | S ILOC=$G(ORDIALOG($$PTR("IMAGING LOCATION"),1))
|
|---|
| 15 | S MODE=$G(ORDIALOG($$PTR("MODE OF TRANSPORT"),1))
|
|---|
| 16 | S CATG=$G(ORDIALOG($$PTR("CATEGORY"),1))
|
|---|
| 17 | S PREOP=$G(ORDIALOG($$PTR("PRE-OP SCHEDULED DATE/TIME"),1))
|
|---|
| 18 | S PREG=$G(ORDIALOG($$PTR("PREGNANT"),1))
|
|---|
| 19 | S MODS=$$PTR("MODIFIERS"),CLHIST=$$PTR("WORD PROCESSING 1")
|
|---|
| 20 | S MODS=$$MULT(MODS) S:ILOC ILOC=ILOC_U_$P($G(^RA(79.1,+ILOC,0)),U)
|
|---|
| 21 | S MODE=$S(MODE="A":"WALK",MODE="P":"PORT",MODE="S":"CART",1:"WHLC")
|
|---|
| 22 | S PREG=$S(PREG="Y":"YES",PREG="N":"NO",1:"UNKNOWN")
|
|---|
| 23 | S QT="^^^"_$$HL7DATE(START)_"^^"_URG,$P(ORMSG(4),"|",8)=QT
|
|---|
| 24 | S PROV=+$G(ORDIALOG($$PTR("PROVIDER"),1)) S:PROV $P(ORMSG(4),"|",12)=PROV
|
|---|
| 25 | S ORMSG(5)="OBR||||"_$$USID^ORMBLD(OI)_"||||||||"_$S(IP:"isolation",1:"")_"||||||"_MODS_"|"_ILOC_"|||||||||||"_MODE,I=5
|
|---|
| 26 | ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
|
|---|
| 27 | D DG1^ORWDBA3($G(IFN),"I",I)
|
|---|
| 28 | OBX S J=0 F S J=$O(^TMP("ORWORD",$J,CLHIST,1,J)) Q:J'>0 S I=I+1,ORMSG(I)="OBX|"_J_"|TX|2000.02^CLINICAL HISTORY^AS4|1|"_^(J,0)
|
|---|
| 29 | S ORSEX=$P($G(^DPT(+ORVP,0)),U,2)
|
|---|
| 30 | S:ORSEX="F" I=I+1,ORMSG(I)="OBX|1|TX|2000.33^PREGNANT^AS4||"_PREG
|
|---|
| 31 | S:PREOP I=I+1,ORMSG(I)="OBX|1|TS|^PRE-OP SCHEDULED DATE/TIME||"_$$HL7DATE(PREOP)
|
|---|
| 32 | I "CS"[CATG S Z=$$PTR("CONTRACT/SHARING SOURCE"),I=I+1,ORMSG(I)="OBX|1|CE|34^CONTRACT/SHARING SOURCE^99DD||"_+$G(ORDIALOG(Z,1))_U_$P($G(^DIC(34,+$G(ORDIALOG(Z,1)),0)),U)
|
|---|
| 33 | I CATG="R" S Z=$$PTR("RESEARCH SOURCE"),I=I+1,ORMSG(I)="OBX|1|TX|^RESEARCH SOURCE||"_$G(ORDIALOG(Z,1))
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | MULT(M) ; -- Returns string of MODIFIER~MODIFIER~...
|
|---|
| 37 | N I,X S X="" Q:'$O(ORDIALOG(M,0)) X
|
|---|
| 38 | S I=$O(ORDIALOG(M,0)),X=$P($G(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)
|
|---|
| 39 | F S I=$O(ORDIALOG(M,I)) Q:I'>0 S X=X_"~"_$P($G(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)
|
|---|
| 40 | Q X
|
|---|
