ORDD100A ;SLC/DCM - DD ENTRIES FOR FILE 100 ;11/03/2014 13:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**24,138,157,350**;Dec 17, 1997;Build 77
ACT1(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- set "ACT" x-ref
Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
I ORVP,ORADT,ORDG S ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)=""
Q
;
ACT2(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- kill "ACT" x-ref
Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
I ORVP,ORADT,ORDG K ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)
Q
;
ES ; -- set "AE" x-ref
N DAES,OI,ORO,ORSTOP,X,X1
S ORO=$G(^OR(100,DA,0))
S ORSTOP=+$P(ORO,U,9) ;138
I ORSTOP,ORSTOP'<DT S ^OR(100,"AE",ORSTOP,DA)="" ;138
;If there is no start date try to get the release date.
S X(3)=$P(ORO,U,8)
I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
I X(3)="" Q
S DAES(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
S X1(1)=X(1),X1(3)=X(3),X1(4)=""
S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
. S (X(2),X1(2))=+$G(^(OI,0)),DAES=OI
.;If there is an entry without a stop date kill it before creating
.;the new one.
. D KOR^ORPXRM(.X1,.DAES)
. D SOR^ORPXRM(.X,.DAES)
Q
EK ; -- kill "AE" x-ref
N ORX
S ORX=$G(X)
N DAEK,OI,ORSTOP,X
S ORO=$G(^OR(100,DA,0))
S ORSTOP=$P(ORO,U,9)
I ORSTOP K ^OR(100,"AE",ORSTOP,DA)
I ORX K ^OR(100,"AE",ORX,DA)
;If there is no start date try to get the release date.
S X(3)=$P(ORO,U,8)
I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
I X(3)="" Q
S DAEK(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
. S X(2)=+$G(^(OI,0)),DAEK=OI
. D KOR^ORPXRM(.X,.DAEK)
Q
;
OI1(ORIFN) ; -- set "AOI" x-ref
N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X,X1
Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
S ORVP=$P(OR0,U,2) Q:'ORVP
S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
S ORSTOP=$P(OR0,U,9)
S DA(1)=ORIFN
S (X(1),X1(1))=ORVP
S X(3)=ORSTRT,X1(3)=$$RDATE^ORPXRM(ORIFN)
S (X(4),X1(4))=ORSTOP
S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
. S ORIT=+$G(^(OI,0)) S:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)=""
. S (X(2),X1(2))=ORIT,DA=OI
. D KOR^ORPXRM(.X1,.DA)
. D SOR^ORPXRM(.X,.DA)
Q
;
OI2(ORIFN) ; -- kill "AOI" x-ref
N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X
Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
S ORVP=$P(OR0,U,2) Q:'ORVP
S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
S ORSTOP=$P(OR0,U,9)
S DA(1)=ORIFN,X(1)=ORVP,X(3)=ORSTRT,X(4)=ORSTOP
S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
. S ORIT=+$G(^(OI,0)) K:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)
. S X(2)=ORIT,DA=OI
. D KOR^ORPXRM(.X,.DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDD100A 2799 printed Sep 23, 2025@20:06:06 Page 2
ORDD100A ;SLC/DCM - DD ENTRIES FOR FILE 100 ;11/03/2014 13:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24,138,157,350**;Dec 17, 1997;Build 77
ACT1(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- set "ACT" x-ref
+1 if '$GET(ORIFN)
QUIT
if '$GET(ORDA)
QUIT
NEW OR0
+2 SET OR0=$GET(^OR(100,ORIFN,0))
if '$GET(ORADT)
SET ORADT=$PIECE($GET(^(8,ORDA,0)),U)
+3 if '$GET(ORVP)
SET ORVP=$PIECE(OR0,U,2)
if '$GET(ORDG)
SET ORDG=$PIECE(OR0,U,11)
+4 IF ORVP
IF ORADT
IF ORDG
SET ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)=""
+5 QUIT
+6 ;
ACT2(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- kill "ACT" x-ref
+1 if '$GET(ORIFN)
QUIT
if '$GET(ORDA)
QUIT
NEW OR0
+2 SET OR0=$GET(^OR(100,ORIFN,0))
if '$GET(ORADT)
SET ORADT=$PIECE($GET(^(8,ORDA,0)),U)
+3 if '$GET(ORVP)
SET ORVP=$PIECE(OR0,U,2)
if '$GET(ORDG)
SET ORDG=$PIECE(OR0,U,11)
+4 IF ORVP
IF ORADT
IF ORDG
KILL ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)
+5 QUIT
+6 ;
ES ; -- set "AE" x-ref
+1 NEW DAES,OI,ORO,ORSTOP,X,X1
+2 SET ORO=$GET(^OR(100,DA,0))
+3 ;138
SET ORSTOP=+$PIECE(ORO,U,9)
+4 ;138
IF ORSTOP
IF ORSTOP'<DT
SET ^OR(100,"AE",ORSTOP,DA)=""
+5 ;If there is no start date try to get the release date.
+6 SET X(3)=$PIECE(ORO,U,8)
+7 IF X(3)=""
SET X(3)=$$RDATE^ORPXRM(DA)
+8 IF X(3)=""
QUIT
+9 SET DAES(1)=DA
SET X(1)=$PIECE(ORO,U,2)
SET X(4)=ORSTOP
+10 SET X1(1)=X(1)
SET X1(3)=X(3)
SET X1(4)=""
+11 SET OI=0
FOR
SET OI=$ORDER(^OR(100,DA,.1,OI))
if OI'>0
QUIT
Begin DoDot:1
+12 SET (X(2),X1(2))=+$GET(^(OI,0))
SET DAES=OI
+13 ;If there is an entry without a stop date kill it before creating
+14 ;the new one.
+15 DO KOR^ORPXRM(.X1,.DAES)
+16 DO SOR^ORPXRM(.X,.DAES)
End DoDot:1
+17 QUIT
EK ; -- kill "AE" x-ref
+1 NEW ORX
+2 SET ORX=$GET(X)
+3 NEW DAEK,OI,ORSTOP,X
+4 SET ORO=$GET(^OR(100,DA,0))
+5 SET ORSTOP=$PIECE(ORO,U,9)
+6 IF ORSTOP
KILL ^OR(100,"AE",ORSTOP,DA)
+7 IF ORX
KILL ^OR(100,"AE",ORX,DA)
+8 ;If there is no start date try to get the release date.
+9 SET X(3)=$PIECE(ORO,U,8)
+10 IF X(3)=""
SET X(3)=$$RDATE^ORPXRM(DA)
+11 IF X(3)=""
QUIT
+12 SET DAEK(1)=DA
SET X(1)=$PIECE(ORO,U,2)
SET X(4)=ORSTOP
+13 SET OI=0
FOR
SET OI=$ORDER(^OR(100,DA,.1,OI))
if OI'>0
QUIT
Begin DoDot:1
+14 SET X(2)=+$GET(^(OI,0))
SET DAEK=OI
+15 DO KOR^ORPXRM(.X,.DAEK)
End DoDot:1
+16 QUIT
+17 ;
OI1(ORIFN) ; -- set "AOI" x-ref
+1 NEW DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X,X1
+2 if '$DATA(^OR(100,ORIFN,.1))
QUIT
SET OR0=$GET(^(0))
+3 SET ORVP=$PIECE(OR0,U,2)
if 'ORVP
QUIT
+4 SET ORSTRT=$PIECE(OR0,U,8)
if 'ORSTRT
QUIT
+5 SET ORSTOP=$PIECE(OR0,U,9)
+6 SET DA(1)=ORIFN
+7 SET (X(1),X1(1))=ORVP
+8 SET X(3)=ORSTRT
SET X1(3)=$$RDATE^ORPXRM(ORIFN)
+9 SET (X(4),X1(4))=ORSTOP
+10 SET OI=0
FOR
SET OI=$ORDER(^OR(100,ORIFN,.1,OI))
if OI'>0
QUIT
Begin DoDot:1
+11 SET ORIT=+$GET(^(OI,0))
if ORIT
SET ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)=""
+12 SET (X(2),X1(2))=ORIT
SET DA=OI
+13 DO KOR^ORPXRM(.X1,.DA)
+14 DO SOR^ORPXRM(.X,.DA)
End DoDot:1
+15 QUIT
+16 ;
OI2(ORIFN) ; -- kill "AOI" x-ref
+1 NEW DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X
+2 if '$DATA(^OR(100,ORIFN,.1))
QUIT
SET OR0=$GET(^(0))
+3 SET ORVP=$PIECE(OR0,U,2)
if 'ORVP
QUIT
+4 SET ORSTRT=$PIECE(OR0,U,8)
if 'ORSTRT
QUIT
+5 SET ORSTOP=$PIECE(OR0,U,9)
+6 SET DA(1)=ORIFN
SET X(1)=ORVP
SET X(3)=ORSTRT
SET X(4)=ORSTOP
+7 SET OI=0
FOR
SET OI=$ORDER(^OR(100,ORIFN,.1,OI))
if OI'>0
QUIT
Begin DoDot:1
+8 SET ORIT=+$GET(^(OI,0))
if ORIT
KILL ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)
+9 SET X(2)=ORIT
SET DA=OI
+10 DO KOR^ORPXRM(.X,.DA)
End DoDot:1
+11 QUIT
