source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI16.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1RMPRPI16 ;HINES OIFO/RVD-PRINT PIP/IFCAP ITEMS ;12/11/02 07:12
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 ;
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
8 ;
9 ;
10CONT S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
11 I '$D(IO("Q")) U IO G PRINT
12 K IO("Q") S ZTDESC="PROSTHETIC PIP/IFCAP ITEMS REPORT"
13 S ZTRTN="PRINT^RMPRPI16",ZTIO=ION,ZTSAVE("RMPR(""L"")")=""
14 S ZTSAVE("RMPR(""STA"")")=""
15 S ZTSAVE("RMDAT")=""
16 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
17 ;
18PRINT I $E(IOST)["C" W !!,"Processing report....."
19 ;
20 ;call API
21 ;input variables:
22 ; RM = any subscript to be used
23 ;
24 S RMSTAT=$$GETSTN^RMPRPIU0(RMPR("STA"))
25 S RM="RM"
26 F I=0:0 S I=$O(^RMPR(661.11,I)) Q:I'>0 D
27 .S RM11=$G(^RMPR(661.11,I,0)),RMHC=$P(RM11,U,1),RMIT=$P(RM11,U,2)
28 .S RMDE=$P(RM11,U,3),RMST=$P(RM11,U,4),RMIF=$P(RM11,U,8)
29 .Q:RMPR("STA")'=RMST
30 .S (RM44,RMIFIT)=""
31 .I $G(RMIF),$D(^RMPR(661,RMIF,0)) S RM44=$P(^RMPR(661,RMIF,0),U,1)
32 .I $G(RM44) S RMIFIT=$$GETITM^RMPRPIU0(RM44)
33 .S ^TMP($J,RM,RMSTAT,RMHC,RMIT)=RMDE_"^"_RMIFIT
34 ;
35 S RMPAGE=1,RMPREND=0
36 I '$D(^TMP($J,"RM")) D NONE G EXIT
37 W:$E(IOST)["C" @IOF
38 D HEAD,WRI
39 G EXIT
40 ;
41 ;write/print report
42 ;
43WRI S RS=""
44 F S RS=$O(^TMP($J,"RM",RS)) Q:(RS="")!(RMPREND) K RMPRFLG S RH="" F S RH=$O(^TMP($J,"RM",RS,RH)) Q:(RH="")!(RMPREND) S J=0 D
45 .F S J=$O(^TMP($J,"RM",RS,RH,J)) Q:(J'>0)!(RMPREND) D
46 ..S RM3=^TMP($J,"RM",RS,RH,J)
47 ..S RMIT=J
48 ..S RMITDE=$P(RM3,U,1)
49 ..S RMIFDE=$P(RM3,U,2)
50 ..S RSO=RS
51 ..I '$D(RMPRFLG) D HEAD1
52 ..S RMITDE=$E(RMITDE,1,20)
53 ..S RMIFDE=$E(RMIFDE,1,35)
54 ..W !,RH_"-"_RMIT,?16,RMITDE,?43,RMIFDE
55 ..S RMPRFLG=1
56 ..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
57 ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
58 W !,RMPR("L"),!,"<End of Report>"
59 Q
60 ;
61HEAD W !,"*** PROSTHETICS PIP/IFCAP ITEMS REPORT***"
62 W ?68,"PAGE: ",RMPAGE
63 W !,"Run Date: ",RMDAT,?35,"Station: ",RMSTAT,!
64 S RMPAGE=RMPAGE+1
65 Q
66 ;
67HEAD1 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
68 I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD
69 W !,RMPR("L")
70 W !,"HCPCS-ITEM",?16,"PIP ITEM",?43,"IFCAP ITEM"
71 W !,"----------",?16,"--------",?43,"----------"
72 S RMPRFLG=1
73 Q
74 ;
75EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
76 ;
77EXIT1 D ^%ZISC
78 N RMPR,RMPRSITE D KILL^XUSCLEAN
79 K ^TMP($J)
80 Q
81 ;
82NONE ;
83 W:$E(IOST)["C" @IOF
84 D HEAD
85 W !!,"NO DATA !!!!"
86 Q
Note: See TracBrowser for help on using the repository browser.