- ORMBLDGM ;SLC/MKB-Build outgoing GMR* ORM msgs ;Sep 10, 2020@14:16:56
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,97,190,195,280,361,350,519**;Dec 17, 1997;Build 36
- ;;ICR
- ;;XLFDT-10103
- ;;CODECS^ICDEX-5747
- HL7DATE(DATE) ; -- FM -> HL7 format
- Q $$FMTHL7^XLFDT(DATE) ;**97
- ;
- PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
- Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
- ;
- CSLT ; -- Segments for new Consult order
- N OI,WP,URG,CATG,PLACE,ATTN,DIAG,CODE,QT,I,J,USID,CTYPE,RSERV,Z,CLIND,X,Y,ORCODE,NLTD,DSTID,TT,OK
- S OI=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
- S CTYPE=$G(ORDIALOG($$PTR("FREE TEXT OI"),1))
- S RSERV=$G(ORDIALOG($$PTR("REQUEST SERVICE"),1))
- S WP=$$PTR("WORD PROCESSING 1"),URG=+$G(ORDIALOG($$PTR("URGENCY"),1))
- S CATG=$G(ORDIALOG($$PTR("CATEGORY"),1))
- S PLACE=$G(ORDIALOG($$PTR("PLACE OF CONSULTATION"),1))
- S ATTN=$G(ORDIALOG($$PTR("PROVIDER"),1))
- S DIAG=$G(ORDIALOG($$PTR("FREE TEXT"),1))
- S CODE=$G(ORDIALOG($$PTR("CODE"),1))
- S DSTID=$G(ORDIALOG($$PTR("DST ID"),1))
- S X=$G(ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1)),%DT="TX" D ^%DT S:Y>0 CLIND=$$HL7DATE(Y) ;WAT/280/350
- CS1 S QT="^^^"_$G(CLIND)_"^^"_$P($G(^ORD(101.42,+URG,0)),U,2),$P(ORMSG(4),"|",8)=QT ;WAT/280
- S $P(ORMSG(3),"|",3)=CATG S:PLACE="C" PLACE="OC"
- S USID=$$USID^ORMBLD(OI) ;S:$L(CTYPE) $P(USID,U,5)=CTYPE
- S ORMSG(5)="OBR||||"_USID_"||||||||||||||"_PLACE_"|"_ATTN,Z=5
- ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) project
- D DG1^ORWDBA3($G(IFN),"Z",5)
- I RSERV'>0,$P(USID,U,6)="99CON" S RSERV=+$P(USID,U,4)
- S:RSERV Z=Z+1,ORMSG(Z)="ZSV|^^^"_+RSERV_U_$$GET1^DIQ(123.5,+RSERV_",",.01)_"^99CON|"_CTYPE
- I $L(DSTID) D
- . S TT="",OK=0
- . F S TT=$O(ORMSG(TT),-1) Q:(TT="")!(OK=1) I $P(ORMSG(TT),"|")="ZSV" D
- . . S ORMSG(TT)=ORMSG(TT)_"|"_DSTID,OK=1
- . S:OK=0 Z=Z+1,ORMSG(Z)="ZSV|^^^^^||"_DSTID
- S I=0,J=+$O(^TMP("ORWORD",$J,WP,1,0)),Z=Z+1 ; get first line
- S ORMSG(Z)="OBX|1|TX|2000.02^REASON FOR REQUEST^AS4||"_$G(^TMP("ORWORD",$J,WP,1,J,0))
- F S J=$O(^TMP("ORWORD",$J,WP,1,J)) Q:J'>0 S I=I+1,ORMSG(Z,I)=^(+J,0)
- I $L(DIAG) D
- . N TYPE,VALUE S TYPE="TX",VALUE=DIAG
- . I $L(CODE) D
- .. S TYPE="CE",ORCODE=$$CODECS^ICDEX(CODE,"80")
- .. S ORCODE=$S($P(ORCODE,U)=1:"I9C",1:"I10")
- .. S VALUE=CODE_U_DIAG_U_ORCODE
- . S Z=Z+1,ORMSG(Z)="OBX|2|"_TYPE_"|^PROVISIONAL DIAGNOSIS^||"_VALUE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDGM 2354 printed Apr 23, 2025@18:46:20 Page 2
- ORMBLDGM ;SLC/MKB-Build outgoing GMR* ORM msgs ;Sep 10, 2020@14:16:56
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,97,190,195,280,361,350,519**;Dec 17, 1997;Build 36
- +2 ;;ICR
- +3 ;;XLFDT-10103
- +4 ;;CODECS^ICDEX-5747
- HL7DATE(DATE) ; -- FM -> HL7 format
- +1 ;**97
- QUIT $$FMTHL7^XLFDT(DATE)
- +2 ;
- PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
- +1 QUIT $ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_NAME,1,63),0))
- +2 ;
- CSLT ; -- Segments for new Consult order
- +1 NEW OI,WP,URG,CATG,PLACE,ATTN,DIAG,CODE,QT,I,J,USID,CTYPE,RSERV,Z,CLIND,X,Y,ORCODE,NLTD,DSTID,TT,OK
- +2 SET OI=$GET(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
- +3 SET CTYPE=$GET(ORDIALOG($$PTR("FREE TEXT OI"),1))
- +4 SET RSERV=$GET(ORDIALOG($$PTR("REQUEST SERVICE"),1))
- +5 SET WP=$$PTR("WORD PROCESSING 1")
- SET URG=+$GET(ORDIALOG($$PTR("URGENCY"),1))
- +6 SET CATG=$GET(ORDIALOG($$PTR("CATEGORY"),1))
- +7 SET PLACE=$GET(ORDIALOG($$PTR("PLACE OF CONSULTATION"),1))
- +8 SET ATTN=$GET(ORDIALOG($$PTR("PROVIDER"),1))
- +9 SET DIAG=$GET(ORDIALOG($$PTR("FREE TEXT"),1))
- +10 SET CODE=$GET(ORDIALOG($$PTR("CODE"),1))
- +11 SET DSTID=$GET(ORDIALOG($$PTR("DST ID"),1))
- +12 ;WAT/280/350
- SET X=$GET(ORDIALOG($$PTR("CLINICALLY INDICATED DATE"),1))
- SET %DT="TX"
- DO ^%DT
- if Y>0
- SET CLIND=$$HL7DATE(Y)
- CS1 ;WAT/280
- SET QT="^^^"_$GET(CLIND)_"^^"_$PIECE($GET(^ORD(101.42,+URG,0)),U,2)
- SET $PIECE(ORMSG(4),"|",8)=QT
- +1 SET $PIECE(ORMSG(3),"|",3)=CATG
- if PLACE="C"
- SET PLACE="OC"
- +2 ;S:$L(CTYPE) $P(USID,U,5)=CTYPE
- SET USID=$$USID^ORMBLD(OI)
- +3 SET ORMSG(5)="OBR||||"_USID_"||||||||||||||"_PLACE_"|"_ATTN
- SET Z=5
- +4 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) project
- +5 DO DG1^ORWDBA3($GET(IFN),"Z",5)
- +6 IF RSERV'>0
- IF $PIECE(USID,U,6)="99CON"
- SET RSERV=+$PIECE(USID,U,4)
- +7 if RSERV
- SET Z=Z+1
- SET ORMSG(Z)="ZSV|^^^"_+RSERV_U_$$GET1^DIQ(123.5,+RSERV_",",.01)_"^99CON|"_CTYPE
- +8 IF $LENGTH(DSTID)
- Begin DoDot:1
- +9 SET TT=""
- SET OK=0
- +10 FOR
- SET TT=$ORDER(ORMSG(TT),-1)
- if (TT="")!(OK=1)
- QUIT
- IF $PIECE(ORMSG(TT),"|")="ZSV"
- Begin DoDot:2
- +11 SET ORMSG(TT)=ORMSG(TT)_"|"_DSTID
- SET OK=1
- End DoDot:2
- +12 if OK=0
- SET Z=Z+1
- SET ORMSG(Z)="ZSV|^^^^^||"_DSTID
- End DoDot:1
- +13 ; get first line
- SET I=0
- SET J=+$ORDER(^TMP("ORWORD",$JOB,WP,1,0))
- SET Z=Z+1
- +14 SET ORMSG(Z)="OBX|1|TX|2000.02^REASON FOR REQUEST^AS4||"_$GET(^TMP("ORWORD",$JOB,WP,1,J,0))
- +15 FOR
- SET J=$ORDER(^TMP("ORWORD",$JOB,WP,1,J))
- if J'>0
- QUIT
- SET I=I+1
- SET ORMSG(Z,I)=^(+J,0)
- +16 IF $LENGTH(DIAG)
- Begin DoDot:1
- +17 NEW TYPE,VALUE
- SET TYPE="TX"
- SET VALUE=DIAG
- +18 IF $LENGTH(CODE)
- Begin DoDot:2
- +19 SET TYPE="CE"
- SET ORCODE=$$CODECS^ICDEX(CODE,"80")
- +20 SET ORCODE=$SELECT($PIECE(ORCODE,U)=1:"I9C",1:"I10")
- +21 SET VALUE=CODE_U_DIAG_U_ORCODE
- End DoDot:2
- +22 SET Z=Z+1
- SET ORMSG(Z)="OBX|2|"_TYPE_"|^PROVISIONAL DIAGNOSIS^||"_VALUE
- End DoDot:1
- +23 QUIT
