source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OB0.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1LR7OB0 ;slc/dcm - Build message, backdoor from Lab ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
3 ;
4NEW(ORD,CONTROL,NAT) ;Create OE/RR order from Lab order #
5 ;Need ORD
6 ;CONTROL=Order control (SN =new order)
7 ;NAT=Nature of order
8 Q:'$L($T(MSG^XQOR))
9 N MSG,CHMSG,BBMSG,APMSG,LRORD,LRODT,LRSN,LRNIFN,LRTMPO
10 K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
11 D ORD^LR7OB1(ORD)
12 I '$D(LRTMPO("LRIFN")) D EN(ORD,CONTROL),CALL Q
13 S LRNIFN=0 F S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1 D EN(ORD,CONTROL),CALL
14 Q
15NEW1(ODT,SN,CONTROL,NAT) ;Create OE/RR order from Lab order date & LRSN
16 Q:'$L($T(MSG^XQOR))
17 N MSG,CHMSG,BBMSG,APMSG,LRORD,LRODT,LRSN,LRNIFN,LRTMPO,X
18 K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
19 D ORD1^LR7OB1(ODT,SN)
20 I '$D(LRTMPO("LRIFN")) D EN1(ODT,SN,CONTROL),CALL Q
21 S LRNIFN=0 F S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1 S X=LRTMPO("LRIFN",LRNIFN) D
22 . 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
23 . D EN1(ODT,SN,CONTROL),CALL
24 Q
25FIRST S LOC="",ROOM=""
26 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)))
27 S MSG(1)=$$MSH^LR7OU0("ORM")
28 S MSG(2)=$$PID^LR7OU0(LRDPF)
29 S MSG(3)=$$PV1^LR7OU0(LOC,$G(ROOM),"")
30 S STDT=$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",2)) ;Obs Start D/T
31 S X1=CONTROL ;Order Control
32 S X2=$P(^TMP("LRX",$J,69),"^")_";"_ODT_";"_SN ;Lab #
33 S X=$G(LRSTATI),X3=$S(X=1:"CA",X=2:"CM",X=6:"SC",1:"IP") ;Status (DFLT=Pend)
34 S X4="^^^"_STDT_"^"_$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",9)) ;Quantity/Timing
35 S X5=$$HL7DT^LR7OU0($P(^TMP("LRX",$J,69),"^",5)) ;Date ordered/entered
36 S X6=$P(^TMP("LRX",$J,69),"^",6) ;Provider
37 S X7=STDT ;Order Effective D/T
38 S X8=$G(NAT) ;Reason
39 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 #
40 S X10=$P(^TMP("LRX",$J,69),"^",12)
41 I $D(LINK)#2,$E(LINK)="~" S X9=LINK ;Set to multiple orders if doing conversion
42 S MSG="MSG",(CTR,ORCMSG)=4 D ORC^LR7OU01(CTR) S MSG=""
43 Q
44EN(ORD,CONTROL,NAT) ;Build msg based on order #
45 ;ORD=Lab order #
46 ;CONTROL=Order control
47 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
48 S ODT=0,LRFIRST=1,MSG=""
49 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
50 Q
51EN1(ODT,SN,CONTROL,NAT) ;Build msg based on date and LRSN
52 ;See doc under EN.
53 ;SN=Specimen # in ^LRO(69,ODT,SN,
54 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
55 K ^TMP("LRX",$J)
56 S LRFIRST=1,MSG="" D 69^LR7OB3
57 Q
58EN2(AC,ACDT,ACN,CONTROL,CH,BB,AP,NAT) ;Build msg based on Accession area,Acc dt,#
59 ;AC=Accession area
60 ;ACDT=Accession Date
61 ;ACN=Accession #
62 ;CONTROL=Order control
63 ;Y=Output array to pass message in
64 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
65 K ^TMP("LRX",$J)
66 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)"
67 S (BYPASS,LRFIRST)=1 D A68^LR7OB68(ACDT,AC,ACN)
68 Q:'$D(^TMP("LRX",$J,69)) Q:'$D(ODT) Q:'$D(SN)
69 D FIRST,SNEAK^LR7OB3 K Y M @MSG=MSG
70 K ^TMP("LRX",$J)
71 Q
72EN3(LABPAT,SS,INVDT,CONTROL,Y) ;Build msg from 63
73 ;LABPAT=LRDFN (Lab patient ptr)
74 ;SS=Lab Subscript (AU,BB,CH,CY,EM,MI,SP)
75 ;INVDT=Inverse date/time
76 ;CONTROL=Order control
77 ;Y=Output array to pass message in
78 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
79 K ^TMP("LRX",$J)
80 Q:'$G(INVDT) S:'$D(CONTROL) CONTROL="RE"
81 S MSG="XMSG"
82 S BYPASS=1 D EN^LR7OB630(LABPAT,SS,INVDT)
83 Q:'$D(^TMP("LRX",$J,69)) Q:'$D(ODT) Q:'$D(SN)
84 D FIRST,SNEAK^LR7OB3 K Y M Y=XMSG
85 K ^TMP("LRX",$J),BYPASS
86 Q
87ALL(RECEIVE) ;Build HL7 message for all patients in file 63
88 ;RECEIVE=Routine entry point to receive message array for each LRIDT
89 N LRDFN
90 S LRDFN=0 S:'$D(RECEIVE) RECEIVE=""
91 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D PAT(LRDFN,RECEIVE)
92 Q
93PAT(LRDFN,RECEIVE) ;Get data for single patient from file 63
94 ;LRDFN=Lab Patient id
95 ;RECEIVE=Routine entry point to receive message array for each LRIDT
96 N SS,LRIDT
97 S SS="A" F S SS=$O(^LR(LRDFN,SS)) Q:SS="" D
98 . I SS="AU" D EN3(LRDFN,SS,"","SN",.Y) D REC Q
99 . 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
100 Q
101REC ;Send to receiving routine
102 I $L($G(RECEIVE)),RECEIVE["^" S X=$P(RECEIVE,"^",2) X ^%ZOSF("TEST") I $T D @RECEIVE
103 Q
104CALL ;Make call to OE/RR and cleanup
105 D CALL^LR7OB1(CONTROL)
106 K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
107 Q
Note: See TracBrowser for help on using the repository browser.