RMPR5SRV ;HIN/RVD-PROS INVENTORY SERVER ;7/23/99
 ;;3.0;PROSTHETICS;**37**;Feb 09, 1996
 ;D DIV4^RMPRSIT I $D(Y),(Y<0) Q
 S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
 ;
EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0
 ;
 S RMPREND=0 D ALL
 I '$D(RMPRI) D NONE G EXIT
C F RMSTA=0:0 S RMSTA=$O(RMPRI(RMSTA)) Q:RMSTA'>0  S RB="" F  S RB=$O(RMPRI(RMSTA,RB)) Q:RB=""  Q:RMPREND  S RMLIEN=RMPRI(RMSTA,RB) D CK
 G:RMPREND EXIT
 D WRI D:'$D(^TMP($J)) NONE G EXIT
 ;
CK Q:'$D(^RMPR(661.3,RMLIEN,1,0))
 F J=0:0 S J=$O(^RMPR(661.3,RMLIEN,1,J)) Q:J'>0  F K=0:0 S K=$O(^RMPR(661.3,RMLIEN,1,J,1,K)) Q:K'>0  S RM3=$G(^RMPR(661.3,RMLIEN,1,J,1,K,0)),RMIT=$P(RM3,U,1) D
 .S RMHCPC=$P(RMIT,"-",1),RMDAIT=$P(RMIT,"-",2),RMDAHC=$O(^RMPR(661.1,"B",RMHCPC,0)) Q:'RMDAHC
 .S RM1=$G(^RMPR(661.1,RMDAHC,3,RMDAIT,0)),RMITEM=$P(RM1,U,1) Q:RM1=""
 .S RMBA=$P(RM3,U,2),RMCO=$P(RM3,U,3),RMUNI=$P(RM3,U,4),RMVEN=$P(RM3,U,5)
 .S RMRLE=$P(RM3,U,6),RMDI=$P(RM3,U,7),RMSO=$P(RM3,U,9),RMAV=$P(RM3,U,10)
 .S ^TMP($J,"RM",RB,RMIT,RMITEM)=RMAV_"^"_RMBA_"^"_RMCO_"^"_RMUNI_"^"_RMVEN_"^"_RMRLE_"^"_RMDI_"^"_RMSO_"^"_RMLIEN_"^"_RMSTA
 Q
 ;Set Tmp global for mailman message.
WRI S RP="",RIJ=0 F  S RP=$O(^TMP($J,"RM",RP)) Q:RP=""  S RMLOC=RP K RMPRFLG S J="" F  S J=$O(^TMP($J,"RM",RP,J)) Q:J=""  S K="" F  S K=$O(^TMP($J,"RM",RP,J,K)) Q:K=""  S RMAST="",RM3=^TMP($J,"RM",RP,J,K) D
 .S RMLODA=$P(RM3,U,9)
 .S RMIT=J
 .S RMITEM=K
 .S RMAV=$P(RM3,U,1)
 .S RMBA=$P(RM3,U,2)
 .S RMCO=$P(RM3,U,3)
 .S RMUNI=$P(RM3,U,4)
 .S RMVEN=$P(RM3,U,5)
 .S RMRLE=$P(RM3,U,6)
 .S RMDI=$P(RM3,U,7)
 .S RMSO=$P(RM3,U,8)
 .S RMST=$P(RM3,U,10)
 .S:RMUNI RMUNI=$P($G(^PRCD(420.5,RMUNI,0)),U,1)
 .S:RMVEN RMVEN=$P($G(^PRC(440,RMVEN,0)),U,1)
 .S RMITEM=$E(RMITEM,1,27),RMVEN=$E(RMVEN,1,12)
 .S RIJ=RIJ+1
 .S ^TMP($J,RIJ)=RMST_"^"_RMLOC_"^"_RMIT_"^"_RMITEM_"^"_RMSO_"^"_RMVEN_"^"_RMUNI_"^"_RMRLE_"^"_RMAV_"^"_RMBA
 .S RMPRFLG=1
 Q
 ;
ALL ;PROCESS ALL LOCATION
 K RMPRI(0) S RML="" F  S RML=$O(^RMPR(661.3,"B",RML)) Q:RML=""  D
 .S RLOC=$O(^RMPR(661.3,"B",RML,0))
 .S RMSTA=$P($G(^RMPR(661.3,RLOC,0)),U,3) S RMPRI(RMSTA,RML)=RLOC
 Q
 ;
EXIT ;I $E(IOST)["C" W ! S DIR(0)="E" D ^DIR
 D ^%ZISC K ^TMP($J,"RM")
 N RMPR,RMPRSITE D KILL^XUSCLEAN
 Q
NONE S ^TMP($J,0)="NO DATA FOR THIS DATE RANGE"
 Q