- ORMBLDLR ; SLC/MKB - Build outgoing Lab ORM msgs ;14-May-2010 11:26;PLS
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**97,190,1002,1004,195,1010**;Dec 17, 1997;Build 47
- ; Modified - IHS/MSC/DKM - Line CH+5
- 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(NAME,1,63),0))
- ;
- AP ; -- new Lab AP order
- ; fall through to CH - no difference at this time
- CH ; -- new Lab CH order
- N IP,OI,START,STOP,URG,CMMT,INST,IND,IND2,I,J,X
- S START=$P($G(^OR(100,IFN,0)),U,8),STOP=$P($G(^(0)),U,9)
- S OI=$$PTR("OR GTX ORDERABLE ITEM"),URG=$$PTR("OR GTX LAB URGENCY")
- S CMMT=$$PTR("OR GTX WORD PROCESSING 1")
- S IND=$$PTR("OR GTX CLININD"),IND2=$$PTR("OR GTX CLININD2") ; IHS/MSC/DKM - Clinical indicator prompts
- S IP="" ;$S($D(^OR(100,<ISOLATION ORDER FOR DFN>)):1,1:0)
- S $P(ORMSG(4),"|",8)="^^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
- S I=4,INST=0 F S INST=$O(ORDIALOG(OI,INST)) Q:INST'>0 D
- . S X=+$G(ORDIALOG(URG,INST)),X=$P($G(^LAB(62.05,X,0)),U,4)_";"_X
- . S I=I+1,ORMSG(I)="OBR||||"_$$USID^ORMBLD(ORDIALOG(OI,INST))_"|||||||"_$$COLLTYPE_"|"_IP_"|||"_$$SPEC_"||||||||||||^^^^^"_X
- . ; IHS/MSC/DKM - Add clinical indicator as reason for study
- . S:IND $P(ORMSG(I),"|",32)=$S(IND2:$G(ORDIALOG(IND2,INST)),1:"")_U_$G(ORDIALOG(IND,INST))_U_$S(IND2:"I9",1:"99IND")
- . ; End of clinical indicator mod
- . S J=$O(^TMP("ORWORD",$J,CMMT,INST,0)) Q:'J ; no comments for test
- . S I=I+1,ORMSG(I)="NTE|"_INST_"|P|"_^TMP("ORWORD",$J,CMMT,INST,J,0)
- . S L=0 F S J=$O(^TMP("ORWORD",$J,CMMT,INST,J)) Q:J'>0 S L=L+1,ORMSG(I,L)=^(J,0)
- ; Add DG1 & ZCL segment(s) for Billing Aware
- D DG1^ORWDBA3($G(IFN),"I",I)
- Q
- ;
- BB ; -- new Lab BB order
- N START,QUAN,WP,I,J
- S QUAN=+$G(ORDIALOG($$PTR("OR GTX QUANTITY"),1))
- S START=$P(^OR(100,IFN,0),U,8),WP=$$PTR("OR GTX WORD PROCESSING 1")
- S $P(ORMSG(4),"|",8)=QUAN_"^^^"_$$HL7DATE(START)
- S ORMSG(5)="OBR||||"_$G(ORDIALOG($$PTR("OR GTX ORDERABLE ITEM"),1))
- S I=$O(^TMP("ORWORD",$J,WP,1,0)) Q:'I
- S ORMSG(6)="NTE|1|P|"_$G(^TMP("ORWORD",$J,WP,1,I,0)),J=0
- F S I=$O(^TMP("ORWORD",$J,WP,1,I)) Q:I'>0 S J=J+1,ORMSG(6,J)=$G(^(I,0))
- Q
- ;
- COLLTYPE() ; -- Returns collection type for current INST
- N TYPE,X
- S TYPE=$G(ORDIALOG($$PTR("OR GTX COLLECTION TYPE"),INST))
- S X=$S(TYPE="LC":"L",TYPE="WC":"O",TYPE="SP":1,TYPE="I":2,1:"")
- Q X
- ;
- SPEC() ; -- Returns specimen/sample string for current INST
- N SAMP,SPEC,X,X0
- S SPEC=+$G(ORDIALOG($$PTR("OR GTX SPECIMEN"),INST))
- S X0=$G(^LAB(61,SPEC,0)),X=$P(X0,U,2)_";"_$P(X0,U)_";SNM"
- S SAMP=+$G(ORDIALOG($$PTR("OR GTX COLLECTION SAMPLE"),INST))
- S X=X_";"_SAMP_";"_$P($G(^LAB(62,+SAMP,0)),U)_";99LRS^^^"_SPEC_";"_$P(X0,U)_";99LRX"
- Q X
- ;
- XO ; -- Send XO message to Lab
- N OR0,DG,ORMSG,ORNEW,OI,URG,I,CNT,INST,ORDIALOG,TEST,CMMT,J,L,OROLD
- S OR0=$G(^OR(100,+IFN,0)),DG=$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,3)
- S DG="LR"_$S(DG="AP":"AP",DG="BB":"BB",1:"CH"),ORDIALOG=+$P(OR0,U,5)
- S OROLD=+$P(^OR(100,IFN,3),U,5),$P(ORMSG(4),"|",4)=$G(^OR(100,+OROLD,4))_U_DG
- S OI=$$PTR("OR GTX ORDERABLE ITEM"),URG=$$PTR("OR GTX URGENCY")
- S CMMT=$$PTR("OR GTX WORD PROCESSING 1"),CNT=3
- S I=0 F S I=$O(^OR(100,+IFN,4.5,I)) Q:I'>0 I $P($G(^(I,0)),U,2)=OI S TEST=$G(^(1)),ORNEW(TEST)=^(0) ; new set of tests
- S I=0 F S I=$O(^OR(100,OROLD,4.5,I)) Q:I'>0 I $P($G(^(I,0)),U,2)=OI S TEST=$G(^(1)),OROLD(TEST)=^(0) ; orig set of tests
- XO1 D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(+IFN)
- S I=0 F S I=$O(ORNEW(I)) Q:I'>0 I '$D(OROLD(I)) D
- . S CNT=CNT+1,TEST=I,INST=$P(ORNEW(I),U,3)
- . S ORMSG(CNT)="OBR|"_(CNT-3)_"|||"_$$USID^ORMBLD(TEST)_"|||||||A||||"_$$SPEC_"||||||||||||^^^^^"_$P($G(^ORD(101.42,+$G(ORDIALOG(URG,INST)),0)),U,2)
- . S J=$O(^TMP("ORWORD",$J,CMMT,INST,0)) Q:'J ; no comments for test
- . S CNT=CNT+1,ORMSG(CNT)="NTE|"_INST_"|L|"_^TMP("ORWORD",$J,CMMT,INST,J,0)
- . S L=0 F S J=$O(^TMP("ORWORD",$J,CMMT,INST,J)) Q:J'>0 S L=L+1,ORMSG(CNT,L)=^(J,0)
- S I=ORDIALOG K ORDIALOG S ORDIALOG=I
- D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(OROLD)
- S I=0 F S I=$O(OROLD(I)) Q:I'>0 I '$D(ORNEW(I)) D
- . S CNT=CNT+1,TEST=I,INST=$P(OROLD(I),U,3)
- . S ORMSG(CNT)="OBR|"_(CNT-3)_"|||"_$$USID^ORMBLD(TEST)_"|||||||3||||"_$$SPEC_"||||||||||||^^^^^"_$P($G(^ORD(101.42,+$G(ORDIALOG(URG,INST)),0)),U,2)
- . S J=$O(^TMP("ORWORD",$J,CMMT,INST,0)) Q:'J ; no comments for test
- . S CNT=CNT+1,ORMSG(CNT)="NTE|"_INST_"|L|"_^TMP("ORWORD",$J,CMMT,INST,J,0)
- . S L=0 F S J=$O(^TMP("ORWORD",$J,CMMT,INST,J)) Q:J'>0 S L=L+1,ORMSG(CNT,L)=^(J,0)
- D MSG^XQOR("OR EVSEND "_DG,.ORMSG)
- Q
- ORMBLDLR ; SLC/MKB - Build outgoing Lab ORM msgs ;14-May-2010 11:26;PLS
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**97,190,1002,1004,195,1010**;Dec 17, 1997;Build 47
- +2 ; Modified - IHS/MSC/DKM - Line CH+5
- 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(NAME,1,63),0))
- +2 ;
- AP ; -- new Lab AP order
- +1 ; fall through to CH - no difference at this time
- CH ; -- new Lab CH order
- +1 NEW IP,OI,START,STOP,URG,CMMT,INST,IND,IND2,I,J,X
- +2 SET START=$PIECE($GET(^OR(100,IFN,0)),U,8)
- SET STOP=$PIECE($GET(^(0)),U,9)
- +3 SET OI=$$PTR("OR GTX ORDERABLE ITEM")
- SET URG=$$PTR("OR GTX LAB URGENCY")
- +4 SET CMMT=$$PTR("OR GTX WORD PROCESSING 1")
- +5 ; IHS/MSC/DKM - Clinical indicator prompts
- SET IND=$$PTR("OR GTX CLININD")
- SET IND2=$$PTR("OR GTX CLININD2")
- +6 ;$S($D(^OR(100,<ISOLATION ORDER FOR DFN>)):1,1:0)
- SET IP=""
- +7 SET $PIECE(ORMSG(4),"|",8)="^^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
- +8 SET I=4
- SET INST=0
- FOR
- SET INST=$ORDER(ORDIALOG(OI,INST))
- IF INST'>0
- QUIT
- Begin DoDot:1
- +9 SET X=+$GET(ORDIALOG(URG,INST))
- SET X=$PIECE($GET(^LAB(62.05,X,0)),U,4)_";"_X
- +10 SET I=I+1
- SET ORMSG(I)="OBR||||"_$$USID^ORMBLD(ORDIALOG(OI,INST))_"|||||||"_$$COLLTYPE_"|"_IP_"|||"_$$SPEC_"||||||||||||^^^^^"_X
- +11 ; IHS/MSC/DKM - Add clinical indicator as reason for study
- +12 IF IND
- SET $PIECE(ORMSG(I),"|",32)=$SELECT(IND2:$GET(ORDIALOG(IND2,INST)),1:"")_U_$GET(ORDIALOG(IND,INST))_U_$SELECT(IND2:"I9",1:"99IND")
- +13 ; End of clinical indicator mod
- +14 ; no comments for test
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,0))
- IF 'J
- QUIT
- +15 SET I=I+1
- SET ORMSG(I)="NTE|"_INST_"|P|"_^TMP("ORWORD",$JOB,CMMT,INST,J,0)
- +16 SET L=0
- FOR
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,J))
- IF J'>0
- QUIT
- SET L=L+1
- SET ORMSG(I,L)=^(J,0)
- End DoDot:1
- +17 ; Add DG1 & ZCL segment(s) for Billing Aware
- +18 DO DG1^ORWDBA3($GET(IFN),"I",I)
- +19 QUIT
- +20 ;
- BB ; -- new Lab BB order
- +1 NEW START,QUAN,WP,I,J
- +2 SET QUAN=+$GET(ORDIALOG($$PTR("OR GTX QUANTITY"),1))
- +3 SET START=$PIECE(^OR(100,IFN,0),U,8)
- SET WP=$$PTR("OR GTX WORD PROCESSING 1")
- +4 SET $PIECE(ORMSG(4),"|",8)=QUAN_"^^^"_$$HL7DATE(START)
- +5 SET ORMSG(5)="OBR||||"_$GET(ORDIALOG($$PTR("OR GTX ORDERABLE ITEM"),1))
- +6 SET I=$ORDER(^TMP("ORWORD",$JOB,WP,1,0))
- IF 'I
- QUIT
- +7 SET ORMSG(6)="NTE|1|P|"_$GET(^TMP("ORWORD",$JOB,WP,1,I,0))
- SET J=0
- +8 FOR
- SET I=$ORDER(^TMP("ORWORD",$JOB,WP,1,I))
- IF I'>0
- QUIT
- SET J=J+1
- SET ORMSG(6,J)=$GET(^(I,0))
- +9 QUIT
- +10 ;
- COLLTYPE() ; -- Returns collection type for current INST
- +1 NEW TYPE,X
- +2 SET TYPE=$GET(ORDIALOG($$PTR("OR GTX COLLECTION TYPE"),INST))
- +3 SET X=$SELECT(TYPE="LC":"L",TYPE="WC":"O",TYPE="SP":1,TYPE="I":2,1:"")
- +4 QUIT X
- +5 ;
- SPEC() ; -- Returns specimen/sample string for current INST
- +1 NEW SAMP,SPEC,X,X0
- +2 SET SPEC=+$GET(ORDIALOG($$PTR("OR GTX SPECIMEN"),INST))
- +3 SET X0=$GET(^LAB(61,SPEC,0))
- SET X=$PIECE(X0,U,2)_";"_$PIECE(X0,U)_";SNM"
- +4 SET SAMP=+$GET(ORDIALOG($$PTR("OR GTX COLLECTION SAMPLE"),INST))
- +5 SET X=X_";"_SAMP_";"_$PIECE($GET(^LAB(62,+SAMP,0)),U)_";99LRS^^^"_SPEC_";"_$PIECE(X0,U)_";99LRX"
- +6 QUIT X
- +7 ;
- XO ; -- Send XO message to Lab
- +1 NEW OR0,DG,ORMSG,ORNEW,OI,URG,I,CNT,INST,ORDIALOG,TEST,CMMT,J,L,OROLD
- +2 SET OR0=$GET(^OR(100,+IFN,0))
- SET DG=$PIECE($GET(^ORD(100.98,+$PIECE(OR0,U,11),0)),U,3)
- +3 SET DG="LR"_$SELECT(DG="AP":"AP",DG="BB":"BB",1:"CH")
- SET ORDIALOG=+$PIECE(OR0,U,5)
- +4 SET OROLD=+$PIECE(^OR(100,IFN,3),U,5)
- SET $PIECE(ORMSG(4),"|",4)=$GET(^OR(100,+OROLD,4))_U_DG
- +5 SET OI=$$PTR("OR GTX ORDERABLE ITEM")
- SET URG=$$PTR("OR GTX URGENCY")
- +6 SET CMMT=$$PTR("OR GTX WORD PROCESSING 1")
- SET CNT=3
- +7 ; new set of tests
- SET I=0
- FOR
- SET I=$ORDER(^OR(100,+IFN,4.5,I))
- IF I'>0
- QUIT
- IF $PIECE($GET(^(I,0)),U,2)=OI
- SET TEST=$GET(^(1))
- SET ORNEW(TEST)=^(0)
- +8 ; orig set of tests
- SET I=0
- FOR
- SET I=$ORDER(^OR(100,OROLD,4.5,I))
- IF I'>0
- QUIT
- IF $PIECE($GET(^(I,0)),U,2)=OI
- SET TEST=$GET(^(1))
- SET OROLD(TEST)=^(0)
- XO1 DO GETDLG1^ORCD(ORDIALOG)
- DO GETORDER^ORCD(+IFN)
- +1 SET I=0
- FOR
- SET I=$ORDER(ORNEW(I))
- IF I'>0
- QUIT
- IF '$DATA(OROLD(I))
- Begin DoDot:1
- +2 SET CNT=CNT+1
- SET TEST=I
- SET INST=$PIECE(ORNEW(I),U,3)
- +3 SET ORMSG(CNT)="OBR|"_(CNT-3)_"|||"_$$USID^ORMBLD(TEST)_"|||||||A||||"_$$SPEC_"||||||||||||^^^^^"_$P($GET(^ORD(101.42,+$GET(ORDIALOG(URG,INST)),0)),U,2)
- +4 ; no comments for test
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,0))
- IF 'J
- QUIT
- +5 SET CNT=CNT+1
- SET ORMSG(CNT)="NTE|"_INST_"|L|"_^TMP("ORWORD",$JOB,CMMT,INST,J,0)
- +6 SET L=0
- FOR
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,J))
- IF J'>0
- QUIT
- SET L=L+1
- SET ORMSG(CNT,L)=^(J,0)
- End DoDot:1
- +7 SET I=ORDIALOG
- KILL ORDIALOG
- SET ORDIALOG=I
- +8 DO GETDLG1^ORCD(ORDIALOG)
- DO GETORDER^ORCD(OROLD)
- +9 SET I=0
- FOR
- SET I=$ORDER(OROLD(I))
- IF I'>0
- QUIT
- IF '$DATA(ORNEW(I))
- Begin DoDot:1
- +10 SET CNT=CNT+1
- SET TEST=I
- SET INST=$PIECE(OROLD(I),U,3)
- +11 SET ORMSG(CNT)="OBR|"_(CNT-3)_"|||"_$$USID^ORMBLD(TEST)_"|||||||3||||"_$$SPEC_"||||||||||||^^^^^"_$P($GET(^ORD(101.42,+$GET(ORDIALOG(URG,INST)),0)),U,2)
- +12 ; no comments for test
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,0))
- IF 'J
- QUIT
- +13 SET CNT=CNT+1
- SET ORMSG(CNT)="NTE|"_INST_"|L|"_^TMP("ORWORD",$JOB,CMMT,INST,J,0)
- +14 SET L=0
- FOR
- SET J=$ORDER(^TMP("ORWORD",$JOB,CMMT,INST,J))
- IF J'>0
- QUIT
- SET L=L+1
- SET ORMSG(CNT,L)=^(J,0)
- End DoDot:1
- +15 DO MSG^XQOR("OR EVSEND "_DG,.ORMSG)
- +16 QUIT
