ORCPRE ; SLC/MKB - CPRS pre-init ;3/26/97 13:41
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ; -- preinit cleanup
D PREORB^ORB3C1 Q:$$VERSION^XPDUTL("OR")'<3
; -- Remove unused fields from #100
N DA,DIK,DIU,ORU,DR,DIE
S DIK="^DD(100,",DA(1)=100
F DA=16,14,1.1,9,21.1,33.1,40,42,43,44,45,35 D ^DIK ; 0,3,4.1,5-nodes
F DA=.02,4,6,23,.68 D ^DIK ; rebuild def'n w/o xrefs
F DA=.61,.62,.63,.64,.65,.66,.67,.68,.69,.691,.6911,.6912,.6913 D ^DIK ; 6-node
F DIU=100.008,100.09 S DIU(0)="S" D EN^DIU2
S DIK="^DD(100.045,",DA(1)=100.045,DA=.04 D ^DIK
; -- Start over with Order Status, Nature of Order files
F DIU=100.01,100.02 S DIU(0)="DT" D EN^DIU2
; -- Setup Display Group, Print Fields, Print Formats files
D PRE^ORSET98,22
Q
;
22 ;Clean out print file entries above 1000
X ^%ZOSF("UCI") Q:Y="OEX,OER"
N DIK,ORK,DA
S DIK="^ORD(100.22,"
;F ORK=1000:0 S ORK=$O(^ORD(100.22,ORK)) Q:ORK<1 S DA=ORK D ^DIK
;S DIK="^ORD(100.23,"
;F ORK=1000:0 S ORK=$O(^ORD(100.23,ORK)) Q:ORK<1 S DA=ORK D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCPRE 1045 printed Nov 22, 2024@17:38:53 Page 2
ORCPRE ; SLC/MKB - CPRS pre-init ;3/26/97 13:41
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
EN ; -- preinit cleanup
+1 DO PREORB^ORB3C1
if $$VERSION^XPDUTL("OR")'<3
QUIT
+2 ; -- Remove unused fields from #100
+3 NEW DA,DIK,DIU,ORU,DR,DIE
+4 SET DIK="^DD(100,"
SET DA(1)=100
+5 ; 0,3,4.1,5-nodes
FOR DA=16,14,1.1,9,21.1,33.1,40,42,43,44,45,35
DO ^DIK
+6 ; rebuild def'n w/o xrefs
FOR DA=.02,4,6,23,.68
DO ^DIK
+7 ; 6-node
FOR DA=.61,.62,.63,.64,.65,.66,.67,.68,.69,.691,.6911,.6912,.6913
DO ^DIK
+8 FOR DIU=100.008,100.09
SET DIU(0)="S"
DO EN^DIU2
+9 SET DIK="^DD(100.045,"
SET DA(1)=100.045
SET DA=.04
DO ^DIK
+10 ; -- Start over with Order Status, Nature of Order files
+11 FOR DIU=100.01,100.02
SET DIU(0)="DT"
DO EN^DIU2
+12 ; -- Setup Display Group, Print Fields, Print Formats files
+13 DO PRE^ORSET98
DO 22
+14 QUIT
+15 ;
22 ;Clean out print file entries above 1000
+1 XECUTE ^%ZOSF("UCI")
if Y="OEX,OER"
QUIT
+2 NEW DIK,ORK,DA
+3 SET DIK="^ORD(100.22,"
+4 ;F ORK=1000:0 S ORK=$O(^ORD(100.22,ORK)) Q:ORK<1 S DA=ORK D ^DIK
+5 ;S DIK="^ORD(100.23,"
+6 ;F ORK=1000:0 S ORK=$O(^ORD(100.23,ORK)) Q:ORK<1 S DA=ORK D ^DIK
+7 QUIT
