Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPI16

RMPRPI16.m

Go to the documentation of this file.
  1. RMPRPI16 ;HINES OIFO/RVD-PRINT PIP/IFCAP ITEMS ;12/11/02 07:12
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. ;
  1. D DIV4^RMPRSIT I $D(Y),(Y<0) Q
  1. S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
  1. ;
  1. EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS
  1. ;
  1. ;
  1. CONT S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
  1. I '$D(IO("Q")) U IO G PRINT
  1. K IO("Q") S ZTDESC="PROSTHETIC PIP/IFCAP ITEMS REPORT"
  1. S ZTRTN="PRINT^RMPRPI16",ZTIO=ION,ZTSAVE("RMPR(""L"")")=""
  1. S ZTSAVE("RMPR(""STA"")")=""
  1. S ZTSAVE("RMDAT")=""
  1. D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
  1. ;
  1. PRINT I $E(IOST)["C" W !!,"Processing report....."
  1. ;
  1. ;call API
  1. ;input variables:
  1. ; RM = any subscript to be used
  1. ;
  1. S RMSTAT=$$GETSTN^RMPRPIU0(RMPR("STA"))
  1. S RM="RM"
  1. F I=0:0 S I=$O(^RMPR(661.11,I)) Q:I'>0 D
  1. .S RM11=$G(^RMPR(661.11,I,0)),RMHC=$P(RM11,U,1),RMIT=$P(RM11,U,2)
  1. .S RMDE=$P(RM11,U,3),RMST=$P(RM11,U,4),RMIF=$P(RM11,U,8)
  1. .Q:RMPR("STA")'=RMST
  1. .S (RM44,RMIFIT)=""
  1. .I $G(RMIF),$D(^RMPR(661,RMIF,0)) S RM44=$P(^RMPR(661,RMIF,0),U,1)
  1. .I $G(RM44) S RMIFIT=$$GETITM^RMPRPIU0(RM44)
  1. .S ^TMP($J,RM,RMSTAT,RMHC,RMIT)=RMDE_"^"_RMIFIT
  1. ;
  1. S RMPAGE=1,RMPREND=0
  1. I '$D(^TMP($J,"RM")) D NONE G EXIT
  1. W:$E(IOST)["C" @IOF
  1. D HEAD,WRI
  1. G EXIT
  1. ;
  1. ;write/print report
  1. ;
  1. WRI S RS=""
  1. 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
  1. .F S J=$O(^TMP($J,"RM",RS,RH,J)) Q:(J'>0)!(RMPREND) D
  1. ..S RM3=^TMP($J,"RM",RS,RH,J)
  1. ..S RMIT=J
  1. ..S RMITDE=$P(RM3,U,1)
  1. ..S RMIFDE=$P(RM3,U,2)
  1. ..S RSO=RS
  1. ..I '$D(RMPRFLG) D HEAD1
  1. ..S RMITDE=$E(RMITDE,1,20)
  1. ..S RMIFDE=$E(RMIFDE,1,35)
  1. ..W !,RH_"-"_RMIT,?16,RMITDE,?43,RMIFDE
  1. ..S RMPRFLG=1
  1. ..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
  1. ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q
  1. W !,RMPR("L"),!,"<End of Report>"
  1. Q
  1. ;
  1. W ?68,"PAGE: ",RMPAGE
  1. W !,"Run Date: ",RMDAT,?35,"Station: ",RMSTAT,!
  1. S RMPAGE=RMPAGE+1
  1. Q
  1. ;
  1. 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
  1. I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD
  1. W !,RMPR("L")
  1. W !,"HCPCS-ITEM",?16,"PIP ITEM",?43,"IFCAP ITEM"
  1. W !,"----------",?16,"--------",?43,"----------"
  1. S RMPRFLG=1
  1. Q
  1. ;
  1. EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
  1. ;
  1. EXIT1 D ^%ZISC
  1. N RMPR,RMPRSITE D KILL^XUSCLEAN
  1. K ^TMP($J)
  1. Q
  1. ;
  1. NONE ;
  1. W:$E(IOST)["C" @IOF
  1. D HEAD
  1. W !!,"NO DATA !!!!"
  1. Q