ORY110 ;SLC/DAN--Clean up orderable items file ;1/4/02 13:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**110**;Dec 17, 1997
N IEN,DIK,IEN6,COUNT
K ^ORD(101.43,"B") ;Delete "B" cross reference to be rebuilt below
D MES^XPDUTL("Re-indexing the B cross reference of the SYNONYM field...")
S IEN=0 F S IEN=$O(^ORD(101.43,IEN)) Q:'+IEN D
.I $G(^ORD(101.43,IEN,0))="" K ^ORD(101.43,IEN) Q ;Delete extraneous nodes when 0 node doesn't exist
.I $O(^ORD(101.43,IEN,2,0)) K ^ORD(101.43,IEN,2,"B") S DIK="^ORD(101.43,IEN,2,",DIK(1)=".01^B",DA(1)=IEN D ENALL^DIK ;Reset "B" cross reference for synonym multiple
;
K DIK,DA
D MES^XPDUTL("Re-indexing the B cross reference of the ORDERABLE ITEMS file")
S DIK="^ORD(101.43,",DIK(1)=".01^B" D ENALL^DIK ;Rebuild B cross reference at the file level
;
D BMES^XPDUTL("Reviewing ORDER DIALOG file for incorrect pointer default values.")
S IEN=0 F S IEN=$O(^ORD(101.41,IEN)) Q:'+IEN I $D(^(IEN,6)) D
.S IEN6=0 F S IEN6=$O(^ORD(101.41,IEN,6,IEN6)) Q:'+IEN6 I $L($G(^(IEN6,1)),"^")>1 S ^ORD(101.41,IEN,6,IEN6,1)=$P(^ORD(101.41,IEN,6,IEN6,1),"^"),COUNT=$G(COUNT)+1
D MES^XPDUTL("Finished."_$S($G(COUNT)>0:" Fixed "_$G(COUNT)_" node"_$S($G(COUNT)>1:"s.",1:"."),1:""))
;
S ZTRTN="DQ^ORY110",ZTDTH=$H,ZTDESC="Patch OR*3*110 ORDER file cleanup",ZTSAVE("DUZ")="",ZTIO="" D ^%ZTLOAD
D MES^XPDUTL("Starting ORDER file clean-up job in the background. Task # "_+$G(ZTSK))
Q
;
DQ ;Entry point for background job to clean up ORDER file
N IEN,SUB,COUNT
S IEN=$$GETIEN(3010826.24)-1 ;get first IEN for date, subtract one so first IEN is reviewed
I IEN=-1 D MAIL Q
F S IEN=$O(^OR(100,IEN)) Q:'+IEN D
.S SUB=0 F S SUB=$O(^OR(100,IEN,.1,SUB)) Q:'+SUB D
..I $L($G(^(SUB,0)),"^")>1 D
...N DIK,DA
...K ^OR(100,IEN,.1,"B",$G(^OR(100,IEN,.1,SUB,0))) ;delete current B xref
...S ^OR(100,IEN,.1,SUB,0)=$P(^OR(100,IEN,.1,SUB,0),"^") ;remove extra pieces
...S DIK="^OR(100,IEN,.1,",DIK(1)=".01^B" ;set index to be reset and global node
...S DA=SUB,DA(1)=IEN ;DA is subfile IEN, DA(1) is file level IEN
...D EN1^DIK ;Set B xref for this entry
...Q
.S SUB=0 F S SUB=$O(^OR(100,IEN,4.5,SUB)) Q:'+SUB D
..I $L($G(^(SUB,1)),"^")>1 S ^(1)=$P(^(1),"^"),COUNT=$G(COUNT)+1 ;remove extra pieces, count changes
;
D MAIL ;Send mail notification upon completion
Q
;
GETIEN(STDT) ;Find first IEN associated with given start date
N DONE,IEN
S (DONE,IEN)=0
F S STDT=$O(^OR(100,"AF",STDT)) Q:'+STDT!(DONE) D
.S IEN=0 F S IEN=$O(^OR(100,"AF",STDT,IEN)) Q:'+IEN I $O(^(IEN,0))=1 S DONE=1 Q ;Find first ORDER that is a new order
Q IEN
;
MAIL ;Send email when finished
N XMSUB,XMTEXT,XMDUZ,ORTXT,XMY
S XMDUZ="Patch OR*3*110 Post-Init"
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S ORTXT(1)="The ORDER file clean-up initiated by patch OR*3*110 has completed."
S ORTXT(2)=""
S ORTXT(3)="There were "_$S($G(COUNT):COUNT,1:"no")_" changes made to the ORDER file."
S XMTEXT="ORTXT("
S XMSUB="Patch OR*3*110 ORDER file clean-up completed."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY110 3043 printed Oct 16, 2024@18:38:51 Page 2
ORY110 ;SLC/DAN--Clean up orderable items file ;1/4/02 13:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**110**;Dec 17, 1997
+2 NEW IEN,DIK,IEN6,COUNT
+3 ;Delete "B" cross reference to be rebuilt below
KILL ^ORD(101.43,"B")
+4 DO MES^XPDUTL("Re-indexing the B cross reference of the SYNONYM field...")
+5 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.43,IEN))
if '+IEN
QUIT
Begin DoDot:1
+6 ;Delete extraneous nodes when 0 node doesn't exist
IF $GET(^ORD(101.43,IEN,0))=""
KILL ^ORD(101.43,IEN)
QUIT
+7 ;Reset "B" cross reference for synonym multiple
IF $ORDER(^ORD(101.43,IEN,2,0))
KILL ^ORD(101.43,IEN,2,"B")
SET DIK="^ORD(101.43,IEN,2,"
SET DIK(1)=".01^B"
SET DA(1)=IEN
DO ENALL^DIK
End DoDot:1
+8 ;
+9 KILL DIK,DA
+10 DO MES^XPDUTL("Re-indexing the B cross reference of the ORDERABLE ITEMS file")
+11 ;Rebuild B cross reference at the file level
SET DIK="^ORD(101.43,"
SET DIK(1)=".01^B"
DO ENALL^DIK
+12 ;
+13 DO BMES^XPDUTL("Reviewing ORDER DIALOG file for incorrect pointer default values.")
+14 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.41,IEN))
if '+IEN
QUIT
IF $DATA(^(IEN,6))
Begin DoDot:1
+15 SET IEN6=0
FOR
SET IEN6=$ORDER(^ORD(101.41,IEN,6,IEN6))
if '+IEN6
QUIT
IF $LENGTH($GET(^(IEN6,1)),"^")>1
SET ^ORD(101.41,IEN,6,IEN6,1)=$PIECE(^ORD(101.41,IEN,6,IEN6,1),"^")
SET COUNT=$GET(COUNT)+1
End DoDot:1
+16 DO MES^XPDUTL("Finished."_$SELECT($GET(COUNT)>0:" Fixed "_$GET(COUNT)_" node"_$SELECT($GET(COUNT)>1:"s.",1:"."),1:""))
+17 ;
+18 SET ZTRTN="DQ^ORY110"
SET ZTDTH=$HOROLOG
SET ZTDESC="Patch OR*3*110 ORDER file cleanup"
SET ZTSAVE("DUZ")=""
SET ZTIO=""
DO ^%ZTLOAD
+19 DO MES^XPDUTL("Starting ORDER file clean-up job in the background. Task # "_+$GET(ZTSK))
+20 QUIT
+21 ;
DQ ;Entry point for background job to clean up ORDER file
+1 NEW IEN,SUB,COUNT
+2 ;get first IEN for date, subtract one so first IEN is reviewed
SET IEN=$$GETIEN(3010826.24)-1
+3 IF IEN=-1
DO MAIL
QUIT
+4 FOR
SET IEN=$ORDER(^OR(100,IEN))
if '+IEN
QUIT
Begin DoDot:1
+5 SET SUB=0
FOR
SET SUB=$ORDER(^OR(100,IEN,.1,SUB))
if '+SUB
QUIT
Begin DoDot:2
+6 IF $LENGTH($GET(^(SUB,0)),"^")>1
Begin DoDot:3
+7 NEW DIK,DA
+8 ;delete current B xref
KILL ^OR(100,IEN,.1,"B",$GET(^OR(100,IEN,.1,SUB,0)))
+9 ;remove extra pieces
SET ^OR(100,IEN,.1,SUB,0)=$PIECE(^OR(100,IEN,.1,SUB,0),"^")
+10 ;set index to be reset and global node
SET DIK="^OR(100,IEN,.1,"
SET DIK(1)=".01^B"
+11 ;DA is subfile IEN, DA(1) is file level IEN
SET DA=SUB
SET DA(1)=IEN
+12 ;Set B xref for this entry
DO EN1^DIK
+13 QUIT
End DoDot:3
End DoDot:2
+14 SET SUB=0
FOR
SET SUB=$ORDER(^OR(100,IEN,4.5,SUB))
if '+SUB
QUIT
Begin DoDot:2
+15 ;remove extra pieces, count changes
IF $LENGTH($GET(^(SUB,1)),"^")>1
SET ^(1)=$PIECE(^(1),"^")
SET COUNT=$GET(COUNT)+1
End DoDot:2
End DoDot:1
+16 ;
+17 ;Send mail notification upon completion
DO MAIL
+18 QUIT
+19 ;
GETIEN(STDT) ;Find first IEN associated with given start date
+1 NEW DONE,IEN
+2 SET (DONE,IEN)=0
+3 FOR
SET STDT=$ORDER(^OR(100,"AF",STDT))
if '+STDT!(DONE)
QUIT
Begin DoDot:1
+4 ;Find first ORDER that is a new order
SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,"AF",STDT,IEN))
if '+IEN
QUIT
IF $ORDER(^(IEN,0))=1
SET DONE=1
QUIT
End DoDot:1
+5 QUIT IEN
+6 ;
MAIL ;Send email when finished
+1 NEW XMSUB,XMTEXT,XMDUZ,ORTXT,XMY
+2 SET XMDUZ="Patch OR*3*110 Post-Init"
+3 SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+4 SET ORTXT(1)="The ORDER file clean-up initiated by patch OR*3*110 has completed."
+5 SET ORTXT(2)=""
+6 SET ORTXT(3)="There were "_$SELECT($GET(COUNT):COUNT,1:"no")_" changes made to the ORDER file."
+7 SET XMTEXT="ORTXT("
+8 SET XMSUB="Patch OR*3*110 ORDER file clean-up completed."
+9 DO ^XMD
+10 QUIT
