source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5SRV.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1RMPR5SRV ;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 ;
6EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0
7 ;
8 S RMPREND=0 D ALL
9 I '$D(RMPRI) D NONE G EXIT
10C 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 ;
14CK 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.
23WRI 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 ;
44ALL ;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 ;
50EXIT ;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
54NONE S ^TMP($J,0)="NO DATA FOR THIS DATE RANGE"
55 Q
Note: See TracBrowser for help on using the repository browser.