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