- 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 Jan 18, 2025@03:37:17 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