ORMORG ; SLC/MKB - Receive Generic Orders messages ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,79,141**;Dec 17, 1997
;
EN ; -- entry point for ORG msgs
I '$L($T(@ORDCNTRL)) S ORERR="Invalid order control code" Q
I 'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q
D @ORDCNTRL
Q
;
XO ; -- edited order
NW ; -- new order
N OR0,OR3,ORSTS,ORSTRT,ORSTOP,ORIG,ORTYP,ORNOW,OREVT
S ^OR(100,+ORIFN,4)=+ORIFN,OR0=$G(^(0)),OR3=$G(^(3))
S ORNOW=+$E($$NOW^XLFDT,1,12),ORSTRT=$P(OR0,U,8),OREVT=+$P(OR0,U,17)
I 'ORSTRT S ORSTRT=ORNOW D DATES^ORCSAVE2(+ORIFN,ORSTRT)
S ORSTS=$S(ORSTRT>ORNOW:8,1:6) D STATUS^ORCSAVE2(+ORIFN,ORSTS)
;I OREVT,$P($G(^ORE(100.2,OREVT,0)),U,4)=+ORIFN,$G(^(1)) D COMP^ORCSAVE2(ORIFN)
S ORIG=+$P(OR3,U,5),ORTYP=$P(OR3,U,11) I ORIG,ORTYP D ;edit or renewal
. S (ORSTOP,ORSTS)=""
. S:ORTYP=1 ORSTOP=ORNOW,ORSTS=12 I ORTYP=2 D
.. N STOP,STS S STOP=$P($G(^OR(100,ORIG,0)),U,9),STS=$P($G(^(3)),U,3)
.. I "^1^2^7^12^13^"[(U_STS_U),STOP'>ORNOW Q ;already terminated
.. S ORSTOP=$S(STOP'>ORNOW:"",ORSTRT<ORNOW:ORNOW,1:ORSTRT)
.. S ORSTS=$S("^1^2^7^12^13^"[(U_STS_U):"",ORSTOP>ORNOW:15,1:7)
. D:ORSTOP DATES^ORCSAVE2(ORIG,,ORSTOP)
. D:ORSTS STATUS^ORCSAVE2(ORIG,ORSTS)
. S:'OREVT OREVT=+$P($G(^OR(100,ORIG,0)),U,17)
. I OREVT,$P($G(^ORE(100.2,OREVT,0)),U,4)=ORIG,'$G(^(1)) D
.. K ^ORE(100.2,"AO",OREVT,ORIG)
.. S $P(^ORE(100.2,OREVT,0),U,4)=+ORIFN,^ORE(100.2,"AO",OREVT,+ORIFN)=""
.. S:'$P(OR0,U,17) $P(^OR(100,+ORIFN,0),U,17)=OREVT,^OR(100,"AEVNT",ORVP,OREVT,+ORIFN)=""
Q
;
CA ; -- cancel
DC ; -- discontinue
D STATUS^ORCSAVE2(+ORIFN,1) ;also sets stop date
Q
;
HD ; -- hold
D STATUS^ORCSAVE2(+ORIFN,3)
Q
;
RL ; -- release hold
N STS,NOW,ORSTRT,ORSTOP
S ORSTRT=$P(^OR(100,+ORIFN,0),U,8),ORSTOP=$P(^(0),U,9),NOW=$$NOW^XLFDT
S STS=$S(ORSTRT>NOW:8,'ORSTOP:6,ORSTOP'>NOW:7,1:6)
D STATUS^ORCSAVE2(+ORIFN,STS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMORG 1937 printed Apr 09, 2024@21:36:35 Page 2
ORMORG ; SLC/MKB - Receive Generic Orders messages ; 08 May 2002 2:12 PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,79,141**;Dec 17, 1997
+2 ;
EN ; -- entry point for ORG msgs
+1 IF '$LENGTH($TEXT(@ORDCNTRL))
SET ORERR="Invalid order control code"
QUIT
+2 IF 'ORIFN!('$DATA(^OR(100,+ORIFN,0)))
SET ORERR="Invalid OE/RR order number"
QUIT
+3 DO @ORDCNTRL
+4 QUIT
+5 ;
XO ; -- edited order
NW ; -- new order
+1 NEW OR0,OR3,ORSTS,ORSTRT,ORSTOP,ORIG,ORTYP,ORNOW,OREVT
+2 SET ^OR(100,+ORIFN,4)=+ORIFN
SET OR0=$GET(^(0))
SET OR3=$GET(^(3))
+3 SET ORNOW=+$EXTRACT($$NOW^XLFDT,1,12)
SET ORSTRT=$PIECE(OR0,U,8)
SET OREVT=+$PIECE(OR0,U,17)
+4 IF 'ORSTRT
SET ORSTRT=ORNOW
DO DATES^ORCSAVE2(+ORIFN,ORSTRT)
+5 SET ORSTS=$SELECT(ORSTRT>ORNOW:8,1:6)
DO STATUS^ORCSAVE2(+ORIFN,ORSTS)
+6 ;I OREVT,$P($G(^ORE(100.2,OREVT,0)),U,4)=+ORIFN,$G(^(1)) D COMP^ORCSAVE2(ORIFN)
+7 ;edit or renewal
SET ORIG=+$PIECE(OR3,U,5)
SET ORTYP=$PIECE(OR3,U,11)
IF ORIG
IF ORTYP
Begin DoDot:1
+8 SET (ORSTOP,ORSTS)=""
+9 if ORTYP=1
SET ORSTOP=ORNOW
SET ORSTS=12
IF ORTYP=2
Begin DoDot:2
+10 NEW STOP,STS
SET STOP=$PIECE($GET(^OR(100,ORIG,0)),U,9)
SET STS=$PIECE($GET(^(3)),U,3)
+11 ;already terminated
IF "^1^2^7^12^13^"[(U_STS_U)
IF STOP'>ORNOW
QUIT
+12 SET ORSTOP=$SELECT(STOP'>ORNOW:"",ORSTRT<ORNOW:ORNOW,1:ORSTRT)
+13 SET ORSTS=$SELECT("^1^2^7^12^13^"[(U_STS_U):"",ORSTOP>ORNOW:15,1:7)
End DoDot:2
+14 if ORSTOP
DO DATES^ORCSAVE2(ORIG,,ORSTOP)
+15 if ORSTS
DO STATUS^ORCSAVE2(ORIG,ORSTS)
+16 if 'OREVT
SET OREVT=+$PIECE($GET(^OR(100,ORIG,0)),U,17)
+17 IF OREVT
IF $PIECE($GET(^ORE(100.2,OREVT,0)),U,4)=ORIG
IF '$GET(^(1))
Begin DoDot:2
+18 KILL ^ORE(100.2,"AO",OREVT,ORIG)
+19 SET $PIECE(^ORE(100.2,OREVT,0),U,4)=+ORIFN
SET ^ORE(100.2,"AO",OREVT,+ORIFN)=""
+20 if '$PIECE(OR0,U,17)
SET $PIECE(^OR(100,+ORIFN,0),U,17)=OREVT
SET ^OR(100,"AEVNT",ORVP,OREVT,+ORIFN)=""
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
CA ; -- cancel
DC ; -- discontinue
+1 ;also sets stop date
DO STATUS^ORCSAVE2(+ORIFN,1)
+2 QUIT
+3 ;
HD ; -- hold
+1 DO STATUS^ORCSAVE2(+ORIFN,3)
+2 QUIT
+3 ;
RL ; -- release hold
+1 NEW STS,NOW,ORSTRT,ORSTOP
+2 SET ORSTRT=$PIECE(^OR(100,+ORIFN,0),U,8)
SET ORSTOP=$PIECE(^(0),U,9)
SET NOW=$$NOW^XLFDT
+3 SET STS=$SELECT(ORSTRT>NOW:8,'ORSTOP:6,ORSTOP'>NOW:7,1:6)
+4 DO STATUS^ORCSAVE2(+ORIFN,STS)
+5 QUIT
