Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORKOR

ORKOR.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. DUP(ORY,ORDFN,OI,ODT,DG) ; return duplicate order in format:
  1. ; order#^order text(first 60 chars) order effective d/t [order status]
  1. Q:DG="FH" ;quit if diet order (all previous diet orders are auto DCed)
  1. N BDT,INBDT,XDT,X,ORDT,ORN,ORS,ORSI
  1. S XDT="",ORN=""
  1. S X=$$DUPRANGE^ORQOR2(OI,DG,ODT,ORDFN)
  1. S BDT=$P(X,U),INBDT=$P(X,U,2)
  1. Q:BDT=0 ;if dup range for OI is zero, don't process dup order oc
  1. F S XDT=$O(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT)) Q:XDT="" D
  1. .I $G(XDT)<INBDT S ORN="" F S ORN=$O(^OR(100,"AOI",OI,ORDFN_";DPT(",XDT,ORN)) Q:ORN="" D
  1. ..S ORDT=9999999-XDT
  1. ..Q:'ORN
  1. ..Q:+$G(ORN)=+$G(ORIFN) ;quit current order # = dup order #
  1. ..Q:($P(^OR(100,ORN,8,$P(^OR(100,ORN,8,0),U,3),0),U,2)="DC")
  1. ..S ORS=$$STATUS^ORQOR2(ORN),ORSI=$P(ORS,U)
  1. ..;if order status is not canceled, discontinued, expired, lapsed, replaced, delayed:
  1. ..I (ORSI'=13)&(ORSI'=1)&(ORSI'=7)&(ORSI'=14)&(ORSI'=12)&(ORSI'=10) D
  1. ...S ORDT=$$FMTE^XLFDT(ORDT,"2P")
  1. ...S ORY=ORN_U_$P($$TEXT(ORN,60),U,2)_" "_$G(ORDT)_" ["_$P(ORS,U,2)_"]"
  1. Q
  1. TEXT(ORNUM,ORCHAR) ;ext funct rtns the first ORCHAR chars of an order text
  1. ;ORNUM - order number (main order number - $P(ORNUM,";",1))
  1. ;ORCHAR - number of characters to return
  1. N ORY
  1. D TEXT^ORQ12(.ORY,+ORNUM,ORCHAR)
  1. Q:+$G(ORY)>0 "1^"_ORY(1)
  1. Q "0^Order text not found."
  1. ORDERER(ORNUM) ;extrinsic function returns the order's (ORNUM) original requesting provider
  1. Q $$ORDERER^ORQOR2(ORNUM)