| 1 | RMPRFO ;PHX/RFM,HPL-DRIVER FOR PROSTHETIC LETTERS ; 1/5/04 1:41pm
|
|---|
| 2 | ;;3.0;PROSTHETICS;**55,77,82,105**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; ODJ - patch 55 - 1/29/01 - replace hard code 121 mail symbol with
|
|---|
| 5 | ; call to extrinsic to read site param.
|
|---|
| 6 | ; nois AUG-1097-32118
|
|---|
| 7 | ;RVD patch #77 - remove link to suspense
|
|---|
| 8 | ;KAM patch #82 - remove SSN from Patient Correspondence print
|
|---|
| 9 | N RMPRAA68 K ^TMP($J,1),^TMP($J,"RMPR") D HOME^%ZIS S RMPRIN=0
|
|---|
| 10 | K RMPRFF,DFN
|
|---|
| 11 | S RMPRDEL="S RMPRGO=$S($D(^RMPR(665.4,RMPRIN,0)):""DEL^RMPRFO1"",1:""EXIT^RMPRFO1"") G @RMPRGO"
|
|---|
| 12 | I '$D(RMPRFF)!($G(DFN)="") D DIV4^RMPRSIT G:$D(X) EXIT^RMPRFO1 S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select PATIENT: "
|
|---|
| 13 | I $D(RMPRFF)&($G(DFN)>0) S DIC="^DPT(",DIC(0)="N"
|
|---|
| 14 | D ^DIC G:Y<0 EXIT^RMPRFO1
|
|---|
| 15 | K DIC S DFN=+Y
|
|---|
| 16 | CUM K ^TMP($J,1),^TMP($J,"RMPR")
|
|---|
| 17 | S Y=DT D DD^%DT S NAME=Y D TRANS^RMPRUTL1 S RMPRDATE=RMPRNAME
|
|---|
| 18 | S DIC="^RMPR(665.2,",DIC(0)="AEMQ",DIC("A")="Select FORM LETTER TYPE: " D ^DIC G:Y<0 EXIT^RMPRFO1
|
|---|
| 19 | K DIC S RMPRFA=+Y
|
|---|
| 20 | S RMPRTY=$P(Y,U,2)
|
|---|
| 21 | I $P(^RMPR(665.2,RMPRFA,0),U,3) D VEN^RMPRFO3 D EXIT^RMPRFO1 Q
|
|---|
| 22 | D DEM^VADPT,ADD^VADPT
|
|---|
| 23 | F RI=1:1:17 S ^TMP($J,1,RI,0)=" "
|
|---|
| 24 | HEAD1 S %=1 W !,"Would you like a header on this letter" D YN^DICN S RMPRAA68=% G:RMPRAA68<0 EXIT^RMPRFO1
|
|---|
| 25 | I RMPRAA68=0 W !,"Answer `YES` for a header, `NO` for no header" G HEAD1
|
|---|
| 26 | W @IOF I RMPRAA68=2 S RMPRHED=1 G HEADER
|
|---|
| 27 | S ^TMP($J,1,1,0)="|SETTAB(""C"")|"
|
|---|
| 28 | S ^TMP($J,1,2,0)="|TAB|Department of Veterans Affairs"
|
|---|
| 29 | S NAME=$P(^RMPR(669.9,RMPRSITE,2),U,4) I NAME]"" S NAME=$S($D(^DIC(5,NAME)):$P(^DIC(5,NAME,0),U),1:"STATE") W $$PARS^RMPRUTL1(NAME)
|
|---|
| 30 | S ^TMP($J,1,3,0)="|TAB|"_$P(^RMPR(669.9,RMPRSITE,0),U)
|
|---|
| 31 | S ^TMP($J,1,4,0)="|TAB|"_$P(^RMPR(669.9,RMPRSITE,2),U,2)
|
|---|
| 32 | S ^TMP($J,1,5,0)="|TAB|"_$P(^RMPR(669.9,RMPRSITE,2),U,3)_", "_FIXDNAME_" "_$P(^RMPR(669.9,RMPRSITE,2),U,5) K FIXDNAME
|
|---|
| 33 | HEADER S ^TMP($J,1,9,0)="|SETTAB(5,50)||TAB|"_RMPRDATE
|
|---|
| 34 | I '$D(RMPRHED) D
|
|---|
| 35 | . S ^TMP($J,1,11,0)="|TAB|"_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"|TAB|In Reply Refer To: "_$$STA^RMPRUTIL_"/"_$$ROU^RMPRUTIL(RMPRSITE)
|
|---|
| 36 | . Q
|
|---|
| 37 | E D
|
|---|
| 38 | . S ^TMP($J,1,11,0)="|TAB|"_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"|TAB|"_" "_$$STA^RMPRUTIL_"/"_$$ROU^RMPRUTIL(RMPRSITE)
|
|---|
| 39 | . Q
|
|---|
| 40 | S ^TMP($J,1,12,0)="|TAB|"_VAPA(1)
|
|---|
| 41 | I VAPA(2)]"" S ^TMP($J,1,13,0)="|TAB|"_VAPA(2)_"|TAB|"_VADM(1),^TMP($J,1,14,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)
|
|---|
| 42 | E S ^TMP($J,1,13,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)_"|TAB|"_VADM(1)
|
|---|
| 43 | S NAME=$P(VADM(1),",")
|
|---|
| 44 | I $P(NAME," ",2)?1A.A D
|
|---|
| 45 | .S NAME1=NAME,NAME=$P(NAME," ",1) D TRANS^RMPRUTL1 S RMPRNAM1=RMPRNAME,NAME=NAME1,NAME=$P(NAME," ",2) D TRANS^RMPRUTL1 S RMPRNAM2=RMPRNAME,RMPRNAME=RMPRNAM1_" "_RMPRNAM2
|
|---|
| 46 | E D TRANS^RMPRUTL1
|
|---|
| 47 | G NAME^RMPRFO1
|
|---|
