VistA-FOIAVistA/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI16.m

87 lines
2.4 KiB
Mathematica

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