ORKOR ; slc/CLA - Order checking support procedure for orders ;12/15/97 [ 04/02/97 2:55 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,92,105**;Dec 17, 1997
Q
DUP(ORY,ORDFN,OI,ODT,DG) ; return duplicate order in format:
; order#^order text(first 60 chars) order effective d/t [order status]
Q:DG="FH" ;quit if diet order (all previous diet orders are auto DCed)
N BDT,INBDT,XDT,X,ORDT,ORN,ORS,ORSI
S XDT="",ORN=""
S X=$$DUPRANGE^ORQOR2(OI,DG,ODT,ORDFN)
S BDT=$P(X,U),INBDT=$P(X,U,2)
Q:BDT=0 ;if dup range for OI is zero, don't process dup order oc
F S XDT=$O(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT)) Q:XDT="" D
.I $G(XDT)<INBDT S ORN="" F S ORN=$O(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT,ORN)) Q:ORN="" D
..S ORDT=9999999-XDT
..Q:'ORN
..Q:+$G(ORN)=+$G(ORIFN) ;quit current order # = dup order #
..Q:($P(^OR(100,ORN,8,$P(^OR(100,ORN,8,0),U,3),0),U,2)="DC")
..S ORS=$$STATUS^ORQOR2(ORN),ORSI=$P(ORS,U)
..;if order status is not canceled, discontinued, expired, lapsed, replaced, delayed:
..I (ORSI'=13)&(ORSI'=1)&(ORSI'=7)&(ORSI'=14)&(ORSI'=12)&(ORSI'=10) D
...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
...S ORY=ORN_U_$P($$TEXT(ORN,60),U,2)_" "_$G(ORDT)_" ["_$P(ORS,U,2)_"]"
Q
TEXT(ORNUM,ORCHAR) ;ext funct rtns the first ORCHAR chars of an order text
;ORNUM - order number (main order number - $P(ORNUM,";",1))
;ORCHAR - number of characters to return
N ORY
D TEXT^ORQ12(.ORY,+ORNUM,ORCHAR)
Q:+$G(ORY)>0 "1^"_ORY(1)
Q "0^Order text not found."
ORDERER(ORNUM) ;extrinsic function returns the order's (ORNUM) original requesting provider
Q $$ORDERER^ORQOR2(ORNUM)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKOR 1613 printed Dec 13, 2024@02:31:08 Page 2
ORKOR ; slc/CLA - Order checking support procedure for orders ;12/15/97 [ 04/02/97 2:55 PM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,92,105**;Dec 17, 1997
+2 QUIT
DUP(ORY,ORDFN,OI,ODT,DG) ; return duplicate order in format:
+1 ; order#^order text(first 60 chars) order effective d/t [order status]
+2 ;quit if diet order (all previous diet orders are auto DCed)
if DG="FH"
QUIT
+3 NEW BDT,INBDT,XDT,X,ORDT,ORN,ORS,ORSI
+4 SET XDT=""
SET ORN=""
+5 SET X=$$DUPRANGE^ORQOR2(OI,DG,ODT,ORDFN)
+6 SET BDT=$PIECE(X,U)
SET INBDT=$PIECE(X,U,2)
+7 ;if dup range for OI is zero, don't process dup order oc
if BDT=0
QUIT
+8 FOR
SET XDT=$ORDER(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT))
if XDT=""
QUIT
Begin DoDot:1
+9 IF $GET(XDT)<INBDT
SET ORN=""
FOR
SET ORN=$ORDER(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT,ORN))
if ORN=""
QUIT
Begin DoDot:2
+10 SET ORDT=9999999-XDT
+11 if 'ORN
QUIT
+12 ;quit current order # = dup order #
if +$GET(ORN)=+$GET(ORIFN)
QUIT
+13 if ($PIECE(^OR(100,ORN,8,$PIECE(^OR(100,ORN,8,0),U,3),0),U,2)="DC")
QUIT
+14 SET ORS=$$STATUS^ORQOR2(ORN)
SET ORSI=$PIECE(ORS,U)
+15 ;if order status is not canceled, discontinued, expired, lapsed, replaced, delayed:
+16 IF (ORSI'=13)&(ORSI'=1)&(ORSI'=7)&(ORSI'=14)&(ORSI'=12)&(ORSI'=10)
Begin DoDot:3
+17 SET ORDT=$$FMTE^XLFDT(ORDT,"2P")
+18 SET ORY=ORN_U_$PIECE($$TEXT(ORN,60),U,2)_" "_$GET(ORDT)_" ["_$PIECE(ORS,U,2)_"]"
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
TEXT(ORNUM,ORCHAR) ;ext funct rtns the first ORCHAR chars of an order text
+1 ;ORNUM - order number (main order number - $P(ORNUM,";",1))
+2 ;ORCHAR - number of characters to return
+3 NEW ORY
+4 DO TEXT^ORQ12(.ORY,+ORNUM,ORCHAR)
+5 if +$GET(ORY)>0
QUIT "1^"_ORY(1)
+6 QUIT "0^Order text not found."
ORDERER(ORNUM) ;extrinsic function returns the order's (ORNUM) original requesting provider
+1 QUIT $$ORDERER^ORQOR2(ORNUM)
