ORMORG.m

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

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