ORY260 ; SLC/STAFF - Patch OR*3.0*260 post init ;8/21/06 13:13
;;3.0;ORDER ENTRY/RESULTS REPORTING;**260**;Dec 17, 1997;Build 26
POST ; post-init to patch OR*3.0*260
; fix any string formatted date/times in CR index
; remove Treatment type from graphing
N DA,DIR,ORMSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE K DIR,ORMSG
S ORMSG(1)="A task is being queued in the background to identify"
S ORMSG(2)="any Start or Start dates where times have trailing zeros."
S ORMSG(3)=""
S ORMSG(4)="These indexes will be reset with the correct canonic"
S ORMSG(5)="values by this background job. A mail message will be"
S ORMSG(6)="sent to the initiator of this patch at completion."
S ORMSG(7)=""
S ORMSG(8)=""
S ZTRTN="DQ^ORY260",ZTIO=""
S ZTDESC="Clean up - Patch 260",ZTDTH=$H,ZTSAVE("DUZ")=""
D ^%ZTLOAD
S ORMSG(9)="The task number is "_$G(ZTSK)
D MES^XPDUTL(.ORMSG) I '$D(ZTQUEUED) D
. N DIR,Y
. S DIR(0)="E",DIR("A")="Press return - installation is complete."
. D ^DIR
Q
;
DQ ; dequeued
N BEGIN,CNT,DFN,ITEM,NODE,OK,START,STOP K ^TMP("ORPXRM",$J),^TMP("ORTXT",$J)
S BEGIN=$$NOW^XLFDT
S CNT=0
S DFN=0
F S DFN=$O(^PXRMINDX(100,"PI",DFN)) Q:DFN<1 D
. S ITEM=0
. F S ITEM=$O(^PXRMINDX(100,"PI",DFN,ITEM)) Q:ITEM<1 D
.. S START=""
.. F S START=$O(^PXRMINDX(100,"PI",DFN,ITEM,START)) Q:START="" D
... S STOP=""
... F S STOP=$O(^PXRMINDX(100,"PI",DFN,ITEM,START,STOP)) Q:STOP="" D
.... S OK=1
.... I START'=+START S OK=0
.... I OK,$E(STOP)'="U",STOP'=+STOP S OK=0
.... I OK Q
.... S NODE=""
.... F S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,START,STOP,NODE)) Q:NODE="" D
..... S ^TMP("ORPXRM",$J,NODE)=DFN_U_ITEM_U_START_U_STOP
..... S CNT=CNT+1
..... ;W !,NODE,?20,$P($G(^OR(100,+NODE,0)),U,8),?35,$P($G(^OR(100,+NODE,0)),U,9),?55,START
S ^TMP("ORTXT",$J,4)="-- "_CNT_" nodes to check --" ; overwrite on finish
S ^TMP("ORTXT",$J,5)=" "
S CNT=5
S NODE=""
F S NODE=$O(^TMP("ORPXRM",$J,NODE)) Q:NODE="" D
. D FIX(NODE,.CNT)
S ^TMP("ORTXT",$J,4)="-- "_(CNT-5)_" changes made --"
K ^TMP("ORPXRM",$J)
D TREMOVE("ORWG GRAPH VIEW") ; removes treatment type from graphing
D MAIL(BEGIN)
K ^TMP("ORTXT",$J)
Q
;
FIX(NODE,CNT) ;
N DA,DATE1,DATE2,DFN,DIE,DR,ITEM,LINE,START,STOP,VALUES,ZERO
S VALUES=$G(^TMP("ORPXRM",$J,NODE))
S DFN=$P(VALUES,U)
S ITEM=$P(VALUES,U,2)
S DATE1=$P(VALUES,U,3)
S DATE2=$P(VALUES,U,4)
K ^PXRMINDX(100,"PI",DFN,ITEM,DATE1,DATE2,NODE)
K ^PXRMINDX(100,"IP",ITEM,DFN,DATE1,DATE2,NODE)
S DIE="^OR(100,"
S DA=+NODE
S ZERO=$G(^OR(100,DA,0))
S START=+$P(ZERO,U,8) I START=0 S START="@"
S STOP=+$P(ZERO,U,9) I STOP=0 S STOP="@"
S DR=""
I START'=DATE1 S DR="21///"_START
I START="@",$P(ZERO,U,8)="" S DR=""
I STOP'=DATE2 D
. I STOP="@",$E(DATE2)="U" Q
. I $L(DR) S DR=DR_";22///"_STOP Q
. S DR="22///"_STOP Q
I '$L(DR) Q
S LINE="Node: "_NODE
I DR["21///" S LINE=LINE_"; Start: "_DATE1_" -> "_START
I DR["22///" S LINE=LINE_"; Stop: "_DATE2_" -> "_STOP
D ^DIE
S CNT=CNT+1
S ^TMP("ORTXT",$J,CNT)=LINE
Q
;
TREMOVE(PARAM) ;
N ENTITY,INST,LINES,OK,VALUES K LINES,VALUES
D XENVAL^ORWGAPIX(.VALUES,PARAM)
I '$L($O(VALUES(""))) Q
S ENTITY=""
F S ENTITY=$O(VALUES(ENTITY)) Q:ENTITY="" D
. S INST=""
. F S INST=$O(VALUES(ENTITY,INST)) Q:INST="" D
.. D XGETWP^ORWGAPIX(.LINES,ENTITY,PARAM,INST)
.. D FIXLINES(.LINES,.OK)
.. I 'OK D FIXIT(.LINES,ENTITY,PARAM,INST)
Q
;
FIXLINES(LINES,OK) ;
N I,LINE,NLINE,NLINES,NNUM,NUM,PART K NLINES
S OK=1,NNUM=0
S NUM=0
F S NUM=$O(LINES(NUM)) Q:NUM<1 D
. S LINE=$G(LINES(NUM,0))
. I '$L(LINE) Q
. S NLINE=LINE
. I LINE["~9000010.15" D
.. S NLINE="",OK=0
.. F I=1:1:999 S PART=$P(LINE,"|",I) Q:PART="" D
... I PART["~9000010.15" Q
... S NLINE=NLINE_PART_"|"
. I NLINE="" Q
. S NNUM=NNUM+1
. S NLINES(NNUM,0)=NLINE
I OK Q
K LINES
M LINES=NLINES
Q
;
FIXIT(LINES,ENTITY,PARAM,INST) ;
D XDEL^ORWGAPIX(ENTITY,PARAM,INST)
I $L($O(LINES(""))) D XEN^ORWGAPIX(ENTITY,PARAM,INST,.LINES)
Q
;
MAIL(BEGIN) ; -- Send completion message to user who initiated cleanup
N TIMES,XMSUB,XMTEXT,XMDUN,XMDUZ,XMY,XMZ K XMY
S XMDUZ="PATCH OR*3.0*260 CLEAN-UP",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S TIMES="Started: "_$$FMTE^XLFDT(BEGIN)_"; Completed: "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
S ^TMP("ORTXT",$J,1)="Clean up for patch OR*3.0*260"
S ^TMP("ORTXT",$J,2)=TIMES
S ^TMP("ORTXT",$J,3)="Order Node Date Cleanup:"
S XMTEXT="^TMP(""ORTXT"","_$J_","
S XMSUB="PATCH OR*3.0*260 Clean Up COMPLETED"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY260 4560 printed Sep 23, 2025@20:16:17 Page 2
ORY260 ; SLC/STAFF - Patch OR*3.0*260 post init ;8/21/06 13:13
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**260**;Dec 17, 1997;Build 26
POST ; post-init to patch OR*3.0*260
+1 ; fix any string formatted date/times in CR index
+2 ; remove Treatment type from graphing
+3 NEW DA,DIR,ORMSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
KILL DIR,ORMSG
+4 SET ORMSG(1)="A task is being queued in the background to identify"
+5 SET ORMSG(2)="any Start or Start dates where times have trailing zeros."
+6 SET ORMSG(3)=""
+7 SET ORMSG(4)="These indexes will be reset with the correct canonic"
+8 SET ORMSG(5)="values by this background job. A mail message will be"
+9 SET ORMSG(6)="sent to the initiator of this patch at completion."
+10 SET ORMSG(7)=""
+11 SET ORMSG(8)=""
+12 SET ZTRTN="DQ^ORY260"
SET ZTIO=""
+13 SET ZTDESC="Clean up - Patch 260"
SET ZTDTH=$HOROLOG
SET ZTSAVE("DUZ")=""
+14 DO ^%ZTLOAD
+15 SET ORMSG(9)="The task number is "_$GET(ZTSK)
+16 DO MES^XPDUTL(.ORMSG)
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+17 NEW DIR,Y
+18 SET DIR(0)="E"
SET DIR("A")="Press return - installation is complete."
+19 DO ^DIR
End DoDot:1
+20 QUIT
+21 ;
DQ ; dequeued
+1 NEW BEGIN,CNT,DFN,ITEM,NODE,OK,START,STOP
KILL ^TMP("ORPXRM",$JOB),^TMP("ORTXT",$JOB)
+2 SET BEGIN=$$NOW^XLFDT
+3 SET CNT=0
+4 SET DFN=0
+5 FOR
SET DFN=$ORDER(^PXRMINDX(100,"PI",DFN))
if DFN<1
QUIT
Begin DoDot:1
+6 SET ITEM=0
+7 FOR
SET ITEM=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM))
if ITEM<1
QUIT
Begin DoDot:2
+8 SET START=""
+9 FOR
SET START=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,START))
if START=""
QUIT
Begin DoDot:3
+10 SET STOP=""
+11 FOR
SET STOP=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,START,STOP))
if STOP=""
QUIT
Begin DoDot:4
+12 SET OK=1
+13 IF START'=+START
SET OK=0
+14 IF OK
IF $EXTRACT(STOP)'="U"
IF STOP'=+STOP
SET OK=0
+15 IF OK
QUIT
+16 SET NODE=""
+17 FOR
SET NODE=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,START,STOP,NODE))
if NODE=""
QUIT
Begin DoDot:5
+18 SET ^TMP("ORPXRM",$JOB,NODE)=DFN_U_ITEM_U_START_U_STOP
+19 SET CNT=CNT+1
+20 ;W !,NODE,?20,$P($G(^OR(100,+NODE,0)),U,8),?35,$P($G(^OR(100,+NODE,0)),U,9),?55,START
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 ; overwrite on finish
SET ^TMP("ORTXT",$JOB,4)="-- "_CNT_" nodes to check --"
+22 SET ^TMP("ORTXT",$JOB,5)=" "
+23 SET CNT=5
+24 SET NODE=""
+25 FOR
SET NODE=$ORDER(^TMP("ORPXRM",$JOB,NODE))
if NODE=""
QUIT
Begin DoDot:1
+26 DO FIX(NODE,.CNT)
End DoDot:1
+27 SET ^TMP("ORTXT",$JOB,4)="-- "_(CNT-5)_" changes made --"
+28 KILL ^TMP("ORPXRM",$JOB)
+29 ; removes treatment type from graphing
DO TREMOVE("ORWG GRAPH VIEW")
+30 DO MAIL(BEGIN)
+31 KILL ^TMP("ORTXT",$JOB)
+32 QUIT
+33 ;
FIX(NODE,CNT) ;
+1 NEW DA,DATE1,DATE2,DFN,DIE,DR,ITEM,LINE,START,STOP,VALUES,ZERO
+2 SET VALUES=$GET(^TMP("ORPXRM",$JOB,NODE))
+3 SET DFN=$PIECE(VALUES,U)
+4 SET ITEM=$PIECE(VALUES,U,2)
+5 SET DATE1=$PIECE(VALUES,U,3)
+6 SET DATE2=$PIECE(VALUES,U,4)
+7 KILL ^PXRMINDX(100,"PI",DFN,ITEM,DATE1,DATE2,NODE)
+8 KILL ^PXRMINDX(100,"IP",ITEM,DFN,DATE1,DATE2,NODE)
+9 SET DIE="^OR(100,"
+10 SET DA=+NODE
+11 SET ZERO=$GET(^OR(100,DA,0))
+12 SET START=+$PIECE(ZERO,U,8)
IF START=0
SET START="@"
+13 SET STOP=+$PIECE(ZERO,U,9)
IF STOP=0
SET STOP="@"
+14 SET DR=""
+15 IF START'=DATE1
SET DR="21///"_START
+16 IF START="@"
IF $PIECE(ZERO,U,8)=""
SET DR=""
+17 IF STOP'=DATE2
Begin DoDot:1
+18 IF STOP="@"
IF $EXTRACT(DATE2)="U"
QUIT
+19 IF $LENGTH(DR)
SET DR=DR_";22///"_STOP
QUIT
+20 SET DR="22///"_STOP
QUIT
End DoDot:1
+21 IF '$LENGTH(DR)
QUIT
+22 SET LINE="Node: "_NODE
+23 IF DR["21///"
SET LINE=LINE_"; Start: "_DATE1_" -> "_START
+24 IF DR["22///"
SET LINE=LINE_"; Stop: "_DATE2_" -> "_STOP
+25 DO ^DIE
+26 SET CNT=CNT+1
+27 SET ^TMP("ORTXT",$JOB,CNT)=LINE
+28 QUIT
+29 ;
TREMOVE(PARAM) ;
+1 NEW ENTITY,INST,LINES,OK,VALUES
KILL LINES,VALUES
+2 DO XENVAL^ORWGAPIX(.VALUES,PARAM)
+3 IF '$LENGTH($ORDER(VALUES("")))
QUIT
+4 SET ENTITY=""
+5 FOR
SET ENTITY=$ORDER(VALUES(ENTITY))
if ENTITY=""
QUIT
Begin DoDot:1
+6 SET INST=""
+7 FOR
SET INST=$ORDER(VALUES(ENTITY,INST))
if INST=""
QUIT
Begin DoDot:2
+8 DO XGETWP^ORWGAPIX(.LINES,ENTITY,PARAM,INST)
+9 DO FIXLINES(.LINES,.OK)
+10 IF 'OK
DO FIXIT(.LINES,ENTITY,PARAM,INST)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
FIXLINES(LINES,OK) ;
+1 NEW I,LINE,NLINE,NLINES,NNUM,NUM,PART
KILL NLINES
+2 SET OK=1
SET NNUM=0
+3 SET NUM=0
+4 FOR
SET NUM=$ORDER(LINES(NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 SET LINE=$GET(LINES(NUM,0))
+6 IF '$LENGTH(LINE)
QUIT
+7 SET NLINE=LINE
+8 IF LINE["~9000010.15"
Begin DoDot:2
+9 SET NLINE=""
SET OK=0
+10 FOR I=1:1:999
SET PART=$PIECE(LINE,"|",I)
if PART=""
QUIT
Begin DoDot:3
+11 IF PART["~9000010.15"
QUIT
+12 SET NLINE=NLINE_PART_"|"
End DoDot:3
End DoDot:2
+13 IF NLINE=""
QUIT
+14 SET NNUM=NNUM+1
+15 SET NLINES(NNUM,0)=NLINE
End DoDot:1
+16 IF OK
QUIT
+17 KILL LINES
+18 MERGE LINES=NLINES
+19 QUIT
+20 ;
FIXIT(LINES,ENTITY,PARAM,INST) ;
+1 DO XDEL^ORWGAPIX(ENTITY,PARAM,INST)
+2 IF $LENGTH($ORDER(LINES("")))
DO XEN^ORWGAPIX(ENTITY,PARAM,INST,.LINES)
+3 QUIT
+4 ;
MAIL(BEGIN) ; -- Send completion message to user who initiated cleanup
+1 NEW TIMES,XMSUB,XMTEXT,XMDUN,XMDUZ,XMY,XMZ
KILL XMY
+2 SET XMDUZ="PATCH OR*3.0*260 CLEAN-UP"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+3 SET TIMES="Started: "_$$FMTE^XLFDT(BEGIN)_"; Completed: "_$$FMTE^XLFDT($$NOW^XLFDT)_"."
+4 SET ^TMP("ORTXT",$JOB,1)="Clean up for patch OR*3.0*260"
+5 SET ^TMP("ORTXT",$JOB,2)=TIMES
+6 SET ^TMP("ORTXT",$JOB,3)="Order Node Date Cleanup:"
+7 SET XMTEXT="^TMP(""ORTXT"","_$JOB_","
+8 SET XMSUB="PATCH OR*3.0*260 Clean Up COMPLETED"
+9 DO ^XMD
+10 QUIT
