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 ---[H[J[2J[HGMRCYP69 5302 printed Dec 13, 2024@01:48 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
