source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI09.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1RMPRPI09 ;HIN/RVD-PRINT ORDER AND RECIEVE ITEM REPORT ;9/18/02 15:13
2 ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
3 ;
4 ;DBIA #800 - global read of file #440.
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 RMPRI S RMPREND=0 D HOME^%ZIS
10 ;
11TYPE ;select type of report
12 K DIR
13 S DIR(0)="S^1:30 Days Old or Less;2:60 Days Old or Less;3:90 Days Old or Less;4:Over 90 Days Old or Less "
14 S DIR("A")="Select number of days old",DIR("B")="30 Days Old or Less"
15 D ^DIR
16 I Y="",$D(DTOUT) G EXIT1
17 I Y="^"!(Y="^^") G EXIT1
18 S RMTY=Y
19 ;
20 ;
21CAT ;select STATUS of report
22 K DIR
23 S DIR(0)="S^O:OPEN;R:RECIEVED;C:CANCEL"
24 S DIR("A")="Select Category of report",DIR("B")="OPEN"
25 D ^DIR
26 I Y="",$D(DTOUT) G EXIT1
27 I Y="^"!(Y="^^") G EXIT1
28 S RMCAT=Y
29 K DIR
30 ;
31DT ;
32 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
33 I '$D(IO("Q")) U IO G PRINT
34 K IO("Q") S ZTDESC="PIP ORDER AND RECEIVE ITEM REPORT"
35 S ZTRTN="PRINT^RMPRPI09",ZTIO=ION,ZTSAVE("RMPR(")=""
36 S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")=""
37 S ZTSAVE("RMTY")="",ZTSAVE("RMDRA")="",ZTSAVE("RMCAT")=""
38 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
39 ;
40PRINT I $E(IOST)["C" W !!,"Processing report....."
41 K RMPRT,RMPRFLG,^TMP($J)
42 S RMCAL=$S(RMTY=1:30,RMTY=2:60,RMTY=3:90,RMTY=4:"OVER 90")
43 S X="T-"_RMCAL D ^%DT S RDT=Y-1 K Y S:'RDT RDT=0
44 S RMCAY=$S(RMCAT="O":"OPEN",RMCAT="R":"RECIEVED",RMCAT="C":"CANCEL")
45 S RS=RMPR("STA")
46 S RMPAGE=1,RMPREND=0
47 W:$E(IOST)["C" @IOF
48 D HEAD
49 G:RMCAT="R" REC
50 ;
51OPCA ;for open and cancel order
52 S RI=""
53 F STS=RMCAT,"R" Q:STS="R"&(RMCAT="C") F S RI=$O(^RMPR(661.41,"ASSHID",RS,STS,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK)) Q:RK'>0!RMPREND=1 D
54 .F RM=RDT:0 S RM=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
55 ..F RN=0:0 S RN=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 D
56 ...S RM3=$G(^RMPR(661.41,RN,0))
57 ...I $P(RM3,U,8)-$P(RM3,U,9)<1 Q
58 ...S ^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN)=""
59 ...Q
60 S RI=""
61 F S RI=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK)) Q:RK'>0!RMPREND=1 D
62 .F RM=RDT:0 S RM=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
63 ..F RN=0:0 S RN=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 D
64 ...S RM3=$G(^RMPR(661.41,RN,0))
65 ...S (RMVNAM,RMIDE)=""
66 ...S RMDOR=$P(RM3,U,1)
67 ...S RMIT=$P(RM3,U,2)
68 ...S RMVEN=$P(RM3,U,5)
69 ...S RMHCPC=$P(RM3,U,6)
70 ...S RMDRE=$P(RM3,U,7)
71 ...S RMQOR=$P(RM3,U,8)
72 ...S RMQRE=$P(RM3,U,9)
73 ...S RMCOM=$P(RM3,U,10)
74 ...S RMSTA=$P(RM3,U,11)
75 ...I '$D(RMPRFLG) D HEAD1
76 ...S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3)
77 ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3)
78 ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1)
79 ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
80 ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3)
81 ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?44,RMDOR,?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6)
82 ...W:RMCOM'="" !,?5,"Comment: ",RMCOM
83 ...S (RMPRFLG,RMPRT)=1
84 ...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
85 ...I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
86 W:$G(RMPRT) !,RMPR("L"),!,"<End of Report>"
87 G EXIT
88 ;
89REC ;process a Recieved order.
90 S RI=""
91 F S RI=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK)) Q:RK'>0!RMPREND=1 D
92 .F RM=RDT:0 S RM=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
93 ..F RN=0:0 S RN=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 F RP=0:0 S RP=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN,RP)) Q:RP'>0!RMPREND=1 D
94 ...S RM3=$G(^RMPR(661.6,RP,0))
95 ...S (RMVNAM,RMIDE)=""
96 ...S RMDOR=$P(RM3,U,1)
97 ...S RMIT=RK
98 ...S RMVEN=$P(RM3,U,12)
99 ...S RMHCPC=RI
100 ...S RMDRE=RM
101 ...S RMQOR=""
102 ...S RMQRE=$P(RM3,U,5)
103 ...S RMCOM=$P(RM3,U,8)
104 ...S RMSTA=RS
105 ...I '$D(RMPRFLG) D HEAD1
106 ...;S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3)
107 ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3)
108 ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1)
109 ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
110 ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3)
111 ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6)
112 ...W:RMCOM'="" !,?5,"Comment: ",RMCOM
113 ...S (RMPRFLG,RMPRT)=1
114 ...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
115 ...I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
116 W:$G(RMPRT) !,RMPR("L"),!,"<End of Report>"
117 G EXIT
118 ;
119HEAD W !,"*** PIP ORDER AND RECEIVE ITEM REPORT ***"," for ",RMCAL," days old or Less, ",RMCAY," order"
120 W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT
121 W ?68,"PAGE: ",RMPAGE
122 S RMPAGE=RMPAGE+1
123 Q
124 ;
125HEAD1 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
126 I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD
127 W !,RMPR("L")
128 W !,?45,"DATE",?56,"DATE",?66,"QTY",?75,"QTY"
129 W !,"HCPCS",?10,"ITEM",?31,"VENDOR",?44,"ORDERED",?54,"RECIEVED"
130 W ?64,"ORDERED",?72,"RECIEVED"
131 W !,"-----",?10,"----",?31,"------",?44,"-------",?54,"--------"
132 W ?64,"-------",?72,"--------"
133 S RMPRFLG=1
134 Q
135 ;
136EXIT W:'$G(RMPRT) !,RMPR("L"),!!,"No DATA to print !!!"
137 I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
138 ;
139EXIT1 D ^%ZISC
140 K ^TMP($J)
141 N RMPR,RMPRSITE D KILL^XUSCLEAN
142 Q
Note: See TracBrowser for help on using the repository browser.