73 lines
2.2 KiB
Mathematica
73 lines
2.2 KiB
Mathematica
LRAPBR ;DALOI/WTY - AP Browser Print/TIU TMP Global;04/03/01
|
|
;;5.2;LAB SERVICE;**259**;Sep 27, 1994
|
|
;
|
|
;Reference to ^DPT supported by IA #918
|
|
;
|
|
INIT(LRAA,LRSS,LRI,LRDFN,LRAA1,LRAU,LRTIU,LRNTIME) ;
|
|
;Define variables and arrays used for report display
|
|
N LRIENS,LCT,LREFLG,LRPRAC
|
|
S:'$D(LRTIU) LRTIU=0
|
|
;KLL-Change all "-" and "=" to "- " and "=-"
|
|
S $P(LR("%"),"- ",IOM/2)="- "
|
|
I $L(LR("%"))>(IOM-1) S LR("%")=$E(LR("%"),1,(IOM-1))
|
|
S $P(LR("%1"),"=-",IOM/2)="=-"
|
|
I $L(LR("%1"))>(IOM-1) S LR("%1")=$E(LR("%1"),1,(IOM-1))
|
|
S LRQ(8)=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),"^",8),1:"")
|
|
S LRQ=0,LRQ(1)=$$INS^LRU
|
|
I LRAU D
|
|
.S LRS="W",LRAP=LRDFN,LRXR="A"_LRSS,LRXREF=LRXR_"A"
|
|
.S LR(.21)=+$G(^LRO(69.2,LRAA,.2)),LRS(5)=1
|
|
.D EN^LRUA
|
|
.D ^LRUP
|
|
I 'LRAU D
|
|
.D SET^LRUA
|
|
.S LRA=1
|
|
.S LRS(5)=1,LRQ(2)=1
|
|
.S LR("DIWF")=$S($P(^LRO(69.2,LRAA,0),"^",6)="D":"D",1:"")_"W"
|
|
MAIN ;Main Subroutine
|
|
K ^UTILITY($J)
|
|
D:'LRAU ENTER^LRAPBR1
|
|
D:LRAU ENTER^LRAPBR4
|
|
I 'LRAU,'LRTIU D
|
|
.D POW,^LRAPBR2
|
|
.I $D(^LR(LRDFN,"AU")),$P(^LR(LRDFN,"AU"),"^") D ^LRAPBR5
|
|
I LRTIU,'LRAU D ESIGLN^LRAPBR1
|
|
D:'LRAU FOOTER^LRAPBR1
|
|
D:'LRTIU BROWSER
|
|
D END
|
|
Q
|
|
POW ;Determine POW or Persian Gulf status
|
|
I $P($G(^LR(LRDFN,0)),"^",2)=2 D
|
|
.S LRPOW=0
|
|
.I $D(^DPT(DFN,.52)) S:$P(^(.52),U,5)="Y" LRPOW=1
|
|
.I $D(^DPT(DFN,.322)) S:$P($G(^(.322)),"^",10)="Y" LRPOW=1
|
|
.D ^LRAPBRPW
|
|
.K LRPOW
|
|
Q
|
|
FINAL ;Final Section
|
|
;Print text in field SNOMED & TC CODING (#10) of the LAB SECTION
|
|
;PRINT FILE (#69.2)
|
|
Q:'$P($G(^LRO(69.2,LRAA,10,0)),"^",4)
|
|
K LRTMP,^UTILITY($J,"W")
|
|
S LRFILE=69.2,LRFLD=10,LRIENS=LRAA_","
|
|
N X,DIWR,DIWL
|
|
S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP")
|
|
S DIWR=IOM-5,DIWL=5,DIWF=""
|
|
S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
|
|
I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
|
|
S A=0 F S A=$O(LRTMP(A)) Q:'A S X=LRTMP(A) D ^DIWP
|
|
S A=0 F S A=$O(^UTILITY($J,"W",DIWL,A)) Q:'A D
|
|
.D GLENTRY^LRAPBR1(^UTILITY($J,"W",DIWL,A,0),DIWL,1)
|
|
K ^UTILITY($J,"W")
|
|
Q
|
|
BROWSER ;
|
|
;SET LRW(1)=2-DIGIT YEAR OF AUTOPSY DATE
|
|
I LRAU,LRQ(8)'="" S LRW(1)=$E(+$$GET1^DIQ(63,LRDFN,11,"I"),2,3)
|
|
S LRTITLE=$S(LRQ(8)'="":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)_" - "_LRP
|
|
S LRROOT="^TMP(""LRAPBR"",$J)"
|
|
D BROWSE^DDBR(LRROOT,"",LRTITLE)
|
|
Q
|
|
END ;
|
|
K LRSR1,LRSR2,LRTEXT,LRTIU,LRTITLE,LRROOT
|
|
Q
|