- RMPRPI09 ;HIN/RVD-PRINT ORDER AND RECIEVE ITEM REPORT ;9/18/02 15:13
- ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
- ;
- ;DBIA #800 - global read of file #440.
- ;
- D DIV4^RMPRSIT I $D(Y),(Y<0) Q
- S X="NOW" D ^%DT D DD^%DT S RMDAT=Y
- ;
- EN K RMPRI S RMPREND=0 D HOME^%ZIS
- ;
- TYPE ;select type of report
- K DIR
- S DIR(0)="S^1:30 Days Old or Less;2:60 Days Old or Less;3:90 Days Old or Less;4:Over 90 Days Old or Less "
- S DIR("A")="Select number of days old",DIR("B")="30 Days Old or Less"
- D ^DIR
- I Y="",$D(DTOUT) G EXIT1
- I Y="^"!(Y="^^") G EXIT1
- S RMTY=Y
- ;
- ;
- CAT ;select STATUS of report
- K DIR
- S DIR(0)="S^O:OPEN;R:RECIEVED;C:CANCEL"
- S DIR("A")="Select Category of report",DIR("B")="OPEN"
- D ^DIR
- I Y="",$D(DTOUT) G EXIT1
- I Y="^"!(Y="^^") G EXIT1
- S RMCAT=Y
- K DIR
- ;
- DT ;
- S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
- I '$D(IO("Q")) U IO G PRINT
- K IO("Q") S ZTDESC="PIP ORDER AND RECEIVE ITEM REPORT"
- S ZTRTN="PRINT^RMPRPI09",ZTIO=ION,ZTSAVE("RMPR(")=""
- S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")=""
- S ZTSAVE("RMTY")="",ZTSAVE("RMDRA")="",ZTSAVE("RMCAT")=""
- D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
- ;
- PRINT I $E(IOST)["C" W !!,"Processing report....."
- K RMPRT,RMPRFLG,^TMP($J)
- S RMCAL=$S(RMTY=1:30,RMTY=2:60,RMTY=3:90,RMTY=4:"OVER 90")
- S X="T-"_RMCAL D ^%DT S RDT=Y-1 K Y S:'RDT RDT=0
- S RMCAY=$S(RMCAT="O":"OPEN",RMCAT="R":"RECIEVED",RMCAT="C":"CANCEL")
- S RS=RMPR("STA")
- S RMPAGE=1,RMPREND=0
- W:$E(IOST)["C" @IOF
- D HEAD
- G:RMCAT="R" REC
- ;
- OPCA ;for open and cancel order
- S RI=""
- F STS=RMCAT,"R" Q:STS="R"&(RMCAT="C") F S RI=$O(^RMPR(661.41,"ASSHID",RS,STS,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK)) Q:RK'>0!RMPREND=1 D
- .F RM=RDT:0 S RM=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
- ..F RN=0:0 S RN=$O(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 D
- ...S RM3=$G(^RMPR(661.41,RN,0))
- ...I $P(RM3,U,8)-$P(RM3,U,9)<1 Q
- ...S ^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN)=""
- ...Q
- S RI=""
- F S RI=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK)) Q:RK'>0!RMPREND=1 D
- .F RM=RDT:0 S RM=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
- ..F RN=0:0 S RN=$O(^TMP($J,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 D
- ...S RM3=$G(^RMPR(661.41,RN,0))
- ...S (RMVNAM,RMIDE)=""
- ...S RMDOR=$P(RM3,U,1)
- ...S RMIT=$P(RM3,U,2)
- ...S RMVEN=$P(RM3,U,5)
- ...S RMHCPC=$P(RM3,U,6)
- ...S RMDRE=$P(RM3,U,7)
- ...S RMQOR=$P(RM3,U,8)
- ...S RMQRE=$P(RM3,U,9)
- ...S RMCOM=$P(RM3,U,10)
- ...S RMSTA=$P(RM3,U,11)
- ...I '$D(RMPRFLG) D HEAD1
- ...S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3)
- ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3)
- ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1)
- ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
- ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3)
- ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?44,RMDOR,?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6)
- ...W:RMCOM'="" !,?5,"Comment: ",RMCOM
- ...S (RMPRFLG,RMPRT)=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:$G(RMPRT) !,RMPR("L"),!,"<End of Report>"
- G EXIT
- ;
- REC ;process a Recieved order.
- S RI=""
- F S RI=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK)) Q:RK'>0!RMPREND=1 D
- .F RM=RDT:0 S RM=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM)) Q:RM'>0!RMPREND=1 D
- ..F RN=0:0 S RN=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 F RP=0:0 S RP=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN,RP)) Q:RP'>0!RMPREND=1 D
- ...S RM3=$G(^RMPR(661.6,RP,0))
- ...S (RMVNAM,RMIDE)=""
- ...S RMDOR=$P(RM3,U,1)
- ...S RMIT=RK
- ...S RMVEN=$P(RM3,U,12)
- ...S RMHCPC=RI
- ...S RMDRE=RM
- ...S RMQOR=""
- ...S RMQRE=$P(RM3,U,5)
- ...S RMCOM=$P(RM3,U,8)
- ...S RMSTA=RS
- ...I '$D(RMPRFLG) D HEAD1
- ...;S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3)
- ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3)
- ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1)
- ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
- ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3)
- ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6)
- ...W:RMCOM'="" !,?5,"Comment: ",RMCOM
- ...S (RMPRFLG,RMPRT)=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:$G(RMPRT) !,RMPR("L"),!,"<End of Report>"
- G EXIT
- ;
- HEAD W !,"*** PIP ORDER AND RECEIVE ITEM REPORT ***"," for ",RMCAL," days old or Less, ",RMCAY," order"
- W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT
- W ?68,"PAGE: ",RMPAGE
- 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 !,?45,"DATE",?56,"DATE",?66,"QTY",?75,"QTY"
- W !,"HCPCS",?10,"ITEM",?31,"VENDOR",?44,"ORDERED",?54,"RECIEVED"
- W ?64,"ORDERED",?72,"RECIEVED"
- W !,"-----",?10,"----",?31,"------",?44,"-------",?54,"--------"
- W ?64,"-------",?72,"--------"
- S RMPRFLG=1
- Q
- ;
- EXIT W:'$G(RMPRT) !,RMPR("L"),!!,"No DATA to print !!!"
- I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR
- ;
- EXIT1 D ^%ZISC
- K ^TMP($J)
- N RMPR,RMPRSITE D KILL^XUSCLEAN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI09 5591 printed Mar 13, 2025@21:40:56 Page 2
- RMPRPI09 ;HIN/RVD-PRINT ORDER AND RECIEVE ITEM REPORT ;9/18/02 15:13
- +1 ;;3.0;PROSTHETICS;**61,132**;Feb 09, 1996;Build 13
- +2 ;
- +3 ;DBIA #800 - global read of file #440.
- +4 ;
- +5 DO DIV4^RMPRSIT
- IF $DATA(Y)
- IF (Y<0)
- QUIT
- +6 SET X="NOW"
- DO ^%DT
- DO DD^%DT
- SET RMDAT=Y
- +7 ;
- EN KILL RMPRI
- SET RMPREND=0
- DO HOME^%ZIS
- +1 ;
- TYPE ;select type of report
- +1 KILL DIR
- +2 SET DIR(0)="S^1:30 Days Old or Less;2:60 Days Old or Less;3:90 Days Old or Less;4:Over 90 Days Old or Less "
- +3 SET DIR("A")="Select number of days old"
- SET DIR("B")="30 Days Old or Less"
- +4 DO ^DIR
- +5 IF Y=""
- IF $DATA(DTOUT)
- GOTO EXIT1
- +6 IF Y="^"!(Y="^^")
- GOTO EXIT1
- +7 SET RMTY=Y
- +8 ;
- +9 ;
- CAT ;select STATUS of report
- +1 KILL DIR
- +2 SET DIR(0)="S^O:OPEN;R:RECIEVED;C:CANCEL"
- +3 SET DIR("A")="Select Category of report"
- SET DIR("B")="OPEN"
- +4 DO ^DIR
- +5 IF Y=""
- IF $DATA(DTOUT)
- GOTO EXIT1
- +6 IF Y="^"!(Y="^^")
- GOTO EXIT1
- +7 SET RMCAT=Y
- +8 KILL DIR
- +9 ;
- DT ;
- +1 SET %ZIS="MQ"
- KILL IOP
- DO ^%ZIS
- if POP
- GOTO EXIT1
- +2 IF '$DATA(IO("Q"))
- USE IO
- GOTO PRINT
- +3 KILL IO("Q")
- SET ZTDESC="PIP ORDER AND RECEIVE ITEM REPORT"
- +4 SET ZTRTN="PRINT^RMPRPI09"
- SET ZTIO=ION
- SET ZTSAVE("RMPR(")=""
- +5 SET ZTSAVE("RMPR(""STA"")")=""
- SET ZTSAVE("RMDAT")=""
- +6 SET ZTSAVE("RMTY")=""
- SET ZTSAVE("RMDRA")=""
- SET ZTSAVE("RMCAT")=""
- +7 DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED!"
- HANG 1
- GOTO EXIT1
- +8 ;
- PRINT IF $EXTRACT(IOST)["C"
- WRITE !!,"Processing report....."
- +1 KILL RMPRT,RMPRFLG,^TMP($JOB)
- +2 SET RMCAL=$SELECT(RMTY=1:30,RMTY=2:60,RMTY=3:90,RMTY=4:"OVER 90")
- +3 SET X="T-"_RMCAL
- DO ^%DT
- SET RDT=Y-1
- KILL Y
- if 'RDT
- SET RDT=0
- +4 SET RMCAY=$SELECT(RMCAT="O":"OPEN",RMCAT="R":"RECIEVED",RMCAT="C":"CANCEL")
- +5 SET RS=RMPR("STA")
- +6 SET RMPAGE=1
- SET RMPREND=0
- +7 if $EXTRACT(IOST)["C"
- WRITE @IOF
- +8 DO HEAD
- +9 if RMCAT="R"
- GOTO REC
- +10 ;
- OPCA ;for open and cancel order
- +1 SET RI=""
- +2 FOR STS=RMCAT,"R"
- if STS="R"&(RMCAT="C")
- QUIT
- FOR
- SET RI=$ORDER(^RMPR(661.41,"ASSHID",RS,STS,RI))
- if RI=""!RMPREND=1
- QUIT
- FOR RK=0:0
- SET RK=$ORDER(^RMPR(661.41,"ASSHID",RS,STS,RI,RK))
- if RK'>0!RMPREND=1
- QUIT
- Begin DoDot:1
- +3 FOR RM=RDT:0
- SET RM=$ORDER(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM))
- if RM'>0!RMPREND=1
- QUIT
- Begin DoDot:2
- +4 FOR RN=0:0
- SET RN=$ORDER(^RMPR(661.41,"ASSHID",RS,STS,RI,RK,RM,RN))
- if RN'>0!RMPREND=1
- QUIT
- Begin DoDot:3
- +5 SET RM3=$GET(^RMPR(661.41,RN,0))
- +6 IF $PIECE(RM3,U,8)-$PIECE(RM3,U,9)<1
- QUIT
- +7 SET ^TMP($JOB,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN)=""
- +8 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 SET RI=""
- +10 FOR
- SET RI=$ORDER(^TMP($JOB,"RMPRPI09",RS,RMCAT,RI))
- if RI=""!RMPREND=1
- QUIT
- FOR RK=0:0
- SET RK=$ORDER(^TMP($JOB,"RMPRPI09",RS,RMCAT,RI,RK))
- if RK'>0!RMPREND=1
- QUIT
- Begin DoDot:1
- +11 FOR RM=RDT:0
- SET RM=$ORDER(^TMP($JOB,"RMPRPI09",RS,RMCAT,RI,RK,RM))
- if RM'>0!RMPREND=1
- QUIT
- Begin DoDot:2
- +12 FOR RN=0:0
- SET RN=$ORDER(^TMP($JOB,"RMPRPI09",RS,RMCAT,RI,RK,RM,RN))
- if RN'>0!RMPREND=1
- QUIT
- Begin DoDot:3
- +13 SET RM3=$GET(^RMPR(661.41,RN,0))
- +14 SET (RMVNAM,RMIDE)=""
- +15 SET RMDOR=$PIECE(RM3,U,1)
- +16 SET RMIT=$PIECE(RM3,U,2)
- +17 SET RMVEN=$PIECE(RM3,U,5)
- +18 SET RMHCPC=$PIECE(RM3,U,6)
- +19 SET RMDRE=$PIECE(RM3,U,7)
- +20 SET RMQOR=$PIECE(RM3,U,8)
- +21 SET RMQRE=$PIECE(RM3,U,9)
- +22 SET RMCOM=$PIECE(RM3,U,10)
- +23 SET RMSTA=$PIECE(RM3,U,11)
- +24 IF '$DATA(RMPRFLG)
- DO HEAD1
- +25 if RMDOR
- SET RMDOR=$EXTRACT(RMDOR,4,5)_"/"_$EXTRACT(RMDOR,6,7)_"/"_$EXTRACT(RMDOR,2,3)
- +26 if RMDRE
- SET RMDRE=$EXTRACT(RMDRE,4,5)_"/"_$EXTRACT(RMDRE,6,7)_"/"_$EXTRACT(RMDRE,2,3)
- +27 if RMVEN
- SET RMVNAM=$PIECE($GET(^PRC(440,RMVEN,0)),U,1)
- +28 SET RMIDA=$ORDER(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
- +29 if RMIDA
- SET RMIDE=$PIECE($GET(^RMPR(661.11,RMIDA,0)),U,3)
- +30 WRITE !,RMHCPC_"-"_RMIT,?10,$EXTRACT(RMIDE,1,20),?31,$EXTRACT(RMVNAM,1,11),?44,RMDOR,?54,RMDRE,?64,$JUSTIFY(RMQOR,6),?72,$JUSTIFY(RMQRE,6)
- +31 if RMCOM'=""
- WRITE !,?5,"Comment: ",RMCOM
- +32 SET (RMPRFLG,RMPRT)=1
- +33 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
- +34 IF $Y>(IOSL-6)
- WRITE @IOF
- DO HEAD
- DO HEAD1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 if $GET(RMPRT)
- WRITE !,RMPR("L"),!,"<End of Report>"
- +36 GOTO EXIT
- +37 ;
- REC ;process a Recieved order.
- +1 SET RI=""
- +2 FOR
- SET RI=$ORDER(^RMPR(661.6,"ASTHIDS",RS,1,RI))
- if RI=""!RMPREND=1
- QUIT
- FOR RK=0:0
- SET RK=$ORDER(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK))
- if RK'>0!RMPREND=1
- QUIT
- Begin DoDot:1
- +3 FOR RM=RDT:0
- SET RM=$ORDER(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM))
- if RM'>0!RMPREND=1
- QUIT
- Begin DoDot:2
- +4 FOR RN=0:0
- SET RN=$ORDER(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN))
- if RN'>0!RMPREND=1
- QUIT
- FOR RP=0:0
- SET RP=$ORDER(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN,RP))
- if RP'>0!RMPREND=1
- QUIT
- Begin DoDot:3
- +5 SET RM3=$GET(^RMPR(661.6,RP,0))
- +6 SET (RMVNAM,RMIDE)=""
- +7 SET RMDOR=$PIECE(RM3,U,1)
- +8 SET RMIT=RK
- +9 SET RMVEN=$PIECE(RM3,U,12)
- +10 SET RMHCPC=RI
- +11 SET RMDRE=RM
- +12 SET RMQOR=""
- +13 SET RMQRE=$PIECE(RM3,U,5)
- +14 SET RMCOM=$PIECE(RM3,U,8)
- +15 SET RMSTA=RS
- +16 IF '$DATA(RMPRFLG)
- DO HEAD1
- +17 ;S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3)
- +18 if RMDRE
- SET RMDRE=$EXTRACT(RMDRE,4,5)_"/"_$EXTRACT(RMDRE,6,7)_"/"_$EXTRACT(RMDRE,2,3)
- +19 if RMVEN
- SET RMVNAM=$PIECE($GET(^PRC(440,RMVEN,0)),U,1)
- +20 SET RMIDA=$ORDER(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0))
- +21 if RMIDA
- SET RMIDE=$PIECE($GET(^RMPR(661.11,RMIDA,0)),U,3)
- +22 WRITE !,RMHCPC_"-"_RMIT,?10,$EXTRACT(RMIDE,1,20),?31,$EXTRACT(RMVNAM,1,11),?54,RMDRE,?64,$JUSTIFY(RMQOR,6),?72,$JUSTIFY(RMQRE,6)
- +23 if RMCOM'=""
- WRITE !,?5,"Comment: ",RMCOM
- +24 SET (RMPRFLG,RMPRT)=1
- +25 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
- +26 IF $Y>(IOSL-6)
- WRITE @IOF
- DO HEAD
- DO HEAD1
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 if $GET(RMPRT)
- WRITE !,RMPR("L"),!,"<End of Report>"
- +28 GOTO EXIT
- +29 ;
- HEAD WRITE !,"*** PIP ORDER AND RECEIVE ITEM REPORT ***"," for ",RMCAL," days old or Less, ",RMCAY," order"
- +1 WRITE !,"Station: ",$EXTRACT($PIECE($GET(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT
- +2 WRITE ?68,"PAGE: ",RMPAGE
- +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 !,?45,"DATE",?56,"DATE",?66,"QTY",?75,"QTY"
- +4 WRITE !,"HCPCS",?10,"ITEM",?31,"VENDOR",?44,"ORDERED",?54,"RECIEVED"
- +5 WRITE ?64,"ORDERED",?72,"RECIEVED"
- +6 WRITE !,"-----",?10,"----",?31,"------",?44,"-------",?54,"--------"
- +7 WRITE ?64,"-------",?72,"--------"
- +8 SET RMPRFLG=1
- +9 QUIT
- +10 ;
- EXIT if '$GET(RMPRT)
- WRITE !,RMPR("L"),!!,"No DATA to print !!!"
- +1 IF $EXTRACT(IOST)["C"
- IF 'RMPREND
- WRITE !
- SET DIR(0)="E"
- DO ^DIR
- +2 ;
- EXIT1 DO ^%ZISC
- +1 KILL ^TMP($JOB)
- +2 NEW RMPR,RMPRSITE
- DO KILL^XUSCLEAN
- +3 QUIT
