ORMBLDGM.m

ORMBLDGM ;SLC/MKB-Build outgoing GMR* ORM msgs ;24-Apr-2014 12:54;PLS

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,97,190,195,1012**;Dec 17, 1997

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,PROB

 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 DIAG=$G(ORDIALOG($$PTR("CLININD"),1))

 S CODE=$G(ORDIALOG($$PTR("SNMDCNPTID"),1))

 S PROB=$G(ORDIALOG($$PTR("PROB IEN"),1))

 S DIAG=$TR(DIAG,"|","*")

CS1 S QT="^^^^^"_$P($G(^ORD(101.42,+URG,0)),U,2),$P(ORMSG(4),"|",8)=QT

 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

 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

 . ;S:$L(CODE) TYPE="CE",VALUE=CODE_U_DIAG_"^I9C"

 . S:$L(CODE) TYPE="CE",VALUE=CODE_U_DIAG_"^SNO"

 . S Z=Z+1,ORMSG(Z)="OBX|2|"_TYPE_"|^PROVISIONAL DIAGNOSIS^||"_VALUE_"|"_PROB

 Q

ORMBLDGM  ;SLC/MKB-Build outgoing GMR* ORM msgs ;24-Apr-2014 12:54;PLS

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,97,190,195,1012**;Dec 17, 1997

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,PROB

 +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       ;S DIAG=$G(ORDIALOG($$PTR("FREE TEXT"),1))

 +10      ;S CODE=$G(ORDIALOG($$PTR("CODE"),1))

 +11       SET DIAG=$GET(ORDIALOG($$PTR("CLININD"),1))

 +12       SET CODE=$GET(ORDIALOG($$PTR("SNMDCNPTID"),1))

 +13       SET PROB=$GET(ORDIALOG($$PTR("PROB IEN"),1))

 +14       SET DIAG=$TRANSLATE(DIAG,"|","*")

CS1        SET QT="^^^^^"_$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       ; get first line

           SET I=0

           SET J=+$ORDER(^TMP("ORWORD",$JOB,WP,1,0))

           SET Z=Z+1

 +9        SET ORMSG(Z)="OBX|1|TX|2000.02^REASON FOR REQUEST^AS4||"_$GET(^TMP("ORWORD",$JOB,WP,1,J,0))

 +10       FOR 

               SET J=$ORDER(^TMP("ORWORD",$JOB,WP,1,J))

               IF J'>0

                   QUIT 

               SET I=I+1

               SET ORMSG(Z,I)=^(+J,0)

 +11       IF $LENGTH(DIAG)

               Begin DoDot:1

 +12               NEW TYPE,VALUE

                   SET TYPE="TX"

                   SET VALUE=DIAG

 +13      ;S:$L(CODE) TYPE="CE",VALUE=CODE_U_DIAG_"^I9C"

 +14               IF $LENGTH(CODE)

                       SET TYPE="CE"

                       SET VALUE=CODE_U_DIAG_"^SNO"

 +15               SET Z=Z+1

                   SET ORMSG(Z)="OBX|2|"_TYPE_"|^PROVISIONAL DIAGNOSIS^||"_VALUE_"|"_PROB

               End DoDot:1

 +16       QUIT