Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OB69.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OB69.m
r613 r623 1 LR7OB69 ;slc/dcm/JAH - Get Lab order data from 69 - 68 - 63 ;8/10/04 2 ;;5.2;LAB SERVICE;**121,187,224,291,373**;Sep 27, 1994;Build 1 3 ; 4 69(ODT,SN) ;Get data from file 69 5 ;ODT=Order Date subscript in file 69 6 ;SN=Specimen number subscript in file 69 7 ;Y1=Lab order number 8 ;Y2=Start date 9 ;Y3=Sample 10 ;Y4=Collection type/Specimen Action code 11 ;Y5=Order date 12 ;Y6=Provider 13 ;Y7=Routing Location 14 ;Y8=Lab arrival time 15 ;Y9=Date/Time Results Available 16 ;Y10=Specimen 17 ;Y11=OERR Order # 18 ;Y12=Entering person 19 ;^TMP("LRX",$J,69)=Y1^Y2^Y3^Y4^Y5^Y6^Y7^Y8^Y9^Y10^Y11^Y12 20 ;^TMP("LRX",$J,69,i)=Test^Urgency^Accession Date^Accession area^Accession #^Combined on order^ORIFN^Panel exploded 21 ;^TMP("LRX",$J,69,"N",i)=Specimen level comments (6 node) 22 ;^TMP("LRX",$J,69,i,"N",ifn)=Comments by test 23 ;^TMP("LRX",$J,69,i,"NC",ifn)=Free text cancel reason 24 ;^TMP("LRX",$J,69,i,"DGX",ifn)=diagnosis^SC^CV^AO^IR^EC^HNC^MST 25 ;^TMP("LRX",$J,69,i,63,ifn)= 26 ;Test subscript^Result^Flag^Units^Ref Range^Result status^Observation Sub ID^Value type^Natl Procedure code^Natl Procedure Name^Natl Coding System^Verified by^^Theraputic flag (T or "")^Print name^Accession^Order #^Link to 63 27 ;^TMP("LRX",$J,69,i,63,"N",ifn)=Result Comments 28 ;^TMP("LRX",$J,69,i,68)=Lab Order #^LRDFN^Accession^Draw Time^Lab Arrival time^DT Results Available^Inverse Date 29 ;^TMP("LRX",$J,69,i,68,ifn)=Test^Urgency^Technologist^Complete Date 30 ;^TMP("LRX",$J,69,"N",i)= Ward comments on specimen 31 N X,X0,XP1,X1,X4,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,IFN,TSTY,NOTE,GOTCOM K ^TMP("LRX",$J,69) 32 Q:'$D(^LRO(69,+ODT,1,+SN,0)) S X0=^(0),XP1=$G(^(.1)),X1=$G(^(1)),X3=$G(^(3)),X4=$O(^(4,0)) 33 Q:'$D(^LR(+X0,0)) ;No matching entry in ^LR 34 S:'$D(DFN) DFN=$P(^LR(+X0,0),"^",3) S:'$D(LRDFN) LRDFN=+X0 S:'$D(LRDPF) LRDPF=$P(^LR(+X0,0),"^",2)_$G(^DIC(+$P(^LR(+X0,0),"^",2),0,"GL")) 35 S Y1=+XP1,Y2=$S($P(X1,"^"):$P(X1,"^"),1:$P(X0,"^",8)),Y3=$P(X0,"^",3),Y4=$P(X0,"^",4),Y5=$P(X0,"^",5),Y6=$P(X0,"^",6),Y7=$P(X0,"^",9),Y8=$P(X3,"^"),Y9=$P(X3,"^",2),Y11=$P(X0,"^",11),Y12=$P(X0,"^",2) 36 ;canceled entries are skipped, so calls to this routine from options 37 ;that are removing tests need to make the call before setting the pieces 38 ;that cancel the test: $P(^LRO(69,ODT,1,SN,2,IFN,0),"^",11) 39 ;See DOUT^LRTSTJAN 40 S IFN=0 F S IFN=$O(^LRO(69,ODT,1,SN,2,IFN)) Q:IFN<1 S X=$G(^(IFN,0)) I X,'$P(X,"^",11) D 41 . I $G(LRNIFN),$D(LRTMPO("LRIFN",LRNIFN)) Q:+X'=+LRTMPO("LRIFN",LRNIFN) 42 . S ^TMP("LRX",$J,69,IFN)=X,I=0 43 . D GDG1^LRBEBA2(ODT,SN,IFN) 44 . F S I=$O(^LRO(69,ODT,1,SN,2,IFN,1,I)) Q:I<1 S X=^(I,0) D 45 .. S ^TMP("LRX",$J,69,IFN,"N",I)=X 46 . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,IFN,1.1,I)) Q:I<1 S X=^(I,0) D 47 .. S ^TMP("LRX",$J,69,IFN,"NC",I)=X 48 S IFN=0 F S IFN=$O(^LRO(69,ODT,1,SN,6,IFN)) Q:IFN<1 S X=^(IFN,0) D 49 . Q:X["removed ==>" Q:X["deleted by" 50 . S ^TMP("LRX",$J,69,"N",IFN)=X 51 S Y10=$O(^LRO(69,ODT,1,SN,4,0)),Y10=$S(Y10:$P(^(Y10,0),"^"),1:"") 52 S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12 53 S IFN=0 F S IFN=$O(^TMP("LRX",$J,69,IFN)) Q:IFN<1 S X=^TMP("LRX",$J,69,IFN) S X1=$P(X,"^",3),X2=$P(X,"^",4),X3=$P(X,"^",5) K TSTY D EN^LR7OU1(+X,$P(^LAB(60,+X,0),"^",5)) D 68^LR7OB68(IFN,X1,X2,X3,+X) 54 Q 1 LR7OB69 ;slc/dcm/JAH - Get Lab order data from 69 - 68 - 63 ;8/10/04 2 ;;5.2;LAB SERVICE;**121,187,224,291**;Sep 27, 1994 3 ; 4 69(ODT,SN) ;Get data from file 69 5 ;ODT=Order Date subscript in file 69 6 ;SN=Specimen number subscript in file 69 7 ;Y1=Lab order number 8 ;Y2=Start date 9 ;Y3=Sample 10 ;Y4=Collection type/Specimen Action code 11 ;Y5=Order date 12 ;Y6=Provider 13 ;Y7=Routing Location 14 ;Y8=Lab arrival time 15 ;Y9=Date/Time Results Available 16 ;Y10=Specimen 17 ;Y11=OERR Order # 18 ;Y12=Entering person 19 ;^TMP("LRX",$J,69)=Y1^Y2^Y3^Y4^Y5^Y6^Y7^Y8^Y9^Y10^Y11^Y12 20 ;^TMP("LRX",$J,69,i)=Test^Urgency^Accession Date^Accession area^Accession #^Combined on order^ORIFN^Panel exploded 21 ;^TMP("LRX",$J,69,"N",i)=Specimen level comments (6 node) 22 ;^TMP("LRX",$J,69,i,"N",ifn)=Comments by test 23 ;^TMP("LRX",$J,69,i,"NC",ifn)=Free text cancel reason 24 ;^TMP("LRX",$J,69,i,"DGX",ifn)=diagnosis^SC^CV^AO^IR^EC^HNC^MST 25 ;^TMP("LRX",$J,69,i,63,ifn)= 26 ;Test subscript^Result^Flag^Units^Ref Range^Result status^Observation Sub ID^Value type^Natl Procedure code^Natl Procedure Name^Natl Coding System^Verified by^^Theraputic flag (T or "")^Print name^Accession^Order #^Link to 63 27 ;^TMP("LRX",$J,69,i,63,"N",ifn)=Result Comments 28 ;^TMP("LRX",$J,69,i,68)=Lab Order #^LRDFN^Accession^Draw Time^Lab Arrival time^DT Results Available^Inverse Date 29 ;^TMP("LRX",$J,69,i,68,ifn)=Test^Urgency^Technologist^Complete Date 30 ;^TMP("LRX",$J,69,"N",i)= Ward comments on specimen 31 N X,X0,XP1,X1,X4,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,IFN,TSTY,NOTE,GOTCOM K ^TMP("LRX",$J,69) 32 Q:'$D(^LRO(69,+ODT,1,+SN,0)) S X0=^(0),XP1=$G(^(.1)),X1=$G(^(1)),X3=$G(^(3)),X4=$O(^(4,0)) 33 Q:'$D(^LR(+X0,0)) ;No matching entry in ^LR 34 S:'$D(DFN) DFN=$P(^LR(+X0,0),"^",3) S:'$D(LRDFN) LRDFN=+X0 S:'$D(LRDPF) LRDPF=$P(^LR(+X0,0),"^",2)_$G(^DIC(+$P(^LR(+X0,0),"^",2),0,"GL")) 35 S Y1=+XP1,Y2=$S($P(X1,"^"):$P(X1,"^"),1:$P(X0,"^",8)),Y3=$P(X0,"^",3),Y4=$P(X0,"^",4),Y5=$P(X0,"^",5),Y6=$P(X0,"^",6),Y7=$P(X0,"^",7),Y8=$P(X3,"^"),Y9=$P(X3,"^",2),Y11=$P(X0,"^",11),Y12=$P(X0,"^",2) 36 S:$L(Y7) Y7=$O(^SC("C",Y7,0)) 37 ;canceled entries are skipped, so calls to this routine from options 38 ;that are removing tests need to make the call before setting the pieces 39 ;that cancel the test: $P(^LRO(69,ODT,1,SN,2,IFN,0),"^",11) 40 ;See DOUT^LRTSTJAN 41 S IFN=0 F S IFN=$O(^LRO(69,ODT,1,SN,2,IFN)) Q:IFN<1 S X=$G(^(IFN,0)) I X,'$P(X,"^",11) D 42 . I $G(LRNIFN),$D(LRTMPO("LRIFN",LRNIFN)) Q:+X'=+LRTMPO("LRIFN",LRNIFN) 43 . S ^TMP("LRX",$J,69,IFN)=X,I=0 44 . D GDG1^LRBEBA2(ODT,SN,IFN) 45 . F S I=$O(^LRO(69,ODT,1,SN,2,IFN,1,I)) Q:I<1 S X=^(I,0) D 46 .. S ^TMP("LRX",$J,69,IFN,"N",I)=X 47 . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,IFN,1.1,I)) Q:I<1 S X=^(I,0) D 48 .. S ^TMP("LRX",$J,69,IFN,"NC",I)=X 49 S IFN=0 F S IFN=$O(^LRO(69,ODT,1,SN,6,IFN)) Q:IFN<1 S X=^(IFN,0) D 50 . Q:X["removed ==>" Q:X["deleted by" 51 . S ^TMP("LRX",$J,69,"N",IFN)=X 52 S Y10=$O(^LRO(69,ODT,1,SN,4,0)),Y10=$S(Y10:$P(^(Y10,0),"^"),1:"") 53 S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12 54 S IFN=0 F S IFN=$O(^TMP("LRX",$J,69,IFN)) Q:IFN<1 S X=^TMP("LRX",$J,69,IFN) S X1=$P(X,"^",3),X2=$P(X,"^",4),X3=$P(X,"^",5) K TSTY D EN^LR7OU1(+X,$P(^LAB(60,+X,0),"^",5)) D 68^LR7OB68(IFN,X1,X2,X3,+X) 55 Q
Note:
See TracChangeset
for help on using the changeset viewer.