56 lines
2.2 KiB
Mathematica
56 lines
2.2 KiB
Mathematica
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
|