| 1 | LRAPBR ;DALOI/WTY - AP Browser Print/TIU TMP Global;04/03/01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^DPT supported by IA #918
|
|---|
| 5 | ;
|
|---|
| 6 | INIT(LRAA,LRSS,LRI,LRDFN,LRAA1,LRAU,LRTIU,LRNTIME) ;
|
|---|
| 7 | ;Define variables and arrays used for report display
|
|---|
| 8 | N LRIENS,LCT,LREFLG,LRPRAC
|
|---|
| 9 | S:'$D(LRTIU) LRTIU=0
|
|---|
| 10 | ;KLL-Change all "-" and "=" to "- " and "=-"
|
|---|
| 11 | S $P(LR("%"),"- ",IOM/2)="- "
|
|---|
| 12 | I $L(LR("%"))>(IOM-1) S LR("%")=$E(LR("%"),1,(IOM-1))
|
|---|
| 13 | S $P(LR("%1"),"=-",IOM/2)="=-"
|
|---|
| 14 | I $L(LR("%1"))>(IOM-1) S LR("%1")=$E(LR("%1"),1,(IOM-1))
|
|---|
| 15 | S LRQ(8)=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),"^",8),1:"")
|
|---|
| 16 | S LRQ=0,LRQ(1)=$$INS^LRU
|
|---|
| 17 | I LRAU D
|
|---|
| 18 | .S LRS="W",LRAP=LRDFN,LRXR="A"_LRSS,LRXREF=LRXR_"A"
|
|---|
| 19 | .S LR(.21)=+$G(^LRO(69.2,LRAA,.2)),LRS(5)=1
|
|---|
| 20 | .D EN^LRUA
|
|---|
| 21 | .D ^LRUP
|
|---|
| 22 | I 'LRAU D
|
|---|
| 23 | .D SET^LRUA
|
|---|
| 24 | .S LRA=1
|
|---|
| 25 | .S LRS(5)=1,LRQ(2)=1
|
|---|
| 26 | .S LR("DIWF")=$S($P(^LRO(69.2,LRAA,0),"^",6)="D":"D",1:"")_"W"
|
|---|
| 27 | MAIN ;Main Subroutine
|
|---|
| 28 | K ^UTILITY($J)
|
|---|
| 29 | D:'LRAU ENTER^LRAPBR1
|
|---|
| 30 | D:LRAU ENTER^LRAPBR4
|
|---|
| 31 | I 'LRAU,'LRTIU D
|
|---|
| 32 | .D POW,^LRAPBR2
|
|---|
| 33 | .I $D(^LR(LRDFN,"AU")),$P(^LR(LRDFN,"AU"),"^") D ^LRAPBR5
|
|---|
| 34 | I LRTIU,'LRAU D ESIGLN^LRAPBR1
|
|---|
| 35 | D:'LRAU FOOTER^LRAPBR1
|
|---|
| 36 | D:'LRTIU BROWSER
|
|---|
| 37 | D END
|
|---|
| 38 | Q
|
|---|
| 39 | POW ;Determine POW or Persian Gulf status
|
|---|
| 40 | I $P($G(^LR(LRDFN,0)),"^",2)=2 D
|
|---|
| 41 | .S LRPOW=0
|
|---|
| 42 | .I $D(^DPT(DFN,.52)) S:$P(^(.52),U,5)="Y" LRPOW=1
|
|---|
| 43 | .I $D(^DPT(DFN,.322)) S:$P($G(^(.322)),"^",10)="Y" LRPOW=1
|
|---|
| 44 | .D ^LRAPBRPW
|
|---|
| 45 | .K LRPOW
|
|---|
| 46 | Q
|
|---|
| 47 | FINAL ;Final Section
|
|---|
| 48 | ;Print text in field SNOMED & TC CODING (#10) of the LAB SECTION
|
|---|
| 49 | ;PRINT FILE (#69.2)
|
|---|
| 50 | Q:'$P($G(^LRO(69.2,LRAA,10,0)),"^",4)
|
|---|
| 51 | K LRTMP,^UTILITY($J,"W")
|
|---|
| 52 | S LRFILE=69.2,LRFLD=10,LRIENS=LRAA_","
|
|---|
| 53 | N X,DIWR,DIWL
|
|---|
| 54 | S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP")
|
|---|
| 55 | S DIWR=IOM-5,DIWL=5,DIWF=""
|
|---|
| 56 | S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
|
|---|
| 57 | I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
|
|---|
| 58 | S A=0 F S A=$O(LRTMP(A)) Q:'A S X=LRTMP(A) D ^DIWP
|
|---|
| 59 | S A=0 F S A=$O(^UTILITY($J,"W",DIWL,A)) Q:'A D
|
|---|
| 60 | .D GLENTRY^LRAPBR1(^UTILITY($J,"W",DIWL,A,0),DIWL,1)
|
|---|
| 61 | K ^UTILITY($J,"W")
|
|---|
| 62 | Q
|
|---|
| 63 | BROWSER ;
|
|---|
| 64 | ;SET LRW(1)=2-DIGIT YEAR OF AUTOPSY DATE
|
|---|
| 65 | I LRAU,LRQ(8)'="" S LRW(1)=$E(+$$GET1^DIQ(63,LRDFN,11,"I"),2,3)
|
|---|
| 66 | S LRTITLE=$S(LRQ(8)'="":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)_" - "_LRP
|
|---|
| 67 | S LRROOT="^TMP(""LRAPBR"",$J)"
|
|---|
| 68 | D BROWSE^DDBR(LRROOT,"",LRTITLE)
|
|---|
| 69 | Q
|
|---|
| 70 | END ;
|
|---|
| 71 | K LRSR1,LRSR2,LRTEXT,LRTIU,LRTITLE,LRROOT
|
|---|
| 72 | Q
|
|---|
