| 1 | RMPR5SRV ;HIN/RVD-PROS INVENTORY SERVER ;7/23/99
|
|---|
| 2 | ;;3.0;PROSTHETICS;**37**;Feb 09, 1996
|
|---|
| 3 | ;D DIV4^RMPRSIT I $D(Y),(Y<0) Q
|
|---|
| 4 | S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
|
|---|
| 5 | ;
|
|---|
| 6 | EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0
|
|---|
| 7 | ;
|
|---|
| 8 | S RMPREND=0 D ALL
|
|---|
| 9 | I '$D(RMPRI) D NONE G EXIT
|
|---|
| 10 | 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
|
|---|
| 11 | G:RMPREND EXIT
|
|---|
| 12 | D WRI D:'$D(^TMP($J)) NONE G EXIT
|
|---|
| 13 | ;
|
|---|
| 14 | CK Q:'$D(^RMPR(661.3,RMLIEN,1,0))
|
|---|
| 15 | 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
|
|---|
| 16 | .S RMHCPC=$P(RMIT,"-",1),RMDAIT=$P(RMIT,"-",2),RMDAHC=$O(^RMPR(661.1,"B",RMHCPC,0)) Q:'RMDAHC
|
|---|
| 17 | .S RM1=$G(^RMPR(661.1,RMDAHC,3,RMDAIT,0)),RMITEM=$P(RM1,U,1) Q:RM1=""
|
|---|
| 18 | .S RMBA=$P(RM3,U,2),RMCO=$P(RM3,U,3),RMUNI=$P(RM3,U,4),RMVEN=$P(RM3,U,5)
|
|---|
| 19 | .S RMRLE=$P(RM3,U,6),RMDI=$P(RM3,U,7),RMSO=$P(RM3,U,9),RMAV=$P(RM3,U,10)
|
|---|
| 20 | .S ^TMP($J,"RM",RB,RMIT,RMITEM)=RMAV_"^"_RMBA_"^"_RMCO_"^"_RMUNI_"^"_RMVEN_"^"_RMRLE_"^"_RMDI_"^"_RMSO_"^"_RMLIEN_"^"_RMSTA
|
|---|
| 21 | Q
|
|---|
| 22 | ;Set Tmp global for mailman message.
|
|---|
| 23 | 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
|
|---|
| 24 | .S RMLODA=$P(RM3,U,9)
|
|---|
| 25 | .S RMIT=J
|
|---|
| 26 | .S RMITEM=K
|
|---|
| 27 | .S RMAV=$P(RM3,U,1)
|
|---|
| 28 | .S RMBA=$P(RM3,U,2)
|
|---|
| 29 | .S RMCO=$P(RM3,U,3)
|
|---|
| 30 | .S RMUNI=$P(RM3,U,4)
|
|---|
| 31 | .S RMVEN=$P(RM3,U,5)
|
|---|
| 32 | .S RMRLE=$P(RM3,U,6)
|
|---|
| 33 | .S RMDI=$P(RM3,U,7)
|
|---|
| 34 | .S RMSO=$P(RM3,U,8)
|
|---|
| 35 | .S RMST=$P(RM3,U,10)
|
|---|
| 36 | .S:RMUNI RMUNI=$P($G(^PRCD(420.5,RMUNI,0)),U,1)
|
|---|
| 37 | .S:RMVEN RMVEN=$P($G(^PRC(440,RMVEN,0)),U,1)
|
|---|
| 38 | .S RMITEM=$E(RMITEM,1,27),RMVEN=$E(RMVEN,1,12)
|
|---|
| 39 | .S RIJ=RIJ+1
|
|---|
| 40 | .S ^TMP($J,RIJ)=RMST_"^"_RMLOC_"^"_RMIT_"^"_RMITEM_"^"_RMSO_"^"_RMVEN_"^"_RMUNI_"^"_RMRLE_"^"_RMAV_"^"_RMBA
|
|---|
| 41 | .S RMPRFLG=1
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ALL ;PROCESS ALL LOCATION
|
|---|
| 45 | K RMPRI(0) S RML="" F S RML=$O(^RMPR(661.3,"B",RML)) Q:RML="" D
|
|---|
| 46 | .S RLOC=$O(^RMPR(661.3,"B",RML,0))
|
|---|
| 47 | .S RMSTA=$P($G(^RMPR(661.3,RLOC,0)),U,3) S RMPRI(RMSTA,RML)=RLOC
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | EXIT ;I $E(IOST)["C" W ! S DIR(0)="E" D ^DIR
|
|---|
| 51 | D ^%ZISC K ^TMP($J,"RM")
|
|---|
| 52 | N RMPR,RMPRSITE D KILL^XUSCLEAN
|
|---|
| 53 | Q
|
|---|
| 54 | NONE S ^TMP($J,0)="NO DATA FOR THIS DATE RANGE"
|
|---|
| 55 | Q
|
|---|
