source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR293.m@ 1729

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