ORDD100 ; slc/dcm - DD entries for file 100 ;06/18/2004  10:00
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,157,255**;Dec 17, 1997
SETALL(ORIFN) ; -- set "AC" xref for all actions
 N ORYD,ORVP,ORSTOP,OR3,ORSTS,ORLOG,ORACT,ORACT0,ORCACT D ORYD
 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORSTOP=$P($G(^(0)),U,9) Q:'ORVP
 S OR3=$G(^OR(100,ORIFN,3)),ORSTS=$P(OR3,U,3),ORCACT=$P(OR3,U,7)
 S ORACT=0 F  S ORACT=$O(^OR(100,ORIFN,8,ORACT)) Q:ORACT'>0  D SET1
 Q
SET(ORIFN,ORACT) ; -- set "AC" xref by action
 N ORYD,ORVP,ORSTOP,OR3,ORSTS,ORLOG,ORACT0,ORCACT D ORYD
 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORSTOP=$P($G(^(0)),U,9) Q:'ORVP
 S OR3=$G(^OR(100,ORIFN,3)),ORSTS=$P(OR3,U,3),ORCACT=$P(OR3,U,7)
SET1 S ORACT0=$G(^OR(100,ORIFN,8,ORACT,0)),ORLOG=$P(ORACT0,U)
 K ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT) ; reset
 I ORACT'=ORCACT D  Q  ; not Current action
 . I $P(ORACT0,U,15)=11 S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)="" Q
 . I ORYD,$P(ORACT0,U,15)=13,ORLOG'<ORYD S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
 . I $P(ORACT0,U,15)="",ORACT=1,$P($G(^OR(100,ORIFN,8,ORCACT,0)),U,2)="RL",$S('ORYD:1,$P($G(^(0)),U,16)<ORYD:1,1:0) S $P(^OR(100,ORIFN,3),U,7)=1,^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,1)="" ;Replace RL w/NW
 I ORSTS,ORSTS'=1,ORSTS'=2,ORSTS'=7,ORSTS'=10,ORSTS'=12,ORSTS'=13,ORSTS'=14,ORSTS'=99 S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
 I ORYD,(ORSTS=1!(ORSTS=2)!(ORSTS=7)!(ORSTS=13)),ORSTOP'<ORYD S ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
 Q
KILALL(ORIFN) ; -- kill "AC" xref for all actions
 N ORVP,ORACT,ORLOG
 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORACT=0 Q:'ORVP
 F  S ORACT=$O(^OR(100,ORIFN,8,ORACT)) Q:ORACT'>0  S ORLOG=$P(^(ORACT,0),U) K:ORLOG ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)
 Q
KIL(ORIFN,ORACT) ; -- kill "AC" xref
 N ORVP,ORLOG
 S ORVP=$P($G(^OR(100,ORIFN,0)),U,2),ORLOG=$P($G(^(8,ORACT,0)),U) Q:'ORVP
 K:ORLOG ^OR(100,"AC",ORVP,9999999-ORLOG,ORIFN,ORACT)
 Q
 ;
ORYD ; -- Return Current Orders context hours in ORYD
 N X,X1,X2,X3,%,%H
 S ORYD=$$GET^XPAR("SYS","ORPF ACTIVE ORDERS CONTEXT HRS",1,"I")
YD1 I ORYD S X=$H,X=+X*24+($P(X,",",2)/3600),X2=ORYD,X1=X-X2,X3=X1#24,X1=X1\24,X2=$J(X3*3600,0,0),%H=X1_","_X2 D YMD^%DTC S ORYD=+(X_%)
 Q
 ;
SS ; -- set "AD" xref
 N ORSTRT S ORSTRT=$P($G(^OR(100,DA,0)),U,8)
 I ORSTRT,ORSTRT>$$NOW^XLFDT S ^OR(100,"AD",ORSTRT,DA)=""
 Q
SK ; -- kill "AD" xref
 N ORSTRT S ORSTRT=$P($G(^OR(100,DA,0)),U,8)
 I ORSTRT K ^OR(100,"AD",ORSTRT,DA)
 Q
 ;
WS ; -- set "AW" xref
 N ORVP,ORDG,ORSTRT,X,X0
 S X0=$G(^OR(100,DA,0)),ORVP=$P(X0,U,2),ORDG=$P(X0,U,11)
 S ORSTRT=$P(X0,U,8),X=$S(ORSTRT:ORSTRT,1:9999999)
 I ORVP,ORDG S ^OR(100,"AW",ORVP,ORDG,X,DA)=""
 Q
WK ; -- kill "AW" xref
 N ORVP,ORDG,ORSTRT,X,X0
 S X0=$G(^OR(100,DA,0)),ORVP=$P(X0,U,2),ORDG=$P(X0,U,11)
 S ORSTRT=$P(X0,U,8),X=$S(ORSTRT:ORSTRT,1:9999999)
 I ORVP,ORDG K ^OR(100,"AW",ORVP,ORDG,X,DA)
 Q
 ;
S1(ORIFN,ORACT,ORVP,ORLOG) ; -- set "AS" xref
 N OR0 S OR0=$G(^OR(100,ORIFN,8,ORACT,0)) Q:$P(OR0,U,4)'=2  ;unsigned
 S:'$G(ORLOG) ORLOG=$P(OR0,U) S:'$G(ORVP) ORVP=$P(^OR(100,ORIFN,0),U,2)
 I ORVP,ORLOG S ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,ORACT)=""
 Q
