| 1 | ORMBLDGM ;SLC/MKB-Build outgoing GMR* ORM msgs ;11/17/00  11:07 | 
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,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 | CSLT ; -- Segments for new Consult order | 
|---|
| 10 | N OI,WP,URG,CATG,PLACE,ATTN,DIAG,CODE,QT,I,J,USID,CTYPE,RSERV,Z | 
|---|
| 11 | S OI=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1)) | 
|---|
| 12 | S CTYPE=$G(ORDIALOG($$PTR("FREE TEXT OI"),1)) | 
|---|
| 13 | S RSERV=$G(ORDIALOG($$PTR("REQUEST SERVICE"),1)) | 
|---|
| 14 | S WP=$$PTR("WORD PROCESSING 1"),URG=+$G(ORDIALOG($$PTR("URGENCY"),1)) | 
|---|
| 15 | S CATG=$G(ORDIALOG($$PTR("CATEGORY"),1)) | 
|---|
| 16 | S PLACE=$G(ORDIALOG($$PTR("PLACE OF CONSULTATION"),1)) | 
|---|
| 17 | S ATTN=$G(ORDIALOG($$PTR("PROVIDER"),1)) | 
|---|
| 18 | S DIAG=$G(ORDIALOG($$PTR("FREE TEXT"),1)) | 
|---|
| 19 | S CODE=$G(ORDIALOG($$PTR("CODE"),1)) | 
|---|
| 20 | CS1 S QT="^^^^^"_$P($G(^ORD(101.42,+URG,0)),U,2),$P(ORMSG(4),"|",8)=QT | 
|---|
| 21 | S $P(ORMSG(3),"|",3)=CATG S:PLACE="C" PLACE="OC" | 
|---|
| 22 | S USID=$$USID^ORMBLD(OI) ;S:$L(CTYPE) $P(USID,U,5)=CTYPE | 
|---|
| 23 | S ORMSG(5)="OBR||||"_USID_"||||||||||||||"_PLACE_"|"_ATTN,Z=5 | 
|---|
| 24 | ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) project | 
|---|
| 25 | D DG1^ORWDBA3($G(IFN),"Z",5) | 
|---|
| 26 | I RSERV'>0,$P(USID,U,6)="99CON" S RSERV=+$P(USID,U,4) | 
|---|
| 27 | S:RSERV Z=Z+1,ORMSG(Z)="ZSV|^^^"_+RSERV_U_$$GET1^DIQ(123.5,+RSERV_",",.01)_"^99CON|"_CTYPE | 
|---|
| 28 | S I=0,J=+$O(^TMP("ORWORD",$J,WP,1,0)),Z=Z+1 ; get first line | 
|---|
| 29 | S ORMSG(Z)="OBX|1|TX|2000.02^REASON FOR REQUEST^AS4||"_$G(^TMP("ORWORD",$J,WP,1,J,0)) | 
|---|
| 30 | F  S J=$O(^TMP("ORWORD",$J,WP,1,J)) Q:J'>0  S I=I+1,ORMSG(Z,I)=^(+J,0) | 
|---|
| 31 | I $L(DIAG) D | 
|---|
| 32 | . N TYPE,VALUE S TYPE="TX",VALUE=DIAG | 
|---|
| 33 | . S:$L(CODE) TYPE="CE",VALUE=CODE_U_DIAG_"^I9C" | 
|---|
| 34 | . S Z=Z+1,ORMSG(Z)="OBX|2|"_TYPE_"|^PROVISIONAL DIAGNOSIS^||"_VALUE | 
|---|
| 35 | Q | 
|---|