RMPR29J ;PHX/JLT-DISPLAY JOB RECORD INFO ;8/29/1994 [ 10/04/94 10:18 AM ]
;;3.0;PROSTHETICS;;Feb 09, 1996
DISP ;GET AND DISPLAY 2529-3 INFO
;CALLED FROM RMPR29B, RMPR29P
;VARIABLE REQUIRED:RMPRDA - ENTRY NUMBER IN FILE 664.1
D HOME^%ZIS D GET^RMPR29W(RMPRDA)
I '$D(RCK) Q
S (PAGE,MC,LC,TMC,TLC,TSH)=0 D HDR^RMPR29W(RMPRDA) S RI=$O(RCK(0)),(RJ,RTHD)=0
ITD G:($Y+5>IOSL)!(RI'>0) MORE D ITM^RMPR293 S RMPRWO=$P(RCK(RI),U,3)
TCH G:'$D(TECH(RMPRWO))!($O(TECH(RMPRWO,0))'>0) MU S RTCD=$O(TECH(RMPRWO,0))
G:($Y+5>IOSL) MORE S RTC=$O(TECH(RMPRWO,RTCD,664.33,0)) I RTC D TDSP^RMPR293 G TCH
MU G:($Y+6>IOSL) MORE I $D(TMP(RMPRWO,664.22)) S RJ=$O(TMP(RMPRWO,664.22,0)) I RJ D MDSP^RMPR293 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)
S RR=1
EXT G:($Y+5>IOSL) MORE S RW=$O(^UTILITY($J,"TEXT",RMPRWO,0)) I RW D WDSP^RMPR293 G EXT
W !,RMPR("L")
S RI=$O(RCK(RI)) G ITD
MORE ;DISPLAY MORE INFO
G:+RI'>0 ASK 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
ASK ;ASK TYPE OF ACTION
K DIR S DIR(0)="NO",DIR("A")="Select Job Number" I $D(RMPRWZ)!($D(RMPRTZ))!($D(RMPRIZ))!($D(RMPRCZ)) S DIR("A")=DIR("A")_" or press 'return' to view more information"
I $Y<21 F W ! Q:$Y>21
D ^DIR G:$D(DTOUT) END^RMPR29A
I X=""&(+RI>0),$D(RMPRTZ) K RMPRTZ,RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(RMPRDA),ITM^RMPR293 G TCH
I X=""&(+RI>0),$D(RMPRIZ) K RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(RMPRDA),ITM^RMPR293 G MU
I X=""&(+RI>0),$D(RMPRWZ) K RMPRWZ,RMPRCZ D HDR^RMPR29W(RMPRDA),ITM^RMPR293 G EXT
I X=""&(+RI>0),$D(RMPRCZ) K RMPRCZ S RI=$O(RCK(RI)) G:+RI'>0 DISP^RMPR29D D HDR^RMPR29W(RMPRDA) G ITD
I $D(DIRUT) K RMPRF G DISP^RMPR29D
I $D(RMPRF),$D(RCK(+Y)),$P($G(^RMPR(664.2,$P(RCK(+Y),U,3),0)),U,10) W !!,?5,$C(7),"Job Has Been Completed You cannot initiate a Purchase!!" G MORE
G:'$D(RCK(+Y)) MORE
I +Y>0,'$D(RMPRF) S RMPRWO=$P(RCK(+Y),U,3),DA660=$P(RCK(+Y),U,2) G TCH^RMPR29B
I +Y>0,$G(RMPRF)=2 S RMPRWO=$P(RCK(+Y),U,3) G STR^RMPR29P
I +Y>0,$G(RMPRF)=4 S RMPRWO=$P(RCK(+Y),U,3) G 2529^RMPR29P
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29J 2253 printed Apr 09, 2024@21:37:47 Page 2
RMPR29J ;PHX/JLT-DISPLAY JOB RECORD INFO ;8/29/1994 [ 10/04/94 10:18 AM ]
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
DISP ;GET AND DISPLAY 2529-3 INFO
+1 ;CALLED FROM RMPR29B, RMPR29P
+2 ;VARIABLE REQUIRED:RMPRDA - ENTRY NUMBER IN FILE 664.1
+3 DO HOME^%ZIS
DO GET^RMPR29W(RMPRDA)
+4 IF '$DATA(RCK)
QUIT
+5 SET (PAGE,MC,LC,TMC,TLC,TSH)=0
DO HDR^RMPR29W(RMPRDA)
SET RI=$ORDER(RCK(0))
SET (RJ,RTHD)=0
ITD if ($Y+5>IOSL)!(RI'>0)
GOTO MORE
DO ITM^RMPR293
SET RMPRWO=$PIECE(RCK(RI),U,3)
TCH if '$DATA(TECH(RMPRWO))!($ORDER(TECH(RMPRWO,0))'>0)
GOTO MU
SET RTCD=$ORDER(TECH(RMPRWO,0))
+1 if ($Y+5>IOSL)
GOTO MORE
SET RTC=$ORDER(TECH(RMPRWO,RTCD,664.33,0))
IF RTC
DO TDSP^RMPR293
GOTO TCH
MU if ($Y+6>IOSL)
GOTO MORE
IF $DATA(TMP(RMPRWO,664.22))
SET RJ=$ORDER(TMP(RMPRWO,664.22,0))
IF RJ
DO MDSP^RMPR293
GOTO MU
+1 SET SCH=^UTILITY("DIQ1",$JOB,664.2,RMPRWO,4,"E")
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)
+2 SET RR=1
EXT if ($Y+5>IOSL)
GOTO MORE
SET RW=$ORDER(^UTILITY($JOB,"TEXT",RMPRWO,0))
IF RW
DO WDSP^RMPR293
GOTO EXT
+1 WRITE !,RMPR("L")
+2 SET RI=$ORDER(RCK(RI))
GOTO ITD
MORE ;DISPLAY MORE INFO
+1 if +RI'>0
GOTO ASK
SET RMPRWO=$PIECE(RCK(RI),U,3)
+2 IF $DATA(^UTILITY($JOB,"TEXT",RMPRWO))
SET RMPRWZ=1
+3 IF $DATA(TECH(RMPRWO))
SET RMPRTZ=1
+4 IF $DATA(TMP(RMPRWO,664.22))
SET RMPRIZ=1
+5 IF $ORDER(RCK(RI))
SET RMPRCZ=1
ASK ;ASK TYPE OF ACTION
+1 KILL DIR
SET DIR(0)="NO"
SET DIR("A")="Select Job Number"
IF $DATA(RMPRWZ)!($DATA(RMPRTZ))!($DATA(RMPRIZ))!($DATA(RMPRCZ))
SET DIR("A")=DIR("A")_" or press 'return' to view more information"
+2 IF $Y<21
FOR
WRITE !
if $Y>21
QUIT
+3 DO ^DIR
if $DATA(DTOUT)
GOTO END^RMPR29A
+4 IF X=""&(+RI>0)
IF $DATA(RMPRTZ)
KILL RMPRTZ,RMPRIZ,RMPRCZ,RMPRWZ
DO HDR^RMPR29W(RMPRDA)
DO ITM^RMPR293
GOTO TCH
+5 IF X=""&(+RI>0)
IF $DATA(RMPRIZ)
KILL RMPRIZ,RMPRCZ,RMPRWZ
DO HDR^RMPR29W(RMPRDA)
DO ITM^RMPR293
GOTO MU
+6 IF X=""&(+RI>0)
IF $DATA(RMPRWZ)
KILL RMPRWZ,RMPRCZ
DO HDR^RMPR29W(RMPRDA)
DO ITM^RMPR293
GOTO EXT
+7 IF X=""&(+RI>0)
IF $DATA(RMPRCZ)
KILL RMPRCZ
SET RI=$ORDER(RCK(RI))
if +RI'>0
GOTO DISP^RMPR29D
DO HDR^RMPR29W(RMPRDA)
GOTO ITD
+8 IF $DATA(DIRUT)
KILL RMPRF
GOTO DISP^RMPR29D
+9 IF $DATA(RMPRF)
IF $DATA(RCK(+Y))
IF $PIECE($GET(^RMPR(664.2,$PIECE(RCK(+Y),U,3),0)),U,10)
WRITE !!,?5,$CHAR(7),"Job Has Been Completed You cannot initiate a Purchase!!"
GOTO MORE
+10 if '$DATA(RCK(+Y))
GOTO MORE
+11 IF +Y>0
IF '$DATA(RMPRF)
SET RMPRWO=$PIECE(RCK(+Y),U,3)
SET DA660=$PIECE(RCK(+Y),U,2)
GOTO TCH^RMPR29B
+12 IF +Y>0
IF $GET(RMPRF)=2
SET RMPRWO=$PIECE(RCK(+Y),U,3)
GOTO STR^RMPR29P
+13 IF +Y>0
IF $GET(RMPRF)=4
SET RMPRWO=$PIECE(RCK(+Y),U,3)
GOTO 2529^RMPR29P
