Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OB0

LR7OB0.m

Go to the documentation of this file.
  1. LR7OB0 ;slc/dcm - Build message, backdoor from Lab ;8/11/97
  1. ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
  1. ;
  1. NEW(ORD,CONTROL,NAT) ;Create OE/RR order from Lab order #
  1. ;Need ORD
  1. ;CONTROL=Order control (SN =new order)
  1. ;NAT=Nature of order
  1. Q:'$L($T(MSG^XQOR))
  1. N MSG,CHMSG,BBMSG,APMSG,LRORD,LRODT,LRSN,LRNIFN,LRTMPO
  1. K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1. D ORD^LR7OB1(ORD)
  1. I '$D(LRTMPO("LRIFN")) D EN(ORD,CONTROL),CALL Q
  1. S LRNIFN=0 F S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1 D EN(ORD,CONTROL),CALL
  1. Q
  1. NEW1(ODT,SN,CONTROL,NAT) ;Create OE/RR order from Lab order date & LRSN
  1. Q:'$L($T(MSG^XQOR))
  1. N MSG,CHMSG,BBMSG,APMSG,LRORD,LRODT,LRSN,LRNIFN,LRTMPO,X
  1. K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1. D ORD1^LR7OB1(ODT,SN)
  1. I '$D(LRTMPO("LRIFN")) D EN1(ODT,SN,CONTROL),CALL Q
  1. S LRNIFN=0 F S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1 S X=LRTMPO("LRIFN",LRNIFN) D
  1. . I CONTROL="ZC",$P(X,"^",7) S X=$P($G(^OR(100,+$P(X,"^",7),3)),"^",3) I X=1!(X=2)!(X=14) Q
  1. . D EN1(ODT,SN,CONTROL),CALL
  1. Q
  1. FIRST S LOC="",ROOM=""
  1. I $P(LRDPF,"^",2)="DPT(" D INP^VADPT I VAIN(1) S ROOM=VAIN(5),LOC=$S($G(CONTROL)="ZC":+$P(^TMP("LRX",$J,69),"^",7),1:+$G(^DIC(42,+VAIN(4),44)))
  1. S MSG(1)=$$MSH^LR7OU0("ORM")
  1. S MSG(2)=$$PID^LR7OU0(LRDPF)
  1. S MSG(3)=$$PV1^LR7OU0(LOC,$G(ROOM),"")
  1. S STDT=$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",2)) ;Obs Start D/T
  1. S X1=CONTROL ;Order Control
  1. S X2=$P(^TMP("LRX",$J,69),"^")_";"_ODT_";"_SN ;Lab #
  1. S X=$G(LRSTATI),X3=$S(X=1:"CA",X=2:"CM",X=6:"SC",1:"IP") ;Status (DFLT=Pend)
  1. S X4="^^^"_STDT_"^"_$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",9)) ;Quantity/Timing
  1. S X5=$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",5)) ;Date ordered/entered
  1. S X6=$P(^TMP("LRX",$J,69),"^",6) ;Provider
  1. S X7=STDT ;Order Effective D/T
  1. S X8=$G(NAT) ;Reason
  1. S X9=$S($G(LRNIFN):$S($D(LRTMPO("LRIFN",LRNIFN)):$P(LRTMPO("LRIFN",LRNIFN),"^",7),1:$P(^TMP("LRX",$J,69),"^",11)),1:$P(^TMP("LRX",$J,69),"^",11)) ;OE/RR #
  1. S X10=$P(^TMP("LRX",$J,69),"^",12)
  1. I $D(LINK)#2,$E(LINK)="~" S X9=LINK ;Set to multiple orders if doing conversion
  1. S MSG="MSG",(CTR,ORCMSG)=4 D ORC^LR7OU01(CTR) S MSG=""
  1. Q
  1. EN(ORD,CONTROL,NAT) ;Build msg based on order #
  1. ;ORD=Lab order #
  1. ;CONTROL=Order control
  1. N I,J,D0,DR,DA,DIC,DIE,CAT,ROOM,LOC,VAIN,VAERR,STDT,X,CTR,II,IFN,IFN1,IFN2,Z,Z1,LOC,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,Y10,Y,COBR,COBX,DFN,LRDPF,LRDFN,LRFIRST,SEX,ORCMSG,OBRMSG,MSG,CHMSG,BBMSG,APMSG,ODT,SN
  1. S ODT=0,LRFIRST=1,MSG=""
  1. F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1 D 69^LR7OB3
  1. Q
  1. EN1(ODT,SN,CONTROL,NAT) ;Build msg based on date and LRSN
  1. ;See doc under EN.
  1. ;SN=Specimen # in ^LRO(69,ODT,SN,
  1. N I,J,D0,DR,DA,DIC,DIE,CAT,ROOM,LOC,VAIN,VAERR,STDT,X,CTR,IFN,IFN1,IFN2,Z,Z1,LOC,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,Y10,Y,COBR,COBX,DFN,LRDPF,LRDFN,LRFIRST,SEX,ORCMSG,OBRMSG,MSG,CHMSG,BBMSG,APMSG
  1. K ^TMP("LRX",$J)
  1. S LRFIRST=1,MSG="" D 69^LR7OB3
  1. Q
  1. EN2(AC,ACDT,ACN,CONTROL,CH,BB,AP,NAT) ;Build msg based on Accession area,Acc dt,#
  1. ;AC=Accession area
  1. ;ACDT=Accession Date
  1. ;ACN=Accession #
  1. ;CONTROL=Order control
  1. ;Y=Output array to pass message in
  1. N I,J,D0,DR,DA,DIC,DIE,CAT,ROOM,LOC,VAIN,VAERR,STDT,X,CTR,IFN,IFN1,IFN2,Z,Z1,LOC,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,Y10,COBR,COBX,DFN,LRDPF,LRDFN,LRFIRST,SEX,ORCMSG,OBRMSG,XMSG,CHMSG,BBMSG,APMSG,BYPASS
  1. K ^TMP("LRX",$J)
  1. S SS=$P($G(^LRO(68,+$G(AC),0)),"^",2),MSG="^TMP(""LR"_$S("CYEMSPAU"[SS:"AP",SS="BB":"BB",SS="MI":"CH",1:"CH")_""",$J)"
  1. S (BYPASS,LRFIRST)=1 D A68^LR7OB68(ACDT,AC,ACN)
  1. Q:'$D(^TMP("LRX",$J,69)) Q:'$D(ODT) Q:'$D(SN)
  1. D FIRST,SNEAK^LR7OB3 K Y M @MSG=MSG
  1. K ^TMP("LRX",$J)
  1. Q
  1. EN3(LABPAT,SS,INVDT,CONTROL,Y) ;Build msg from 63
  1. ;LABPAT=LRDFN (Lab patient ptr)
  1. ;SS=Lab Subscript (AU,BB,CH,CY,EM,MI,SP)
  1. ;INVDT=Inverse date/time
  1. ;CONTROL=Order control
  1. ;Y=Output array to pass message in
  1. N I,J,D0,DR,DA,DIC,DIE,CAT,ROOM,LOC,VAIN,VAERR,STDT,X,CTR,IFN,IFN1,IFN2,Z,Z1,LOC,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,Y10,COBR,COBX,DFN,LRDPF,LRDFN,LRFIRST,SEX,ORCMSG,OBRMSG,XMSG,CHMSG,BBMSG,APMSG
  1. K ^TMP("LRX",$J)
  1. Q:'$G(INVDT) S:'$D(CONTROL) CONTROL="RE"
  1. S MSG="XMSG"
  1. S BYPASS=1 D EN^LR7OB630(LABPAT,SS,INVDT)
  1. Q:'$D(^TMP("LRX",$J,69)) Q:'$D(ODT) Q:'$D(SN)
  1. D FIRST,SNEAK^LR7OB3 K Y M Y=XMSG
  1. K ^TMP("LRX",$J),BYPASS
  1. Q
  1. ALL(RECEIVE) ;Build HL7 message for all patients in file 63
  1. ;RECEIVE=Routine entry point to receive message array for each LRIDT
  1. N LRDFN
  1. S LRDFN=0 S:'$D(RECEIVE) RECEIVE=""
  1. F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D PAT(LRDFN,RECEIVE)
  1. Q
  1. PAT(LRDFN,RECEIVE) ;Get data for single patient from file 63
  1. ;LRDFN=Lab Patient id
  1. ;RECEIVE=Routine entry point to receive message array for each LRIDT
  1. N SS,LRIDT
  1. S SS="A" F S SS=$O(^LR(LRDFN,SS)) Q:SS="" D
  1. . I SS="AU" D EN3(LRDFN,SS,"","SN",.Y) D REC Q
  1. . I SS'="AU" S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,SS,LRIDT)) Q:LRIDT<1 D EN3(LRDFN,SS,LRIDT,"RR",.Y),REC
  1. Q
  1. REC ;Send to receiving routine
  1. I $L($G(RECEIVE)),RECEIVE["^" S X=$P(RECEIVE,"^",2) X ^%ZOSF("TEST") I $T D @RECEIVE
  1. Q
  1. CALL ;Make call to OE/RR and cleanup
  1. D CALL^LR7OB1(CONTROL)
  1. K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1. Q