- RMPR293 ;PHX/JLT/HNB -DISPLAY JOB RECORD INFO ;[ 10/04/94 10:15 AM ]
- ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
- ;
- ; ODJ - patch 50 - 7/14/00 - fix display problem which is causing
- ; remarks not to be displayed
- ; NOIS CTX-0197-70330
- ; - patch 50 - 7/18/00 - prevent crash at DISP+8 see NOIS's
- ; FGH-1099-30059, KAN-0500-40811
- ;
- DISP(PRDA) ;CALLED FROM TEMPLATE [RMPR 25293] AND RMPRPRT
- ; VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.1
- ; PRDA - ENTRY IN FILE 664.1 (COPY PASSED IN)
- ; RMPR("L") - A LINE OF '-'S
- Q:$G(PRDA)'>1
- ;disp is called from RMPR29R, and print template [RMPR 25293]
- ;iost could be either C- or P-, quit if it is a printer
- Q:IOST["P-"
- Q:'$D(^RMPR(664.1,PRDA,0)) ; p50 LAB issue problem not setting 664.1
- Q:$P(^RMPR(664.1,PRDA,0),U,20) N D0 D GET^RMPR29W(PRDA) Q:'$D(RCK)
- SGL ;DISPLAY JOB SECTION INFO
- ;EXPECTS ^UTILITY("DIQ1",$J,644.1, ARRAY TO BE SET UP.
- ;
- ;p50 - remove PRDA from NEWED vars.
- N LC,MC,PAGE,SCH,SRC,TLC,TMC,TSH,TYPE
- ;RMPRBCK is set from RMPRPAT3, display extended screen from
- ;page 4 of the 2319 record.
- I IOST["C-",'$D(RMPRBCK) N DIR S DIR(0)="E" D ^DIR
- S (PAGE,MC,LC,TMC,TLC,TSH)=0 D HDR^RMPR29W(RMPRDA) S RI=$O(RCK(0)),(RJ,RTHD)=0
- ITD ;item display
- G:($Y+6>IOSL)!(RI'>0) MORE D ITM S RMPRWO=$P(RCK(RI),U,3)
- TCH ;Check technician on work order
- G:'$D(TECH(RMPRWO))!($O(TECH(RMPRWO,0))'>0) MU
- S RTCD=$O(TECH(RMPRWO,0))
- G:($Y+6>IOSL) MORE S RTC=$O(TECH(RMPRWO,RTCD,664.33,0))
- I RTC D TDSP G TCH
- MU ;display work order
- G:($Y+3>IOSL) MORE
- I $D(TMP(RMPRWO,664.22)) S RJ=$O(TMP(RMPRWO,664.22,0)) I RJ D MDSP G MU
- S SCH=^UTILITY("DIQ1",$J,664.2,RMPRWO,4,"E")
- I +SCH S:^UTILITY("DIQ1",$J,664.2,RMPRWO,5,"E") SCH=^("E") S TSH=TSH+SCH W !,?37,"SHIPPING CHARGE: ",?70,$J(SCH,10,2)
- EXT ;display work order
- G:($Y+6>IOSL) MORE S RW=$O(^UTILITY($J,"TEXT",RMPRWO,0))
- I RW D WDSP G EXT
- W !,RMPR("L")
- S RI=$O(RCK(RI)) G ITD
- MORE ;DISPLAY MORE INFO
- ;
- ;p50 ensure next page prompt is asked if not all data displayed
- I IOST["C-",$Y>(IOSL-6) D
- . W:$Y<(IOSL-5) !!
- . N DIR S DIR(0)="E" D ^DIR W @IOF
- . Q
- G:+RI'>0 EXIT
- G:'$D(PRDA) EXIT
- S RMPRWO=$P(RCK(RI),U,3)
- I $D(^UTILITY($J,"TEXT",RMPRWO)) S RMPRWZ=1
- I $D(TECH(RMPRWO)) S RMPRTZ=1
- I $D(TMP(RMPRWO,664.22)) S RMPRIZ=1
- I $O(RCK(RI)) S RMPRCZ=1
- I (+RI>0),$D(RMPRTZ) K RMPRTZ,RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(PRDA),ITM G TCH
- I (+RI>0),$D(RMPRIZ) K RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(PRDA),ITM G MU
- I (+RI>0),$D(RMPRWZ) K RMPRWZ,RMPRCZ D HDR^RMPR29W(PRDA),ITM G EXT
- I $D(RMPRCZ),+RI K RMPRCZ S RI=$O(RCK(RI)) G:+RI'>0 EXIT D HDR^RMPR29W(PRDA) G ITD
- G EXIT
- ITM ;DISPLAY ITEM
- W !,"JOB#:",?6,"("_RI_")",?10,"ITM#: "_$P(RCK(RI),U),?25,$E(^UTILITY("DIQ1",$J,664.16,$P(RCK(RI),U,4),.01),1,25),?54,"DATE MEASURED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),10,"I"),2)
- W !,"DATE COMPLETED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),8,"I"),2)
- W ?25,"COMPLETED BY: "_$E(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),9,"E"),1,14),?54,"CHECKED BY: "_$E(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),11,"E"),1,14),!
- Q
- AMC ;GET AMIS CODES FROM 660
- S PZD=$G(^RMPR(661,$P($G(^RMPR(660,+$P($G(RCK(RI)),U,2),0)),U,6),0)) G DA
- ADC(RD0,RD1) ;SEARCH AMIS ITEM
- K RLAB
- I '$D(PZD),$D(RD0),$D(RD1) D
- .S:$P(^RMPR(664.1,RD0,0),U,15)=$G(RMPR("STA")) RLAB=1
- .S PZD=$G(^RMPR(661,$P($G(^RMPR(664.1,RD0,2,RD1,0)),U),0))
- .S TYPE=$P(^RMPR(664.1,RD0,2,RD1,0),U,7)
- .S SRC=$P(^RMPR(664.1,RD0,0),U,11)
- DA ;DISPLAY SINGLE ITEM AMIS
- ;restoration repair
- ;new line
- Q:'$D(SRC)
- I TYPE="X",SRC="R" D
- .X $S($D(D0):"W !,?9",1:"W !,?10")
- .W "ADMIN REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,4),0)),U)
- .W:$D(RLAB) ?50,"RESTORATION REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,8),0)),U)
- ;ortho repair
- I TYPE="X",SRC'="R" D
- .X $S($D(D0):"W !,?9",1:"W !,?10")
- .W "ADMIN REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,4),0)),U)
- .W:$D(RLAB) ?50,"ORTHO REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,6),0)),U)
- ;ortho new
- I TYPE'="X",SRC'="R" D
- .X $S($D(D0):"W !,?9",1:"W !,?10")
- .W "ADMIN NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,3),0)),U)
- .W:$D(RLAB) ?50,"ORTHO NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,5),0)),U)
- ;restoration new
- I TYPE'="X",SRC="R" D
- .X $S($D(D0):"W !,?9",1:"W !,?10")
- .W "ADMIN NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,3),0)),U)
- .W:$D(RLAB) ?50,"RESTORATION NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,7),0)),U)
- K PZD,RLAB,RD0,RD1 Q
- MDSP ;DISPLAY MATERIALS
- W !,"MATERIALS:",?15,$E(TMP(RMPRWO,664.22,RJ,.01),1,20)
- W ?37,TMP(RMPRWO,664.22,RJ,1),?42,TMP(RMPRWO,664.22,RJ,6)
- W ?47,$E(TMP(RMPRWO,664.22,RJ,3),1),?53,$J(TMP(RMPRWO,664.22,RJ,2),7,2)
- S MC=TMP(RMPRWO,664.22,RJ,1)*TMP(RMPRWO,664.22,RJ,2),TMC=TMC+MC
- W ?64,"TOTAL:",?69,$J(MC,10,2)
- I $G(TMP(RMPRWO,664.22,RJ,10))'="" D
- .S RVA=$O(^RMPR(660,"E",TMP(RMPRWO,664.22,RJ,10),0))
- .W !,?15,TMP(RMPRWO,664.22,RJ,10)
- .I $D(^RMPR(660,+RVA,0)) S RDEL=$P(^(0),U,12) W ?37,"DATE DELIVERED: ",?53,$$FMTE^XLFDT(RDEL,2)
- K TMP(RMPRWO,664.22,RJ)
- Q
- TDSP ;DISPLAY TECHNICIAN
- W !,"DATE:",?6,$$FMTE^XLFDT(RTCD,2)
- W ?15,$E(TECH(RMPRWO,RTCD,664.33,RTC,.01,"E"),1,20),?37,"HRS"
- W ?42,TECH(RMPRWO,RTCD,664.33,RTC,1,"E"),?47,"RATE:"
- S RTR=TECH(RMPRWO,RTCD,664.33,RTC,2,"I") W ?53,$J(RTR,7,2)
- S LC=TECH(RMPRWO,RTCD,664.33,RTC,1,"I")*RTR,TLC=TLC+LC
- W ?64,"TOTAL:",$J(LC,10,2) K TECH(RMPRWO,RTCD,664.33,RTC) S RTHD=RTCD
- Q
- WDSP ;DISPLAY REMARKS FIELD
- W !,^UTILITY($J,"TEXT",RMPRWO,RW)
- K ^UTILITY($J,"TEXT",RMPRWO,RW),RR Q
- EXIT ;common exit point
- W !,?45,"TOTAL LABOR COST: ",?69,$J(TLC,10,2)
- W !,?45,"TOTAL MATERIAL COST:",?69,$J(TMC+TSH,10,2)
- W !,?45,"TOTAL COST",?69,$J(TLC+TMC,10,2)
- ;D MORE ;I IOST["C-" W !,"Press 'RETURN' to continue:" ;R !,"Press RETURN to Continue:",RX:DTIME W "KEY PRESSED !" I '$T Q
- N DIR S DIR(0)="E" D ^DIR W @IOF
- K TECH,TMP,RDEL,RCK,RI,RJ,RP,RTC,RTCD,RTHD,RTR,RVA,RW,RX
- I $G(RMPRBAC1)>0 Q
- I $G(RMPRDA)'>0 K RMPRBAC1,RMPRDA,RMPRWO Q
- K RMPRWO Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR293 6100 printed Feb 18, 2025@23:58:30 Page 2
- RMPR293 ;PHX/JLT/HNB -DISPLAY JOB RECORD INFO ;[ 10/04/94 10:15 AM ]
- +1 ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
- +2 ;
- +3 ; ODJ - patch 50 - 7/14/00 - fix display problem which is causing
- +4 ; remarks not to be displayed
- +5 ; NOIS CTX-0197-70330
- +6 ; - patch 50 - 7/18/00 - prevent crash at DISP+8 see NOIS's
- +7 ; FGH-1099-30059, KAN-0500-40811
- +8 ;
- DISP(PRDA) ;CALLED FROM TEMPLATE [RMPR 25293] AND RMPRPRT
- +1 ; VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.1
- +2 ; PRDA - ENTRY IN FILE 664.1 (COPY PASSED IN)
- +3 ; RMPR("L") - A LINE OF '-'S
- +4 if $GET(PRDA)'>1
- QUIT
- +5 ;disp is called from RMPR29R, and print template [RMPR 25293]
- +6 ;iost could be either C- or P-, quit if it is a printer
- +7 if IOST["P-"
- QUIT
- +8 ; p50 LAB issue problem not setting 664.1
- if '$DATA(^RMPR(664.1,PRDA,0))
- QUIT
- +9 if $PIECE(^RMPR(664.1,PRDA,0),U,20)
- QUIT
- NEW D0
- DO GET^RMPR29W(PRDA)
- if '$DATA(RCK)
- QUIT
- SGL ;DISPLAY JOB SECTION INFO
- +1 ;EXPECTS ^UTILITY("DIQ1",$J,644.1, ARRAY TO BE SET UP.
- +2 ;
- +3 ;p50 - remove PRDA from NEWED vars.
- +4 NEW LC,MC,PAGE,SCH,SRC,TLC,TMC,TSH,TYPE
- +5 ;RMPRBCK is set from RMPRPAT3, display extended screen from
- +6 ;page 4 of the 2319 record.
- +7 IF IOST["C-"
- IF '$DATA(RMPRBCK)
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +8 SET (PAGE,MC,LC,TMC,TLC,TSH)=0
- DO HDR^RMPR29W(RMPRDA)
- SET RI=$ORDER(RCK(0))
- SET (RJ,RTHD)=0
- ITD ;item display
- +1 if ($Y+6>IOSL)!(RI'>0)
- GOTO MORE
- DO ITM
- SET RMPRWO=$PIECE(RCK(RI),U,3)
- TCH ;Check technician on work order
- +1 if '$DATA(TECH(RMPRWO))!($ORDER(TECH(RMPRWO,0))'>0)
- GOTO MU
- +2 SET RTCD=$ORDER(TECH(RMPRWO,0))
- +3 if ($Y+6>IOSL)
- GOTO MORE
- SET RTC=$ORDER(TECH(RMPRWO,RTCD,664.33,0))
- +4 IF RTC
- DO TDSP
- GOTO TCH
- MU ;display work order
- +1 if ($Y+3>IOSL)
- GOTO MORE
- +2 IF $DATA(TMP(RMPRWO,664.22))
- SET RJ=$ORDER(TMP(RMPRWO,664.22,0))
- IF RJ
- DO MDSP
- GOTO MU
- +3 SET SCH=^UTILITY("DIQ1",$JOB,664.2,RMPRWO,4,"E")
- +4 IF +SCH
- if ^UTILITY("DIQ1",$JOB,664.2,RMPRWO,5,"E")
- SET SCH=^("E")
- SET TSH=TSH+SCH
- WRITE !,?37,"SHIPPING CHARGE: ",?70,$JUSTIFY(SCH,10,2)
- EXT ;display work order
- +1 if ($Y+6>IOSL)
- GOTO MORE
- SET RW=$ORDER(^UTILITY($JOB,"TEXT",RMPRWO,0))
- +2 IF RW
- DO WDSP
- GOTO EXT
- +3 WRITE !,RMPR("L")
- +4 SET RI=$ORDER(RCK(RI))
- GOTO ITD
- MORE ;DISPLAY MORE INFO
- +1 ;
- +2 ;p50 ensure next page prompt is asked if not all data displayed
- +3 IF IOST["C-"
- IF $Y>(IOSL-6)
- Begin DoDot:1
- +4 if $Y<(IOSL-5)
- WRITE !!
- +5 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- WRITE @IOF
- +6 QUIT
- End DoDot:1
- +7 if +RI'>0
- GOTO EXIT
- +8 if '$DATA(PRDA)
- GOTO EXIT
- +9 SET RMPRWO=$PIECE(RCK(RI),U,3)
- +10 IF $DATA(^UTILITY($JOB,"TEXT",RMPRWO))
- SET RMPRWZ=1
- +11 IF $DATA(TECH(RMPRWO))
- SET RMPRTZ=1
- +12 IF $DATA(TMP(RMPRWO,664.22))
- SET RMPRIZ=1
- +13 IF $ORDER(RCK(RI))
- SET RMPRCZ=1
- +14 IF (+RI>0)
- IF $DATA(RMPRTZ)
- KILL RMPRTZ,RMPRIZ,RMPRCZ,RMPRWZ
- DO HDR^RMPR29W(PRDA)
- DO ITM
- GOTO TCH
- +15 IF (+RI>0)
- IF $DATA(RMPRIZ)
- KILL RMPRIZ,RMPRCZ,RMPRWZ
- DO HDR^RMPR29W(PRDA)
- DO ITM
- GOTO MU
- +16 IF (+RI>0)
- IF $DATA(RMPRWZ)
- KILL RMPRWZ,RMPRCZ
- DO HDR^RMPR29W(PRDA)
- DO ITM
- GOTO EXT
- +17 IF $DATA(RMPRCZ)
- IF +RI
- KILL RMPRCZ
- SET RI=$ORDER(RCK(RI))
- if +RI'>0
- GOTO EXIT
- DO HDR^RMPR29W(PRDA)
- GOTO ITD
- +18 GOTO EXIT
- ITM ;DISPLAY ITEM
- +1 WRITE !,"JOB#:",?6,"("_RI_")",?10,"ITM#: "_$PIECE(RCK(RI),U),?25,$EXTRACT(^UTILITY("DIQ1",$JOB,664.16,$PIECE(RCK(RI),U,4),.01),1,25),?54,"DATE MEASURED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$JOB,664.2,$PIECE(RCK(RI),U,3),10,"I"),2)
- +2 WRITE !,"DATE COMPLETED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$JOB,664.2,$PIECE(RCK(RI),U,3),8,"I"),2)
- +3 WRITE ?25,"COMPLETED BY: "_$EXTRACT(^UTILITY("DIQ1",$JOB,664.2,$PIECE(RCK(RI),U,3),9,"E"),1,14),?54,"CHECKED BY: "_$EXTRACT(^UTILITY("DIQ1",$JOB,664.2,$PIECE(RCK(RI),U,3),11,"E"),1,14),!
- +4 QUIT
- AMC ;GET AMIS CODES FROM 660
- +1 SET PZD=$GET(^RMPR(661,$PIECE($GET(^RMPR(660,+$PIECE($GET(RCK(RI)),U,2),0)),U,6),0))
- GOTO DA
- ADC(RD0,RD1) ;SEARCH AMIS ITEM
- +1 KILL RLAB
- +2 IF '$DATA(PZD)
- IF $DATA(RD0)
- IF $DATA(RD1)
- Begin DoDot:1
- +3 if $PIECE(^RMPR(664.1,RD0,0),U,15)=$GET(RMPR("STA"))
- SET RLAB=1
- +4 SET PZD=$GET(^RMPR(661,$PIECE($GET(^RMPR(664.1,RD0,2,RD1,0)),U),0))
- +5 SET TYPE=$PIECE(^RMPR(664.1,RD0,2,RD1,0),U,7)
- +6 SET SRC=$PIECE(^RMPR(664.1,RD0,0),U,11)
- End DoDot:1
- DA ;DISPLAY SINGLE ITEM AMIS
- +1 ;restoration repair
- +2 ;new line
- +3 if '$DATA(SRC)
- QUIT
- +4 IF TYPE="X"
- IF SRC="R"
- Begin DoDot:1
- +5 XECUTE $SELECT($DATA(D0):"W !,?9",1:"W !,?10")
- +6 WRITE "ADMIN REPAIR CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,4),0)),U)
- +7 if $DATA(RLAB)
- WRITE ?50,"RESTORATION REPAIR CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,8),0)),U)
- End DoDot:1
- +8 ;ortho repair
- +9 IF TYPE="X"
- IF SRC'="R"
- Begin DoDot:1
- +10 XECUTE $SELECT($DATA(D0):"W !,?9",1:"W !,?10")
- +11 WRITE "ADMIN REPAIR CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,4),0)),U)
- +12 if $DATA(RLAB)
- WRITE ?50,"ORTHO REPAIR CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,6),0)),U)
- End DoDot:1
- +13 ;ortho new
- +14 IF TYPE'="X"
- IF SRC'="R"
- Begin DoDot:1
- +15 XECUTE $SELECT($DATA(D0):"W !,?9",1:"W !,?10")
- +16 WRITE "ADMIN NEW CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,3),0)),U)
- +17 if $DATA(RLAB)
- WRITE ?50,"ORTHO NEW CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,5),0)),U)
- End DoDot:1
- +18 ;restoration new
- +19 IF TYPE'="X"
- IF SRC="R"
- Begin DoDot:1
- +20 XECUTE $SELECT($DATA(D0):"W !,?9",1:"W !,?10")
- +21 WRITE "ADMIN NEW CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,3),0)),U)
- +22 if $DATA(RLAB)
- WRITE ?50,"RESTORATION NEW CODE: ",$PIECE($GET(^RMPR(663,+$PIECE(PZD,U,7),0)),U)
- End DoDot:1
- +23 KILL PZD,RLAB,RD0,RD1
- QUIT
- MDSP ;DISPLAY MATERIALS
- +1 WRITE !,"MATERIALS:",?15,$EXTRACT(TMP(RMPRWO,664.22,RJ,.01),1,20)
- +2 WRITE ?37,TMP(RMPRWO,664.22,RJ,1),?42,TMP(RMPRWO,664.22,RJ,6)
- +3 WRITE ?47,$EXTRACT(TMP(RMPRWO,664.22,RJ,3),1),?53,$JUSTIFY(TMP(RMPRWO,664.22,RJ,2),7,2)
- +4 SET MC=TMP(RMPRWO,664.22,RJ,1)*TMP(RMPRWO,664.22,RJ,2)
- SET TMC=TMC+MC
- +5 WRITE ?64,"TOTAL:",?69,$JUSTIFY(MC,10,2)
- +6 IF $GET(TMP(RMPRWO,664.22,RJ,10))'=""
- Begin DoDot:1
- +7 SET RVA=$ORDER(^RMPR(660,"E",TMP(RMPRWO,664.22,RJ,10),0))
- +8 WRITE !,?15,TMP(RMPRWO,664.22,RJ,10)
- +9 IF $DATA(^RMPR(660,+RVA,0))
- SET RDEL=$PIECE(^(0),U,12)
- WRITE ?37,"DATE DELIVERED: ",?53,$$FMTE^XLFDT(RDEL,2)
- End DoDot:1
- +10 KILL TMP(RMPRWO,664.22,RJ)
- +11 QUIT
- TDSP ;DISPLAY TECHNICIAN
- +1 WRITE !,"DATE:",?6,$$FMTE^XLFDT(RTCD,2)
- +2 WRITE ?15,$EXTRACT(TECH(RMPRWO,RTCD,664.33,RTC,.01,"E"),1,20),?37,"HRS"
- +3 WRITE ?42,TECH(RMPRWO,RTCD,664.33,RTC,1,"E"),?47,"RATE:"
- +4 SET RTR=TECH(RMPRWO,RTCD,664.33,RTC,2,"I")
- WRITE ?53,$JUSTIFY(RTR,7,2)
- +5 SET LC=TECH(RMPRWO,RTCD,664.33,RTC,1,"I")*RTR
- SET TLC=TLC+LC
- +6 WRITE ?64,"TOTAL:",$JUSTIFY(LC,10,2)
- KILL TECH(RMPRWO,RTCD,664.33,RTC)
- SET RTHD=RTCD
- +7 QUIT
- WDSP ;DISPLAY REMARKS FIELD
- +1 WRITE !,^UTILITY($JOB,"TEXT",RMPRWO,RW)
- +2 KILL ^UTILITY($JOB,"TEXT",RMPRWO,RW),RR
- QUIT
- EXIT ;common exit point
- +1 WRITE !,?45,"TOTAL LABOR COST: ",?69,$JUSTIFY(TLC,10,2)
- +2 WRITE !,?45,"TOTAL MATERIAL COST:",?69,$JUSTIFY(TMC+TSH,10,2)
- +3 WRITE !,?45,"TOTAL COST",?69,$JUSTIFY(TLC+TMC,10,2)
- +4 ;D MORE ;I IOST["C-" W !,"Press 'RETURN' to continue:" ;R !,"Press RETURN to Continue:",RX:DTIME W "KEY PRESSED !" I '$T Q
- +5 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- WRITE @IOF
- +6 KILL TECH,TMP,RDEL,RCK,RI,RJ,RP,RTC,RTCD,RTHD,RTR,RVA,RW,RX
- +7 IF $GET(RMPRBAC1)>0
- QUIT
- +8 IF $GET(RMPRDA)'>0
- KILL RMPRBAC1,RMPRDA,RMPRWO
- QUIT
- +9 KILL RMPRWO
- QUIT