source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRWRKLS1.m@ 1604

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1LRWRKLS1 ;DALOI/CJS/DRH - LRWRKLST, CONT. ;2/7/91 14:29
2 ;;5.2;LAB SERVICE;**121,153,185,268**;Sep 27, 1994
3 ;
4LST1 ;from LRWRKLST
5 D CHKPAGE
6 Q:$G(LRSTOP)=1
7 S LRDX=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRCE=$S($D(^(.1)):^(.1),1:""),LRACC=$S($D(^(.2)):^(.2),1:"")
8 Q:'$D(^LR(+LRDX,0))#2
9 ;
10 S LRDPF=$P(^LR(+LRDX,0),U,2),DFN=$P(^(0),U,3)
11 D PT^LRX
12 ;
13 S (LRDLA,LRDLC,LRACO)=""
14 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) D
15 . N LRY
16 . S LRY=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRACO=$P(LRY,U,6)
17 . S LRDLC=$$FMTE^XLFDT($P(LRY,"^"),"5MZ")
18 . S LRDLA=$$FMTE^XLFDT($P(LRY,"^",3),"5MZ")
19 S LRDTO=$$FMTE^XLFDT($P(LRDX,"^",4),"5MZ")
20 ;
21 W ! D DASH^LRX
22 ;
23 S LN=$G(LN)+1
24 D CHKPAGE
25 Q:$G(LRSTOP)
26 ;
27 W !,"ACCESSION: ",LRACC,?40,"PATIENT: ",PNM
28 W !," ORDER #: ",LRCE,?41,"SSN/ID: ",SSN,!
29 S X=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
30 W:X'="" ?6,"UID: ",X
31 W ?44,"DOB: ",$$FMTE^XLFDT(DOB,"5MZ")
32 W !," LOCATION: ",$E($P(LRDX,"^",7),1,19)
33 W:$L(LRDTO) ?35,"DATE ORDERED: ",LRDTO,!
34 W:$P(LRDX,U,6) " IDENTITY: ",$P(LRDX,U,6)
35 W:$L(LRDLC) ?38,"COLLECTED: ",LRDLC
36 ;
37 S (LRPRAC,LRX)=$P(LRDX,"^",8)
38 I LRPRAC S LRX=$$GET1^DIQ(200,LRPRAC_",",.01)
39 I LRX="" S LRX=$S($L(LRPRAC):LRPRAC,1:"UNKNOWN")
40 W !," PROVIDER: ",LRX
41 W:$L(LRDLA) ?36,"LAB ARRIVAL: ",LRDLA
42 S LN=$G(LN)+6
43 ;
44 N PRAC,PR
45 D PRAC^LR7OMERG(LRAA,LRAD,LRAN,.PRAC)
46 S PR=0
47 F S PR=$O(PRAC(PR)) Q:PR<1 W !?11,$$GET1^DIQ(200,PR_",",.01) S LN=LN+1
48 ;
49 D CHKPAGE
50 Q:$G(LRSTOP)=1
51 ;
52 ;
53 D LEDI
54 ;
55 ; Find and print order comments from file #69
56 S X1=+$P(LRDX,U,4),X2=+$P(LRDX,U,5)
57 I $D(^LRO(69,X1,1,X2,6)) D
58 . W !," Order Comment:" S LN=LN+1
59 . S I=0
60 . F S I=$O(^LRO(69,X1,1,X2,6,I)) Q:I<1 W !?11,^(I,0) S LN=LN+1 D CHKPAGE Q:$G(LRSTOP)
61 ;
62 ;
63TSTCOM ; Display test comments
64 ;
65 N LRI,LRX,LRY
66 ;
67 Q:$G(LRSTOP)
68 ;
69 ; Check for canceled test and print test and cancel reason
70 S LRI=0
71 F S LRI=$O(^LRO(69,X1,1,X2,2,LRI)) Q:LRI<1 D
72 . S LRX=$G(^LRO(69,X1,1,X2,2,LRI,0))
73 . I '$P(LRX,"^",11) Q
74 . W !," CANCELED TEST: ",$P($G(^LAB(60,+LRX,0),"UNKNOWN"),"^")
75 . W " "_$E($P($G(^LAB(62.05,+$P(LRX,"^",2),0),"ROUTINE"),"^"),1,15)
76 . W " by: "_$$GET1^DIQ(200,+$P(LRX,"^",11)_",",.01)
77 . S LN=LN+1,LRI(2)=0
78 . F S LRI(2)=$O(^LRO(69,X1,1,X2,2,LRI,1.1,LRI(2))) Q:LRI(2)<1 D Q:$G(LRSTOP)
79 . . S LRY=$G(^LRO(69,X1,1,X2,2,LRI,1.1,LRI(2),0))
80 . . W !?3,": "_LRY
81 . . S LN=LN+1 D CHKPAGE
82 ;
83 I $L(LRACO) W !," Accession Comment: ",LRACO S LN=LN+1
84 ;
85 I $L($P(LRDX,U,6,7))>1 W ! S LN=LN+1
86 Q
87 ;
88 ;
89CHKPAGE ;
90 ; Check if task and user wants to stop task.
91 I $D(ZTQUEUED),$$S^%ZTLOAD D Q
92 . S (LRSTOP,ZTSTOP)=1
93 . W !!,"*** Report requested to stop by TaskMan ***"
94 . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
95 ;
96 Q:$G(LRSTOP)!($D(ZTQUEUED))!($E(IOST,1,2)'="C-")
97 Q:$G(LN)<(IOSL-2)
98 K DIR
99 S DIR(0)="E"
100 D ^DIR
101 I $D(DIRUT) S (LREND,LRSTOP)=1
102 S LN=1
103 W !
104 Q
105 ;
106 ;
107LEDI ; print LEDI information
108 ;
109 N LRIENS,LRUID,LRX,LRY
110 ;
111 S LRY=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),LRIENS=LRAN_","_LRAD_","_LRAA_","
112 ;
113 S LRX=$$GET1^DIQ(68.02,LRIENS,16.1),LRUID=$P(LRY,"^",5)
114 I $L(LRX)!($L(LRUID)) D
115 . W !!
116 . I $L(LRX) W $J($$GET1^DID(68.02,16.2,"","LABEL")_": ",17),$E(LRX,1,20)
117 . I $L(LRUID) W ?40,$$GET1^DID(68.02,16.4,"","LABEL"),": ",LRUID
118 . S LN=LN+2
119 ;
120 S LRX=$$GET1^DIQ(68.02,LRIENS,16.2)
121 I $L(LRX) D
122 . W !,$J($$GET1^DID(68.02,16.1,"","LABEL")_": ",17),$E(LRX,1,20)
123 . S LN=LN+1
124 ;
125 Q
Note: See TracBrowser for help on using the repository browser.