source: FOIAVistA/trunk/r/SURGERY-SR/SROALET.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1SROALET ;BIR/MAM - PRINT 30 DAY LETTER ;01/31/07
2 ;;3.0; Surgery ;**38,63,95,98,113,153,160**;24 Jun 93;Build 7
3 K VADM,VAPA I $P($G(^SRF(SRTN,30)),"^")!'$P($G(^SRF(SRTN,.2)),"^",12) Q
4 S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^",6)["N" Q
5 I $P(SR("RA"),"^")="" Q
6 S DFN=$P(^SRF(SRTN,0),"^") S X=$G(^DPT(DFN,.35)) Q:$P(X,"^")'="" ; no letter if deceased
7 S VAINDT="NOW" D INP^VADPT I $G(VAIN(1)) Q ; no letter if inpatient
8 D DEM^VADPT,ADD^VADPT
9 S SRANAME=$P(VADM(1),"^"),X=$P(SRANAME,",")
10 S SRSP=$P($G(^SRF(SRTN,0)),"^",4),SRSP="Specialty: "_$E($P($G(^SRO(137.45,SRSP,0)),"^"),1,17) D
11 .I X["-" N SRNM,J,Z D Q
12 ..F J=1:1 S Z=$P(X,"-",J) Q:Z="" S SRNM(J)=$E(Z)_$TR($E(Z,2,$L(Z)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
13 ..S Y=SRNM(1) F J=2:1 Q:'$D(SRNM(J)) S Y=Y_"-"_SRNM(J)
14 .S Y=$E(X)_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
15 S TITLE=$S($P(VADM(5),"^")="F":"Ms. ",1:"Mr. "),SRANAME=TITLE_Y
16 S SRADATE=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)
17 S Y=DT D D^DIQ S SRDT=Y
18 S SEX=$P(VADM(5),"^")
19 S SRNM=$P(VADM(1),",",2)_" "_$P(VADM(1),",")
20 W:$Y @IOF W !!!!!!!!!!,?4,SRNM,?60,SRDT
21 N SRCCADD,SRSPF,SRADO S SRCCADD=0,SRSPF=1
22 S Y=$P(^SRF(SRTN,0),"^",9),SRADO=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) D CCADD
23 I 'SRCCADD S STATE="" I VAPA(5) S STATE=$P(^DIC(5,$P(VAPA(5),"^"),0),"^",2)
24 I 'SRCCADD D
25 .W !,?4,VAPA(1),?48,"Operation Date: ",SRADO
26 .I $G(VAPA(2))'="" W !,?4,VAPA(2),?48,SRSP S SRSPF=0
27 .I $G(VAPA(3))'="" W !,?4,VAPA(3) I SRSPF W ?48,SRSP S SRSPF=0
28 .I $G(VAPA(4))'="" W !,?4,VAPA(4)_", "_STATE_" "_VAPA(6) I SRSPF W ?48,SRSP S SRSPF=0
29 I SRSPF W !,?48,SRSP S SRSPF=0
30 W !!!,?4,"Dear "_SRANAME_","
31MM ;
32 N SRDIV S SRDIV=$$SITE^SROUTL0(SRTN) I 'SRDIV D DFLT Q
33 I '$O(^SRO(133,SRDIV,5,0)) D DFLT Q
34 W ! S SRLINE=0 F S SRLINE=$O(^SRO(133,SRDIV,5,SRLINE)) Q:'SRLINE W !,?4,^SRO(133,SRDIV,5,SRLINE,0)
35 Q
36DFLT W !!,?4,"One month ago, you had an operation at the VA Medical Center. We are",!,?4,"interested in how you feel. Have you had any health problems since your",!,?4,"operation ? We would like to hear from you. Please take a few minutes"
37 W !,?4,"to answer these questions and return this letter in the self-addressed",!,?4,"stamped envelope."
38 W !!,?4,"Have you been to a hospital or seen a doctor for any reason since your",!,?4,"operation ? ___ Yes ___ No"
39 W !!,?4,"If you answered NO, you do not need to answer any more questions. Please",!,?4,"return this sheet in the self-addressed stamped envelope."
40 W !!,?4,"If you have answered YES, please answer the following questions.",!!,?7,"1) Have you been seen in an outpatient clinic or doctor's office ? "
41 W !,?10,"___ Yes ___ No",!!,?10,"Why did you go to the clinic or doctor's office ? ________________"
42 W !!,?10,"Where ? (name and location) _____________________ Date ? ________"
43 W !!,?10,"Who was your doctor ? ____________________________________________"
44 W !!!,?7,"2) Were you admitted to a hospital ? ___ Yes ___ No",!!,?10,"Why did you go to the hospital ? _________________________________"
45 W !!,?10,"Where ? (name and location) _____________________ Date ? ________"
46 W !!,?10,"Who was your doctor ? ____________________________________________"
47 W !!!,?4,"Please return this letter whether or not you have had any medical problems.",!,?4,"Your health and opinion are important to us. Thank You.",!!,?4,"Sincerely,",!!!,?4,"Surgical Clinical Nurse Reviewer"
48 Q
49 ;
50CCADD ; Get Confidential Correspondence Address if one is active
51 ; and has the category "all other".
52 ;
53 N NSTATE S NSTATE=""
54 ; See if CC address exists
55 I '$G(VAPA(12)) Q
56 ; code to check the CC category in the variable array VAPA(22)
57 I $P($G(VAPA(22,5)),"^",3)'="Y" Q
58 ; if the category "All Other" is active, set SRCCADD=1 and print the CC address
59 S SRCCADD=1
60 S:$G(VAPA(17)) NSTATE=$P(^DIC(5,$P(VAPA(17),"^"),0),"^",2)
61 W:$G(VAPA(13))'="" !,?4,VAPA(13) W:$G(VAPA(14))'="" !,?4,VAPA(14) W:$G(VAPA(15))'="" !,?4,VAPA(15) W:$G(VAPA(16))'="" !,?4,VAPA(16)_", "_NSTATE_" "_$P(VAPA(18),"^",2)
62 Q
Note: See TracBrowser for help on using the repository browser.