ORMBLDRA.m

ORMBLDRA ; SLC/MKB - Build outgoing Radiology ORM msgs ;05/30/06  11:30AM

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**75,97,190,195,243**;Dec 17, 1997;Build 242

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))

 ;

EN ; -- Segments for new Radiology order

 N ORSEX,OI,START,IP,URG,ILOC,MODE,CATG,PREOP,PREG,MODS,CLHIST,PROV,REASON,QT,I,J,Z,J0,LIN,RA75

 S OI=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1))

 S START=$P($G(^OR(100,IFN,0)),U,8),IP=$G(ORDIALOG($$PTR("YES/NO"),1))

 S URG=$P($G(^ORD(101.42,+$G(ORDIALOG($$PTR("URGENCY"),1)),0)),U,2)

 S ILOC=$G(ORDIALOG($$PTR("IMAGING LOCATION"),1))

 S MODE=$G(ORDIALOG($$PTR("MODE OF TRANSPORT"),1))

 S CATG=$G(ORDIALOG($$PTR("CATEGORY"),1))

 S PREOP=$G(ORDIALOG($$PTR("PRE-OP SCHEDULED DATE/TIME"),1))

 S PREG=$G(ORDIALOG($$PTR("PREGNANT"),1))

 S REASON=$G(ORDIALOG($$PTR("STUDY REASON"),1))

 S MODS=$$PTR("MODIFIERS"),CLHIST=$$PTR("WORD PROCESSING 1")

 S MODS=$$MULT(MODS) S:ILOC ILOC=ILOC_U_$P($G(^RA(79.1,+ILOC,0)),U)

 S MODE=$S(MODE="A":"WALK",MODE="P":"PORT",MODE="S":"CART",1:"WHLC")

 S PREG=$S(PREG="Y":"YES",PREG="N":"NO",1:"UNKNOWN")

 S QT="^^^"_$$HL7DATE(START)_"^^"_URG,$P(ORMSG(4),"|",8)=QT

 S PROV=+$G(ORDIALOG($$PTR("PROVIDER"),1)) S:PROV $P(ORMSG(4),"|",12)=PROV

 S RA75=$$PATCH^XPDUTL("RA*5.0*75")

 S ORMSG(5)="OBR||||"_$$USID^ORMBLD(OI)_"||||||||"_$S(IP:"isolation",1:"")_"||||||"_MODS_"|"_ILOC_"|||||||||||"_MODE,I=5

 I +RA75 S $P(ORMSG(5),"|",32)=U_REASON

 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project

 D DG1^ORWDBA3($G(IFN),"I",I)

OBX S J0=0

 I 'RA75 D

 . S I=I+1,ORMSG(I)="OBX|1|TX|2000.02^CLINICAL HISTORY^AS4|1|"_"REASON FOR STUDY: "_REASON

 . S $P(LIN,"-",55)=""

 . S I=I+1,ORMSG(I)="OBX|2|TX|2000.02^CLINICAL HISTORY^AS4|1|"_LIN

 . S J0=2

 S J=0 F  S J=$O(^TMP("ORWORD",$J,CLHIST,1,J)) Q:J'>0  S I=I+1,J0=J0+1,ORMSG(I)="OBX|"_J0_"|TX|2000.02^CLINICAL HISTORY^AS4|1|"_^(J,0)

 S ORSEX=$P($G(^DPT(+ORVP,0)),U,2)

 S:ORSEX="F" I=I+1,ORMSG(I)="OBX|1|TX|2000.33^PREGNANT^AS4||"_PREG

 S:PREOP I=I+1,ORMSG(I)="OBX|1|TS|^PRE-OP SCHEDULED DATE/TIME||"_$$HL7DATE(PREOP)

 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)

 I CATG="R" S Z=$$PTR("RESEARCH SOURCE"),I=I+1,ORMSG(I)="OBX|1|TX|^RESEARCH SOURCE||"_$G(ORDIALOG(Z,1))

 Q

