source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI06.m

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1RMPRPI06 ;HIN/RVD-PRINT INVENTORY BALANCE BY HCPCS ;3/8/05 11:36
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 ; DBIA #10090 - Read Access to entire file #4.
4 ; DBIA #10096 - Access to all %ZOSF nodes.
5 ;
6 D DIV4^RMPRSIT I $D(Y),(Y<0) Q
7 S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
8 ;
9EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS
10 S DIC="^RMPR(661.1,",DIC(0)="AEQM"
11 S DIC("S")="I $D(^RMPR(661.1,+Y,0))"
12 ;
13EN1 ;
14 S RAS1="Enter 'ALL' for all HCPCS or 'RETURN' "
15 S RAS2="to select individual HCPCS: "
16 W !!,RAS1,RAS2
17 R RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1
18 G:RMENTER["?" EN1
19 S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y
20 I RMENTER="ALL" S RMPRI="*" G CONT
21 ;
22SEL W ! F RML=1:1 S DIC("A")="Select HCPCS "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D
23 .S RMI=$P(^RMPR(661.1,+Y,0),U,1)
24 .I $D(RMPRI(RMI)) W $C(7)," ??",?40,"..Duplicate HCPCS" S RML=RML-1 Q
25 .S RMPRI(RMI)=+Y
26 ;
27CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
28 I '$D(IO("Q")) U IO G PRINT
29 K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY"
30 S ZTRTN="PRINT^RMPRPI06",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPRI")=""
31 S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")=""
32 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
33 ;
34PRINT I $E(IOST)["C" W !!,"Processing report......."
35 S RMSUB="RM",RS=RMPR("STA")
36 ;call API
37 ;input variables:
38 ; RMSUB = 'RM' subscript
39 ; RS = rmpr("sta")
40 ; rmpri = an array of Location
41 ;S RMCHK=$$HBAL^RMPRPI01(RMSUB,RS,.RMPRI)
42 ;I RMCHK W !!,"*** Error in API RMPRPI01 !!!" G EXIT
43 D PROC^RMPRPI01(RMSUB,RS,.RMPRI)
44 ;
45 S RMPAGE=1,(RMTOBAL,RMPREND)=0
46 I '$D(^TMP($J,"RM")) D NONE G EXIT
47 W:$E(IOST)["C" @IOF
48 D HEAD,WRI
49 I RMSUF D TOTAL W !,"<End of Report>" G EXIT
50 ;
51 ;write/print report
52 ;rh = HCPCS
53 ;rl = Location
54 ;j = Item
55 ;k = Date
56 ;
57WRI S RH="",(RMPREND,RMSUF)=0 D HEAD1
58 F S RH=$O(^TMP($J,"RM",RH)) Q:(RH="")!(RMPREND) D:RMSUF TOTAL S (RVA,RTO)=0,RHO=RH K RMPRFLG S RI=0 F S RI=$O(^TMP($J,"RM",RH,RI)) Q:(RI'>0)!(RMPREND) S J=0 D
59 .F S J=$O(^TMP($J,"RM",RH,RI,J)) Q:(J'>0)!(RMPREND) S RMPRLOCN="" F S RMPRLOCN=$O(^TMP($J,"RM",RH,RI,J,RMPRLOCN)) Q:(RMPRLOCN="")!(RMPREND) D
60 ..S RMAST="",RMTMP=^TMP($J,"RM",RH,RI,J,RMPRLOCN),RMQTY=$P(RMTMP,U,1)
61 ..S RMVAL=$P(RMTMP,U,2),RMCOS=$P(RMTMP,U,3),RMVEN=$P(RMTMP,U,4)_" "
62 ..S RMIDE=$P(RMTMP,U,5),RMLOC=$P(RMTMP,U,6),RMUNI=$P(RMTMP,U,8)
63 ..;S RMDAT=$E(J,4,5)_"/"_$E(J,6,7)_"/"_$E(J,2,3)
64 ..S RMROR=$P(RMTMP,U,7)
65 ..S RMSOR=$P(RMTMP,U,9)
66 ..S:RMROR>RMQTY RMAST="*"
67 ..S:RMQTY="" RMQTY=0
68 ..S RTO=RTO+RMQTY,RVA=RVA+RMVAL
69 ..S RMITEM=RI,RMHCPC=RH,RMSUF=1
70 ..S RMIDE=$E(RMIDE,1,17)
71 ..W !,RH_"-"_RI,?10,RMIDE,?28,RMSOR,?31,$E(RMLOC,1,8),?40,$E(RMVEN,1,7)
72 ..W ?46,$J(RMROR,4),?52,RMUNI,?57,$J(RMQTY,4),?61,$J(RMCOS,8,2),?69,$J($FN(RMVAL,",",2),10)
73 ..S RMPRFLG=1
74 ..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
75 ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 K RMPRFLG Q
76 Q
77 ;
78TOTAL W !,?56,"=======================",!,?31,"Totals for ",RHO," = "
79 W ?54,$J(RTO,7),?69,$J($FN(RVA,",",2),10),!,RMPR("L")
80 S RMSUF=0,RTO=0
81 Q
82 ;
83HEAD W !,"*** PROSTHETICS INVENTORY BALANCE BY HCPCS ***"
84 W ?68,"PAGE: ",RMPAGE,!,"Run Date: ",RMDAT
85 W ?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20)
86 S RMPAGE=RMPAGE+1
87 Q
88 ;
89HEAD1 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
90 I $E(IOST)'["C"&($Y>(IOSL-6)) W @IOF D HEAD
91 W !,RMPR("L")
92 W !,?47,"RE-",?52,"UNIT"
93 W !,?46,"ORDER",?53,"OF",?65,"UNIT",?74,"TOTAL"
94 W !,"HCPCS",?10,"ITEM",?26,"SRC",?30,"LOCATION",?39,"VENDOR"
95 W ?46,"LEVEL",?52,"ISSUE",?59,"QTY",?65,"COST",?74,"VALUE"
96 W !,"-----",?10,"----",?26,"---",?30,"--------",?39,"------"
97 W ?46,"-----",?52,"-----",?59,"---",?65,"----",?73,"------"
98 S RMPRFLG=1
99 Q
100 ;
101EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
102 ;
103EXIT1 D ^%ZISC
104 N RMPR,RMPRSITE D KILL^XUSCLEAN
105 K ^TMP($J)
106 Q
107 ;
108NONE ;
109 W:$E(IOST)["C" @IOF
110 D HEAD W !!,"NO DATA !!!!!"
111 Q
Note: See TracBrowser for help on using the repository browser.