source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI14.m@ 1005

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1RMPRPI14 ;HIN/ODJ - ITEMS NOT ISSUED WITHIN 30-DAY ;3/9/05 07:34
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 RMTODAT=Y
8 S X="T-30" D ^%DT S RMD30=Y
9 ;
10EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS
11 S DIC="^RMPR(661.5,",DIC(0)="AEQ"
12 S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")"
13 ;
14EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1
15 G:RMENTER["?" EN1
16 S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y
17 I RMENTER="ALL" S RMPRI="*" G CONT
18 W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D
19 .S RMLOCI=+Y
20 .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q
21 .S RMPRI(RMLOCI)=""
22 ;
23CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
24 I '$D(IO("Q")) U IO G PRINT
25 K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY"
26 S ZTRTN="PRINT^RMPRPI14",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPRI")=""
27 S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMTODAT")="",ZTSAVE("RMPR(")=""
28 S ZTSAVE("RMD30")=""
29 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
30 ;
31PRINT I $E(IOST)["C" W !!,"Processing report....."
32 ;
33 ;call API
34 ;input variables:
35 ; RM = any subscript to be used
36 ; RS = rmpr("sta")
37 ; RMPRI = rmpri(location array)
38 ;
39 S RS=RMPR("STA"),RM="RM"
40 D PROC^RMPRPI02(RM,RS,.RMPRI)
41 ;
42 S RMPAGE=1,RMPREND=0,RMCNT=0
43 I '$D(^TMP($J,"RM")) D NONE G EXIT
44 W:$E(IOST)["C" @IOF
45 D HEAD,WRI
46 G EXIT
47 ;
48 ;write/print report
49 ;rl = Location
50 ;rh = HCPCS
51 ;j = Item
52 ;k = Date
53 ;
54WRI S RL=""
55 F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="",RLF=RL F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J=0 D
56 .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J'>0)!(RMPREND) S K=0 F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K'>0)!(RMPREND) D
57 ..Q:K>RMD30
58 ..S RM3=^TMP($J,"RM",RL,RH,J,K)
59 ..S RMFLG=0
60 ..F RDT=RMD30:0 S RDT=$O(^RMPR(661.6,"ASTHIDS",RS,3,RH,J,RDT)) Q:RDT'>0 I RDT>RMD30 S RMFLG=1 Q
61 ..Q:RMFLG=1!(K=1)
62 ..S RMIT=J
63 ..S RMDAT=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3)
64 ..S RMAST=""
65 ..S RMROR=$P(RM3,U,7)
66 ..S RMQTY=$P(RM3,U,1)
67 ..S RMCOS=$P(RM3,U,3)
68 ..S RMVAL=$P(RM3,U,2)
69 ..S RMVEN=$P(RM3,U,4)
70 ..S RMIDE=$P(RM3,U,5)
71 ..S RMSOR=$P(RM3,U,9)
72 ..S:RMROR>RMQTY RMAST="*"
73 ..S RLO=RL
74 ..I '$D(RMPRFLG) D HEAD1
75 ..S RMCNT=RMCNT+1
76 ..S RMIDE=$E(RMIDE,1,24)
77 ..W !,RH_"-"_RMIT,?10,RMIDE,?36,RMSOR,?39,$E(RMVEN,1,7),?47,RMDAT,?56,$J(RMQTY,4)
78 ..W ?61,$J(RMCOS,8,2),?69,$J($FN(RMVAL,",",2),10)
79 ..S RMPRFLG=1
80 ..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
81 ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
82 W:'$G(RMCNT) !!,"NO DATA TO PRINT!!!!",!!
83 W !,RMPR("L"),!,"<End of Report>"
84 Q
85 ;
86HEAD W !,"*** PROSTHETICS ITEMS NOT ISSUED WITHIN 30-DAY ***"
87 W ?68,"PAGE: ",RMPAGE
88 W !,"Run Date: ",RMTODAT,?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20)
89 S RMPAGE=RMPAGE+1
90 Q
91 ;
92HEAD1 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
93 I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD
94 W !,RMPR("L")
95 W !,"Location: ",RLO
96 W !,?48,"DATE",?65,"UNIT",?74,"TOTAL"
97 W !,"HCPCS",?10,"ITEM",?34,"SRC",?39,"VENDOR"
98 W ?47,"ENTERED",?57,"QTY",?65,"COST",?74,"VALUE"
99 W !,"-----",?10,"----",?34,"---",?39,"------"
100 W ?47,"-------",?57,"---",?65,"----",?73,"------"
101 S RMPRFLG=1
102 Q
103 ;
104EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
105 ;
106EXIT1 D ^%ZISC
107 N RMPR,RMPRSITE D KILL^XUSCLEAN
108 K ^TMP($J)
109 Q
110 ;
111NONE ;
112 W:$E(IOST)["C" @IOF
113 D HEAD
114 W !!,"NO DATA !!!!"
115 Q
Note: See TracBrowser for help on using the repository browser.