| 1 | RMPRPI16 ;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 |  ;
 | 
|---|
| 7 | EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 | CONT 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 |  ;
 | 
|---|
| 18 | PRINT 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 |  ;
 | 
|---|
| 43 | WRI 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 |  ;
 | 
|---|
| 61 | HEAD 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 |  ;
 | 
|---|
| 67 | HEAD1 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 |  ;
 | 
|---|
| 75 | EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | EXIT1 D ^%ZISC
 | 
|---|
| 78 |  N RMPR,RMPRSITE D KILL^XUSCLEAN
 | 
|---|
| 79 |  K ^TMP($J)
 | 
|---|
| 80 |  Q
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 | NONE ;
 | 
|---|
| 83 |  W:$E(IOST)["C" @IOF
 | 
|---|
| 84 |  D HEAD
 | 
|---|
| 85 |  W !!,"NO DATA !!!!"
 | 
|---|
| 86 |  Q
 | 
|---|