ORCPRE.m

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 ---ORCPRE   1045     printed  Apr 09, 2024@21:24:29                                                                                                                                                                                                      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