- 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 Feb 18, 2025@23:58:41 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
