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

ORMORG.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN ; -- entry point for ORG msgs
  1. I '$L($T(@ORDCNTRL)) S ORERR="Invalid order control code" Q
  1. I 'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q
  1. D @ORDCNTRL
  1. Q
  1. ;
  1. XO ; -- edited order
  1. NW ; -- new order
  1. N OR0,OR3,ORSTS,ORSTRT,ORSTOP,ORIG,ORTYP,ORNOW,OREVT
  1. S ^OR(100,+ORIFN,4)=+ORIFN,OR0=$G(^(0)),OR3=$G(^(3))
  1. S ORNOW=+$E($$NOW^XLFDT,1,12),ORSTRT=$P(OR0,U,8),OREVT=+$P(OR0,U,17)
  1. I 'ORSTRT S ORSTRT=ORNOW D DATES^ORCSAVE2(+ORIFN,ORSTRT)
  1. S ORSTS=$S(ORSTRT>ORNOW:8,1:6) D STATUS^ORCSAVE2(+ORIFN,ORSTS)
  1. ;I OREVT,$P($G(^ORE(100.2,OREVT,0)),U,4)=+ORIFN,$G(^(1)) D COMP^ORCSAVE2(ORIFN)
  1. S ORIG=+$P(OR3,U,5),ORTYP=$P(OR3,U,11) I ORIG,ORTYP D ;edit or renewal
  1. . S (ORSTOP,ORSTS)=""
  1. . S:ORTYP=1 ORSTOP=ORNOW,ORSTS=12 I ORTYP=2 D
  1. .. N STOP,STS S STOP=$P($G(^OR(100,ORIG,0)),U,9),STS=$P($G(^(3)),U,3)
  1. .. I "^1^2^7^12^13^"[(U_STS_U),STOP'>ORNOW Q ;already terminated
  1. .. S ORSTOP=$S(STOP'>ORNOW:"",ORSTRT<ORNOW:ORNOW,1:ORSTRT)
  1. .. S ORSTS=$S("^1^2^7^12^13^"[(U_STS_U):"",ORSTOP>ORNOW:15,1:7)
  1. . D:ORSTOP DATES^ORCSAVE2(ORIG,,ORSTOP)
  1. . D:ORSTS STATUS^ORCSAVE2(ORIG,ORSTS)
  1. . S:'OREVT OREVT=+$P($G(^OR(100,ORIG,0)),U,17)
  1. . I OREVT,$P($G(^ORE(100.2,OREVT,0)),U,4)=ORIG,'$G(^(1)) D
  1. .. K ^ORE(100.2,"AO",OREVT,ORIG)
  1. .. S $P(^ORE(100.2,OREVT,0),U,4)=+ORIFN,^ORE(100.2,"AO",OREVT,+ORIFN)=""
  1. .. S:'$P(OR0,U,17) $P(^OR(100,+ORIFN,0),U,17)=OREVT,^OR(100,"AEVNT",ORVP,OREVT,+ORIFN)=""
  1. Q
  1. ;
  1. CA ; -- cancel
  1. DC ; -- discontinue
  1. D STATUS^ORCSAVE2(+ORIFN,1) ;also sets stop date
  1. Q
  1. ;
  1. HD ; -- hold
  1. D STATUS^ORCSAVE2(+ORIFN,3)
  1. Q
  1. ;
  1. RL ; -- release hold
  1. N STS,NOW,ORSTRT,ORSTOP
  1. S ORSTRT=$P(^OR(100,+ORIFN,0),U,8),ORSTOP=$P(^(0),U,9),NOW=$$NOW^XLFDT
  1. S STS=$S(ORSTRT>NOW:8,'ORSTOP:6,ORSTOP'>NOW:7,1:6)
  1. D STATUS^ORCSAVE2(+ORIFN,STS)
  1. Q