| 1 | ORPR06 ; slc/dcm - Rent a Requisition ; 07 Dec 99 01:43PM
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69**;Dec 17, 1997
|
|---|
| 3 | REQ1 ;
|
|---|
| 4 | I '$S($P($G(^OR(100,+ORIFN,3)),"^",3)'=11:1,1:0) Q
|
|---|
| 5 | N ORTCNT,ORX,OR3,ORPK,ORPKG
|
|---|
| 6 | D GET^ORPR01(ORIFN)
|
|---|
| 7 | S ORPKG=$P(ORX,"^",14)
|
|---|
| 8 | I $D(OROPKG),(OROPKG'=ORPKG) S ORSNUM=1 D FOOT^ORPR01(ORFOOT) W @ORIOF
|
|---|
| 9 | D REQSET
|
|---|
| 10 | I +ORFMT'>0,'+$G(OREND) W:$E(IOST)="C" $C(7),!!,"Requisition copy format is not defined for this package.",!! H 1 Q
|
|---|
| 11 | Q:+$P(OR3,"^",9)>0!'$L(ORX)
|
|---|
| 12 | D CPRINT^ORPR01(ORIFN)
|
|---|
| 13 | Q
|
|---|
| 14 | REQSET ;Setup
|
|---|
| 15 | I $S('$G(ORPKG):1,ORPKG=$G(OROPKG):1,1:0) Q
|
|---|
| 16 | S ORHEAD=$$GET^XPAR("SYS","ORPF WARD REQUISITION HEADER",ORPKG,"I")
|
|---|
| 17 | S ORFOOT=$$GET^XPAR("SYS","ORPF WARD REQUISITION FOOTER",ORPKG,"I")
|
|---|
| 18 | S (OROFMT,ORFMT)=$$GET^XPAR("SYS","ORPF WARD REQUISITION FORMAT",ORPKG,"I")
|
|---|
| 19 | S ORIOSL=IOSL
|
|---|
| 20 | I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT
|
|---|
| 21 | S ORIOF=IOF
|
|---|
| 22 | I +ORHEAD D PRINT^ORPR00(ORHEAD,1)
|
|---|
| 23 | S IOF="!"
|
|---|
| 24 | I +OROFMT S ORFMT=OROFMT
|
|---|
| 25 | Q
|
|---|
| 26 | REQCLN ;Cleanup
|
|---|
| 27 | G:+$G(OREND) REQX
|
|---|
| 28 | I +$G(ORFOOT) S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)
|
|---|
| 29 | I $E(IOST)="C" D
|
|---|
| 30 | . N DIR S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
|
|---|
| 31 | . D ^DIR I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
|
|---|
| 32 | REQX ;
|
|---|
| 33 | S:$D(ORIOF) IOF=ORIOF
|
|---|
| 34 | K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL
|
|---|
| 35 | Q
|
|---|
| 36 | ARAY(ORVP,PKG,FIELD1,FIELD2) ;Sort by field in ^TMP("ORAFTER",$J,field,ORIFN;ACTION)
|
|---|
| 37 | ;This entry point takes an array of orders and sorts them by field
|
|---|
| 38 | ;PKG=ptr to package file
|
|---|
| 39 | ;FIELD1=Name of field for 1st sort (e.g. START DATE)
|
|---|
| 40 | ;FIELD2=Name of field for 2nd sort (e.g. SAMPLE)
|
|---|
| 41 | ;^TMP("ORBEFORE",$J)=Input array
|
|---|
| 42 | ;^TMP("ORAFTER",$J,FIELD1,FIELD2,ORIFN;ACTION)=Output array
|
|---|
| 43 | Q:'$G(PKG) Q:'$G(ORVP)
|
|---|
| 44 | N X,IFN,ACT,CIFN
|
|---|
| 45 | S IFN=""
|
|---|
| 46 | F S IFN=$O(^TMP("ORBEFORE",$J,IFN)) Q:IFN="" S ACT=$P(IFN,";",2) D
|
|---|
| 47 | . I $O(^OR(100,+IFN,2,0)) S CIFN=0 D Q
|
|---|
| 48 | .. F S CIFN=$O(^OR(100,+IFN,2,CIFN)) Q:CIFN<1 I $D(^OR(100,CIFN,0)) D SET(^(0),ACT)
|
|---|
| 49 | . S X=$G(^OR(100,+IFN,0)) D SET(X,ACT)
|
|---|
| 50 | Q
|
|---|
| 51 | SET(X,ACT) ;
|
|---|
| 52 | I $P(X,"^",2)'=ORVP K ^TMP("ORBEFORE",$J,IFN) Q
|
|---|
| 53 | I +X,PKG=$P(X,"^",14) D
|
|---|
| 54 | . N VAL1,VAL2
|
|---|
| 55 | . S VAL1=$S($L($G(FIELD1)):$$VALUE^ORCSAVE2(+X,FIELD1),1:1)
|
|---|
| 56 | . S:'$L(VAL1) VAL1=0
|
|---|
| 57 | . I $G(FIELD1)="START",'VAL1 S VAL1=+$P($G(^OR(100,+IFN,0)),"^",8)
|
|---|
| 58 | . S VAL2=$S($L($G(FIELD2)):$$VALUE^ORCSAVE2(+X,FIELD2),1:1)
|
|---|
| 59 | . S:'$L(VAL2) VAL2=0
|
|---|
| 60 | . S ^TMP("ORAFTER",$J,VAL1,VAL2,+X_$S(ACT:";"_ACT,1:""))=""
|
|---|
| 61 | Q
|
|---|
