Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPOLF0

RMPOLF0.m

Go to the documentation of this file.
  1. RMPOLF0 ;HIN CIOFO/RVD-DRIVER FOR HO LETTERS ;06/22/99
  1. ;;3.0;PROSTHETICS;**29,55,115,159**;Feb 09, 1996;Build 2
  1. ;
  1. ; ODJ - patch 55 - 1/29/01 - replace 121 hard code mail symbol with
  1. ; call to site param. extrinsic
  1. ; see nois AUG-1097-32118
  1. ;
  1. D HOME^%ZIS S RMPRIN=0
  1. K VADM,^TMP("RL",$J)
  1. S Y=DT D DD^%DT S NAME=Y D TRANS^RMPRUTL1 S (RMPODT,RMPODATE)=RMPRNAME
  1. D PIKSOM Q:$$QUIT I Y="" S VALMBCK="R" Q
  1. M ^TMP("RL",$J)=^TMP($J)
  1. S LFNS=Y I 'JOB D FULL^VALM1
  1. ;
  1. QUED ;
  1. F ZI=1:1:$L(LFNS,",")-1 D
  1. . S LFN=$P(LFNS,",",ZI) Q:LFN'>0
  1. . S RMPONAM="",CNT=0 F S RMPONAM=$O(^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
  1. .. S RMPOLTR=$P(^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
  1. .. S RMPODFN=$P(^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
  1. .. S RMDA=$P(^TMP("RL",$J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,3)
  1. .. S CNT=CNT+1
  1. .. S:CNT=LFN ^TMP("RL",$J,RMPOXITE,"LTR",RMPONAM)=RMPODFN_"^"_RMPOLTR_"^"_RMDA
  1. S (RMBLNK,RMPONAM)="",RMQUIT=0
  1. F S RMPONAM=$O(^TMP("RL",$J,RMPOXITE,"LTR",RMPONAM)) Q:RMPONAM=""!$G(RMQUIT) D CUM
  1. ;end
  1. EXIT ;
  1. K LFNS,LFN,ZI,RTN,DIR,RMLET,^TMP($J)
  1. K %X,RMPRFFL,RMPRHED,RMPRPRIN,%Y,RMPRDEL,RMPRRVA,DIC,RMPRFA,KILL,DIE,DA
  1. K DR,DIK,RMPR1,RMPR2,RMPRDATE,RMPRIN,RMPRL,RMPRNAME,RMPRU,RMPRDELE,FR
  1. K RMPREND,VADM,VAPA,VA,NAME,RMPRGO,NAME1,RMPONAM
  1. K RMPRDEN,RMPRFLAG,RMPRNAM1,RMPRNAM2,RMPRFF,J,RP,RO,RZ D KVAR^VADPT
  1. M ^TMP($J)=^TMP("RL",$J) K ^TMP("RL",$J)
  1. D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q:$D(ZTQUEUED)
  1. D HOME^%ZIS D CLEAN^VALM10,INIT^RMPOLT S VALMBCK="R"
  1. Q
  1. ;
  1. CUM ;
  1. K RMPRNT S RDATA=^TMP("RL",$J,RMPOXITE,"LTR",RMPONAM)
  1. S DFN=$P(RDATA,U,1),RMPOLTR=$P(RDATA,U,2),RMDA=$P(RDATA,U,3)
  1. S RMREC=^TMP("RL",$J,RMPOXITE,"RMPODEMO",DFN)
  1. S RMPORX=$P(RMREC,U,6) S:RMPORX="" RMPORX="Not on file"
  1. S RMPORXDT=$P(RMREC,U,4)
  1. I RMPORXDT="" S RMPORXDT="n/a"
  1. E S Y=RMPORXDT X ^DD("DD") S RMPORXDT=Y
  1. S RMPRFA=RMPOLTR
  1. D DEM^VADPT,ADD^VADPT
  1. F RI=1:1:21 S ^TMP($J,"DW",RI,0)=" "
  1. HEADER1 ;
  1. S RMPRHED=$G(^TMP("RL",$J,RMPOXITE,"HEADER",RMPOLTR))
  1. W @IOF I 'RMPRHED G HEADER
  1. S ^TMP($J,"DW",1,0)="|SETTAB(""C"")|"
  1. S ^TMP($J,"DW",2,0)="|TAB|Department of Veterans Affairs"
  1. 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)
  1. S ^TMP($J,"DW",3,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,0),U)
  1. S ^TMP($J,"DW",4,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,2),U,2)
  1. 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
  1. S ^TMP($J,"DW",9,0)="|SETTAB(5,50)||TAB|"_RMPODT
  1. S STATNID=$P(^RMPR(669.9,RMPOXITE,0),U,2) I $D(^DIC(4,STATNID,99)) S STATNID=$P(^DIC(4,STATNID,99),U)
  1. S ^TMP($J,"DW",11,0)="|TAB|"_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"|TAB|In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
  1. K STATNID
  1. S ^TMP($J,"DW",12,0)="|TAB|"_VAPA(1)
  1. 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)
  1. E S ^TMP($J,"DW",13,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)_"|TAB|"_VADM(1)
  1. ;
  1. S ^TMP($J,"DW",15,0)="|TAB|"_RMBLNK_"|TAB|"_DFN
  1. S ^TMP($J,"DW",16,0)="|TAB|"_RMBLNK_"|TAB|Current Home Oxygen Rx#: "_RMPORX
  1. S ^TMP($J,"DW",17,0)="|TAB|"_RMBLNK_"|TAB|Rx Expiration Date: "_RMPORXDT
  1. ;
  1. S NAME=$P(VADM(1),",")
  1. I $P(NAME," ",2)?1A.A D
  1. .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
  1. E D TRANS^RMPRUTL1
  1. D NAME^RMPOLF1
  1. Q
  1. QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
  1. Q
  1. PIKSOM ; ALLOW SELECTION FROM DISPLAYED ENTRIES
  1. K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR
  1. Q