- ORUHDR ; slc/dcm - Order entry display headers ;3/25/92 15:05 ;
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- OE ;Main Order Entry Header, expects ORUIEN (variable pointer)
- ;From: OR USER MENU
- K ORDG S ORTIT="ORDER ENTRY",ORSTIT=""
- S ORSTIT=$P(@("^"_$P(ORUIEN,";",2)_+ORUIEN_",0)"),"^",2),ORSTIT=$P(ORSTIT,"...")
- D TIT,STIT3 W:'$G(ORANSI) ! D:$G(ORANSI) STIT2
- K ORDG,ORPD,ORTIT,ORSTIT Q
- OE2 ;Accept Orders Screen Header From: ORREV31
- K ORDG S ORTIT="ORDER ENTRY"
- D TIT I $D(ORSTIT),$L(ORSTIT) D STIT3 D:$G(ORANSI) STIT2
- Q
- EXT ;Detailed Display Header From: ORSED
- Q:'$D(^OR(100,+$G(ORIFN),0))
- N ORL,OROLD
- S:'$D(ORTIT) ORTIT="DETAILED DISPLAY" S X=^OR(100,ORIFN,0),ORDG=$P(X,"^",11),ORDG=$P(^ORD(100.98,ORDG,0),"^",3),ORVP=$P(X,"^",2),Y=+ORVP D END^ORUDPA Q:'$D(ORPNM)
- S:'$D(ORANSI) ORANSI=0 S:'$D(ORFT) ORFT=0 S:'$D(ORIO) ORIO="HOME"
- I '$D(IOF) S IOP=ORIO D ^%ZIS Q:POP S X=0 X ^%ZOSF("RM") S (ORFT,ORANSI)=0
- D TIT K ORDG,ORTIT Q
- TIT ;General Header From: OROPRO
- N ORCWAD S ORCWAD=""
- I '$D(ORDG),$D(^OR(100,+$G(ORIFN),0)) D
- . S ORDG=$P($G(^ORD(100.98,+$P($G(^OR(100,+$G(ORIFN),0)),U,11),0)),U,3)
- I $L($T(CWAD^GMRPNOR1)),$D(ORVP) S ORCWAD=$$CWAD^GMRPNOR1(+ORVP) K GMRPCWAD
- I $G(ORANSI) D:ORFT=0 ANSIH^ORPRS09 Q:ORFT=0 S ORFT=0 D ANSIR
- ;W !! F I=1:1:79 W "-"
- S:'$D(XQORSPEW) XQORSPEW=0 W @IOF I $L($G(ORDG)),(ORTIT'[$G(ORDG)) S ORTIT=$G(ORDG)_" "_ORTIT
- S X="" F I=1:1:$L(ORTIT) S X=X_" "_$E(ORTIT,I)
- W $C(13),$$HON^ORU,$S($L(ORCWAD):"<"_ORCWAD_">",1:""),$$HOFF^ORU,?(80-($L(ORTIT)*2))/2,X,?(IOM-12),$$HON^ORU,$S(XQORSPEW:"Quick mode",1:""),$$HOFF^ORU
- I $D(ORPNM),$D(ORSSN),$D(ORL),$D(ORDOB) D HDG
- W ! F I=1:1:79 W "-"
- I $G(ORANSI) K ORANSI("ST") S ORANSI("T")=$Y+2,ORANSI("B")=24,ORANSI("SL")=ORANSI("B")-ORANSI("T") D ANSIS,ANSIT
- Q
- STIT ;Print Sub-header
- S ORSTIT=$P(@("^"_$P(ORUIEN,";",2)_+ORUIEN_",0)"),"^",2) W !
- STIT1 W $C(13),?(40-($L(ORSTIT)\2)-4),"--- "_ORSTIT_" ---"
- K ORSTIT Q
- STIT2 I '$D(ORANSI("ST")) S ORANSI("T")=ORANSI("T")+1,ORANSI("SL")=ORANSI("SL")-1
- D ANSIS,ANSIT
- Q
- STIT3 I $G(ORANSI),'$D(ORANSI("ST")) S ORANSI("ST")=ORANSI("T"),ORANSI("T")=ORANSI("T")+1,ORANSI("SL")=ORANSI("SL")-1
- I $G(ORANSI) S DX=1,DY=ORANSI("ST") W @ORANSI("XY"),@ORANSI("EOLN")
- W:'$G(ORANSI) ! D STIT1
- Q
- HDG ;PRINT HEADING
- ;I $D(VAIN("5")) S Y=+ORVP D END^ORUDPA
- S X=" "_ORDOB_" ("_ORAGE_") "_"Wt (lb): "_$S($D(ORPD):ORPD,1:" ")
- S X1=$S($G(ORL):$S($L($P(^SC(+ORL,0),"^",2)):$P(^(0),"^",2),1:$E($P(^(0),"^"),1,4)),1:"")_$S($L($G(ORL(1))):"/"_ORL(1),1:"")
- W !,ORPNM_" "_ORSSN_" ",?(39-($L(X1)\2))," "_X1_" ",?(79-$L(X)),X
- Q
- PGBRK ;Call for page break
- N I,X I $D(IOST),$E(IOST)["C" F I=$Y:1:IOSL-4 W !
- PGBRK1 S OREND=0,X="" I $S($D(IOST):$E(IOST)["C",1:1) R !!,"Press return to continue or ""^"" to escape ",X:$S($D(DTIME):DTIME,1:300)
- I X["^" S:X="^^" DIROUT=1 S OREND=1
- Q
- ANSIR ;Reset scroll region to full screen
- W $C(27),$C(91),"1",$C(59),"24",$C(114),$C(13),#,$C(27),$C(91),$C(50),$C(74),$C(27),$C(91),$C(72)
- Q
- ANSIS ;Set scroll region
- W $C(27),$C(91),ORANSI("T"),$C(59),ORANSI("B"),$C(114),$C(13)
- S (DX,DY)=0 X ^%ZOSF("XY")
- Q
- ANSIT ;Move cursor to top of scroll region
- S DX=1,DY=ORANSI("T") W @ORANSI("XY"),$C(13)
- Q
- ORUHDR ; slc/dcm - Order entry display headers ;3/25/92 15:05 ;
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- OE ;Main Order Entry Header, expects ORUIEN (variable pointer)
- +1 ;From: OR USER MENU
- +2 KILL ORDG
- SET ORTIT="ORDER ENTRY"
- SET ORSTIT=""
- +3 SET ORSTIT=$PIECE(@("^"_$PIECE(ORUIEN,";",2)_+ORUIEN_",0)"),"^",2)
- SET ORSTIT=$PIECE(ORSTIT,"...")
- +4 DO TIT
- DO STIT3
- IF '$GET(ORANSI)
- WRITE !
- IF $GET(ORANSI)
- DO STIT2
- +5 KILL ORDG,ORPD,ORTIT,ORSTIT
- QUIT
- OE2 ;Accept Orders Screen Header From: ORREV31
- +1 KILL ORDG
- SET ORTIT="ORDER ENTRY"
- +2 DO TIT
- IF $DATA(ORSTIT)
- IF $LENGTH(ORSTIT)
- DO STIT3
- IF $GET(ORANSI)
- DO STIT2
- +3 QUIT
- EXT ;Detailed Display Header From: ORSED
- +1 IF '$DATA(^OR(100,+$GET(ORIFN),0))
- QUIT
- +2 NEW ORL,OROLD
- +3 IF '$DATA(ORTIT)
- SET ORTIT="DETAILED DISPLAY"
- SET X=^OR(100,ORIFN,0)
- SET ORDG=$PIECE(X,"^",11)
- SET ORDG=$PIECE(^ORD(100.98,ORDG,0),"^",3)
- SET ORVP=$PIECE(X,"^",2)
- SET Y=+ORVP
- DO END^ORUDPA
- IF '$DATA(ORPNM)
- QUIT
- +4 IF '$DATA(ORANSI)
- SET ORANSI=0
- IF '$DATA(ORFT)
- SET ORFT=0
- IF '$DATA(ORIO)
- SET ORIO="HOME"
- +5 IF '$DATA(IOF)
- SET IOP=ORIO
- DO ^%ZIS
- IF POP
- QUIT
- SET X=0
- XECUTE ^%ZOSF("RM")
- SET (ORFT,ORANSI)=0
- +6 DO TIT
- KILL ORDG,ORTIT
- QUIT
- TIT ;General Header From: OROPRO
- +1 NEW ORCWAD
- SET ORCWAD=""
- +2 IF '$DATA(ORDG)
- IF $DATA(^OR(100,+$GET(ORIFN),0))
- Begin DoDot:1
- +3 SET ORDG=$PIECE($GET(^ORD(100.98,+$PIECE($GET(^OR(100,+$GET(ORIFN),0)),U,11),0)),U,3)
- End DoDot:1
- +4 IF $LENGTH($TEXT(CWAD^GMRPNOR1))
- IF $DATA(ORVP)
- SET ORCWAD=$$CWAD^GMRPNOR1(+ORVP)
- KILL GMRPCWAD
- +5 IF $GET(ORANSI)
- IF ORFT=0
- DO ANSIH^ORPRS09
- IF ORFT=0
- QUIT
- SET ORFT=0
- DO ANSIR
- +6 ;W !! F I=1:1:79 W "-"
- +7 IF '$DATA(XQORSPEW)
- SET XQORSPEW=0
- WRITE @IOF
- IF $LENGTH($GET(ORDG))
- IF (ORTIT'[$GET(ORDG))
- SET ORTIT=$GET(ORDG)_" "_ORTIT
- +8 SET X=""
- FOR I=1:1:$LENGTH(ORTIT)
- SET X=X_" "_$EXTRACT(ORTIT,I)
- +9 WRITE $CHAR(13),$$HON^ORU,$SELECT($LENGTH(ORCWAD):"<"_ORCWAD_">",1:""),$$HOFF^ORU,?(80-($LENGTH(ORTIT)*2))/2,X,?(IOM-12),$$HON^ORU,$SELECT(XQORSPEW:"Quick mode",1:""),$$HOFF^ORU
- +10 IF $DATA(ORPNM)
- IF $DATA(ORSSN)
- IF $DATA(ORL)
- IF $DATA(ORDOB)
- DO HDG
- +11 WRITE !
- FOR I=1:1:79
- WRITE "-"
- +12 IF $GET(ORANSI)
- KILL ORANSI("ST")
- SET ORANSI("T")=$Y+2
- SET ORANSI("B")=24
- SET ORANSI("SL")=ORANSI("B")-ORANSI("T")
- DO ANSIS
- DO ANSIT
- +13 QUIT
- STIT ;Print Sub-header
- +1 SET ORSTIT=$PIECE(@("^"_$PIECE(ORUIEN,";",2)_+ORUIEN_",0)"),"^",2)
- WRITE !
- STIT1 WRITE $CHAR(13),?(40-($LENGTH(ORSTIT)\2)-4),"--- "_ORSTIT_" ---"
- +1 KILL ORSTIT
- QUIT
- STIT2 IF '$DATA(ORANSI("ST"))
- SET ORANSI("T")=ORANSI("T")+1
- SET ORANSI("SL")=ORANSI("SL")-1
- +1 DO ANSIS
- DO ANSIT
- +2 QUIT
- STIT3 IF $GET(ORANSI)
- IF '$DATA(ORANSI("ST"))
- SET ORANSI("ST")=ORANSI("T")
- SET ORANSI("T")=ORANSI("T")+1
- SET ORANSI("SL")=ORANSI("SL")-1
- +1 IF $GET(ORANSI)
- SET DX=1
- SET DY=ORANSI("ST")
- WRITE @ORANSI("XY"),@ORANSI("EOLN")
- +2 IF '$GET(ORANSI)
- WRITE !
- DO STIT1
- +3 QUIT
- HDG ;PRINT HEADING
- +1 ;I $D(VAIN("5")) S Y=+ORVP D END^ORUDPA
- +2 SET X=" "_ORDOB_" ("_ORAGE_") "_"Wt (lb): "_$SELECT($DATA(ORPD):ORPD,1:" ")
- +3 SET X1=$SELECT($GET(ORL):$SELECT($LENGTH($PIECE(^SC(+ORL,0),"^",2)):$PIECE(^(0),"^",2),1:$EXTRACT($PIECE(^(0),"^"),1,4)),1:"")_$SELECT($LENGTH($GET(ORL(1))):"/"_ORL(1),1:"")
- +4 WRITE !,ORPNM_" "_ORSSN_" ",?(39-($LENGTH(X1)\2))," "_X1_" ",?(79-$LENGTH(X)),X
- +5 QUIT
- PGBRK ;Call for page break
- +1 NEW I,X
- IF $DATA(IOST)
- IF $EXTRACT(IOST)["C"
- FOR I=$Y:1:IOSL-4
- WRITE !
- PGBRK1 SET OREND=0
- SET X=""
- IF $SELECT($DATA(IOST):$EXTRACT(IOST)["C",1:1)
- READ !!,"Press return to continue or ""^"" to escape ",X:$SELECT($DATA(DTIME):DTIME,1:300)
- +1 IF X["^"
- IF X="^^"
- SET DIROUT=1
- SET OREND=1
- +2 QUIT
- ANSIR ;Reset scroll region to full screen
- +1 WRITE $CHAR(27),$CHAR(91),"1",$CHAR(59),"24",$CHAR(114),$CHAR(13),#,$CHAR(27),$CHAR(91),$CHAR(50),$CHAR(74),$CHAR(27),$CHAR(91),$CHAR(72)
- +2 QUIT
- ANSIS ;Set scroll region
- +1 WRITE $CHAR(27),$CHAR(91),ORANSI("T"),$CHAR(59),ORANSI("B"),$CHAR(114),$CHAR(13)
- +2 SET (DX,DY)=0
- XECUTE ^%ZOSF("XY")
- +3 QUIT
- ANSIT ;Move cursor to top of scroll region
- +1 SET DX=1
- SET DY=ORANSI("T")
- WRITE @ORANSI("XY"),$CHAR(13)
- +2 QUIT
