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