Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAPPF1

LRAPPF1.m

Go to the documentation of this file. 
  1. LRAPPF1 ;DALOI/STAFF - ANAT PATH FILE PRINT BY PT ;11/17/11  10:59
  1.  ;;5.2;LAB SERVICE;**72,173,201,259,362,392,350**;Sep 27, 1994;Build 230
  1.  ;
  1.  ;Reference to ^DIC supported by IA #916
  1.  ;
  1.  I $G(LRSF515)="" N LRSF515 S LRSF515=0
  1.  ;
  1.  S F=0
  1.  F  S F=$O(^TMP($J,F)) Q:'F!(LR("Q"))  D
  1.  . S F(1)=$P(^DIC(F,0),"^"),F(2)=^DIC(F,0,"GL")
  1.  . K LR("F") D H S LR("F")=1 D W
  1.  Q:LR("Q")
  1.  D ^LRAPPF2
  1.  Q
  1.  ;
  1.  ;
  1. W ;
  1.  S W=0
  1.  F LRB=0:0 S W=$O(^TMP($J,F,W)) Q:W=""!(LR("Q"))  D LR
  1.  Q
  1.  ;
  1.  ;
  1. LR ;
  1.  S LRDFN=0
  1.  F  S LRDFN=$O(^TMP($J,F,W,LRDFN)) Q:'LRDFN!(LR("Q"))  D NM
  1.  Q
  1.  ;
  1.  ;
  1. NM ;
  1.  S X=^LR(LRDFN,0),LRDPF=$P(X,U,2),N=$P(X,"^",3),N=@(F(2)_N_",0)")
  1.  S LRP=$P(N,"^"),SSN=$P(N,"^",9),Y=$P(N,"^",3)
  1.  D D^LRU,SSN^LRU S DOB=$S(Y'[1700:Y,1:"")
  1.  ;
  1.  I $Y>(IOSL-4) D H Q:LR("Q")
  1.  ;
  1.  W !!,LRP,?31,SSN W:DOB'="" ?51,"BORN: ",DOB
  1.  S LRI=0
  1.  F  S LRI=$O(^TMP($J,F,W,LRDFN,LRI)) Q:'LRI!(LR("Q"))  D
  1.  . D @($S("CYEMSP"[LRSS:"EN",1:"AUT"))
  1.  Q
  1.  ;
  1.  ;
  1. AUT S LRSF515=+$G(LRSF515)
  1.  D:$Y>(IOSL-12) H1 Q:LR("Q")
  1.  S X=^LR(LRDFN,"AU"),N=$P(X,"^",6),Y=+X D D^LRU S LRH(3)=Y,DA=LRDFN
  1.  D D^LRAUAW S Y=LR(63,12) D D^LRU S E=Y,H(2)=$E(H(1),1,3)
  1.  W !,"AUTOPSY #: ",N," AUTOPSY DATE: ",LRH(3),?51,"DIED: ",E
  1.  D EN^LRAPT2
  1.  S X=0 F  S X=$O(^LR(LRDFN,"AY",X)) Q:'X!(LR("Q"))  D
  1.  . S Y=+^LR(LRDFN,"AY",X,0),Y=$S($D(^LAB(61,Y,0)):$P(^(0),"^"),1:Y)
  1.  . W !,Y D AM
  1.  Q
  1.  ;
  1.  ;
  1. AM S M=0 F  S M=$O(^LR(LRDFN,"AY",X,2,M)) Q:'M!(LR("Q"))  D
  1.  . S Y=+^LR(LRDFN,"AY",X,2,M,0)
  1.  . S Y=$S($D(^LAB(61.1,Y,0)):$P(^(0),"^"),1:Y)
  1.  . W !?5,Y
  1.  Q
  1.  ;
  1.  ;
  1. EN ; from LRAPT1,LRAPQACN
  1.  S LRSF515=+$G(LRSF515)  ;Indicates that this is generating an SF515
  1.  S X=$G(^LR(LRDFN,S,LRI,0)) Q:X=""  S LR("PATH")=$P(X,U,2),N=$P(X,U,6)
  1.  S N(11)=$P(X,U,11),X=$P(X,U,10),X=$P(X,"."),LRH(3)=$$Y2K^LRX(X)
  1.  S H(2)=$E(X,1,3)
  1.  I LR("PATH")]"" S LR("PATH")=$$EXTERNAL^DILFD(LRSF,.02,"",LR("PATH"),LR("PATH"))
  1.  S:N="" N="?" S:'H(2) H(2)="?"
  1.  I LRSF515,($Y>(IOSL-11)) D H1 Q:LR("Q")
  1.  I 'LRSF515,($Y>(IOSL-4)) D H1 Q:LR("Q")
  1.  ;
  1.  W !?2,"Organ/tissue:",?17,"Date rec'd: ",LRH(3),?43,"Acc #:",N
  1.  W ?64,$E(LR("PATH"),1,12)
  1.  I 'N(11) W !?5,"Report not verified." Q
  1.  ; SNOMED codes
  1.  I '+$G(LR("SPSM")) D  Q:LR("Q")
  1.  . S O=0
  1.  . F  S O=$O(^LR(LRDFN,S,LRI,2,O)) Q:'O!(LR("Q"))  D
  1.  . . I LRSF515,($Y>(IOSL-11)) D H2 Q:LR("Q")
  1.  . . I 'LRSF515,($Y>(IOSL-4)) D H2 Q:LR("Q")
  1.  . . S X=^LR(LRDFN,S,LRI,2,O,0),W(3)=$P(X,"^",3)
  1.  . . S O(6)=$P(^LAB(61,+X,0),"^")
  1.  . . W !?5,O(6) W:W(3) " ",W(3)," gm"
  1.  . . D L
  1.  ; Comments
  1.  I $D(LRQ(3)) D
  1.  . S B=0 F  S B=$O(^LR(LRDFN,S,LRI,99,B)) Q:'B!(LR("Q"))  D
  1.  . . W !?5,$E(^LR(LRDFN,S,LRI,99,B,0),1,74)
  1.  . . I LRSF515,($Y>(IOSL-11)) D H2 Q:LR("Q")
  1.  . . I 'LRSF515,($Y>(IOSL-4)) D H2 Q:LR("Q")
  1.  Q
  1.  ;
  1.  ;
  1. DES ; Print Microscopic Description
  1.  Q:$G(LR("Q"))
  1.  ; If printing SF515 then only print main entry (LRAP="LRDFN^LRIDT") or entry on print queue
  1.  I $G(LRSF515),LRAPX=3,$G(LRAP),(LRSS'=S!(LRI'=$P(LRAP,"^",2))) Q
  1.  I $G(LRSF515),LRAPX=4,$G(LRPRE),(LRSS'=S!(LRI'=$P(^LRO(69.2,LRAA,1,LRAN,0),"^",2))) Q
  1.  Q:'$O(^LR(LRDFN,S,LRI,1.1,0))
  1.  W !!,"Microscopic Description/Diagnosis:"
  1.  N X,LRL,LRVAL
  1.  S LRL=0
  1.  F  S LRL=$O(^LR(LRDFN,S,LRI,1.1,LRL)) Q:LRL<1!$G(LR("Q"))  I ($D(^(LRL,0))#2) S LRVAL=$G(^(0)) D
  1.  . I $Y>(IOSL-13) D H2 Q:$G(LR("Q"))  W !!,"Microscopic Description/Diagnosis:"
  1.  . W !?5,LRVAL
  1.  W !
  1.  Q
  1.  ;
  1.  ;
  1. L ;
  1.  S B=0
  1.  F  S B=$O(^LR(LRDFN,S,LRI,2,O,3,B)) Q:'B!(LR("Q"))  D
  1.  . S B(1)=+^LR(LRDFN,S,LRI,2,O,3,B,0)
  1.  . I LRSF515,($Y>(IOSL-11)) D H3 Q:LR("Q")
  1.  . I 'LRSF515,($Y>(IOSL-4)) D H3 Q:LR("Q")
  1.  . W !?10,$P(^LAB(61.3,B(1),0),"^")
  1.  S B=0
  1.  F  S B=$O(^LR(LRDFN,S,LRI,2,O,4,B)) Q:'B!(LR("Q"))  D
  1.  . S X=^LR(LRDFN,S,LRI,2,O,4,B,0),B(1)=+X,B(2)=$P(X,"^",2)
  1.  . I LRSF515,($Y>(IOSL-11)) D H3 Q:LR("Q")
  1.  . I 'LRSF515,($Y>(IOSL-4)) D H3 Q:LR("Q")
  1.  . W !?10,$P(^LAB(61.5,B(1),0),"^")
  1.  . W:B(2)]"" " (",$S(B(2)=0:"Negative",B(2)=1:"Positive",1:"?"),")"
  1.  S B=0
  1.  F  S B=$O(^LR(LRDFN,S,LRI,2,O,1,B)) Q:'B!(LR("Q"))  D
  1.  . S B(1)=+^LR(LRDFN,S,LRI,2,O,1,B,0)
  1.  . I LRSF515,($Y>(IOSL-11)) D H3 Q:LR("Q")
  1.  . I 'LRSF515,($Y>(IOSL-4)) D H3 Q:LR("Q")
  1.  . W !?10,$P(^LAB(61.4,B(1),0),"^")
  1.  S M=0
  1.  F  S M=$O(^LR(LRDFN,S,LRI,2,O,2,M)) Q:'M!(LR("Q"))  D
  1.  . S M(1)=+^LR(LRDFN,S,LRI,2,O,2,M,0)
  1.  . I LRSF515,($Y>(IOSL-11)) D H3 Q:LR("Q")
  1.  . I 'LRSF515,($Y>(IOSL-4)) D H3 Q:LR("Q")
  1.  . W !?10,$P(^LAB(61.1,M(1),0),"^") D E
  1.  S E=0
  1.  F  S E=$O(^LR(LRDFN,S,LRI,2,O,5,E)) Q:'E!(LR("Q"))  D
  1.  . S E(1)=^LR(LRDFN,S,LRI,2,O,5,E,0) D A
  1.  Q
  1.  ;
  1.  ;
  1. A ;
  1.  S Y=$P(E(1),"^",2),E(3)=$P(E(1),"^",3),E(4)=$P(E(1),"^")_":"
  1.  S E(4)=$P($P(LR(S),E(4),2),";") D D^LRU S E(2)=Y D D^LRU
  1.  I LRSF515,($Y>(IOSL-11)) D H3 Q:LR("Q")
  1.  I 'LRSF515,($Y>(IOSL-4)) D H3 Q:LR("Q")
  1.  W !?5,E(4)," ",E(3)," Date: ",E(2)
  1.  Q
  1.  ;
  1.  ;
  1. E ;
  1.  S E=0
  1.  F  S E=$O(^LR(LRDFN,S,LRI,2,O,2,M,1,E)) Q:'E!(LR("Q"))  W !?12,$P(^LAB(61.2,+^LR(LRDFN,S,LRI,2,O,2,M,1,E,0),0),"^")
  1.  Q
  1.  ;
  1.  ;
  1. H ;
  1.  ;
  1.  I LRSF515 D F^LRAPF,^LRAPF Q
  1.  I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
  1.  I $D(LRQ(2)) D H^LRSPT Q
  1.  I $D(LRQ(9)) D H^LRAPT1 Q
  1.  D F^LRU W !,LRO(68)," "
  1.  W:F(2)'="^DPT(" !,"Demographic data in ",F(1)," file."
  1.  W !,"Entries listed by PATIENT (From: ",LRSTR," to: ",LRLST,")"
  1.  W !,"Name",?31,"Identifier"
  1.  W !,LR("%")
  1.  Q
  1.  ;
  1.  ;
  1. H1 ;
  1.  D H
  1.  I '$D(LRQ(9)) W !,LRP,?30,SSN,?42,DOB
  1.  Q
  1.  ;
  1.  ;
  1. H2 ;
  1.  D H1
  1.  W !?5,"Organ/tissue:",?25,"Date received: ",LRH(3),?51,"Acc #:",N
  1.  Q
  1.  ;
  1.  ;
  1. H3 ;
  1.  D H2
  1.  W !?5,O(6) W:W(3) " ",W(3)," gm"
  1.  Q