source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5N2.m@ 1093

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1RMPR5N2 ;HIN/RVD-PRINT INVENTORY BALANCE BY LOCATION ;3/17/03 13:19
2 ;;3.0;PROSTHETICS;**33,37,77**;Feb 09, 1996
3 ;RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION.
4 D DIV4^RMPRSIT I $D(Y),(Y<0) Q
5 S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
6 ;
7EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS S DIC="^RMPR(661.3,",DIC(0)="AEQ",DIC("S")="I $P(^RMPR(661.3,+Y,0),U,3)=RMPR(""STA"")"
8EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1
9 G:RMENTER["?" EN1
10 S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y I RMENTER="ALL" S RMPRI(0)=1 G CONT
11 W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D
12 .S RMLOCI=$P(^RMPR(661.3,+Y,0),U,1)
13 .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q
14 .S RMPRI(RMLOCI)=+Y
15CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 I '$D(IO("Q")) U IO G PRINT
16 K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY",ZTRTN="PRINT^RMPR5N2",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")=""
17 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
18 ;
19PRINT I $E(IOST)["C" W !!,"Processing report....."
20 S RMPAGE=1,RMPREND=0,RS=RMPR("STA") D:$D(RMPRI(0)) ALL
21 I '$D(RMPRI) D NONE G EXIT
22C S RB="" F S RB=$O(RMPRI(RB)) Q:RB="" Q:RMPREND S RMLIEN=RMPRI(RB) D CK
23 G:RMPREND EXIT
24 W:$E(IOST)["C" @IOF
25 D HEAD,WRI D:'$D(^TMP($J)) NONE G EXIT
26 ;
27CK Q:'$D(^RMPR(661.3,RMLIEN,1,0))
28 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
29 .S RMHCPC=$P(RMIT,"-",1),RMDAIT=$P(RMIT,"-",2),RMDAHC=$O(^RMPR(661.1,"B",RMHCPC,0)) Q:'RMDAHC
30 .S RM1=$G(^RMPR(661.1,RMDAHC,3,RMDAIT,0)),RMITEM=$P(RM1,U,1) Q:RM1=""
31 .S RMBA=$P(RM3,U,2),RMCO=$P(RM3,U,3),RMUNI=$P(RM3,U,4),RMVEN=$P(RM3,U,5)
32 .S RMRLE=$P(RM3,U,6),RMDI=$P(RM3,U,7),RMSO=$P(RM3,U,9),RMAV=$P(RM3,U,10)
33 .S ^TMP($J,RB,RMIT,RMITEM)=RMAV_"^"_RMBA_"^"_RMCO_"^"_RMUNI_"^"_RMVEN_"^"_RMRLE_"^"_RMDI_"^"_RMSO_"^"_RMLIEN
34 Q
35 ;write/print report
36WRI S RP="" F S RP=$O(^TMP($J,RP)) Q:RP="" Q:RMPREND K RMPRFLG S J="" F S J=$O(^TMP($J,RP,J)) Q:J="" Q:RMPREND S K="" F S K=$O(^TMP($J,RP,J,K)) Q:K="" Q:RMPREND S RMAST="",RM3=^TMP($J,RP,J,K) D
37 .I '$D(RMPRFLG) D HEAD1
38 .S RMLODA=$P(RM3,U,9)
39 .S RMIT=J
40 .S RMITEM=K
41 .S RMAV=$P(RM3,U,1)
42 .S RMBA=$P(RM3,U,2)
43 .S RMCO=$P(RM3,U,3)
44 .S RMUNI=$P(RM3,U,4)
45 .S RMVEN=$P(RM3,U,5)
46 .S RMRLE=$P(RM3,U,6)
47 .S RMDI=$P(RM3,U,7)
48 .S RMSO=$P(RM3,U,8)
49 .S:RMUNI RMUNI=$P($G(^PRCD(420.5,RMUNI,0)),U,1)
50 .S:RMVEN RMVEN=$P($G(^PRC(440,RMVEN,0)),U,1)
51 .S RMITEM=$E(RMITEM,1,27),RMVEN=$E(RMVEN,1,12)
52 .S:RMBA<RMRLE RMAST="*"
53 .;I RMSO="V" W !,RMHCPC,?9,RMITEM,?37,RMSO,?41,RMVEN,?55,RMUNI,?74,$J(RMBA,5)
54 .;I RMSO="C" W !,RMHCPC,?9,RMITEM,?37,RMSO,?41,RMVEN,?55,RMUNI,?58,$J(RMRLE,4),?65,$J(RMAV,8,2),?74,$J(RMBA,5),RMAST
55 .W !,RMIT,?9,RMITEM,?37,RMSO,?41,RMVEN,?55,RMUNI,?58,$J(RMRLE,4),?65,$J(RMAV,8,2),?74,$J(RMBA,5),RMAST
56 .S RMPRFLG=1
57 .I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q
58 .I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
59 Q
60 ;
61HEAD W !,"*** PROSTHETICS INVENTORY BALANCE BY LOCATION ***",?68,"PAGE: ",RMPAGE,!,"Run Date: ",RMDAT,?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20)
62 S RMPAGE=RMPAGE+1
63 Q
64 ;
65HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD
66 I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD
67 W !,RMPR("L")
68 W !,"Location: ",RP
69 W !,?54,"UNIT",?60,"RE-"
70 W !,?55,"OF",?59,"ORDER",?68,"AVG",?75,"CUR"
71 W !,"HCPCS",?9,"ITEM",?36,"SRC",?41,"VENDOR",?53,"ISSUE",?59,"LEVEL",?68,"COST",?75,"BAL"
72 W !,"-----",?9,"----",?36,"---",?41,"------",?53,"-----",?59,"-----",?67,"------",?74,"-----"
73 S RMPRFLG=1
74 Q
75 ;
76ALL ;PROCESS ALL LOCATION
77 K RMPRI(0) S RML="" F S RML=$O(^RMPR(661.3,"B",RML)) Q:RML="" D
78 .S RLOC=$O(^RMPR(661.3,"B",RML,0))
79 .I $P($G(^RMPR(661.3,RLOC,0)),U,3)=RMPR("STA") S RMPRI(RML)=RLOC
80 Q
81 ;
82EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
83EXIT1 D ^%ZISC
84 N RMPR,RMPRSITE D KILL^XUSCLEAN
85 Q
86NONE W !!,"NO DATA !!!!"
87 Q
Note: See TracBrowser for help on using the repository browser.