- 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 Feb 18, 2025@23:58:36 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