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)
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY56 1227 printed Dec 13, 2024@02:42:59 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
