source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLF0A.m@ 824

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1RMPOLF0A ;HIN CIOFO/RVD-DRIVER FOR HO LETTERS(ALL) ;06/28/99
2 ;;3.0;PROSTHETICS;**29,55,115**;Feb 09, 1996
3 ;
4 ; ODJ - patch 55 - 29/1/01 - replace 121 hard coded mail code with call
5 ; to site param. extrinsic (AUG-1097-32118)
6 ;
7 D HOME^%ZIS S RMPRIN=0
8 S RMPRTFLG=1
9 S Y=DT D DD^%DT S NAME=Y D TRANS^RMPRUTL1 S (RMPODT,RMPODATE)=RMPRNAME
10 K ZTSAVE,^TMP("RL",$J) D FULL^VALM1
11 M ^TMP("RL",$J)=^TMP($J) K ^TMP($J)
12 ;
13QUED ;
14 S (RMBLNK,RMPONAM)="",RMQUIT=0 S:'$D(ZTQUEUED) RMIOST=IOST,RMIO=IO
15 F S RMPONAM=$O(^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM=""!$G(RMQUIT) D CUM
16 D PRALL^RMPOLF1
17 F RI=0:0 S RI=$O(^TMP("RL",$J,1,RI)) Q:RI'>0 S RMDFN=^TMP("RL",$J,1,RI) D
18 .I RMPOLCD="A" S $P(^RMPR(665,RMDFN,"RMPOA"),U,9)=DT,$P(^("RMPOA"),U,10)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT1") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT1",0)="^669.9002P^^^"
19 .I RMPOLCD="B" S $P(^RMPR(665,RMDFN,"RMPOA"),U,11)=DT,$P(^("RMPOA"),U,12)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT2") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT2",0)="^669.972P^^^"
20 .I RMPOLCD="C" S $P(^RMPR(665,RMDFN,"RMPOA"),U,13)=DT,$P(^("RMPOA"),U,14)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT3") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT3",0)="^669.974P^^^"
21 ;
22EXIT K LFNS,LFN,ZI,RTN,DIR,RMLET,RMPRTFLG,RMPRIN,RMIO,RMIOST,RMION,RMPONAM
23 K RMDAT,DFN,RMDA,RMPRFA,RMDFN,RI
24 M ^TMP($J)=^TMP("RL",$J) K ^TMP("RL",$J)
25 K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD)
26 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q:$D(ZTQUEUED)
27 D CLEAN^VALM10,INIT^RMPOLT,RE^VALM4
28 S VALMBCK="R"
29 Q
30 ;
31CUM ;
32 S RMDAT=^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)
33 S RMPOLTR=$P(RMDAT,U,1)
34 S DFN=$P(RMDAT,U,2)
35 S RMDA=$P(RMDAT,U,3)
36 S RMPRFA=RMPOLTR,RMPRTFLG=1
37 S RMREC=^TMP("RL",$J,RMPOXITE,"RMPODEMO",DFN)
38 S RMPORX=$P(RMREC,U,6) S:RMPORX="" RMPORX="Not on file"
39 S RMPORXDT=$P(RMREC,U,4)
40 I RMPORXDT="" S RMPORXDT="n/a"
41 E S Y=RMPORXDT X ^DD("DD") S RMPORXDT=Y
42 D DEM^VADPT,ADD^VADPT
43 F RI=1:1:21 S ^TMP($J,"DW",RI,0)=" "
44HEADER1 ;
45 S RMPRHED=$G(^TMP("RL",$J,RMPOXITE,"HEADER",RMPOLTR))
46 W @IOF I 'RMPRHED G HEADER
47 S ^TMP($J,"DW",1,0)="|SETTAB(""C"")|"
48 S ^TMP($J,"DW",2,0)="|TAB|Department of Veterans Affairs"
49 S NAME=$P(^RMPR(669.9,RMPOXITE,2),U,4) I NAME]"" S NAME=$S($D(^DIC(5,NAME)):$P(^DIC(5,NAME,0),U),1:"STATE") S RMFXN=$$PARS^RMPRUTL1(NAME)
50 S ^TMP($J,"DW",3,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,0),U)
51 S ^TMP($J,"DW",4,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,2),U,2)
52 S ^TMP($J,"DW",5,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,2),U,3)_", "_RMFXN_" "_$P(^RMPR(669.9,RMPOXITE,2),U,5) K RMFXN
53HEADER ;
54 S ^TMP($J,"DW",9,0)="|SETTAB(5,50)||TAB|"_RMPODT
55 S STATNID=$P(^RMPR(669.9,RMPOXITE,0),U,2) I $D(^DIC(4,STATNID,99)) S STATNID=$P(^DIC(4,STATNID,99),U)
56 S ^TMP($J,"DW",11,0)="|TAB|"_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"|TAB|In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
57 K STATNID
58 S ^TMP($J,"DW",12,0)="|TAB|"_VAPA(1)_"|TAB|SSN: "_$P(VADM(2),U,2)
59 I VAPA(2)]"" S ^TMP($J,"DW",13,0)="|TAB|"_VAPA(2)_"|TAB|"_VADM(1),^TMP($J,"DW",14,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)
60 E S ^TMP($J,"DW",13,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)_"|TAB|"_VADM(1)
61 S ^TMP($J,"DW",15,0)="|TAB|"_RMBLNK_"|TAB|"_DFN
62 S ^TMP($J,"DW",16,0)="|TAB|"_RMBLNK_"|TAB|Current Home Oxygen Rx#: "_RMPORX
63 S ^TMP($J,"DW",17,0)="|TAB|"_RMBLNK_"|TAB|Rx Expiration Date: "_RMPORXDT
64 ;
65 S NAME=$P(VADM(1),",")
66 I $P(NAME," ",2)?1A.A D
67 .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
68 E D TRANS^RMPRUTL1
69 D NAME^RMPOLF1
70 Q
Note: See TracBrowser for help on using the repository browser.