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

ORDD100A.m

Go to the documentation of this file.
  1. 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
  1. ACT1(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- set "ACT" x-ref
  1. Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
  1. S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
  1. S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
  1. I ORVP,ORADT,ORDG S ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)=""
  1. Q
  1. ;
  1. ACT2(ORIFN,ORDA,ORADT,ORVP,ORDG) ; -- kill "ACT" x-ref
  1. Q:'$G(ORIFN) Q:'$G(ORDA) N OR0
  1. S OR0=$G(^OR(100,ORIFN,0)) S:'$G(ORADT) ORADT=$P($G(^(8,ORDA,0)),U)
  1. S:'$G(ORVP) ORVP=$P(OR0,U,2) S:'$G(ORDG) ORDG=$P(OR0,U,11)
  1. I ORVP,ORADT,ORDG K ^OR(100,"ACT",ORVP,9999999-ORADT,ORDG,ORIFN,ORDA)
  1. Q
  1. ;
  1. ES ; -- set "AE" x-ref
  1. N DAES,OI,ORO,ORSTOP,X,X1
  1. S ORO=$G(^OR(100,DA,0))
  1. S ORSTOP=+$P(ORO,U,9) ;138
  1. I ORSTOP,ORSTOP'<DT S ^OR(100,"AE",ORSTOP,DA)="" ;138
  1. ;If there is no start date try to get the release date.
  1. S X(3)=$P(ORO,U,8)
  1. I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
  1. I X(3)="" Q
  1. S DAES(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
  1. S X1(1)=X(1),X1(3)=X(3),X1(4)=""
  1. S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
  1. . S (X(2),X1(2))=+$G(^(OI,0)),DAES=OI
  1. .;If there is an entry without a stop date kill it before creating
  1. .;the new one.
  1. . D KOR^ORPXRM(.X1,.DAES)
  1. . D SOR^ORPXRM(.X,.DAES)
  1. Q
  1. EK ; -- kill "AE" x-ref
  1. N ORX
  1. S ORX=$G(X)
  1. N DAEK,OI,ORSTOP,X
  1. S ORO=$G(^OR(100,DA,0))
  1. S ORSTOP=$P(ORO,U,9)
  1. I ORSTOP K ^OR(100,"AE",ORSTOP,DA)
  1. I ORX K ^OR(100,"AE",ORX,DA)
  1. ;If there is no start date try to get the release date.
  1. S X(3)=$P(ORO,U,8)
  1. I X(3)="" S X(3)=$$RDATE^ORPXRM(DA)
  1. I X(3)="" Q
  1. S DAEK(1)=DA,X(1)=$P(ORO,U,2),X(4)=ORSTOP
  1. S OI=0 F S OI=$O(^OR(100,DA,.1,OI)) Q:OI'>0 D
  1. . S X(2)=+$G(^(OI,0)),DAEK=OI
  1. . D KOR^ORPXRM(.X,.DAEK)
  1. Q
  1. ;
  1. OI1(ORIFN) ; -- set "AOI" x-ref
  1. N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X,X1
  1. Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
  1. S ORVP=$P(OR0,U,2) Q:'ORVP
  1. S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
  1. S ORSTOP=$P(OR0,U,9)
  1. S DA(1)=ORIFN
  1. S (X(1),X1(1))=ORVP
  1. S X(3)=ORSTRT,X1(3)=$$RDATE^ORPXRM(ORIFN)
  1. S (X(4),X1(4))=ORSTOP
  1. S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
  1. . S ORIT=+$G(^(OI,0)) S:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)=""
  1. . S (X(2),X1(2))=ORIT,DA=OI
  1. . D KOR^ORPXRM(.X1,.DA)
  1. . D SOR^ORPXRM(.X,.DA)
  1. Q
  1. ;
  1. OI2(ORIFN) ; -- kill "AOI" x-ref
  1. N DA,OI,OR0,ORVP,ORSTRT,ORSTOP,ORIT,X
  1. Q:'$D(^OR(100,ORIFN,.1)) S OR0=$G(^(0))
  1. S ORVP=$P(OR0,U,2) Q:'ORVP
  1. S ORSTRT=$P(OR0,U,8) Q:'ORSTRT
  1. S ORSTOP=$P(OR0,U,9)
  1. S DA(1)=ORIFN,X(1)=ORVP,X(3)=ORSTRT,X(4)=ORSTOP
  1. S OI=0 F S OI=$O(^OR(100,ORIFN,.1,OI)) Q:OI'>0 D
  1. . S ORIT=+$G(^(OI,0)) K:ORIT ^OR(100,"AOI",ORIT,ORVP,9999999-ORSTRT,ORIFN)
  1. . S X(2)=ORIT,DA=OI
  1. . D KOR^ORPXRM(.X,.DA)
  1. Q