| 1 | LRDIQ ;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 |  ;
 | 
|---|
| 6 | EN ; 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 |  ;
 | 
|---|
| 30 | DSP ; 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 |  ;
 | 
|---|
| 59 | STOP() ;
 | 
|---|
| 60 |  I $X W !
 | 
|---|
| 61 |  X DX(0)
 | 
|---|
| 62 |  Q '$G(S)
 | 
|---|