MULT(M) ; -- Returns string of MODIFIER~MODIFIER~...

 N I,X S X="" Q:'$O(ORDIALOG(M,0)) X

 S I=$O(ORDIALOG(M,0)),X=$P($G(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)

 F  S I=$O(ORDIALOG(M,I)) Q:I'>0  S X=X_"~"_$P($G(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)

 Q X

ORMBLDRA  ; SLC/MKB - Build outgoing Radiology ORM msgs ;05/30/06  11:30AM

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**75,97,190,195,243**;Dec 17, 1997;Build 242

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       ;

EN        ; -- Segments for new Radiology order

 +1        NEW ORSEX,OI,START,IP,URG,ILOC,MODE,CATG,PREOP,PREG,MODS,CLHIST,PROV,REASON,QT,I,J,Z,J0,LIN,RA75

 +2        SET OI=$GET(ORDIALOG($$PTR("ORDERABLE ITEM"),1))

 +3        SET START=$PIECE($GET(^OR(100,IFN,0)),U,8)

           SET IP=$GET(ORDIALOG($$PTR("YES/NO"),1))

 +4        SET URG=$PIECE($GET(^ORD(101.42,+$GET(ORDIALOG($$PTR("URGENCY"),1)),0)),U,2)

 +5        SET ILOC=$GET(ORDIALOG($$PTR("IMAGING LOCATION"),1))

 +6        SET MODE=$GET(ORDIALOG($$PTR("MODE OF TRANSPORT"),1))

 +7        SET CATG=$GET(ORDIALOG($$PTR("CATEGORY"),1))

 +8        SET PREOP=$GET(ORDIALOG($$PTR("PRE-OP SCHEDULED DATE/TIME"),1))

 +9        SET PREG=$GET(ORDIALOG($$PTR("PREGNANT"),1))

 +10       SET REASON=$GET(ORDIALOG($$PTR("STUDY REASON"),1))

 +11       SET MODS=$$PTR("MODIFIERS")

           SET CLHIST=$$PTR("WORD PROCESSING 1")

 +12       SET MODS=$$MULT(MODS)

           IF ILOC

               SET ILOC=ILOC_U_$PIECE($GET(^RA(79.1,+ILOC,0)),U)

 +13       SET MODE=$SELECT(MODE="A":"WALK",MODE="P":"PORT",MODE="S":"CART",1:"WHLC")

 +14       SET PREG=$SELECT(PREG="Y":"YES",PREG="N":"NO",1:"UNKNOWN")

 +15       SET QT="^^^"_$$HL7DATE(START)_"^^"_URG

           SET $PIECE(ORMSG(4),"|",8)=QT

 +16       SET PROV=+$GET(ORDIALOG($$PTR("PROVIDER"),1))

           IF PROV

               SET $PIECE(ORMSG(4),"|",12)=PROV

 +17       SET RA75=$$PATCH^XPDUTL("RA*5.0*75")

 +18       SET ORMSG(5)="OBR||||"_$$USID^ORMBLD(OI)_"||||||||"_$SELECT(IP:"isolation",1:"")_"||||||"_MODS_"|"_ILOC_"|||||||||||"_MODE

           SET I=5

 +19       IF +RA75

               SET $PIECE(ORMSG(5),"|",32)=U_REASON

 +20      ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project

 +21       DO DG1^ORWDBA3($GET(IFN),"I",I)

OBX        SET J0=0

 +1        IF 'RA75

               Begin DoDot:1

 +2                SET I=I+1

                   SET ORMSG(I)="OBX|1|TX|2000.02^CLINICAL HISTORY^AS4|1|"_"REASON FOR STUDY: "_REASON

 +3                SET $PIECE(LIN,"-",55)=""

 +4                SET I=I+1

                   SET ORMSG(I)="OBX|2|TX|2000.02^CLINICAL HISTORY^AS4|1|"_LIN

 +5                SET J0=2

               End DoDot:1

 +6        SET J=0

           FOR 

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

               IF J'>0

                   QUIT 

               SET I=I+1

               SET J0=J0+1

               SET ORMSG(I)="OBX|"_J0_"|TX|2000.02^CLINICAL HISTORY^AS4|1|"_^(J,0)

 +7        SET ORSEX=$PIECE($GET(^DPT(+ORVP,0)),U,2)

 +8        IF ORSEX="F"

               SET I=I+1

               SET ORMSG(I)="OBX|1|TX|2000.33^PREGNANT^AS4||"_PREG

 +9        IF PREOP

               SET I=I+1

               SET ORMSG(I)="OBX|1|TS|^PRE-OP SCHEDULED DATE/TIME||"_$$HL7DATE(PREOP)

 +10       IF "CS"[CATG

               SET Z=$$PTR("CONTRACT/SHARING SOURCE")

               SET I=I+1

               SET ORMSG(I)="OBX|1|CE|34^CONTRACT/SHARING SOURCE^99DD||"_+$GET(ORDIALOG(Z,1))_U_$PIECE($GET(^DIC(34,+$GET(ORDIALOG(Z,1)),0)),U)

 +11       IF CATG="R"

               SET Z=$$PTR("RESEARCH SOURCE")

               SET I=I+1

               SET ORMSG(I)="OBX|1|TX|^RESEARCH SOURCE||"_$GET(ORDIALOG(Z,1))

 +12       QUIT 

MULT(M)   ; -- Returns string of MODIFIER~MODIFIER~...

 +1        NEW I,X

           SET X=""

           IF '$ORDER(ORDIALOG(M,0))

               QUIT X

 +2        SET I=$ORDER(ORDIALOG(M,0))

           SET X=$PIECE($GET(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)

 +3        FOR 

               SET I=$ORDER(ORDIALOG(M,I))

               IF I'>0

                   QUIT 

               SET X=X_"~"_$PIECE($GET(^RAMIS(71.2,+ORDIALOG(M,I),0)),U)

 +4        QUIT X