Routine: ORY56

ORY56 ; SLC/MKB - Postinit for patch OR*3*56 ;5/20/99  15:37

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**56**;Dec 17, 1997

POST ; -- Update Nature of Order file, Task job to move OC Messages

 N DA,DIE,DR,DIK,X,Y,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,MSG

 S DA=$O(^ORD(100.02,"C","E",0)) I $E($G(^ORD(100.02,DA,0)))="P" D

 . S DIE="^ORD(100.02,",DR=".01///ELECTRONICALLY ENTERED" D ^DIE

 . S DA=$O(^ORD(100.02,"C","X",0)) S:DA $P(^ORD(100.02,DA,0),U,3)=1

 Q:'$$EXISTS(100.09,.03)  ;OC fields already converted

 S DIK="^DD(100.09,",DA=.03,DA(1)=100.09 D ^DIK ;remove old field

 S ZTRTN="OCMSG^ORY56",ZTDTH=$H,ZTIO=""

 S ZTDESC="Move Order Checking Messages to new node"

 D ^%ZTLOAD S MSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."

 D MES^XPDUTL(MSG)

EXISTS(FILE,FLD) ; -- Returns 1 or 0, if FLD exists in FILE

 I '$G(FILE)!('$G(FLD)) Q 0

 N ORY,ORZ D FIELD^DID(FILE,FLD,,"LABEL","ORY")

 S ORZ=$L($G(ORY("LABEL")))

 Q ORZ

OCMSG ; -- Move OC messages to new ^(1) node

 N ORIFN,ORCK,ORMSG S ORIFN=0

 F  S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0  I $D(^(ORIFN,9)) S ORCK=0 D

 . F  S ORCK=$O(^OR(100,ORIFN,9,ORCK)) Q:ORCK'>0  S ORMSG=$P($G(^(ORCK,0)),U,3) S:$L(ORMSG) $P(^(0),U,3)="",^(1)=ORMSG

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY56   1227     printed  Feb 19, 2025@00:09:31                                                                                                                                                                                                       Page 2

ORY56     ; SLC/MKB - Postinit for patch OR*3*56 ;5/20/99  15:37

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**56**;Dec 17, 1997

 +2       ;

POST      ; -- Update Nature of Order file, Task job to move OC Messages

 +1       ;

 +2        NEW DA,DIE,DR,DIK,X,Y,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,MSG

 +3        SET DA=$ORDER(^ORD(100.02,"C","E",0))

           IF $EXTRACT($GET(^ORD(100.02,DA,0)))="P"

               Begin DoDot:1

 +4                SET DIE="^ORD(100.02,"

                   SET DR=".01///ELECTRONICALLY ENTERED"

                   DO ^DIE

 +5                SET DA=$ORDER(^ORD(100.02,"C","X",0))

                   if DA

                       SET $PIECE(^ORD(100.02,DA,0),U,3)=1

               End DoDot:1

 +6       ;OC fields already converted

           if '$$EXISTS(100.09,.03)

               QUIT

 +7       ;remove old field

           SET DIK="^DD(100.09,"

           SET DA=.03

           SET DA(1)=100.09

           DO ^DIK

 +8        SET ZTRTN="OCMSG^ORY56"

           SET ZTDTH=$HOROLOG

           SET ZTIO=""

 +9        SET ZTDESC="Move Order Checking Messages to new node"

 +10       DO ^%ZTLOAD

           SET MSG="Task "_$SELECT($GET(ZTSK):"#"_ZTSK,1:"not")_" started."

 +11       DO MES^XPDUTL(MSG)

 +12       QUIT

 +13      ;

EXISTS(FILE,FLD) ; -- Returns 1 or 0, if FLD exists in FILE

 +1        IF '$GET(FILE)!('$GET(FLD))

               QUIT 0

 +2        NEW ORY,ORZ

           DO FIELD^DID(FILE,FLD,,"LABEL","ORY")

 +3        SET ORZ=$LENGTH($GET(ORY("LABEL")))

 +4        QUIT ORZ

 +5       ;

OCMSG     ; -- Move OC messages to new ^(1) node

 +1       ;

 +2        NEW ORIFN,ORCK,ORMSG

           SET ORIFN=0

 +3        FOR

               SET ORIFN=$ORDER(^OR(100,ORIFN))

               if ORIFN'>0

                   QUIT

               IF $DATA(^(ORIFN,9))

                   SET ORCK=0

                   Begin DoDot:1

 +4                    FOR

                           SET ORCK=$ORDER(^OR(100,ORIFN,9,ORCK))

                           if ORCK'>0

                               QUIT

                           SET ORMSG=$PIECE($GET(^(ORCK,0)),U,3)

                           if $LENGTH(ORMSG)

                               SET $PIECE(^(0),U,3)=""

                               SET ^(1)=ORMSG

                   End DoDot:1

 +5        QUIT

ORY56.m