ORQOR1 ; slc/CLA - Functions which return order information ;12/15/97 [ 04/02/97 3:01 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**78,127,242**;Dec 17, 1997;Build 6
LIST(ORY,PATIENT,GROUP,FLAG,ORSDT,OREDT,ORXREF,GETKID) ;return list of patient orders
; return PATIENT's orders for a display GROUP of type FLAG
; between start (ORSDT) and end dates (OREDT)
; dates can be in Fileman or T, T-14 formats
N GIEN S GIEN=""
I $L($G(ORSDT)) D DT^DILF("T",ORSDT,.ORSDT,"","")
I $L($G(OREDT)) D DT^DILF("T",OREDT,.OREDT,"","")
I (ORSDT=-1)!(OREDT=-1) S ORY(1)="^Error in date range." Q
S PATIENT=PATIENT_";DPT("
S:$L($G(GROUP)) GIEN=$O(^ORD(100.98,"B",GROUP,GIEN))
K ^TMP("ORR",$J)
D EN^ORQ1(PATIENT,GIEN,FLAG,"",ORSDT,OREDT,1,0,$G(ORXREF),$G(GETKID))
N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1
F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
.S X=^TMP("ORR",$J,HOR,SEQ)
.S ORY(J)=$P(X,U)_U_$E(^TMP("ORR",$J,HOR,SEQ,"TX",1),1,60)_U_$P(X,U,4)_U_$P(X,U,6),J=J+1
K ^TMP("ORR",$J)
S:+$G(ORY(1))<1 ORY(1)="^No orders found."
Q
STATI(ORY) ; return stati from ORDER STATUS file [#100.01]
N STATUS,IEN,I S STATUS="",IEN=0,I=1
F S STATUS=$O(^ORD(100.01,"B",STATUS)) Q:STATUS="" D
.S IEN=$O(^ORD(100.01,"B",STATUS,IEN))
.Q:$$SCREEN^XTID(100.01,,IEN_",") ;inactive VUID
.S ORY(I)=IEN_"^"_STATUS,IEN=0,I=I+1
Q
DG(DGNAME) ; extrinsic function returns display group ien
Q:'$L($G(DGNAME)) ""
N DGIEN S DGIEN=0
S DGIEN=$O(^ORD(100.98,"B",DGNAME,DGIEN))
Q +$G(DGIEN)
OI(OINAME) ; extrinsic function returns orderable item ien
Q:'$L($G(OINAME)) ""
N OI S OI=""
S OI=$O(^ORD(101.43,"B",OINAME,OI))
Q +$G(OI)
TEXTSTAT(ORNUM) ;extrinsic function returns the first 200 chars of order text
;and order status in format: <order text>^<order status>
;ORNUM - order number (main order number - $P(ORNUM,";",1))
S ORNUM=+ORNUM
Q:'$L($G(ORNUM)) ""
Q:'$L($G(^OR(100,ORNUM,0))) ""
N ORSTATUS,ORY
D TEXT^ORQ12(.ORY,ORNUM,200)
Q:+$G(ORY)<1 "Order text not found.^"
S ORSTATUS=$P(^OR(100,ORNUM,3),U,3)
S ORSTATUS=$G(^ORD(100.01,+ORSTATUS,0))
S ORSTATUS=$P(ORSTATUS,U)
Q ORY(1)_U_ORSTATUS
FULLTEXT(ORNUM) ;extrinsic function returns the full text of an order
;and order status in format: <order text>^<order status>
;ORNUM - order number (main order number - $P(ORNUM,";",1))
N ORX,ORTXT
S ORTXT=""
S ORNUM=+ORNUM
Q:'$L($G(ORNUM)) ""
Q:'$L($G(^OR(100,ORNUM,0))) ""
N ORSTATUS,ORY
D TEXT^ORQ12(.ORY,ORNUM,"")
Q:+$G(ORY)<1 "Order text not found.^"
S:ORY>2 ORY=2 ;only display first two lines of text
F ORX=1:1:ORY S ORTXT=ORTXT_ORY(ORX)_" "
S ORSTATUS=$P(^OR(100,ORNUM,3),U,3)
S ORSTATUS=$G(^ORD(100.01,+ORSTATUS,0))
S ORSTATUS=$P(ORSTATUS,U)
Q ORTXT_U_ORSTATUS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQOR1 2777 printed Oct 16, 2024@18:33:52 Page 2
ORQOR1 ; slc/CLA - Functions which return order information ;12/15/97 [ 04/02/97 3:01 PM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**78,127,242**;Dec 17, 1997;Build 6
LIST(ORY,PATIENT,GROUP,FLAG,ORSDT,OREDT,ORXREF,GETKID) ;return list of patient orders
+1 ; return PATIENT's orders for a display GROUP of type FLAG
+2 ; between start (ORSDT) and end dates (OREDT)
+3 ; dates can be in Fileman or T, T-14 formats
+4 NEW GIEN
SET GIEN=""
+5 IF $LENGTH($GET(ORSDT))
DO DT^DILF("T",ORSDT,.ORSDT,"","")
+6 IF $LENGTH($GET(OREDT))
DO DT^DILF("T",OREDT,.OREDT,"","")
+7 IF (ORSDT=-1)!(OREDT=-1)
SET ORY(1)="^Error in date range."
QUIT
+8 SET PATIENT=PATIENT_";DPT("
+9 if $LENGTH($GET(GROUP))
SET GIEN=$ORDER(^ORD(100.98,"B",GROUP,GIEN))
+10 KILL ^TMP("ORR",$JOB)
+11 DO EN^ORQ1(PATIENT,GIEN,FLAG,"",ORSDT,OREDT,1,0,$GET(ORXREF),$GET(GETKID))
+12 NEW J,HOR,SEQ,X
SET J=1
SET HOR=0
SET SEQ=0
+13 SET HOR=$ORDER(^TMP("ORR",$JOB,HOR))
if +HOR<1
QUIT
+14 FOR
SET SEQ=$ORDER(^TMP("ORR",$JOB,HOR,SEQ))
if +SEQ<1
QUIT
Begin DoDot:1
+15 SET X=^TMP("ORR",$JOB,HOR,SEQ)
+16 SET ORY(J)=$PIECE(X,U)_U_$EXTRACT(^TMP("ORR",$JOB,HOR,SEQ,"TX",1),1,60)_U_$PIECE(X,U,4)_U_$PIECE(X,U,6)
SET J=J+1
End DoDot:1
+17 KILL ^TMP("ORR",$JOB)
+18 if +$GET(ORY(1))<1
SET ORY(1)="^No orders found."
+19 QUIT
STATI(ORY) ; return stati from ORDER STATUS file [#100.01]
+1 NEW STATUS,IEN,I
SET STATUS=""
SET IEN=0
SET I=1
+2 FOR
SET STATUS=$ORDER(^ORD(100.01,"B",STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+3 SET IEN=$ORDER(^ORD(100.01,"B",STATUS,IEN))
+4 ;inactive VUID
if $$SCREEN^XTID(100.01,,IEN_",")
QUIT
+5 SET ORY(I)=IEN_"^"_STATUS
SET IEN=0
SET I=I+1
End DoDot:1
+6 QUIT
DG(DGNAME) ; extrinsic function returns display group ien
+1 if '$LENGTH($GET(DGNAME))
QUIT ""
+2 NEW DGIEN
SET DGIEN=0
+3 SET DGIEN=$ORDER(^ORD(100.98,"B",DGNAME,DGIEN))
+4 QUIT +$GET(DGIEN)
OI(OINAME) ; extrinsic function returns orderable item ien
+1 if '$LENGTH($GET(OINAME))
QUIT ""
+2 NEW OI
SET OI=""
+3 SET OI=$ORDER(^ORD(101.43,"B",OINAME,OI))
+4 QUIT +$GET(OI)
TEXTSTAT(ORNUM) ;extrinsic function returns the first 200 chars of order text
+1 ;and order status in format: <order text>^<order status>
+2 ;ORNUM - order number (main order number - $P(ORNUM,";",1))
+3 SET ORNUM=+ORNUM
+4 if '$LENGTH($GET(ORNUM))
QUIT ""
+5 if '$LENGTH($GET(^OR(100,ORNUM,0)))
QUIT ""
+6 NEW ORSTATUS,ORY
+7 DO TEXT^ORQ12(.ORY,ORNUM,200)
+8 if +$GET(ORY)<1
QUIT "Order text not found.^"
+9 SET ORSTATUS=$PIECE(^OR(100,ORNUM,3),U,3)
+10 SET ORSTATUS=$GET(^ORD(100.01,+ORSTATUS,0))
+11 SET ORSTATUS=$PIECE(ORSTATUS,U)
+12 QUIT ORY(1)_U_ORSTATUS
FULLTEXT(ORNUM) ;extrinsic function returns the full text of an order
+1 ;and order status in format: <order text>^<order status>
+2 ;ORNUM - order number (main order number - $P(ORNUM,";",1))
+3 NEW ORX,ORTXT
+4 SET ORTXT=""
+5 SET ORNUM=+ORNUM
+6 if '$LENGTH($GET(ORNUM))
QUIT ""
+7 if '$LENGTH($GET(^OR(100,ORNUM,0)))
QUIT ""
+8 NEW ORSTATUS,ORY
+9 DO TEXT^ORQ12(.ORY,ORNUM,"")
+10 if +$GET(ORY)<1
QUIT "Order text not found.^"
+11 ;only display first two lines of text
if ORY>2
SET ORY=2
+12 FOR ORX=1:1:ORY
SET ORTXT=ORTXT_ORY(ORX)_" "
+13 SET ORSTATUS=$PIECE(^OR(100,ORNUM,3),U,3)
+14 SET ORSTATUS=$GET(^ORD(100.01,+ORSTATUS,0))
+15 SET ORSTATUS=$PIECE(ORSTATUS,U)
+16 QUIT ORTXT_U_ORSTATUS