SROALET ;BIR/MAM - PRINT 30 DAY LETTER ;01/31/07
;;3.0; Surgery ;**38,63,95,98,113,153,160**;24 Jun 93;Build 7
K VADM,VAPA I $P($G(^SRF(SRTN,30)),"^")!'$P($G(^SRF(SRTN,.2)),"^",12) Q
S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^",6)["N" Q
I $P(SR("RA"),"^")="" Q
S DFN=$P(^SRF(SRTN,0),"^") S X=$G(^DPT(DFN,.35)) Q:$P(X,"^")'="" ; no letter if deceased
S VAINDT="NOW" D INP^VADPT I $G(VAIN(1)) Q ; no letter if inpatient
D DEM^VADPT,ADD^VADPT
S SRANAME=$P(VADM(1),"^"),X=$P(SRANAME,",")
S SRSP=$P($G(^SRF(SRTN,0)),"^",4),SRSP="Specialty: "_$E($P($G(^SRO(137.45,SRSP,0)),"^"),1,17) D
.I X["-" N SRNM,J,Z D Q
..F J=1:1 S Z=$P(X,"-",J) Q:Z="" S SRNM(J)=$E(Z)_$TR($E(Z,2,$L(Z)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
..S Y=SRNM(1) F J=2:1 Q:'$D(SRNM(J)) S Y=Y_"-"_SRNM(J)
.S Y=$E(X)_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S TITLE=$S($P(VADM(5),"^")="F":"Ms. ",1:"Mr. "),SRANAME=TITLE_Y
S SRADATE=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)
S Y=DT D D^DIQ S SRDT=Y
S SEX=$P(VADM(5),"^")
S SRNM=$P(VADM(1),",",2)_" "_$P(VADM(1),",")
W:$Y @IOF W !!!!!!!!!!,?4,SRNM,?60,SRDT
N SRCCADD,SRSPF,SRADO S SRCCADD=0,SRSPF=1
S Y=$P(^SRF(SRTN,0),"^",9),SRADO=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) D CCADD
I 'SRCCADD S STATE="" I VAPA(5) S STATE=$P(^DIC(5,$P(VAPA(5),"^"),0),"^",2)
I 'SRCCADD D
.W !,?4,VAPA(1),?48,"Operation Date: ",SRADO
.I $G(VAPA(2))'="" W !,?4,VAPA(2),?48,SRSP S SRSPF=0
.I $G(VAPA(3))'="" W !,?4,VAPA(3) I SRSPF W ?48,SRSP S SRSPF=0
.I $G(VAPA(4))'="" W !,?4,VAPA(4)_", "_STATE_" "_VAPA(6) I SRSPF W ?48,SRSP S SRSPF=0
I SRSPF W !,?48,SRSP S SRSPF=0
W !!!,?4,"Dear "_SRANAME_","
MM ;
N SRDIV S SRDIV=$$SITE^SROUTL0(SRTN) I 'SRDIV D DFLT Q
I '$O(^SRO(133,SRDIV,5,0)) D DFLT Q
W ! S SRLINE=0 F S SRLINE=$O(^SRO(133,SRDIV,5,SRLINE)) Q:'SRLINE W !,?4,^SRO(133,SRDIV,5,SRLINE,0)
Q
DFLT 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"
W !,?4,"to answer these questions and return this letter in the self-addressed",!,?4,"stamped envelope."
W !!,?4,"Have you been to a hospital or seen a doctor for any reason since your",!,?4,"operation ? ___ Yes ___ No"
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."
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 ? "
W !,?10,"___ Yes ___ No",!!,?10,"Why did you go to the clinic or doctor's office ? ________________"
W !!,?10,"Where ? (name and location) _____________________ Date ? ________"
W !!,?10,"Who was your doctor ? ____________________________________________"
W !!!,?7,"2) Were you admitted to a hospital ? ___ Yes ___ No",!!,?10,"Why did you go to the hospital ? _________________________________"
W !!,?10,"Where ? (name and location) _____________________ Date ? ________"
W !!,?10,"Who was your doctor ? ____________________________________________"
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"
Q
;
CCADD ; Get Confidential Correspondence Address if one is active
; and has the category "all other".
;
N NSTATE S NSTATE=""
; See if CC address exists
I '$G(VAPA(12)) Q
; code to check the CC category in the variable array VAPA(22)
I $P($G(VAPA(22,5)),"^",3)'="Y" Q
; if the category "All Other" is active, set SRCCADD=1 and print the CC address
S SRCCADD=1
S:$G(VAPA(17)) NSTATE=$P(^DIC(5,$P(VAPA(17),"^"),0),"^",2)
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROALET 4103 printed Nov 22, 2024@17:50:41 Page 2
SROALET ;BIR/MAM - PRINT 30 DAY LETTER ;01/31/07
+1 ;;3.0; Surgery ;**38,63,95,98,113,153,160**;24 Jun 93;Build 7
+2 KILL VADM,VAPA
IF $PIECE($GET(^SRF(SRTN,30)),"^")!'$PIECE($GET(^SRF(SRTN,.2)),"^",12)
QUIT
+3 SET SR("RA")=$GET(^SRF(SRTN,"RA"))
IF $PIECE(SR("RA"),"^",6)["N"
QUIT
+4 IF $PIECE(SR("RA"),"^")=""
QUIT
+5 ; no letter if deceased
SET DFN=$PIECE(^SRF(SRTN,0),"^")
SET X=$GET(^DPT(DFN,.35))
if $PIECE(X,"^")'=""
QUIT
+6 ; no letter if inpatient
SET VAINDT="NOW"
DO INP^VADPT
IF $GET(VAIN(1))
QUIT
+7 DO DEM^VADPT
DO ADD^VADPT
+8 SET SRANAME=$PIECE(VADM(1),"^")
SET X=$PIECE(SRANAME,",")
+9 SET SRSP=$PIECE($GET(^SRF(SRTN,0)),"^",4)
SET SRSP="Specialty: "_$EXTRACT($PIECE($GET(^SRO(137.45,SRSP,0)),"^"),1,17)
Begin DoDot:1
+10 IF X["-"
NEW SRNM,J,Z
Begin DoDot:2
+11 FOR J=1:1
SET Z=$PIECE(X,"-",J)
if Z=""
QUIT
SET SRNM(J)=$EXTRACT(Z)_$TRANSLATE($EXTRACT(Z,2,$LENGTH(Z)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+12 SET Y=SRNM(1)
FOR J=2:1
if '$DATA(SRNM(J))
QUIT
SET Y=Y_"-"_SRNM(J)
End DoDot:2
QUIT
+13 SET Y=$EXTRACT(X)_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
End DoDot:1
+14 SET TITLE=$SELECT($PIECE(VADM(5),"^")="F":"Ms. ",1:"Mr. ")
SET SRANAME=TITLE_Y
+15 SET SRADATE=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)
+16 SET Y=DT
DO D^DIQ
SET SRDT=Y
+17 SET SEX=$PIECE(VADM(5),"^")
+18 SET SRNM=$PIECE(VADM(1),",",2)_" "_$PIECE(VADM(1),",")
+19 if $Y
WRITE @IOF
WRITE !!!!!!!!!!,?4,SRNM,?60,SRDT
+20 NEW SRCCADD,SRSPF,SRADO
SET SRCCADD=0
SET SRSPF=1
+21 SET Y=$PIECE(^SRF(SRTN,0),"^",9)
SET SRADO=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
DO CCADD
+22 IF 'SRCCADD
SET STATE=""
IF VAPA(5)
SET STATE=$PIECE(^DIC(5,$PIECE(VAPA(5),"^"),0),"^",2)
+23 IF 'SRCCADD
Begin DoDot:1
+24 WRITE !,?4,VAPA(1),?48,"Operation Date: ",SRADO
+25 IF $GET(VAPA(2))'=""
WRITE !,?4,VAPA(2),?48,SRSP
SET SRSPF=0
+26 IF $GET(VAPA(3))'=""
WRITE !,?4,VAPA(3)
IF SRSPF
WRITE ?48,SRSP
SET SRSPF=0
+27 IF $GET(VAPA(4))'=""
WRITE !,?4,VAPA(4)_", "_STATE_" "_VAPA(6)
IF SRSPF
WRITE ?48,SRSP
SET SRSPF=0
End DoDot:1
+28 IF SRSPF
WRITE !,?48,SRSP
SET SRSPF=0
+29 WRITE !!!,?4,"Dear "_SRANAME_","
MM ;
+1 NEW SRDIV
SET SRDIV=$$SITE^SROUTL0(SRTN)
IF 'SRDIV
DO DFLT
QUIT
+2 IF '$ORDER(^SRO(133,SRDIV,5,0))
DO DFLT
QUIT
+3 WRITE !
SET SRLINE=0
FOR
SET SRLINE=$ORDER(^SRO(133,SRDIV,5,SRLINE))
if 'SRLINE
QUIT
WRITE !,?4,^SRO(133,SRDIV,5,SRLINE,0)
+4 QUIT
DFLT WRITE !!,?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"
+1 WRITE !,?4,"to answer these questions and return this letter in the self-addressed",!,?4,"stamped envelope."
+2 WRITE !!,?4,"Have you been to a hospital or seen a doctor for any reason since your",!,?4,"operation ? ___ Yes ___ No"
+3 WRITE !!,?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."
+4 WRITE !!,?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 ? "
+5 WRITE !,?10,"___ Yes ___ No",!!,?10,"Why did you go to the clinic or doctor's office ? ________________"
+6 WRITE !!,?10,"Where ? (name and location) _____________________ Date ? ________"
+7 WRITE !!,?10,"Who was your doctor ? ____________________________________________"
+8 WRITE !!!,?7,"2) Were you admitted to a hospital ? ___ Yes ___ No",!!,?10,"Why did you go to the hospital ? _________________________________"
+9 WRITE !!,?10,"Where ? (name and location) _____________________ Date ? ________"
+10 WRITE !!,?10,"Who was your doctor ? ____________________________________________"
+11 WRITE !!!,?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"
+12 QUIT
+13 ;
CCADD ; Get Confidential Correspondence Address if one is active
+1 ; and has the category "all other".
+2 ;
+3 NEW NSTATE
SET NSTATE=""
+4 ; See if CC address exists
+5 IF '$GET(VAPA(12))
QUIT
+6 ; code to check the CC category in the variable array VAPA(22)
+7 IF $PIECE($GET(VAPA(22,5)),"^",3)'="Y"
QUIT
+8 ; if the category "All Other" is active, set SRCCADD=1 and print the CC address
+9 SET SRCCADD=1
+10 if $GET(VAPA(17))
SET NSTATE=$PIECE(^DIC(5,$PIECE(VAPA(17),"^"),0),"^",2)
+11 if $GET(VAPA(13))'=""
WRITE !,?4,VAPA(13)
if $GET(VAPA(14))'=""
WRITE !,?4,VAPA(14)
if $GET(VAPA(15))'=""
WRITE !,?4,VAPA(15)
if $GET(VAPA(16))'=""
WRITE !,?4,VAPA(16)_", "_NSTATE_" "_$PIECE(VAPA(18),"^",2)
+12 QUIT
