ORY260.m

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

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