source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDIQ.m@ 824

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1LRDIQ ;DALOI/FHS - MODIFIED LAB VERSION OF CAPTIONED TEMPLATE FILEMAN 19 ; 30 June 2004
2 ;;5.2;LAB SERVICE;**86,153,263,290**;Sep 27, 1994
3 Q
4 ;
5 ;
6EN ; From LRLIST,LROE1,LRSOR
7 S:'$G(S) S=1
8 I $G(DX(0))="" N DX D
9 . S DX(0)="Q"
10 . I $D(IOST)#2,IOST?1"C".E S DX(0)="S S=$Y I S>22 N X,Y S DIR(0)=""E"" D ^DIR K DIR W @IOF S S=$S($D(DIRUT):0,1:1)"
11 . I $D(IOST)#2,IOST?1"P".E S DX(0)="S S=$G(S)+1 I S>(IOSL-6) W @IOF S S=1"
12 S ^UTILITY($J,1)=DX(0)
13 I $X W !
14 ; If file #63 "CH" subscript then special handling
15 I $G(LRLONG),DIC["""CH""",$P(DR,":",2)>1 D Q
16 . N LRDFN,LRDR,LRSB,LRX
17 . S LRDR=DR,DR=$P(LRDR,":")_":1"
18 . D EN^DIQ Q:$G(DIRUT)
19 . I $X W !
20 . S LRSB=1,LRX=$P($P(DIC,","),"(",2) S:LRX'=+LRX LRX=@LRX
21 . F S LRSB=$O(^LR(LRX,"CH",DA,LRSB)) Q:'LRSB D DSP Q:$G(DIRUT)
22 . K ^UTILITY($J,1)
23 ;
24 ; Otherwise all others use normal FileMan DIQ call
25 D EN^DIQ
26 K ^UTILITY($J,1)
27 Q
28 ;
29 ;
30DSP ; Display FileMan fields and
31 ; non FileMan fields only shown with LRVERIFY key on certain supervisor reports
32 ;
33 N LRQX,LRW,LRWL,LRY,X,Y,ZZ
34 S LRY=$$TSTRES^LRRPU(LRX,"CH",DA,LRSB,"",1)
35 S ZZ(0)=$$GET1^DID(63.04,LRSB,"","LABEL")_": "_$TR($P(LRY,"^",1,2),"^"," ")
36 I $P($G(LRLABKY),U,2) D
37 . ; set Result[DUZ/Institution/LOINC code/EEI]
38 . I $P(LRY,"^",9) S ZZ(1)="PERFORMED/RELEASED BY: "_$$NAME^XUSER($P(LRY,"^",9),"F")
39 . I $P(LRY,"^",6) S ZZ(2)="PERFORMING LAB: "_$P($$NS^XUAF4($P(LRY,"^",6)),"^")
40 . S X=$P(LRY,"^",8)
41 . I $P(X,"!",3)'="" S ZZ(3)="LOINC Code: "_$P($P(X,"!",3),";")
42 . I $P(LRY,U,10)'="" S ZZ(4)="EII: "_$P(LRY,U,10)
43 . I $G(LRLONG)=1 Q
44 . ; set low/high/units
45 . S ZZ(0)=ZZ(0)_" ("_$P(LRY,"^",3)_$S($P(LRY,"^",4)'="":"-"_$P(LRY,"^",4),1:"")_" "_$P(LRY,"^",5)_")"
46 ;
47 S LRW=""
48 F S LRW=$O(ZZ(LRW)) Q:LRW="" D Q:$G(DIRUT)
49 . D I ($L(ZZ(LRW))+LRQX)>IOM Q:$$STOP D
50 . . S LRQX=$S($X:$X+1\40+1*40,1:2)
51 . . I LRQX=2,LRW>0 S LRQX=3
52 . W ?LRQX
53 . F S LRWL=IOM-$X D Q:ZZ(LRW)="" Q:$$STOP
54 . . W $E(ZZ(LRW),1,LRWL)
55 . . S ZZ(LRW)=$E(ZZ(LRW),LRWL+1,999)
56 Q
57 ;
58 ;
59STOP() ;
60 I $X W !
61 X DX(0)
62 Q '$G(S)
Note: See TracBrowser for help on using the repository browser.