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

LRAPBR1.m

Go to the documentation of this file. 
  1. LRAPBR1 ;DALOI/WTY/KLL - AP Browser Print Cont.;11/08/01
  1.  ;;5.2;LAB SERVICE;**1030,1031**;NOV 1, 1997
  1.  ;
  1.  ;;VA LR Patche(s): 259,317,363
  1.  ;
  1.  ;
  1. ENTER ; EP - from LRAPBR
  1.  N LRCNT,LRTMP,LRA1,LRADESC,LRLENG1,LRLENG2,LRFILE,LRAPMD
  1.  N LRFLD,LRV,LRV1,LRV2,LRB1,LRTEXT,LRSPCE,LRIENS,LRAPMR
  1.  Q:'$D(^LR(LRDFN,LRSS,LRI,0))
  1.  S:'LRTIU GROOT="^TMP(""LRAPBR"",$J,"
  1.  S:LRTIU GROOT="^TMP(""TIUP"",$J,"
  1.  D INP^VADPT S LRPRAC=+VAIN(2)
  1.  S:'LRPRAC LRPRAC(1)=""
  1.  I LRPRAC S X=LRPRAC D D^LRUA S LRPRAC(1)=X
  1.  S LRQ=0 D ^LRUA,HEADER
  1.  S LR("F")=1
  1.  D DASH
  1.  D:LRTIU GLENTRY("$TEXT",,1)
  1.  D GLENTRY("Submitted by: "_LRW(5),"",1)
  1.  D GLENTRY("Date obtained: "_LRTK,44)
  1.  D:LRA DASH
  1.  ;
  1. MAIN ;
  1.  D SPEC
  1.  D MODCHK
  1.  D SUPBNNR
  1.  D DIAG
  1.  D DOC
  1.  D WPFLD
  1.  D SUPRPT
  1.  D SSJR
  1.  Q
  1.  ;
  1. SPEC ;List specimens
  1.  D GLENTRY("Specimen (Received "_LRTK(1)_"):","",1)
  1.  S LRCNT=$P(^LR(LRDFN,LRSS,LRI,.1,0),U,4)
  1.  Q:'LRCNT
  1.  S LRFILE=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
  1.  S LRIENS=LRI_","_LRDFN_","
  1.  S LRCT2=0
  1.  F LRB1=1:1 D  Q:LRCT2=LRCNT
  1.  .D GETS^DIQ(LRFILE,LRB1_","_LRIENS,.01,"","LRTMP("_LRB1_")")
  1.  .I $D(LRTMP(LRB1)) S LRCT2=LRCT2+1
  1.  S LRA1=0 F  S LRA1=$O(LRTMP(LRA1)) Q:'LRA1  D
  1.  .S LRTEXT=LRTMP(LRA1,LRFILE,LRA1_","_LRIENS,.01)
  1.  .D GLENTRY(LRTEXT,"",1)
  1.  Q
  1.  ;
  1. MODCHK ;Display modified banner if required
  1.  S LRAPMR=$$GET1^DIQ(LRSF,LRIENS,.17,"I")
  1.  Q:'LRAPMR
  1.  S LRAPMD=$$GET1^DIQ(LRSF,LRIENS,.172,"I")
  1.  D GLENTRY("","",1)
  1.  S LRTEXT=""
  1.  F LRCNT=1:1:$S(LRAPMD:14,1:15) D
  1.  .S LRTEXT=LRTEXT_"*+"
  1.  S LRTEXT=LRTEXT_" MODIFIED "
  1.  S LRTEXT=LRTEXT_$S(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
  1.  F LRCNT=1:1:$S(LRAPMD:14,1:15) D
  1.  .S LRTEXT=LRTEXT_"*+"
  1.  D GLENTRY(LRTEXT,"",1)
  1.  D GLENTRY("","",1)
  1.  Q
  1.  ;
  1. SUPBNNR ;Display supplementary report header if one or more has been added
  1.  I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
  1.  .S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
  1.  .D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
  1.  .S LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
  1.  .D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
  1.  .D GLENTRY("","",1)
  1.  Q
  1.  ;
  1. DIAG ;
  1.  ;Display the Brief Clinical History, Preoperative Diagnosis,
  1.  ;Operative Findings, and Postoperative Diagnosis
  1.  S LRFILE=LRSF,LRCNT=0,LRIENS=LRI_","_LRDFN_","
  1.  F LRFLD=.013:.001:.016 D
  1.  .D:LRA DASH
  1.  .S LRCNT=LRCNT+1
  1.  .D GLENTRY($P($T(TEXT1+LRCNT),";",2),"",1)
  1.  .D WP
  1.  Q
  1.  ;
  1. DOC ;
  1.  ;Pathologist information
  1.  D GLENTRY("","",1)
  1.  D GLENTRY("Surgeon/physician: "_LRMD,27,1)
  1.  D:LRA GLENTRY(LR("%1"),"",1)
  1.  D DASH
  1.  D HEADER2
  1.  D:LRA DASH
  1.  I LRRC="" D
  1.  .D GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
  1.  .D GLENTRY("","",1)
  1.  D GLENTRY("","",1)
  1.  I LRRMD'="" D
  1.  .S LRCNT=0 F LRA1="SP","CY","EM" D
  1.  ..S LRCNT=LRCNT+1
  1.  ..S LRTMP(LRA1)=$P($T(TEXT2+LRCNT),";",3)
  1.  .S LRTMP=LRTMP(LRSS)
  1.  .D GLENTRY(LRTMP_" "_LRRMD,31)
  1.  Q
  1.  ;
  1. WPFLD ;
  1.  ;Display Frozen Section, Gross Description, Microscopic Description
  1.  ;and Surgical Path Diagnosis
  1.  F LRCNT=1:1:4 D
  1.  .S X=$T(FIELDS+LRCNT)
  1.  .S LRV=$P(X,";",2),LRV1=$P(X,";",3),LRV2=$P(X,";",4)
  1.  .D TEXTCHK
  1.  .I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D
  1.  ..D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1)
  1.  ..S LRFILE=LRSF,LRIENS=LRI_","_LRDFN_",",LRFLD=LRV
  1.  ..I $P($G(^LR(LRDFN,LRSS,LRI,LRV2,0)),U,4) D
  1.  ...S LRFILE1=+$$GET1^DID(LRSF,LRV2,"","SPECIFIER")
  1.  ...D GLENTRY("*+* MODIFIED REPORT *+*",28,1)
  1.  ...D GLENTRY("(Last modified: ","",1)
  1.  ...S (LRA1,LRB1)=0
  1.  ...F  S LRA1=$O(^LR(LRDFN,LRSS,LRI,LRV2,LRA1)) Q:'LRA1  S LRB1=LRA1
  1.  ...Q:'$D(^LR(LRDFN,LRSS,LRI,LRV2,LRB1,0))
  1.  ...S LRSR1=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.01)
  1.  ...S LRSR2=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.02)
  1.  ...S LRTEXT=LRSR1_" typed by "_LRSR2_")"
  1.  ...D GLENTRY(LRTEXT,BTAB)
  1.  ..D WP
  1.  Q
  1.  ;
  1. SUPRPT ;Supplementary Report
  1.  I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
  1.  .S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
  1.  .S LRIENS1=LRI_","_LRDFN_","
  1.  .D GLENTRY("","",1),GLENTRY("SUPPLEMENTARY REPORT(S):","",1)
  1.  .S LRV=0 F  S LRV=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV)) Q:'LRV  D
  1.  ..S LRIENS=LRV_","_LRIENS1
  1.  ..S LRSR1=$$GET1^DIQ(LRFILE,LRIENS,.01)
  1.  ..S LRSR2=+$$GET1^DIQ(LRFILE,LRIENS,.02)
  1.  ..D GLENTRY("Supplementary Report Date: "_LRSR1,3,1)
  1.  ..I $D(LR("R")),'LRSR2 D GLENTRY(" not verified",BTAB) Q
  1.  ..I $P($G(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4) D
  1.  ...S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
  1.  ...D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
  1.  ...D GLENTRY("(Added/Last","",1)
  1.  ...S (LRA1,LRB1)=0
  1.  ...F  S LRA1=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRA1)) Q:'LRA1  D
  1.  ....S LRB1=LRA1
  1.  ...Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRB1,0))
  1.  ...S LRA2=^(0),Y=+LRA2,LRA2A=$P(LRA2,"^",2),LRSGN=" Typed by ",LRDSC=" modified: "
  1.  ...I $P(LRA2,"^",3) S LRSGN=" Signed by ",LRDSC=" released: ",LRA2A=$P(LRA2,"^",3),Y=$P(LRA2,"^",4)
  1.  ...S LRA2A=$S($D(^VA(200,LRA2A,0)):$P(^(0),"^"),1:LRA2A)
  1.  ...D D^LRU
  1.  ...D GLENTRY(LRDSC_Y_LRSGN_LRA2A_")",BTAB)
  1.  ..S LRFLD=1 D WP
  1.  ..D GLENTRY("","",1)
  1.  Q
  1.  ;
  1. SSJR ;Print special studies/journal references
  1.  D ^LRAPBR3
  1.  S LREFLG=1
  1.  Q
  1.  ;
  1. WP ;Display word procesing fields
  1.  K LRTMP,^UTILITY($J,"W")
  1.  N X,DIWR,DIWL,LRINC
  1.  S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP",)
  1.  S DIWR=IOM-5,DIWL=5,DIWF=""
  1.  S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
  1.  I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
  1.  S LRINC=0
  1.  F  S LRINC=$O(LRTMP(LRINC)) Q:'LRINC  S X=LRTMP(LRINC) D ^DIWP
  1.  S LRINC=0
  1.  F  S LRINC=$O(^UTILITY($J,"W",DIWL,LRINC)) Q:'LRINC  D
  1.  .D GLENTRY(^UTILITY($J,"W",DIWL,LRINC,0),DIWL,1)
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ;
  1.  D:LRTIU GLENTRY("$APHDR",,1)
  1.  D GLENTRY("","",1)
  1.  D DASH
  1.  D GLENTRY("MEDICAL RECORD |",5,1)
  1.  D GLENTRY(LRAA1,40)
  1.  D DASH
  1.  ;
  1. HEADER2 ;
  1.  S LRADESC="Accession No. "_$S(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
  1.  S LRLENG1=$L(LRQ(1)),LRLENG2=$L(LRADESC),LRSPCE=IOM-LRLENG2-14
  1.  S:LRLENG1>LRSPCE LRQ(1)=$E(LRQ(1),1,LRSPCE)
  1.  D GLENTRY("PATHOLOGY REPORT",30,1)
  1.  D GLENTRY("Laboratory: "_LRQ(1),"",1)
  1.  D GLENTRY(LRADESC,IOM-LRLENG2-1)
  1.  Q
  1.  ;
  1.  D:LRTIU GLENTRY("$FTR",,1)
  1.  D DASH
  1.  S LRTEXT=$S('$D(LR("W")):"",1:"See signed copy in chart")
  1.  D GLENTRY(LRTEXT,"",1)
  1.  S LRTEXT="("_$S($D(LREFLG):"End of report",1:"See next page")_")"
  1.  D GLENTRY(LRTEXT,57)
  1.  D GLENTRY(LRPMD,"",1),GLENTRY(LRW(9),52),GLENTRY("| Date "_LRRC,55)
  1.  D DASH
  1.  D GLENTRY(LRP,"",1)
  1.  S LRTEXT=$S('$D(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
  1.  D GLENTRY(LRTEXT,50)
  1.  ; D GLENTRY("ID:"_SSN,"",1)
  1.  D GLENTRY("ID:"_HRCN,"",1)            ; IHS/MSC/MKK - LR*5.2*1031
  1.  D GLENTRY("SEX:"_SEX,16),GLENTRY(" DOB:"_DOB,BTAB)
  1.  I AGE D
  1.  .S LRTEXT=$S($G(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: ")_AGE
  1.  .D GLENTRY(LRTEXT,BTAB)
  1.  D GLENTRY(" LOC:"_LRLLOC,BTAB)
  1.  D GLENTRY("","",1)
  1.  D:$L(LRADM) GLENTRY("ADM:"_$P(LRADM,"@"),BTAB)
  1.  D:$L(LRADX) GLENTRY("DX:"_$E(LRADX,1,26),17)
  1.  D GLENTRY("PCP:",46)
  1.  D:$L(LRPRAC) GLENTRY($E(LRPRAC(1),1,28),51)
  1.  Q
  1.  ;
  1. ESIGLN ;Write signature block name, title, and date of signature
  1.  D GLENTRY(,,1)
  1.  I $D(^VA(200,DUZ,0)) D
  1.  .S LRFILE=200,LRFLD=20.2,LRFLD2=20.3
  1.  .S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD)
  1.  ;Compare DUZ to pathologist, if different, use proxy signature
  1.  S:LRSS="AU" LRPATH=$$GET1^DIQ(63,LRDFN,13.6,"I")
  1.  I LRSS'="AU" D
  1.  .S LRFL2=$S(LRSS="EM":63.02,LRSS="CY":63.09,LRSS="SP":63.08,1:0)
  1.  .S LRIENS=LRI_","_LRDFN_","
  1.  .S LRPATH=$$GET1^DIQ(LRFL2,LRIENS,.02,"I")
  1.  S LRPATH2=""
  1.  S:LRPATH'=DUZ LRPATH2=" FOR "_$$GET1^DIQ(LRFILE,LRPATH,LRFLD)
  1.  S LRTEXT="/es/ "_X_LRPATH2
  1.  ;S LRTEXT="/es/ "_X
  1.  D GLENTRY(LRTEXT,,1)
  1.  S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD2)
  1.  S LRTEXT=X
  1.  D GLENTRY(LRTEXT,,1)
  1.  S Y=LRNTIME D DD^%DT
  1.  S LRTEXT="Signed "_Y
  1.  D GLENTRY(LRTEXT,,1)
  1.  Q
  1.  ;
  1. DASH ;Display a line of dashes
  1.  D GLENTRY(LR("%"),"",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)
  1.  S LRPR2=+$G(LRPR2)
  1.  S LRPR3=+$G(LRPR3)
  1.  D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
  1.  D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
  1.  Q
  1.  ;
  1. TEXT1 ;Text for top of report
  1.  ;BRIEF CLINICAL HISTORY:
  1.  ;PREOPERATIVE DIAGNOSIS:
  1.  ;OPERATIVE FINDINGS:
  1.  ;POSTOPERATIVE DIAGNOSIS:
  1. TEXT2 ;Descriptive text based on section
  1.  ;SP;Pathology Resident:
  1.  ;CY;Screened by:
  1.  ;EM;Prepared by:
  1. FIELDS ;Field numbers for word processing fields
  1.  ;1.3;.13;6
  1.  ;1;.03;7
  1.  ;1.1;.04;4
  1.  ;1.4;.14;5
  1. TEXTCHK ; update text line counter if it is missing (Remedy 116253)
  1.  N I,X,DATA
  1.  S I=0
  1.  K ^TMP("WP",$J)
  1.  S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))
  1.  I X'="",$L(X,"^")=1 D
  1.  . F  S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I=""  D
  1.  . . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))
  1.  . . S ^TMP("WP",$J,I,0)=DATA
  1.  I $D(^TMP("WP",$J)) D
  1.  . D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
  1.  . K ^TMP("WP",$J)
  1.  Q