- LRAPBR4 ;DALOI/WTY/KLL - Autopsy Browser Display;7/27/01
- ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- ;
- ;;VA LR Patch(s): 259,317
- ;
- ;Reference to ^DPT supported by IA #918
- ;
- Q
- ;
- ENTER ; EP - Entry point
- N LRTEXT,LRFILE,LRFIELD,LRTMP,LRFLG
- D INIT
- Q:'$D(^LR(LRDFN,LRSS))
- D HEADER
- D BODY
- D:'LRTIU POW
- D:LRTIU ESIGLN^LRAPBR1
- D FOOTER
- Q
- ;
- INIT ;Initialize variables
- S X=^LR(LRDFN,0) D ^LRUP
- Q:'$D(^LR(LRDFN,LRSS))
- F LRTMP=1:1 D Q:LRFIELD="Q"
- .S X=$T(VART1+LRTMP)
- .S LRFIELD=$P(X,";",2),VAR=$P(X,";",3),LRFLG=$P(X,";",4)
- .Q:LRFIELD="Q"
- .S @VAR=$$GET1^DIQ(63,LRDFN_",",LRFIELD,LRFLG)
- .I VAR["LRM",@VAR S X=@VAR D D^LRUA S @VAR=X
- S LRH(2)=$E(LRH(2),2,3)
- ;Get date of death (LRH)
- S DA=LRDFN D D^LRAUAW
- S Y=LR(63,12) D D^LRU S LRH=Y
- S LCT=0
- S:'LRTIU GROOT="^TMP(""LRAPBR"",$J,"
- S:LRTIU GROOT="^TMP(""TIUP"",$J,"
- K ^TMP("LRAPBR",$J)
- Q
- ;
- BODY ;Report body
- D:LRTIU GLENTRY("$TEXT",,1)
- S LR("F")=1
- I LRH(1)="" D
- .D GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
- .D GLENTRY(,,1)
- D MODAUCK
- ;Display supplementary report header if one or more has been added
- I $P($G(^LR(LRDFN,84,0)),U,4) D
- .S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
- .S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- .D GLENTRY(LRTEXT,,1)
- .S LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
- .S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- .D GLENTRY(LRTEXT,,1)
- D GLENTRY(,,1)
- F LRV=81,82,84 D
- .D:LRV'=84 GLENTRY(,,1)
- .D:LRV=81 GLENTRY(LRAU(1),0)
- .D:LRV=82 GLENTRY(LRAU(2),0)
- .I LRV'=84 D
- ..D GLENTRY(,,1)
- ..S LRFILE=63,LRIENS=LRDFN_","
- ..S LRFIELD=$S(LRV=81:32.2,1:32.3)
- ..D WP
- .I LRV=84 D
- ..N LRIENS1,LRIENS
- ..S LRFILE=63.324
- ..S LRA=0 F S LRA=$O(^LR(LRDFN,84,LRA)) Q:'LRA D
- ...S LRIENS1=LRA_","_LRDFN_","
- ...D GLENTRY("SUPPLEMENTARY REPORT DATE: ",0,1)
- ...S LRB=$$GET1^DIQ(LRFILE,LRIENS1,.01)
- ...D GLENTRY(LRB,BTAB)
- ...D:$P($G(^LR(LRDFN,84,LRA,2,0)),U,4) SUPA
- ...S LRFIELD=1,LRIENS=LRIENS1 D WP
- ...D GLENTRY(,,1)
- .I LRV'=84 D DASH,GLENTRY(,,1)
- D ^LRAPBR5
- Q
- ;
- WP ;Display word procesing fields
- K LRTMP,^UTILITY($J,"W")
- N LRX,DIWR,DIWL,LRA1
- S LRX=$$GET1^DIQ(LRFILE,LRIENS,LRFIELD,"","LRTMP","LRERR(1)")
- S DIWR=IOM-5,DIWL=5,DIWF=""
- S LRX=+$$GET1^DID(LRFILE,LRFIELD,"","SPECIFIER","LRERR(2)")
- I $$GET1^DID(LRX,.01,"","SPECIFIER","LRERR(2)")["L" S DIWF="N"
- S LRA1=0 F S LRA1=$O(LRTMP(LRA1)) Q:'LRA1 S X=LRTMP(LRA1) D ^DIWP
- S LRA1=0 F S LRA1=$O(^UTILITY($J,"W",DIWL,LRA1)) Q:'LRA1 D
- .D GLENTRY(^UTILITY($J,"W",DIWL,LRA1,0),DIWL,1)
- K ^UTILITY($J,"W")
- Q
- ;
- SUPA ;Print supplementary report audit information
- N LRFILE,LRIENS1,LRWP
- S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
- S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- D GLENTRY(LRTEXT,,1)
- S LRTEXT="(Added/Last" D GLENTRY(LRTEXT,0,1)
- S (A,B)=0 F S A=$O(^LR(LRDFN,84,LRA,2,A)) Q:'A D
- .S B=A
- Q:'$D(^LR(LRDFN,84,LRA,2,B,0))
- S A=^(0),Y=+A,LRSGN=" typed by ",LRDSC=" modified: ",A2=$P(A,"^",2)
- ;If supp rpt is released, display 'signed by' instead of 'typed by'
- I $P(A,"^",3) S LRSGN=" signed by ",LRDSC=" released: ",A2=$P(A,"^",3),Y=$P(A,"^",4)
- S A2=$S($D(^VA(200,A2,0)):$P(^(0),"^"),1:A2)
- ;S LRFILE=63.3242,LRIENS1=B_","_LRA_","_LRDFN_","
- ;D GETS^DIQ(LRFILE,LRIENS1,"*","","LRWP")
- ;S Y=LRWP(LRFILE,LRIENS1,.01)
- ;S A=LRWP(LRFILE,LRIENS1,.02)
- D D^LRU
- S LRTEXT=LRDSC_Y_LRSGN_A2_")" D GLENTRY(LRTEXT,BTAB)
- Q
- ;
- S LRQ=LRQ+1
- D:LRTIU GLENTRY("$APHDR",,1)
- F I=1:1:2 D GLENTRY(,,1)
- D DASH
- S LRTEXT="CLINICAL RECORD |" D GLENTRY(LRTEXT,5,1)
- S LRTEXT="AUTOPSY PROTOCOL" D GLENTRY(LRTEXT,40)
- D DASH
- S LRTEXT="Date died: "_LRH D GLENTRY(LRTEXT,0,1)
- S LRTEXT="| Autopsy date: "_LRH(1) D GLENTRY(LRTEXT,40)
- S LRTEXT="Resident: "_LRM(2) D GLENTRY(LRTEXT,0,1)
- S LRTEXT="| "_$E(LRS(3),1,13) D GLENTRY(LRTEXT,40)
- S LRTEXT="Autopsy No. "_$S(LRQ(8)'="":LRQ(8)_LRH(2)_" "_LRAC,1:LRAC)
- D GLENTRY(LRTEXT,56)
- D DASH
- Q
- ;
- MODAUCK ;Display modified banner if required
- S LRAPMR=$$GET1^DIQ(63,LRDFN,102,"I")
- Q:'LRAPMR
- S LRAPMD=$$GET1^DIQ(63,LRDFN,102.2,"I")
- D GLENTRY("","",1)
- S LRTEXT=""
- F LRCNT=1:1:$S(LRAPMD:29,1:31) D
- .S LRTEXT=LRTEXT_"*"
- S LRTEXT=LRTEXT_" MODIFIED "
- S LRTEXT=LRTEXT_$S(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
- F LRCNT=1:1:$S(LRAPMD:29,1:31) D
- .S LRTEXT=LRTEXT_"*"
- D GLENTRY(LRTEXT,"",1)
- D GLENTRY("","",1)
- 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
- ;
- D:LRTIU GLENTRY("$FTR",,1)
- D DASH
- D GLENTRY(,,1)
- I LRH(3)=""&(LRH(17)'="") D
- .S LRTEXT="| Provisional Anatomic Dx"
- .D GLENTRY(LRTEXT,55)
- S LRTEXT="Pathologist: "_LRM(3) D GLENTRY(LRTEXT,0,1)
- D GLENTRY(LRW(9),52)
- S LRTEXT="| Date " D GLENTRY(LRTEXT,55)
- S LRTEXT=$E($S(LRH(3)'="":LRH(3),1:LRH(17)),1,12) D GLENTRY(LRTEXT,BTAB)
- D DASH
- S LRTEXT=LRQ(1) D GLENTRY(LRTEXT,0,1)
- S LRTEXT="AUTOPSY PROTOCOL" D GLENTRY(LRTEXT,IOM-17)
- S LRTEXT="Patient: "_$E(LRP,1,30) D GLENTRY(LRTEXT,0,1)
- ; D GLENTRY(SSN,43),GLENTRY("SEX:"_SEX,56),GLENTRY("DOB:"_DOB,63)
- D GLENTRY(HRCN,43),GLENTRY("SEX:"_SEX,56),GLENTRY("DOB:"_DOB,63) ; IHS/MSC/MKK - LR*5.2*1031
- D GLENTRY($E(LRLLOC,1,22),0,1)
- S LRTEXT="Physician: "_$E(LRM(1),1,28) D GLENTRY(LRTEXT,23)
- S LRTEXT="AGE AT DEATH:"_$J(AGE,3) D GLENTRY(LRTEXT,63)
- Q
- ;
- DASH ;
- D GLENTRY(LR("%"),0,1)
- Q
- ;
- GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
- ;LRPR1 = Text to be written to global
- ;LRPR2 = Tab position
- ;LRPR3 = 1 means start a new line. Othewise, write on current line.
- S LRPR1=$G(LRPR1),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)
- D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
- D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
- Q
- ;
- VART1 ;Setup variables
- ;14;LRAC;I;AUTOPSY ACCESSION #
- ;13.5;LRM(2);I;RESIDENT PATHOLOGIST
- ;12.1;LRM(1);I;PHYSICIAN
- ;13.01;LRW(9);I;AUTOPSY TYPIST
- ;13.6;LRM(3);I;SENIOR PATHOLOGIST
- ;11;LRH(1);;AUTOPSY DATE/TIME
- ;11;LRH(2);I;AUTOPSY DATE/TIME 2 DIGIT YEAR
- ;13;LRH(3);;DATE AUTOPSY REPORT COMPLETED
- ;14.9;LRH(17);;PROVISIONAL ANAT DX DATE
- ;14.1;LRLLOC;I;LOCATION
- ;12.5;AGE;I;AGE AT DEATH
- ;14.5;LRSVC;;SERVICE
- ;13.7;LRS(3);;AUTOPSY TYPE
- ;Q
- LRAPBR4 ;DALOI/WTY/KLL - Autopsy Browser Display;7/27/01
- +1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- +2 ;
- +3 ;;VA LR Patch(s): 259,317
- +4 ;
- +5 ;Reference to ^DPT supported by IA #918
- +6 ;
- +7 QUIT
- +8 ;
- ENTER ; EP - Entry point
- +1 NEW LRTEXT,LRFILE,LRFIELD,LRTMP,LRFLG
- +2 DO INIT
- +3 IF '$DATA(^LR(LRDFN,LRSS))
- QUIT
- +4 DO HEADER
- +5 DO BODY
- +6 IF 'LRTIU
- DO POW
- +7 IF LRTIU
- DO ESIGLN^LRAPBR1
- +8 DO FOOTER
- +9 QUIT
- +10 ;
- INIT ;Initialize variables
- +1 SET X=^LR(LRDFN,0)
- DO ^LRUP
- +2 IF '$DATA(^LR(LRDFN,LRSS))
- QUIT
- +3 FOR LRTMP=1:1
- Begin DoDot:1
- +4 SET X=$TEXT(VART1+LRTMP)
- +5 SET LRFIELD=$PIECE(X,";",2)
- SET VAR=$PIECE(X,";",3)
- SET LRFLG=$PIECE(X,";",4)
- +6 IF LRFIELD="Q"
- QUIT
- +7 SET @VAR=$$GET1^DIQ(63,LRDFN_",",LRFIELD,LRFLG)
- +8 IF VAR["LRM"
- IF @VAR
- SET X=@VAR
- DO D^LRUA
- SET @VAR=X
- End DoDot:1
- IF LRFIELD="Q"
- QUIT
- +9 SET LRH(2)=$EXTRACT(LRH(2),2,3)
- +10 ;Get date of death (LRH)
- +11 SET DA=LRDFN
- DO D^LRAUAW
- +12 SET Y=LR(63,12)
- DO D^LRU
- SET LRH=Y
- +13 SET LCT=0
- +14 IF 'LRTIU
- SET GROOT="^TMP(""LRAPBR"",$J,"
- +15 IF LRTIU
- SET GROOT="^TMP(""TIUP"",$J,"
- +16 KILL ^TMP("LRAPBR",$JOB)
- +17 QUIT
- +18 ;
- BODY ;Report body
- +1 IF LRTIU
- DO GLENTRY("$TEXT",,1)
- +2 SET LR("F")=1
- +3 IF LRH(1)=""
- Begin DoDot:1
- +4 DO GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
- +5 DO GLENTRY(,,1)
- End DoDot:1
- +6 DO MODAUCK
- +7 ;Display supplementary report header if one or more has been added
- +8 IF $PIECE($GET(^LR(LRDFN,84,0)),U,4)
- Begin DoDot:1
- +9 SET LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
- +10 SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- +11 DO GLENTRY(LRTEXT,,1)
- +12 SET LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
- +13 SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- +14 DO GLENTRY(LRTEXT,,1)
- End DoDot:1
- +15 DO GLENTRY(,,1)
- +16 FOR LRV=81,82,84
- Begin DoDot:1
- +17 IF LRV'=84
- DO GLENTRY(,,1)
- +18 IF LRV=81
- DO GLENTRY(LRAU(1),0)
- +19 IF LRV=82
- DO GLENTRY(LRAU(2),0)
- +20 IF LRV'=84
- Begin DoDot:2
- +21 DO GLENTRY(,,1)
- +22 SET LRFILE=63
- SET LRIENS=LRDFN_","
- +23 SET LRFIELD=$SELECT(LRV=81:32.2,1:32.3)
- +24 DO WP
- End DoDot:2
- +25 IF LRV=84
- Begin DoDot:2
- +26 NEW LRIENS1,LRIENS
- +27 SET LRFILE=63.324
- +28 SET LRA=0
- FOR
- SET LRA=$ORDER(^LR(LRDFN,84,LRA))
- IF 'LRA
- QUIT
- Begin DoDot:3
- +29 SET LRIENS1=LRA_","_LRDFN_","
- +30 DO GLENTRY("SUPPLEMENTARY REPORT DATE: ",0,1)
- +31 SET LRB=$$GET1^DIQ(LRFILE,LRIENS1,.01)
- +32 DO GLENTRY(LRB,BTAB)
- +33 IF $PIECE($GET(^LR(LRDFN,84,LRA,2,0)),U,4)
- DO SUPA
- +34 SET LRFIELD=1
- SET LRIENS=LRIENS1
- DO WP
- +35 DO GLENTRY(,,1)
- End DoDot:3
- End DoDot:2
- +36 IF LRV'=84
- DO DASH
- DO GLENTRY(,,1)
- End DoDot:1
- +37 DO ^LRAPBR5
- +38 QUIT
- +39 ;
- WP ;Display word procesing fields
- +1 KILL LRTMP,^UTILITY($JOB,"W")
- +2 NEW LRX,DIWR,DIWL,LRA1
- +3 SET LRX=$$GET1^DIQ(LRFILE,LRIENS,LRFIELD,"","LRTMP","LRERR(1)")
- +4 SET DIWR=IOM-5
- SET DIWL=5
- SET DIWF=""
- +5 SET LRX=+$$GET1^DID(LRFILE,LRFIELD,"","SPECIFIER","LRERR(2)")
- +6 IF $$GET1^DID(LRX,.01,"","SPECIFIER","LRERR(2)")["L"
- SET DIWF="N"
- +7 SET LRA1=0
- FOR
- SET LRA1=$ORDER(LRTMP(LRA1))
- IF 'LRA1
- QUIT
- SET X=LRTMP(LRA1)
- DO ^DIWP
- +8 SET LRA1=0
- FOR
- SET LRA1=$ORDER(^UTILITY($JOB,"W",DIWL,LRA1))
- IF 'LRA1
- QUIT
- Begin DoDot:1
- +9 DO GLENTRY(^UTILITY($JOB,"W",DIWL,LRA1,0),DIWL,1)
- End DoDot:1
- +10 KILL ^UTILITY($JOB,"W")
- +11 QUIT
- +12 ;
- SUPA ;Print supplementary report audit information
- +1 NEW LRFILE,LRIENS1,LRWP
- +2 SET LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
- +3 SET LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
- +4 DO GLENTRY(LRTEXT,,1)
- +5 SET LRTEXT="(Added/Last"
- DO GLENTRY(LRTEXT,0,1)
- +6 SET (A,B)=0
- FOR
- SET A=$ORDER(^LR(LRDFN,84,LRA,2,A))
- IF 'A
- QUIT
- Begin DoDot:1
- +7 SET B=A
- End DoDot:1
- +8 IF '$DATA(^LR(LRDFN,84,LRA,2,B,0))
- QUIT
- +9 SET A=^(0)
- SET Y=+A
- SET LRSGN=" typed by "
- SET LRDSC=" modified: "
- SET A2=$PIECE(A,"^",2)
- +10 ;If supp rpt is released, display 'signed by' instead of 'typed by'
- +11 IF $PIECE(A,"^",3)
- SET LRSGN=" signed by "
- SET LRDSC=" released: "
- SET A2=$PIECE(A,"^",3)
- SET Y=$PIECE(A,"^",4)
- +12 SET A2=$SELECT($DATA(^VA(200,A2,0)):$PIECE(^(0),"^"),1:A2)
- +13 ;S LRFILE=63.3242,LRIENS1=B_","_LRA_","_LRDFN_","
- +14 ;D GETS^DIQ(LRFILE,LRIENS1,"*","","LRWP")
- +15 ;S Y=LRWP(LRFILE,LRIENS1,.01)
- +16 ;S A=LRWP(LRFILE,LRIENS1,.02)
- +17 DO D^LRU
- +18 SET LRTEXT=LRDSC_Y_LRSGN_A2_")"
- DO GLENTRY(LRTEXT,BTAB)
- +19 QUIT
- +20 ;
- +1 SET LRQ=LRQ+1
- +2 IF LRTIU
- DO GLENTRY("$APHDR",,1)
- +3 FOR I=1:1:2
- DO GLENTRY(,,1)
- +4 DO DASH
- +5 SET LRTEXT="CLINICAL RECORD |"
- DO GLENTRY(LRTEXT,5,1)
- +6 SET LRTEXT="AUTOPSY PROTOCOL"
- DO GLENTRY(LRTEXT,40)
- +7 DO DASH
- +8 SET LRTEXT="Date died: "_LRH
- DO GLENTRY(LRTEXT,0,1)
- +9 SET LRTEXT="| Autopsy date: "_LRH(1)
- DO GLENTRY(LRTEXT,40)
- +10 SET LRTEXT="Resident: "_LRM(2)
- DO GLENTRY(LRTEXT,0,1)
- +11 SET LRTEXT="| "_$EXTRACT(LRS(3),1,13)
- DO GLENTRY(LRTEXT,40)
- +12 SET LRTEXT="Autopsy No. "_$SELECT(LRQ(8)'="":LRQ(8)_LRH(2)_" "_LRAC,1:LRAC)
- +13 DO GLENTRY(LRTEXT,56)
- +14 DO DASH
- +15 QUIT
- +16 ;
- MODAUCK ;Display modified banner if required
- +1 SET LRAPMR=$$GET1^DIQ(63,LRDFN,102,"I")
- +2 IF 'LRAPMR
- QUIT
- +3 SET LRAPMD=$$GET1^DIQ(63,LRDFN,102.2,"I")
- +4 DO GLENTRY("","",1)
- +5 SET LRTEXT=""
- +6 FOR LRCNT=1:1:$SELECT(LRAPMD:29,1:31)
- Begin DoDot:1
- +7 SET LRTEXT=LRTEXT_"*"
- End DoDot:1
- +8 SET LRTEXT=LRTEXT_" MODIFIED "
- +9 SET LRTEXT=LRTEXT_$SELECT(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
- +10 FOR LRCNT=1:1:$SELECT(LRAPMD:29,1:31)
- Begin DoDot:1
- +11 SET LRTEXT=LRTEXT_"*"
- End DoDot:1
- +12 DO GLENTRY(LRTEXT,"",1)
- +13 DO GLENTRY("","",1)
- +14 QUIT
- +15 ;
- POW ;Determine POW or Persian Gulf status
- +1 IF $PIECE($GET(^LR(LRDFN,0)),"^",2)=2
- Begin DoDot:1
- +2 SET LRPOW=0
- +3 IF $DATA(^DPT(DFN,.52))
- IF $PIECE(^(.52),U,5)="Y"
- SET LRPOW=1
- +4 IF $DATA(^DPT(DFN,.322))
- IF $PIECE($GET(^(.322)),"^",10)="Y"
- SET LRPOW=1
- +5 DO ^LRAPBRPW
- +6 KILL LRPOW
- End DoDot:1
- +7 QUIT
- +8 ;
- +1 IF LRTIU
- DO GLENTRY("$FTR",,1)
- +2 DO DASH
- +3 DO GLENTRY(,,1)
- +4 IF LRH(3)=""&(LRH(17)'="")
- Begin DoDot:1
- +5 SET LRTEXT="| Provisional Anatomic Dx"
- +6 DO GLENTRY(LRTEXT,55)
- End DoDot:1
- +7 SET LRTEXT="Pathologist: "_LRM(3)
- DO GLENTRY(LRTEXT,0,1)
- +8 DO GLENTRY(LRW(9),52)
- +9 SET LRTEXT="| Date "
- DO GLENTRY(LRTEXT,55)
- +10 SET LRTEXT=$EXTRACT($SELECT(LRH(3)'="":LRH(3),1:LRH(17)),1,12)
- DO GLENTRY(LRTEXT,BTAB)
- +11 DO DASH
- +12 SET LRTEXT=LRQ(1)
- DO GLENTRY(LRTEXT,0,1)
- +13 SET LRTEXT="AUTOPSY PROTOCOL"
- DO GLENTRY(LRTEXT,IOM-17)
- +14 SET LRTEXT="Patient: "_$EXTRACT(LRP,1,30)
- DO GLENTRY(LRTEXT,0,1)
- +15 ; D GLENTRY(SSN,43),GLENTRY("SEX:"_SEX,56),GLENTRY("DOB:"_DOB,63)
- +16 ; IHS/MSC/MKK - LR*5.2*1031
- DO GLENTRY(HRCN,43)
- DO GLENTRY("SEX:"_SEX,56)
- DO GLENTRY("DOB:"_DOB,63)
- +17 DO GLENTRY($EXTRACT(LRLLOC,1,22),0,1)
- +18 SET LRTEXT="Physician: "_$EXTRACT(LRM(1),1,28)
- DO GLENTRY(LRTEXT,23)
- +19 SET LRTEXT="AGE AT DEATH:"_$JUSTIFY(AGE,3)
- DO GLENTRY(LRTEXT,63)
- +20 QUIT
- +21 ;
- DASH ;
- +1 DO GLENTRY(LR("%"),0,1)
- +2 QUIT
- +3 ;
- GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
- +1 ;LRPR1 = Text to be written to global
- +2 ;LRPR2 = Tab position
- +3 ;LRPR3 = 1 means start a new line. Othewise, write on current line.
- +4 SET LRPR1=$GET(LRPR1)
- SET LRPR2=+$GET(LRPR2)
- SET LRPR3=+$GET(LRPR3)
- +5 IF LRPR3
- DO NEWLN^LRAPUTL(LRPR1,LRPR2)
- +6 IF 'LRPR3
- DO GLBWRT^LRAPUTL(LRPR1,LRPR2)
- +7 QUIT
- +8 ;
- VART1 ;Setup variables
- +1 ;14;LRAC;I;AUTOPSY ACCESSION #
- +2 ;13.5;LRM(2);I;RESIDENT PATHOLOGIST
- +3 ;12.1;LRM(1);I;PHYSICIAN
- +4 ;13.01;LRW(9);I;AUTOPSY TYPIST
- +5 ;13.6;LRM(3);I;SENIOR PATHOLOGIST
- +6 ;11;LRH(1);;AUTOPSY DATE/TIME
- +7 ;11;LRH(2);I;AUTOPSY DATE/TIME 2 DIGIT YEAR
- +8 ;13;LRH(3);;DATE AUTOPSY REPORT COMPLETED
- +9 ;14.9;LRH(17);;PROVISIONAL ANAT DX DATE
- +10 ;14.1;LRLLOC;I;LOCATION
- +11 ;12.5;AGE;I;AGE AT DEATH
- +12 ;14.5;LRSVC;;SERVICE
- +13 ;13.7;LRS(3);;AUTOPSY TYPE
- +14 ;Q