source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OC0.m@ 899

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1LR7OC0 ;slc/dcm - Convert orders from old to new format ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
3 ;
4EN ;For a good time, enter here. Lab order conversion with KIDS.
5 I $$VER^LR7OU1<3 Q ;OE/RR 2.5 Check
6 S ZTDTH=$H,ZTIO="",ZTRTN="EN1^LR7OC0" D ^%ZTLOAD
7 Q
8EN1 ;Convert orders without KIDS
9 I $$VER^LR7OU1<3 Q ;OE/RR 2.5 Check
10 Q:$G(^ORD(100.99,1,"CONV"))
11 N LRORD,LRODT,LRSN,TST,LR1,X,SUBHEAD
12 S LRORD=$S($G(^LRO(69,"LRORD CONV",0)):+^(0),1:0) D:'LRORD CK
13 F S LRORD=$O(^LRO(69,"C",LRORD)) Q:LRORD<1 L +^LRCNVRT(LRORD):9999 D L -^LRCNVRT(LRORD)
14 . S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 I $D(^LRO(69,LRODT,1,LRSN,0)),'$P(^(0),"^",11) D
15 .. D NEW1^LR7OB0(LRODT,LRSN,"ZC")
16 .. S $P(^LRO(69,LRODT,1,LRSN,0),"^",11)=1.69
17 . S ^LRO(69,"LRORD CONV",0)=LRORD
18 D NOW^%DTC S Y=% X ^DD("DD")
19 K ^LRO(69,"LRORD CONV",0)
20 S X(1)="Conversion of lab orders for patch LR*5.2*121 completed: "_Y
21 S X(2)="Task #"_$G(ZTSK)
22 D BULL(.X,"Lab Conversion")
23 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
24 Q
25CHK ;Check that all lab orders were converted.
26 N LRORD,LRODT,LRSN,TST,LINK,X0
27 S LRORD=0
28 F S LRORD=$O(^LRO(69,"C",LRORD)) Q:LRORD<1 D
29 . S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 I $D(^LRO(69,LRODT,1,LRSN,0)) S X0=^(0) I $D(^LR(+X0,0)),$P(^(0),"^",2)=2 D
30 .. S TST=0 F S TST=$O(^LRO(69,LRODT,1,LRSN,2,TST)) Q:TST<1 S T0=^(TST,0) I $P(T0,"^",7),'$P(T0,"^",11),'$P(T0,"^",14) D
31 ... ;I '$P(X0,"^",6),$P(T0,"^",7),$D(^OR(100,$P(T0,"^",7),0)),$P(^(0),"^",4) S X=$P(^(0),"^",4),$P(^LRO(69,LRODT,1,LRSN,0),"^",6)=X,$P(X0,"^",6)=X
32 ... I $P(T0,"^",7),$D(^OR(100,$P(T0,"^",7),0)),$G(^(4))["^" D
33 .... S X=$P($G(^OR(100,$P(T0,"^",7),3)),"^",3) I X=""!(X=1)!(X=2)!(X=14) Q
34 .... W !,"NOT CNVRTD-ODT:"_LRODT_" SN:"_LRSN_" ORIFN:"_$P(T0,"^",7)_$S('$P(X0,"^",6):" No Provider",1:"") S ORX4=^(4),ORIFN=$P(T0,"^",7)
35 Q
36CK1 ;Check please (more validity checking). Find bad/missing ptrs to OE/RR 3.0
37 N LRORD,LRODT,LRSN,TST,ORIFN
38 S LRORD=0
39 F S LRORD=$O(^LRO(69,"C",LRORD)) Q:LRORD<1 D
40 . S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 I $D(^LRO(69,LRODT,1,LRSN,0)) S X=^(0),ORIFN=$P(X,"^",11) I $D(^LR(+X,0)),$P(^(0),"^",2)=2 D
41 .. I '$L(ORIFN),$O(^LRO(69,LRODT,1,LRSN,2,0)) W !,"Missing ptr at LRSN level to 100:LRODT:"_LRODT_" LRSN:"_LRSN Q
42 .. I ORIFN,ORIFN'=1.69 D
43 ... I '$D(^OR(100,ORIFN,0)) W !,"Bad ptr to 100:"_X_" LRODT:"_LRODT_" LRSN:"_LRSN
44 ... S TST=0 F S TST=$O(^LRO(69,LRODT,1,LRSN,2,TST)) Q:TST<1 S X=^(TST,0) I '$P(X,"^",6),'$P(X,"^",7) W !,"Missing ORIFN at test level:LRODT:"_LRODT_" LRSN:"_LRSN_" IFN:"_TST_">>"_X
45 Q
46CK ;Rebuild C & D -xref in 69
47 N ODT,SN,X
48 S ODT=0
49 F S ODT=$O(^LRO(69,ODT)) Q:ODT<1 S SN=0 F S SN=$O(^LRO(69,ODT,1,SN)) Q:SN<1 I $D(^(SN,0)) S X=^(0) D
50 . I +X,'$D(^LRO(69,"D",+X,ODT,SN)) S ^LRO(69,"D",+X,ODT,SN)=""
51 . I '$D(^LRO(69,ODT,1,SN,.1)) Q
52 . S X=+^LRO(69,ODT,1,SN,.1) I 'X Q
53 . I '$D(^LRO(69,"C",X,ODT,SN)) S ^LRO(69,"C",X,ODT,SN)=""
54 Q
55COUNT ;Count orders in file 69
56 N ORD,ODT,SN,X,CT1,CT2,CT3,CT4,X3
57 S (CT1,CT2,CT3,CT4,ORD)=0
58 F S ORD=$O(^LRO(69,"C",ORD)) Q:ORD<1 S ODT=0 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
59 . S CT1=CT1+1
60 . I $D(^LRO(69,ODT,1,SN)) S CT2=CT2+1 D
61 .. S TST=0 F S TST=$O(^LRO(69,ODT,1,SN,2,TST)) Q:TST<1 I $D(^(TST,0)) S CT3=CT3+1 I $P(^(0),"^",7),$D(^OR(100,+$P(^(0),"^",7),3)) S X3=$P(^(3),"^",3) I X3'=1,X3'=2,X3'=14 S CT4=CT4+1
62 W !!,"Valid Specimen Nodes: "_CT2
63 W !,"Total Specimen Count: "_CT1
64 W !,"Total Tests: "_CT3
65 W !,"Tests to Convert: "_CT4
66 Q
67BULL(X,XMSUB) ;Send bulletin
68 ;X()=Array of text to be in bulletin
69 ;XMSUB=Subject of bulletin
70 S XMY(DUZ)="",XMDUZ=.5,XMTEXT="X("
71 D ^XMD
72 Q
73TEST(ODT,SN) ;Test HL7 message build without calling
74 Q:'$L($T(MSG^XQOR))
75 N MSG,CHMSG,BBMSG,APMSG,LRORD,LRODT,LRSN,LRNIFN,LRTMPO,X,CONTROL
76 K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
77 S CONTROL="TEST"
78 D ORD1^LR7OB1(ODT,SN)
79 I '$D(LRTMPO("LRIFN")) W !!,"NO LRTMPO(""LRIFN"",LRNIFN) BUILT." D EN1^LR7OB0(ODT,SN,CONTROL) Q
80 S LRNIFN=0 F S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1 S X=LRTMPO("LRIFN",LRNIFN) D
81 . 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
82 . D EN1^LR7OB0(ODT,SN,CONTROL)
83 D DISP
84 Q
85DISP ;Display HL7 message
86 F I="LRAP","LRBB","LRCH" I $D(^TMP(I,$J)) S J=0 F S J=$O(^TMP(I,$J,J)) Q:J<1 W !,^(J)
87 Q
Note: See TracBrowser for help on using the repository browser.