S2(ORIFN,ORACT,ORVP,ORLOG) ; -- kill "AS" xref
 N OR0 S:'$G(ORVP) ORVP=$P(^OR(100,ORIFN,0),U,2)
 S:'$G(ORLOG) ORLOG=$P($G(^OR(100,ORIFN,8,ORACT,0)),U)
 I ORLOG,ORVP K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,ORACT)
 Q
 ;
RS(ORIFN,ORACT,ORVP,ORRDT) ; -- set "AR" xref
 N OR80
 Q:'$G(ORIFN)  Q:'$G(ORACT)
 S:'$G(ORVP) ORVP=$P($G(^OR(100,ORIFN,0)),U,2)
 S OR80=$G(^OR(100,ORIFN,8,ORACT,0))
 S:'$G(ORRDT) ORRDT=$P(OR80,U,16)
 I ORVP,ORRDT S ^OR(100,"AR",ORVP,(9999999-ORRDT),ORIFN,ORACT)=""
 I ORVP'["DPT"!ORRDT="" Q
 I $P(OR80,U,2)="NW" D PXRMADD(ORIFN,ORVP,ORRDT)
 Q
 ;
PXRMADD(ORIFN,ORVP,ORRDT)   ; -- set "PXRM" xref
 N DAES,OI,OR0,START,X
 S DAES(1)=ORIFN
 S X(1)=ORVP
 S OR0=^OR(100,ORIFN,0)
 S START=$P(OR0,U,8)
 S X(3)=$S(START="":ORRDT,1:START)
 S X(4)=$P(OR0,U,9)
 S OI=0 F  S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0  D
 . S X(2)=+$G(^(OI,0)),DAES=OI
 . D SOR^ORPXRM(.X,.DAES)
 Q
 ;
RK(ORIFN,ORACT,ORVP,ORRDT) ; -- kill "AR" xref
 N OR80
 Q:'$G(ORIFN)  Q:'$G(ORACT)
 S:'$G(ORVP) ORVP=$P($G(^OR(100,ORIFN,0)),U,2)
 S OR80=$G(^OR(100,ORIFN,8,ORACT,0))
 S:'$G(ORRDT) ORRDT=$P(OR80,U,16)
 I ORVP,ORRDT K ^OR(100,"AR",ORVP,(9999999-ORRDT),ORIFN,ORACT)
 I ORVP'["DPT"!ORRDT="" Q
 I $P(OR80,U,2)="NW" D PXRMKILL(ORIFN,ORVP,ORRDT)
 Q
 ;
PXRMKILL(ORIFN,ORVP,ORRDT)  ; -- kill "PXRM" xref
 N DAES,OI,OR0,START,X
 S DAES(1)=ORIFN
 S X(1)=ORVP
 S OR0=^OR(100,ORIFN,0)
 S START=$P(OR0,U,8)
 S X(3)=$S(START="":ORRDT,1:START)
 S X(4)=$P(OR0,U,9)
 S OI=0 F  S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0  D
 . S X(2)=+$G(^(OI,0)),DAES=OI
 . D KOR^ORPXRM(.X,.DAES)
 Q
 ;
VS ; -- set "AEVNT" xref
 N ORVP,OREVNT
 S ORVP=$P($G(^OR(100,DA,0)),U,2),OREVNT=$P($G(^(0)),U,17)
 I ORVP,$L(OREVNT) S ^OR(100,"AEVNT",ORVP,OREVNT,DA)=""
 Q
 ;
VK ; -- kill "AEVNT" xref
 N ORVP,OREVNT
 S ORVP=$P($G(^OR(100,DA,0)),U,2),OREVNT=$P($G(^(0)),U,17)
 I ORVP,$L(OREVNT) K ^OR(100,"AEVNT",ORVP,OREVNT,DA)
 Q
 ;
UP(X) ; -- Convert X to upper case
 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")