| [613] | 1 | LRACSUM1 ;SLC/DCM - INDIVIDUAL PATIENT SUMMARY CONT. ; 10/8/87 11:14 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**225**;Sep 27, 1994
|
|---|
| 3 | LRIDT ;from LRACSUM
|
|---|
| 4 | F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT) S X=^(LRIDT,0) D LRIIDT
|
|---|
| 5 | Q
|
|---|
| 6 | LRIIDT S (LRIIDT,LRVIDT)=$P(X,U,1),LRSUB=1,LRTNN=1
|
|---|
| 7 | S LRSPM=$P(X,U,5),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6)
|
|---|
| 8 | Q:'$L(LRVDT) D LRSUB Q
|
|---|
| 9 | LRSUB S LRSUB=1 F S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1 S X=^(LRSUB) D SUB1
|
|---|
| 10 | Q
|
|---|
| 11 | SUB1 S LRTSTVAL=$P(X,U,1),X1=$P(X,U,2),LRNOFL=""
|
|---|
| 12 | S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0)) Q:LRTST=""
|
|---|
| 13 | Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
|
|---|
| 14 | I '$D(^LAB(64.5,"AC",LRSUB)) D MISC Q
|
|---|
| 15 | K LRNON D LRMH I '$D(LRNON) D MISC Q
|
|---|
| 16 | LRMH S LRMH=0 F S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:LRMH<1 D LRSH
|
|---|
| 17 | Q
|
|---|
| 18 | LRSH S LRSH=0 F S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:LRSH<1 D TST
|
|---|
| 19 | Q
|
|---|
| 20 | TST S LRTSTS=0 F S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS S LRSPM1=^(LRTSTS) D TST1
|
|---|
| 21 | Q
|
|---|
| 22 | TST1 Q:LRSPM'=LRSPM1
|
|---|
| 23 | SBSET S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1
|
|---|
| 24 | ;**LRTE=Total minor headings,LRMHN=Major heading name^TE^Lab performing tests,LRTF=Minor header^Profile specimen^Total tests^Type of display**
|
|---|
| 25 | S LRIIDT=LRVIDT
|
|---|
| 26 | S:'$D(^TMP($J,LRDFN,LRMH)) ^(LRMH)=LRMHN S:'$D(^TMP($J,LRDFN,LRMH,LRSH))!($D(^(LRSH))=10) ^(LRSH)=LRTF_U S:'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIIDT,0)) ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT
|
|---|
| 27 | LRTSTVAL S ^TMP($J,LRDFN,LRMH,LRSH,LRIIDT,LRTSTS)=LRTSTVAL_U_X1
|
|---|
| 28 | I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIIDT,"TX",0)) D TEXT
|
|---|
| 29 | Q
|
|---|
| 30 | MISC S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0)) Q:LRTST=""
|
|---|
| 31 | Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
|
|---|
| 32 | S LRTOP=LRSPM
|
|---|
| 33 | S:'$D(^TMP($J,LRDFN,"MISC",LRIIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM S ^(LRTNN)=LRTSTVAL_U_LRSPM_U_LRTST_U_X1_U_LRSUB
|
|---|
| 34 | I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIIDT,"TX",0)) S ^TMP($J,LRDFN,"MISC",LRIIDT,"TX",0)="" S L=0 F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:'L S ^TMP($J,LRDFN,"MISC",LRIIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
|
|---|
| 35 | S LRTNN=LRTNN+1
|
|---|
| 36 | Q
|
|---|
| 37 | TEXT S LRYESCOM=0
|
|---|
| 38 | S M=0 F S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:'M!(LRYESCOM) F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM S:$E(^(0),N)'[$C(32) LRYESCOM=1
|
|---|
| 39 | Q:'LRYESCOM
|
|---|
| 40 | S L=0 F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:'L S ^TMP($J,LRDFN,LRMH,LRSH,LRIIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
|
|---|
| 41 | Q
|
|---|
| 42 | LRCALE ;from LRACSUM
|
|---|
| 43 | S A7=0 F S A7=$O(^LAB(64.5,1,1,A7)) Q:A7<1 D A7
|
|---|
| 44 | K A7,B3 Q
|
|---|
| 45 | A7 S B3=0 F S B3=$O(^LAB(64.5,1,1,A7,1,B3)) Q:B3<1 D B3
|
|---|
| 46 | Q
|
|---|
| 47 | B3 S:$P(^LAB(64.5,1,1,A7,1,B3,0),U,4) LRCALE(A7,B3)=1
|
|---|
| 48 | Q
|
|---|
| 49 | MICRO ;from LRACSUM
|
|---|
| 50 | Q:'$D(^LR(LRDFN,"MI")) S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5) S (LRONESPC,LRONETST)="",LREND=0
|
|---|
| 51 | S LRWRDVEW="",LRSB=0,LRIDT=LRIN F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT) S LRNLOC=LRLLOC D EN1^LRMIPC S LRLLOC=LRNLOC
|
|---|
| 52 | K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
|
|---|
| 53 | Q
|
|---|
