source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKOR.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1ORKOR ; 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
4DUP(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
24TEXT(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."
31ORDERER(ORNUM) ;extrinsic function returns the order's (ORNUM) original requesting provider
32 Q $$ORDERER^ORQOR2(ORNUM)
Note: See TracBrowser for help on using the repository browser.