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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI16 2550 printed Dec 13, 2024@02:36:08 Page 2
RMPRPI16 ;HINES OIFO/RVD-PRINT PIP/IFCAP ITEMS ;12/11/02 07:12
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 ;
+3 DO DIV4^RMPRSIT
IF $DATA(Y)
IF (Y<0)
QUIT
+4 SET X="NOW"
DO ^%DT
DO DD^%DT
SET RMDAT=Y
+5 ;
EN KILL ^TMP($JOB),RMPRI,RMPRFLG
SET RMPREND=0
DO HOME^%ZIS
+1 ;
+2 ;
CONT SET %ZIS="MQ"
KILL IOP
DO ^%ZIS
if POP
GOTO EXIT1
+1 IF '$DATA(IO("Q"))
USE IO
GOTO PRINT
+2 KILL IO("Q")
SET ZTDESC="PROSTHETIC PIP/IFCAP ITEMS REPORT"
+3 SET ZTRTN="PRINT^RMPRPI16"
SET ZTIO=ION
SET ZTSAVE("RMPR(""L"")")=""
+4 SET ZTSAVE("RMPR(""STA"")")=""
+5 SET ZTSAVE("RMDAT")=""
+6 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!"
HANG 1
GOTO EXIT1
+7 ;
PRINT IF $EXTRACT(IOST)["C"
WRITE !!,"Processing report....."
+1 ;
+2 ;call API
+3 ;input variables:
+4 ; RM = any subscript to be used
+5 ;
+6 SET RMSTAT=$$GETSTN^RMPRPIU0(RMPR("STA"))
+7 SET RM="RM"
+8 FOR I=0:0
SET I=$ORDER(^RMPR(661.11,I))
if I'>0
QUIT
Begin DoDot:1
+9 SET RM11=$GET(^RMPR(661.11,I,0))
SET RMHC=$PIECE(RM11,U,1)
SET RMIT=$PIECE(RM11,U,2)
+10 SET RMDE=$PIECE(RM11,U,3)
SET RMST=$PIECE(RM11,U,4)
SET RMIF=$PIECE(RM11,U,8)
+11 if RMPR("STA")'=RMST
QUIT
+12 SET (RM44,RMIFIT)=""
+13 IF $GET(RMIF)
IF $DATA(^RMPR(661,RMIF,0))
SET RM44=$PIECE(^RMPR(661,RMIF,0),U,1)
+14 IF $GET(RM44)
SET RMIFIT=$$GETITM^RMPRPIU0(RM44)
+15 SET ^TMP($JOB,RM,RMSTAT,RMHC,RMIT)=RMDE_"^"_RMIFIT
End DoDot:1
+16 ;
+17 SET RMPAGE=1
SET RMPREND=0
+18 IF '$DATA(^TMP($JOB,"RM"))
DO NONE
GOTO EXIT
+19 if $EXTRACT(IOST)["C"
WRITE @IOF
+20 DO HEAD
DO WRI
+21 GOTO EXIT
+22 ;
+23 ;write/print report
+24 ;
WRI SET RS=""
+1 FOR
SET RS=$ORDER(^TMP($JOB,"RM",RS))
if (RS="")!(RMPREND)
QUIT
KILL RMPRFLG
SET RH=""
FOR
SET RH=$ORDER(^TMP($JOB,"RM",RS,RH))
if (RH="")!(RMPREND)
QUIT
SET J=0
Begin DoDot:1
+2 FOR
SET J=$ORDER(^TMP($JOB,"RM",RS,RH,J))
if (J'>0)!(RMPREND)
QUIT
Begin DoDot:2
+3 SET RM3=^TMP($JOB,"RM",RS,RH,J)
+4 SET RMIT=J
+5 SET RMITDE=$PIECE(RM3,U,1)
+6 SET RMIFDE=$PIECE(RM3,U,2)
+7 SET RSO=RS
+8 IF '$DATA(RMPRFLG)
DO HEAD1
+9 SET RMITDE=$EXTRACT(RMITDE,1,20)
+10 SET RMIFDE=$EXTRACT(RMIFDE,1,35)
+11 WRITE !,RH_"-"_RMIT,?16,RMITDE,?43,RMIFDE
+12 SET RMPRFLG=1
+13 IF $EXTRACT(IOST)["C"
IF ($Y>(IOSL-7))
SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!(Y=0)
SET RMPREND=1
if RMPREND
QUIT
WRITE @IOF
DO HEAD
DO HEAD1
QUIT
+14 IF $Y>(IOSL-6)
WRITE @IOF
DO HEAD
DO HEAD1
QUIT
End DoDot:2
End DoDot:1
+15 WRITE !,RMPR("L"),!,"<End of Report>"
+16 QUIT
+17 ;
HEAD WRITE !,"*** PROSTHETICS PIP/IFCAP ITEMS REPORT***"
+1 WRITE ?68,"PAGE: ",RMPAGE
+2 WRITE !,"Run Date: ",RMDAT,?35,"Station: ",RMSTAT,!
+3 SET RMPAGE=RMPAGE+1
+4 QUIT
+5 ;
HEAD1 IF $EXTRACT(IOST)["C"
IF ($Y>(IOSL-7))
SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!(Y=0)
SET RMPREND=1
if RMPREND
QUIT
WRITE @IOF
DO HEAD
+1 IF $EXTRACT(IOST)'["C"
IF ($Y>(IOSL-6))
WRITE @IOF
DO HEAD
+2 WRITE !,RMPR("L")
+3 WRITE !,"HCPCS-ITEM",?16,"PIP ITEM",?43,"IFCAP ITEM"
+4 WRITE !,"----------",?16,"--------",?43,"----------"
+5 SET RMPRFLG=1
+6 QUIT
+7 ;
EXIT IF $EXTRACT(IOST)["C"
IF 'RMPREND
WRITE !
SET DIR(0)="E"
DO ^DIR
+1 ;
EXIT1 DO ^%ZISC
+1 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
+2 KILL ^TMP($JOB)
+3 QUIT
+4 ;
NONE ;
+1 if $EXTRACT(IOST)["C"
WRITE @IOF
+2 DO HEAD
+3 WRITE !!,"NO DATA !!!!"
+4 QUIT
