source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPBRPW.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1LRAPBRPW ;DALOI/WTY - POW Patient Browser Print;04/03/01
2 ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
3 ;
4MAIN ;Main subroutine
5 N LRTEXT
6 D:$$GET1^DIQ(2,DFN_",",.525,"I")="Y" POW
7 D:$$GET1^DIQ(2,DFN_",",.32201,"I")="Y" PERSGULF
8 Q
9POW ;Prisoner-of-War text
10 N LRCLOC
11 D GLENTRY("","",1)
12 S LRTEXT="*** THIS PATIENT WAS A PRISONER OF WAR ***"
13 D GLENTRY(LRTEXT,19,1)
14 F I=1:1:2 D GLENTRY("","",1)
15 S LRCLOC=$$GET1^DIQ(2,DFN_",",".526:.01")
16 D:LRCLOC'="" GLENTRY("POW PERIOD: "_LRCLOC,24)
17 D GLENTRY("","",1)
18 S LRTEXT="FORWARD A DUPLICATE SET OF SLIDES, BLOCKS AND REPRESENTATIVE "
19 S LRTEXT=LRTEXT_"WET TISSUE TO:"
20 D GLENTRY(LRTEXT,"",1)
21 D GLENTRY("","",1)
22 D GLENTRY("DIRECTOR,ARMED FORCES INSTITUTE OF PATHOLOGY",3,1)
23 D GLENTRY("ATTENTION: FORMER POW REGISTRY",3,1)
24 D GLENTRY("WASHINGTON, D.C. 20306",3,1)
25 S LRTEXT="<A POW label (VA Form 10-5558) may be attached to packaged "
26 S LRTEXT=LRTEXT_"specimens>"
27 D GLENTRY(LRTEXT,"",1)
28 D GLENTRY("","",1)
29 D GLENTRY("MARK CASE CLEARLY AS: FORMER POW "_LRCLOC,"",1)
30 S LRTEXT="NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE "
31 S LRTEXT=LRTEXT_"AFIP"
32 D GLENTRY(LRTEXT,"",1)
33 I $D(LRSS),LRSS="AU" D AUNOTE
34 F I=1:1:2 D GLENTRY("","",1)
35 Q
36AUNOTE ;Autopsy text
37 D GLENTRY("","",1)
38 S LRTEXT="Follow Guidelines for Performing Autopsy Examination on "
39 S LRTEXT=LRTEXT_"Former Prisoners of War (POW's) PROFESSIONAL "
40 S LRTEXT=LRTEXT_"SERVICES LETTER IL 11-82-17"
41 D GLENTRY(LRTEXT,"",1)
42 D GLENTRY("Be sure to take appropriate samples of:","",1)
43 S LRTEXT="BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"
44 D GLENTRY(LRTEXT,"",1)
45 Q
46PERSGULF ;Persian Gulf text
47 S LRTEXT="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"
48 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
49 D GLENTRY("","",1)
50 D GLENTRY(LRTEXT,"",1)
51 F I=1:1:2 D GLENTRY("","",1)
52 S LRTEXT=$$CJ^XLFSTR("***************",IOM)
53 D GLENTRY(LRTEXT,"",1)
54 D GLENTRY("","",1)
55 S LRTEXT="Send a set of DUPLICATE paraffin blocks/smears, "
56 S LRTEXT=LRTEXT_"H & E slides for "
57 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
58 D GLENTRY(LRTEXT,"",1)
59 D GLENTRY("","",1)
60 S LRTEXT="Anatomic Path material and a copy of the Final Pathology "
61 S LRTEXT=LRTEXT_"Report to "
62 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
63 D GLENTRY(LRTEXT,"",1)
64 D GLENTRY("","",1)
65 S LRTEXT=$$CJ^XLFSTR("the AFIP using the AFIP Requisition form. ",IOM)
66 D GLENTRY(LRTEXT,"",1)
67 F I=1:1:2 D GLENTRY("","",1)
68 S LRTEXT=$$CJ^XLFSTR("***************",IOM)
69 D GLENTRY(LRTEXT,"",1)
70 D GLENTRY("","",1)
71 Q
72GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
73 ;LRPR1 = Text to be written to global
74 ;LRPR2 = Tab position
75 ;LRPR3 = 1 means start a new line. Othewise, write an current line.
76 S LRPR3=+$G(LRPR3)
77 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
78 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
79 Q
Note: See TracBrowser for help on using the repository browser.