ORMBLDRA ; SLC/MKB - Build outgoing Radiology ORM msgs ; 6/22/20 2:52pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**75,97,190,195,243,512**;Dec 17, 1997;Build 2
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))
;Added for OR 512 GDU/SLC
D RESDT
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
RESDT ;RESOLVE +, T+ DATE TO ACTUAL DATE VALUE
;ADDED FOR OR 512 GDU/SLC
N %DT,DA,IENS,FDA,EMSG,X,Y
S IENS=0
S IENS=$O(^OR(100,IFN,4.5,"ID","START",IENS))
I IENS="" Q
S X=$G(^OR(100,IFN,4.5,IENS,1))
I X="" Q
I X["+" D
. S %DT="TX" D ^%DT
. S X=Y
. S IENS=IENS_","_IFN_","
. D DA^DILF(IENS,.DA)
. D FDA^DILF(100.045,.DA,1,"",X,"FDA","EMSG")
. D FILE^DIE("","FDA","EMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDRA 3176 printed Oct 16, 2024@18:32:25 Page 2
ORMBLDRA ; SLC/MKB - Build outgoing Radiology ORM msgs ; 6/22/20 2:52pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**75,97,190,195,243,512**;Dec 17, 1997;Build 2
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 ;Added for OR 512 GDU/SLC
+13 DO RESDT
+14 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
RESDT ;RESOLVE +, T+ DATE TO ACTUAL DATE VALUE
+1 ;ADDED FOR OR 512 GDU/SLC
+2 NEW %DT,DA,IENS,FDA,EMSG,X,Y
+3 SET IENS=0
+4 SET IENS=$ORDER(^OR(100,IFN,4.5,"ID","START",IENS))
+5 IF IENS=""
QUIT
+6 SET X=$GET(^OR(100,IFN,4.5,IENS,1))
+7 IF X=""
QUIT
+8 IF X["+"
Begin DoDot:1
+9 SET %DT="TX"
DO ^%DT
+10 SET X=Y
+11 SET IENS=IENS_","_IFN_","
+12 DO DA^DILF(IENS,.DA)
+13 DO FDA^DILF(100.045,.DA,1,"",X,"FDA","EMSG")
+14 DO FILE^DIE("","FDA","EMSG")
End DoDot:1
+15 QUIT
