- 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 Feb 18, 2025@23:56:21 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