1 | LRAPBRPW ;DALOI/WTY - POW Patient Browser Print;04/03/01
|
---|
2 | ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
|
---|
3 | ;
|
---|
4 | MAIN ;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
|
---|
9 | POW ;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
|
---|
36 | AUNOTE ;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
|
---|
46 | PERSGULF ;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
|
---|
72 | GLENTRY(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
|
---|