- 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
- 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
