GMRCYP69.m

GMRCYP69 ;SLC/WAT - Reformat long comments from Edit/Resubmit ;1/21/09

 ;;3.0;CONSULT/REQUEST TRACKING;**69**;DEC 27, 1997;Build 13

 ;;

 ;;ICR Invoked

 ;;10063, ^%ZTLOAD - $$S

 ;;10141, ^XPDUTL - BMES, PATCH

 ;;10103, ^XLFDT - $$FMADD, $$NOW, $$FMTH

 ;;10113, ^XMB(3.9

 ;;10066, XMZ^XMA2

 ;;10070, ^XMD - ENL,  ENT1

 ;;10011, ^DIWP, ^UTILITY($J

 ;;2053, WP^DIE

PRE ;sys check

 I $G(DUZ)="" D BMES^XPDUTL("Your DUZ is not defined. Install aborted. Transport global NOT deleted from system.") S XPDABORT=2 Q

 I '$$PATCH^XPDUTL("OR*3.0*296") S XPDABORT=2 D  Q 

 .D BMES^XPDUTL("*************")

 .D BMES^XPDUTL("OR*3.0*296 and the associated CPRS GUI exe must be installed first!")

 .D BMES^XPDUTL("Install aborted. Transport global NOT deleted from system.")

 Q

POST ;go

 D QUEUE

 Q

QUEUE ;task entry point

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

      S ZTRTN="EN^GMRCYP69",ZTDESC="GMRC Reformat Long Comments from Edit/Resubmit Action",ZTIO="",ZTDTH=$H

 D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN EN^GMRCYP69 AFTER INSTALL FINISHES") Q 

 D BMES^XPDUTL("Post-install queued as task #"_$G(ZTSK))

 D BMES^XPDUTL("If any records are locked, task will re-run 5 minutes after completion.")

 Q

EN ;main

 S $P(^XTMP("GMRC_PRE69",0),U)=$$FMADD^XLFDT(DT,45),$P(^XTMP("GMRC_PRE69",0),U,2)=DT

 S $P(^XTMP("GMRC_PRE69",0),U,3)=DUZ_" Patch installer's DUZ, global contains comment data before reformat in GMRC*3.0*69"

 S ^XTMP("GMRC_PRE69","DUZ")=DUZ ;get user's DUZ for mail mesage

 D SRCH

 I $D(^XTMP("GMRC_PRE69","RECHECK")) D RECHECK S ZTREQ="@" Q  ;some are locked, run recheck, clean task and quit

 I $D(^XTMP("GMRC_PRE69","RECHECK"))=0 D MSG S ZTREQ="@" Q  ;If all are checked, send msg, clean task, and quit

 Q

RECHECK ;if locked records requeue and re-run until all are checked

 Q:'$D(ZTQUEUED)&($D(^XTMP("GMRC_PRE69","RECHECK"))=0)  ;abort if outside taskman and all records already checked.

 N RECLOCK,IEN,A,B,TOTAL,IDX S (IEN,TOTAL)=0,IDX=""

 F  S IEN=$O(^XTMP("GMRC_PRE69","RECHECK",IEN)) Q:IEN=""  D

 .S RECLOCK=$$LOCKREC^GMRCUTL1(IEN)

 .Q:$G(RECLOCK)'=1  ;if still locked, do nothing

 .F  S IDX=$O(^XTMP("GMRC_PRE69","RECHECK",IEN,IDX)) Q:IDX=""  D

 ..S A=$P(^XTMP("GMRC_PRE69","RECHECK",IEN,IDX),",",4),B=1

 ..D REFORMAT D UNLKREC^GMRCUTL1(IEN) S ^XTMP("GMRC_PRE69","TOTAL")=$G(^XTMP("GMRC_PRE69","TOTAL"))+1

 ..K ^XTMP("GMRC_PRE69","RECHECK",IEN,IDX)

 I $D(^XTMP("GMRC_PRE69","RECHECK"))=0 D MSG S:($D(ZTQUEUED)) ZTREQ="@" Q

 E  D

 .N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE

      .S ZTRTN="RECHECK^GMRCYP69",ZTDESC="GMRC Reformat Long Comments from Edit/Resubmit Action - RECHECK",ZTIO=""

      .S ZTDTH=$$FMTH^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,,,5)) ;set to re-run in 5 minutes

      .D ^%ZTLOAD

      S ZTREQ="@"

 Q

