Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR293

RMPR293.m

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