- 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 Jan 18, 2025@03:32:18 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)