SRCH ;search for long comments

 N IEN,A,B,C,TOTAL,FLG,LNCNT,RECLOCK,STPCHK,IDX S (IEN,TOTAL,RECLOCK,STPCHK,IDX)=0,LNCNT=1

 F  S IEN=$O(^GMR(123,IEN)) Q:+IEN=0!($G(ZTSTOP))  D

 .S A=0,STPCHK=STPCHK+1

 .I STPCHK>1000,$D(ZTQUEUED) S:$$S^%ZTLOAD ZTSTOP=1 Q:$G(ZTSTOP)  S STPCHK=0

 .F  S A=$O(^GMR(123,IEN,40,A)) Q:+A=0  D

 ..Q:$D(^GMR(123,IEN,40,A,0))<1

 ..Q:$P(^GMR(123,IEN,40,A,0),U,2)'=20  ;quit if action is not Add Comment

 ..;quit if next action not Edit/Resubmit, only get comments from Edit/Resubmit

 ..Q:$D(^GMR(123,IEN,40,A+1,0))<10&($P($G(^GMR(123,IEN,40,A+1,0)),U,2)'=11)

 ..S B=0

 ..F  S B=$O(^GMR(123,IEN,40,A,B)) Q:+B=0  D

 ...S C=0,FLG=0

 ...F  S C=$O(^GMR(123,IEN,40,A,B,C)) Q:+C=0  D  Q:FLG=1!($G(RECLOCK)=1)

 ....S FLG=0,RECLOCK=0 S:($L(^GMR(123,IEN,40,A,B,C,0))>80) FLG=1 Q:FLG'=1

 ....S RECLOCK=$$LOCKREC^GMRCUTL1(IEN)

 ....I $G(RECLOCK)'=1 S ^XTMP("GMRC_PRE69","RECHECK",IEN,IDX)=$NA(^GMR(123,IEN,40,A,B,C,0)),IDX=IDX+1

 ....S:$G(RECLOCK)=1 TOTAL=TOTAL+1,^XTMP("GMRC_PRE69","TOTAL")=$G(^XTMP("GMRC_PRE69","TOTAL"))+1

 ....D REFORMAT D:$G(RECLOCK)=1 UNLKREC^GMRCUTL1(IEN)

 Q

REFORMAT ;reformat data to 74 characters

 K ^UTILITY($J,"W")

 N INT,GMRC69,GMRCTMP,REF S INT=0,REF=A

 N X,DIWL,DIWR,DIWF

 S DIWL=1,DIWR=74,DIWF=""

 Q:$G(RECLOCK)'=1

 F  S INT=$O(^GMR(123,IEN,40,A,B,INT)) Q:+INT=0  D

 .S ^XTMP("GMRC_PRE69",IEN,40,A,B,INT,0)=^GMR(123,IEN,40,A,B,INT,0)

 .S X=^GMR(123,IEN,40,A,B,INT,0)

 .D ^DIWP

 .S:$G(RECLOCK)'=1 INT="A"

 D WP^DIE(123.02,REF_","_IEN_",","5","","^UTILITY($J,""W"",1)","^TMP($J,""ERR"")")

 Q

MSG ;create and send message

 N XMDUZ,XMSUB,XMZ,XMTEXT,XMY ;i/o args for XMZ^XMA2.

 N IEN,A,B,C,LNCNT S (IEN,A,B,C)=0,LNCNT=1

 S XMY(^XTMP("GMRC_PRE69","DUZ"))=""

 S XMDUZ="GMRC PACKAGE"

 S XMSUB="GMRC*3.0*69 COMMENTS BEFORE REFORMAT"

 D XMZ^XMA2 ; call Create Message Module

 I $G(^XTMP("GMRC_PRE69","TOTAL"))>0 F  S IEN=$O(^XTMP("GMRC_PRE69",IEN)) Q:+IEN=0  D

 .F  S A=$O(^XTMP("GMRC_PRE69",IEN,40,A)) Q:+A=0  D

 ..F  S B=$O(^XTMP("GMRC_PRE69",IEN,40,A,B)) Q:+B=0  D

 ...F  S C=$O(^XTMP("GMRC_PRE69",IEN,40,A,B,C)) Q:+C=0  D

 ....S ^XMB(3.9,XMZ,2,LNCNT,0)=$NA(^GMR(123,IEN,40,A,B,C,0))_U_^XTMP("GMRC_PRE69",IEN,40,A,B,C,0)

 ....S ^XMB(3.9,XMZ,2,0)="^3.92^"_LNCNT_"^"_LNCNT_"^"_DT ;define zero node per API

 ....S LNCNT=LNCNT+1

 I $G(^XTMP("GMRC_PRE69","TOTAL"))=0!($D(^XTMP("GMRC_PRE69","TOTAL"))=0) D

 .S XMTEXT="XMTEXT"

 .S XMTEXT(1)="No long comments found.  No records were modified in ^GMR(123."

 .D ENL^XMD

 D ENT1^XMD

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRCYP69   5302     printed  Mar 13, 2025@20:52:40                                                                                                                                                                                                    Page 2

GMRCYP69  ;SLC/WAT - Reformat long comments from Edit/Resubmit ;1/21/09

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**69**;DEC 27, 1997;Build 13

 +2       ;;

 +3       ;;ICR Invoked

 +4       ;;10063, ^%ZTLOAD - $$S

 +5       ;;10141, ^XPDUTL - BMES, PATCH

 +6       ;;10103, ^XLFDT - $$FMADD, $$NOW, $$FMTH

 +7       ;;10113, ^XMB(3.9

 +8       ;;10066, XMZ^XMA2

 +9       ;;10070, ^XMD - ENL,  ENT1

 +10      ;;10011, ^DIWP, ^UTILITY($J

 +11      ;;2053, WP^DIE

PRE       ;sys check

 +1        IF $GET(DUZ)=""

               DO BMES^XPDUTL("Your DUZ is not defined. Install aborted. Transport global NOT deleted from system.")

               SET XPDABORT=2

               QUIT 

 +2        IF '$$PATCH^XPDUTL("OR*3.0*296")

               SET XPDABORT=2

               Begin DoDot:1

 +3                DO BMES^XPDUTL("*************")

 +4                DO BMES^XPDUTL("OR*3.0*296 and the associated CPRS GUI exe must be installed first!")

 +5                DO BMES^XPDUTL("Install aborted. Transport global NOT deleted from system.")

               End DoDot:1

               QUIT 

 +6        QUIT 

POST      ;go

 +1        DO QUEUE

 +2        QUIT 

QUEUE     ;task entry point

 +1        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

 +2        SET ZTRTN="EN^GMRCYP69"

           SET ZTDESC="GMRC Reformat Long Comments from Edit/Resubmit Action"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +3        DO ^%ZTLOAD

           IF '$GET(ZTSK)

               DO BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN EN^GMRCYP69 AFTER INSTALL FINISHES")

               QUIT 

 +4        DO BMES^XPDUTL("Post-install queued as task #"_$GET(ZTSK))

 +5        DO BMES^XPDUTL("If any records are locked, task will re-run 5 minutes after completion.")

 +6        QUIT 

EN        ;main

 +1        SET $PIECE(^XTMP("GMRC_PRE69",0),U)=$$FMADD^XLFDT(DT,45)

           SET $PIECE(^XTMP("GMRC_PRE69",0),U,2)=DT

 +2        SET $PIECE(^XTMP("GMRC_PRE69",0),U,3)=DUZ_" Patch installer's DUZ, global contains comment data before reformat in GMRC*3.0*69"

 +3       ;get user's DUZ for mail mesage

           SET ^XTMP("GMRC_PRE69","DUZ")=DUZ

 +4        DO SRCH

 +5       ;some are locked, run recheck, clean task and quit

           IF $DATA(^XTMP("GMRC_PRE69","RECHECK"))

               DO RECHECK

               SET ZTREQ="@"

               QUIT 

 +6       ;If all are checked, send msg, clean task, and quit

           IF $DATA(^XTMP("GMRC_PRE69","RECHECK"))=0

               DO MSG

               SET ZTREQ="@"

               QUIT 

 +7        QUIT 

RECHECK   ;if locked records requeue and re-run until all are checked

 +1       ;abort if outside taskman and all records already checked.

           if '$DATA(ZTQUEUED)&($DATA(^XTMP("GMRC_PRE69","RECHECK"))=0)

               QUIT 

 +2        NEW RECLOCK,IEN,A,B,TOTAL,IDX

           SET (IEN,TOTAL)=0

           SET IDX=""

 +3        FOR 

               SET IEN=$ORDER(^XTMP("GMRC_PRE69","RECHECK",IEN))

               if IEN=""

                   QUIT 

               Begin DoDot:1

 +4                SET RECLOCK=$$LOCKREC^GMRCUTL1(IEN)

 +5       ;if still locked, do nothing

                   if $GET(RECLOCK)'=1

                       QUIT 

 +6                FOR 

                       SET IDX=$ORDER(^XTMP("GMRC_PRE69","RECHECK",IEN,IDX))

                       if IDX=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET A=$PIECE(^XTMP("GMRC_PRE69","RECHECK",IEN,IDX),",",4)

                           SET B=1

 +8                        DO REFORMAT

                           DO UNLKREC^GMRCUTL1(IEN)

                           SET ^XTMP("GMRC_PRE69","TOTAL")=$GET(^XTMP("GMRC_PRE69","TOTAL"))+1

 +9                        KILL ^XTMP("GMRC_PRE69","RECHECK",IEN,IDX)

                       End DoDot:2

               End DoDot:1

 +10       IF $DATA(^XTMP("GMRC_PRE69","RECHECK"))=0

               DO MSG

               if ($DATA(ZTQUEUED))

                   SET ZTREQ="@"

               QUIT 

 +11      IF '$TEST

               Begin DoDot:1

 +12               NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE

 +13               SET ZTRTN="RECHECK^GMRCYP69"

                   SET ZTDESC="GMRC Reformat Long Comments from Edit/Resubmit Action - RECHECK"

                   SET ZTIO=""

 +14      ;set to re-run in 5 minutes

                   SET ZTDTH=$$FMTH^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,,,5))

 +15               DO ^%ZTLOAD

               End DoDot:1

 +16       SET ZTREQ="@"

 +17       QUIT 

SRCH      ;search for long comments

 +1        NEW IEN,A,B,C,TOTAL,FLG,LNCNT,RECLOCK,STPCHK,IDX

           SET (IEN,TOTAL,RECLOCK,STPCHK,IDX)=0

           SET LNCNT=1

 +2        FOR 

               SET IEN=$ORDER(^GMR(123,IEN))

               if +IEN=0!($GET(ZTSTOP))

                   QUIT 

               Begin DoDot:1

 +3                SET A=0

                   SET STPCHK=STPCHK+1

 +4                IF STPCHK>1000

                       IF $DATA(ZTQUEUED)

                           if $$S^%ZTLOAD

                               SET ZTSTOP=1

                           if $GET(ZTSTOP)

                               QUIT 

                           SET STPCHK=0

 +5                FOR 

                       SET A=$ORDER(^GMR(123,IEN,40,A))

                       if +A=0

                           QUIT 

                       Begin DoDot:2

 +6                        if $DATA(^GMR(123,IEN,40,A,0))<1

                               QUIT 

 +7       ;quit if action is not Add Comment

                           if $PIECE(^GMR(123,IEN,40,A,0),U,2)'=20

                               QUIT 

 +8       ;quit if next action not Edit/Resubmit, only get comments from Edit/Resubmit

 +9                        if $DATA(^GMR(123,IEN,40,A+1,0))<10&($PIECE($GET(^GMR(123,IEN,40,A+1,0)),U,2)'=11)

                               QUIT 

 +10                       SET B=0

 +11                       FOR 

                               SET B=$ORDER(^GMR(123,IEN,40,A,B))

                               if +B=0

                                   QUIT 

                               Begin DoDot:3

 +12                               SET C=0

                                   SET FLG=0

 +13                               FOR 

                                       SET C=$ORDER(^GMR(123,IEN,40,A,B,C))

                                       if +C=0

                                           QUIT 

                                       Begin DoDot:4

 +14                                       SET FLG=0

                                           SET RECLOCK=0

                                           if ($LENGTH(^GMR(123,IEN,40,A,B,C,0))>80)

                                               SET FLG=1

                                           if FLG'=1

                                               QUIT 

 +15                                       SET RECLOCK=$$LOCKREC^GMRCUTL1(IEN)

 +16                                       IF $GET(RECLOCK)'=1

                                               SET ^XTMP("GMRC_PRE69","RECHECK",IEN,IDX)=$NAME(^GMR(123,IEN,40,A,B,C,0))

                                               SET IDX=IDX+1

 +17                                       if $GET(RECLOCK)=1

                                               SET TOTAL=TOTAL+1

                                               SET ^XTMP("GMRC_PRE69","TOTAL")=$GET(^XTMP("GMRC_PRE69","TOTAL"))+1

 +18                                       DO REFORMAT

                                           if $GET(RECLOCK)=1

                                               DO UNLKREC^GMRCUTL1(IEN)

                                       End DoDot:4

                                       if FLG=1!($GET(RECLOCK)=1)

                                           QUIT 

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19       QUIT 

REFORMAT  ;reformat data to 74 characters

 +1        KILL ^UTILITY($JOB,"W")

 +2        NEW INT,GMRC69,GMRCTMP,REF

           SET INT=0

           SET REF=A

 +3        NEW X,DIWL,DIWR,DIWF

 +4        SET DIWL=1

           SET DIWR=74

           SET DIWF=""

 +5        if $GET(RECLOCK)'=1

               QUIT 

 +6        FOR 

               SET INT=$ORDER(^GMR(123,IEN,40,A,B,INT))

               if +INT=0

                   QUIT 

               Begin DoDot:1

 +7                SET ^XTMP("GMRC_PRE69",IEN,40,A,B,INT,0)=^GMR(123,IEN,40,A,B,INT,0)

 +8                SET X=^GMR(123,IEN,40,A,B,INT,0)

 +9                DO ^DIWP

 +10               if $GET(RECLOCK)'=1

                       SET INT="A"

               End DoDot:1

 +11       DO WP^DIE(123.02,REF_","_IEN_",","5","","^UTILITY($J,""W"",1)","^TMP($J,""ERR"")")

 +12       QUIT 

MSG       ;create and send message

 +1       ;i/o args for XMZ^XMA2.

           NEW XMDUZ,XMSUB,XMZ,XMTEXT,XMY

 +2        NEW IEN,A,B,C,LNCNT

           SET (IEN,A,B,C)=0

           SET LNCNT=1

 +3        SET XMY(^XTMP("GMRC_PRE69","DUZ"))=""

 +4        SET XMDUZ="GMRC PACKAGE"

 +5        SET XMSUB="GMRC*3.0*69 COMMENTS BEFORE REFORMAT"

 +6       ; call Create Message Module

           DO XMZ^XMA2

 +7        IF $GET(^XTMP("GMRC_PRE69","TOTAL"))>0

               FOR 

                   SET IEN=$ORDER(^XTMP("GMRC_PRE69",IEN))

                   if +IEN=0

                       QUIT 

                   Begin DoDot:1

 +8                    FOR 

                           SET A=$ORDER(^XTMP("GMRC_PRE69",IEN,40,A))

                           if +A=0

                               QUIT 

                           Begin DoDot:2

 +9                            FOR 

                                   SET B=$ORDER(^XTMP("GMRC_PRE69",IEN,40,A,B))

                                   if +B=0

                                       QUIT 

                                   Begin DoDot:3

 +10                                   FOR 

                                           SET C=$ORDER(^XTMP("GMRC_PRE69",IEN,40,A,B,C))

                                           if +C=0

                                               QUIT 

                                           Begin DoDot:4

 +11                                           SET ^XMB(3.9,XMZ,2,LNCNT,0)=$NAME(^GMR(123,IEN,40,A,B,C,0))_U_^XTMP("GMRC_PRE69",IEN,40,A,B,C,0)

 +12      ;define zero node per API

                                               SET ^XMB(3.9,XMZ,2,0)="^3.92^"_LNCNT_"^"_LNCNT_"^"_DT

 +13                                           SET LNCNT=LNCNT+1

                                           End DoDot:4

                                   End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +14       IF $GET(^XTMP("GMRC_PRE69","TOTAL"))=0!($DATA(^XTMP("GMRC_PRE69","TOTAL"))=0)

               Begin DoDot:1

 +15               SET XMTEXT="XMTEXT"

 +16               SET XMTEXT(1)="No long comments found.  No records were modified in ^GMR(123."

 +17               DO ENL^XMD

               End DoDot:1

 +18       DO ENT1^XMD

 +19       QUIT