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

LRAPPOW.m

Go to the documentation of this file.
  1. LRAPPOW ;DALOI/REG/WTY - POW PATIENT LOOK-UP ;01/29/13 16:51
  1. ;;5.2;LAB SERVICE;**72,114,259,427**;Sep 27, 1994;Build 33
  1. ;
  1. ;Reference to ^DIC(22 supported by IA #935
  1. ;Reference to ^DPT supported by IA #918
  1. ;
  1. ;16-OCT-01;WTY;Unwrapped code and added device handling
  1. ;
  1. S:'$D(LRSF515) LRSF515=0
  1. S:'$D(LR("Q")) LR("Q")=0
  1. I $D(^DPT(DFN,.52)),$P(^(.52),U,5)="Y" D Q:LR("Q")
  1. .S X=$P(^(.52),U,6)
  1. .D FLG
  1. I $D(^DPT(DFN,.322)) D
  1. .S X=$P($G(^(.322)),"^",10)
  1. .D:X="Y" R
  1. Q
  1. FLG ;
  1. D PAGE Q:LR("Q")
  1. W !!?19,$C(7),"*** THIS PATIENT WAS A PRISONER OF WAR ***"
  1. D PAGE Q:LR("Q")
  1. W !!
  1. I X S X=$S($D(^DIC(22,X,0)):$P(^(0),U,1),1:"") W ?24,"POW PERIOD: ",X
  1. D PAGE Q:LR("Q")
  1. W !!,"FORWARD A DUPLICATE SET OF SLIDES,BLOCKS AND REPRESENTATIVE "
  1. W "WET TISSUE TO:"
  1. D PAGE Q:LR("Q")
  1. W !!,?3,"DIRECTOR,JOINT PATHOLOGY CENTER"
  1. D PAGE Q:LR("Q")
  1. W !,?3,"ATTENTION: FORMER POW REGISTRY"
  1. D PAGE Q:LR("Q")
  1. W !,?3,"606 STEPHEN SITTER AVENUE"
  1. D PAGE Q:LR("Q")
  1. W !,?3,"SILVER SPRING, MD 20910-1290",!,"<A POW label (VA Form 10-5558) may "
  1. W "be attached to packaged specimens>"
  1. D PAGE Q:LR("Q")
  1. W !!,"MARK CASE CLEARLY AS:"
  1. W " FORMER POW ",X
  1. D PAGE Q:LR("Q")
  1. W !,"NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE JPC"
  1. I $D(LRSS),LRSS="AU" D NOTE
  1. W !!
  1. Q
  1. NOTE ;
  1. D PAGE Q:LR("Q")
  1. W !!,"Follow Guidelines for Performing Autopsy Examination on Former "
  1. W "Prisoners of War (POW's) PROFESSIONAL SERVICES LETTER IL 11-82-17"
  1. D PAGE Q:LR("Q")
  1. W !,"Be sure to take appropriate samples of:"
  1. D PAGE Q:LR("Q")
  1. W !,"BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"
  1. Q
  1. R ;
  1. N LRTMP
  1. D PAGE Q:LR("Q")
  1. S LRTMP="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"
  1. W $C(7),!!,$$CJ^XLFSTR(LRTMP,IOM)
  1. D PAGE Q:LR("Q")
  1. W !!
  1. D PAGE Q:LR("Q")
  1. W !,$$CJ^XLFSTR("***************",IOM)
  1. D PAGE Q:LR("Q")
  1. S LRTMP="Send a set of DUPLICATE paraffin blocks/smears, "
  1. S LRTMP=LRTMP_"H & E slides for "
  1. W !!,$$CJ^XLFSTR(LRTMP,IOM)
  1. D PAGE Q:LR("Q")
  1. S LRTMP="Anatomic Path material and a copy of the Final Pathology "
  1. S LRTMP=LRTMP_"Report to "
  1. W !!,$$CJ^XLFSTR(LRTMP,IOM)
  1. D PAGE Q:LR("Q")
  1. W !!,$$CJ^XLFSTR("the JPC using the JPC Requisition form. ",IOM)
  1. D PAGE Q:LR("Q")
  1. W !!
  1. D PAGE Q:LR("Q")
  1. W !,$$CJ^XLFSTR("***************",IOM)
  1. D PAGE Q:LR("Q")
  1. W !
  1. Q
  1. PAGE ;
  1. Q:'LRSF515
  1. D:$Y>(IOSL-13) F^LRAPF,^LRAPF
  1. Q