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

LRAPBR5.m

Go to the documentation of this file. 
  1. LRAPBR5 ;VA/DALOI/WTY - AUTOPSY BROWSER DISPLAY/TIU STORAGE;6/5/2001
  1.  ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
  1.  ;
  1.  ;;VA LR Patch(s): 259
  1.  ;
  1.  ;This routine was copied from ^LRAPT2.  It was updated with FileMan
  1.  ;DBS calls and modified to be used for browser display and storage
  1.  ;of the SF515 in TIU.
  1.  ;
  1. MAIN ; EP
  1.  N LRLLOC,LRDTDIED,LRTMP,LRNUM,LRINC,LRINC1
  1.  S LRQUIT=0
  1.  S:'$D(LRIENS) LRIENS=LRDFN_","
  1.  D HEADER
  1.  Q:LRQUIT
  1.  D WEIGHTS
  1.  D SPCSTD
  1.  D JRNLREF
  1.  D:'LRAU DIAGS
  1.  Q
  1.  ;
  1.  D GLENTRY("","",1)
  1.  D GLENTRY(LRP,"",1)
  1.  ; D GLENTRY(SSN,32)
  1.  D GLENTRY(HRCN,32)          ; IHS/MSC/MKK - LR*5.2*1031
  1.  D GLENTRY("DOB: "_DOB,52)
  1.  S LR("F")=1
  1.  I 'LRTIU,'+$$GET1^DIQ(63,LRIENS,14.7,"I") D  Q
  1.  .D GLENTRY("","",1)
  1.  .D GLENTRY("Autopsy protocol report not verified.","",1)
  1.  .S LRQUIT=1
  1.  S LRLLOC=$$GET1^DIQ(63,LRIENS,14.5,"E")
  1.  S DA=LRDFN D D^LRAUAW S Y=LR(63,12) D D^LRU S LRDTDIED=Y
  1.  D GLENTRY("Acc: "_$$GET1^DIQ(63,LRIENS,14),"",1)
  1.  D GLENTRY("AUTOPSY DATA",32)
  1.  D GLENTRY("Age: "_$J($$GET1^DIQ(63,LRIENS,12.5),3),52)
  1.  D GLENTRY("Date/time Died","",1)
  1.  D GLENTRY("Date/time of Autopsy",52)
  1.  D GLENTRY(LRDTDIED,"",1)
  1.  D GLENTRY($E($$GET1^DIQ(63,LRIENS,13.7,"E"),1,18),32)
  1.  D GLENTRY($$GET1^DIQ(63,LRIENS,11,"E"),52)
  1.  D GLENTRY("Resident: "_$$GET1^DIQ(63,LRIENS,13.5,"E"),"",1)
  1.  D GLENTRY("Senior: "_$E($$GET1^DIQ(63,LRIENS,13.6,"E"),1,19),52)
  1.  Q
  1.  ;
  1. WEIGHTS ;Display/Store Weights & Measures
  1.  D GLENTRY("","",1)
  1.  I $D(^LR(LRDFN,"AW")) D
  1.  .S LRTMP="Rt--Lung--Lt  Liver Spleen  Rt--Kidney--Lt  Brain  Body "
  1.  .S LRTMP=LRTMP_"Wt(lb)    Ht(in)"
  1.  .D GLENTRY(LRTMP,"",1)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,18),4),"",1)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,19),4),8)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,20),5),14)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,21),5),21)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,22),4),28)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,23),4),38)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,25),4),45)
  1.  .D GLENTRY($$GET1^DIQ(63,LRIENS,17),55)
  1.  .D GLENTRY($$GET1^DIQ(63,LRIENS,16),68)
  1.  F LRINC=1:1:2 D GLENTRY("","",1)
  1.  D:$D(^LR(LRDFN,"AW")) GLENTRY("Heart(gm)",BTAB)
  1.  I $D(^LR(LRDFN,"AV")) D
  1.  .D GLENTRY("TV(cm)  PV(cm)  MV(cm)  AV(cm)  RV(cm)  LV(cm)",12)
  1.  D GLENTRY("","",1)
  1.  D GLENTRY($J($$GET1^DIQ(63,LRIENS,24),5),BTAB)
  1.  I $D(^LR(LRDFN,"AV")) D
  1.  .S LRNUM=12
  1.  .F LRINC=26:1:31 D
  1.  ..D GLENTRY($J($$GET1^DIQ(63,LRIENS,LRINC),4),LRNUM)
  1.  ..S LRNUM=LRNUM+8
  1.  .D GLENTRY("","",1)
  1.  .S LRTMP="Cavities(ml): Rt--Pleural--Lt  Pericardial  Peritoneal"
  1.  .D GLENTRY(LRTMP,"",1)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.2),4),14,1)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.1),4),25)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.3),4),33)
  1.  .D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.4),4),45)
  1.  I $D(^LR(LRDFN,"AW")) D
  1.  .D GLENTRY("","",1)
  1.  .F LRINC=1:1:8 D
  1.  ..S LRTMP=$$GET1^DIQ(63,LRIENS,"25."_LRINC)
  1.  ..Q:LRTMP=""
  1.  ..D GLENTRY($$GET1^DID(63,"25."_LRINC,"","LABEL")_": "_LRTMP,"",1)
  1.  I $D(^LR(LRDFN,"AWI")) D
  1.  .D GLENTRY("","",1)
  1.  .F LRINC=1:1:5 D
  1.  ..S LRNUM=$S(LRINC=1:25.9,1:25.9_(LRINC-1))
  1.  ..S LRTMP=$$GET1^DIQ(63,LRIENS,LRNUM)
  1.  ..Q:LRTMP=""
  1.  ..D GLENTRY($$GET1^DID(63,LRNUM,"","LABEL")_": "_LRTMP,"",1)
  1.  Q
  1.  ;
  1. SPCSTD ;Display/store special studies
  1.  N LRARR,LRSPC,LRORGTS,LRIENS1,LRFLG,LRTEXT,LRCNT
  1.  D GLENTRY("","",1)
  1.  S (LRFLG,LRINC)=0
  1.  F  S LRINC=$O(^LR(LRDFN,"AY",LRINC)) Q:'LRINC  D
  1.  .S LRORGTS=$$GET1^DIQ(63.2,LRINC_","_LRIENS,".01:.01")
  1.  .S LRINC1=0
  1.  .F  S LRINC1=$O(^LR(LRDFN,"AY",LRINC,5,LRINC1)) Q:'LRINC1  D
  1.  ..S LRIENS1=LRINC1_","_LRINC_","_LRIENS
  1.  ..D GETS^DIQ(63.26,LRIENS1,".01;.03","","LRARR")
  1.  ..M LRSPC=LRARR(63.26,LRIENS1)
  1.  ..S LRSPC(.02)=$$GET1^DIQ(63.26,LRIENS1,.02,"E")
  1.  ..I 'LRFLG D
  1.  ...D GLENTRY("","",1)
  1.  ...D GLENTRY(LRORGTS,BTAB)
  1.  ...S LRFLG=1
  1.  ..S LRTEXT=LRSPC(.01)_" "_LRSPC(.03)_" Date: "_LRSPC(.02)
  1.  ..D GLENTRY(LRTEXT,"",1)
  1.  ..K ^UTILITY($J,"W"),LRTMP
  1.  ..S X=$$GET1^DIQ(63.26,LRIENS1,1,"","LRTMP")
  1.  ..S DIWR=IOM-10,DIWL=10,DIWF=""
  1.  ..S X=+$$GET1^DID(63.27,1,"","SPECIFIER","LRDBERR")
  1.  ..I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
  1.  ..S LRCNT=0 F  S LRCNT=$O(LRTMP(LRCNT)) Q:'LRCNT  D
  1.  ...S X=LRTMP(LRCNT) D ^DIWP
  1.  ..S LRCNT=0 F  S LRCNT=$O(^UTILITY($J,"W",DIWL,LRCNT)) Q:'LRCNT  D
  1.  ...D GLENTRY(^UTILITY($J,"W",DIWL,LRCNT,0),DIWL,1)
  1.  ..K ^UTILITY($J,"W")
  1.  ..D GLENTRY("","",1)
  1.  Q
  1.  ;
  1. JRNLREF ;Print journal references
  1.  N LRFL,LRM,LRN,LRTP,LRIENS1,LRIENS2,LRIENS3,LRFILE1,LRFILE3,LRFILE4
  1.  D GLENTRY(,,1)
  1.  S LRINC1=0,LRFILE=63.2
  1.  F  S LRINC1=$O(^LR(LRDFN,"AY",LRINC1)) Q:'LRINC1  D
  1.  .S LRIENS1=LRINC1_","_LRIENS
  1.  .S LRTP=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
  1.  .;Topography
  1.  .N LRN
  1.  .S LRFL=LRTP,LRFILE1=61 D JREFPRT
  1.  .;Morphology
  1.  .S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
  1.  .S LRM=0 F  S LRM=$O(^LR(LRDFN,"AY",LRINC1,2,LRM)) Q:'LRM  D
  1.  ..S LRIENS2=LRM_","_LRIENS1
  1.  ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
  1.  ..D JREFPRT
  1.  ..;Etiology
  1.  ..S LRFILE1=61.2,LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
  1.  ..S LRN=0 F  S LRN=$O(^LR(LRDFN,"AY",LRINC1,2,LRM,1,LRN)) Q:'LRN  D
  1.  ...S LRIENS3=LRN_","_LRIENS2
  1.  ...S LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
  1.  ...D JREFPRT
  1.  .;Disease
  1.  .S LRFILE1=61.4,LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
  1.  .S LRM=0 F  S LRM=$O(^LR(LRDFN,"AY",LRINC1,1,LRM)) Q:'LRM  D
  1.  ..S LRIENS2=LRM_","_LRIENS1
  1.  ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
  1.  ..D JREFPRT
  1.  .;Function
  1.  .S LRFILE1=61.3,LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
  1.  .S LRM=0 F  S LRM=$O(^LR(LRDFN,"AY",LRINC1,3,LRM)) Q:'LRM  D
  1.  ..S LRIENS2=LRM_","_LRIENS1
  1.  ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
  1.  ..D JREFPRT
  1.  .S LRFILE1=61.5,LRFILE3=+$$GET1^DID(LRFILE,1.5,"","SPECIFIER")
  1.  .S LRM=0 F  S LRM=$O(^LR(LRDFN,"AY",LRINC1,4,LRM)) Q:'LRM  D
  1.  ..S LRIENS2=LRM_","_LRIENS1
  1.  ..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
  1.  ..D JREFPRT
  1.  Q
  1.  ;
  1. JREFPRT ;
  1.  ; Print journal reference on the patient report if the 
  1.  ; reference is flagged for printing.
  1.  N LRJR,LRINC
  1.  S LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")
  1.  S LRJR=0 F  S LRJR=$O(^LAB(LRFILE1,LRFL,"JR",LRJR)) Q:'LRJR  D
  1.  .S LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)
  1.  .F LRINC=1:1:5 D
  1.  ..S LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)
  1.  .S LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")
  1.  .Q:'LRJR(6)
  1.  .D GLENTRY(,,1),GLENTRY("Reference: ",,1)
  1.  .D GLENTRY(LRJR(.01),,1)
  1.  .D GLENTRY(LRJR(1),,1),GLENTRY(,,1)
  1.  .I LRJR(2)'="" D
  1.  ..D GLENTRY(LRJR(2)_"  vol."_LRJR(3),BTAB)
  1.  ..D GLENTRY(" pg."_LRJR(4),BTAB)
  1.  .D GLENTRY("  Date: "_LRJR(5),BTAB)
  1.  Q
  1.  ;
  1. DIAGS ;
  1.  N LRV
  1.  D GLENTRY("","",1)
  1.  F LRV=81,82 D
  1.  .D GLENTRY("","",1)
  1.  .D:LRV=81 GLENTRY(LRAU(1),BTAB)
  1.  .D:LRV=82 GLENTRY(LRAU(2),BTAB)
  1.  .S LRFILE=63
  1.  .S LRFIELD=$S(LRV=81:32.2,1:32.3)
  1.  .D WP^LRAPBR4
  1.  .D GLENTRY("","",1)
  1.  Q
  1.  ;
  1. GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
  1.  ;LRPR1 = Text to be written to global
  1.  ;LRPR2 = Tab position
  1.  ;LRPR3 = 1 means start a new line.  Othewise, write an current line.
  1.  S LRPR1=$G(LRPR1),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)
  1.  D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
  1.  D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
  1.  Q