GMRAP053 ;ISP/RFR - PATCH 53 INSTALL CODE ;04/07/2017 12:48
;;4.0;Adverse Reaction Tracking;**53**;Mar 29, 1996;Build 306
Q
POST ;POST-INSTALLATION
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
D BMES^XPDUTL(" Queueing the data clean-up task...")
S ZTRTN="CLEAN^GMRAP053",ZTDESC="GMRA*4*53 DATA CLEAN-UP"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,2),ZTIO=""
D ^%ZTLOAD
I +$G(ZTSK)>0 D MES^XPDUTL(" Successfully queued the task with task #"_ZTSK)
I '+$G(ZTSK) D MES^XPDUTL(" Failed to queue the task"),CLEAN
Q
CLEAN ;STRIP TRAILING COMMA FROM OTHER SIGN/SYMPTOM
I '$D(ZTQUEUED) D BMES^XPDUTL(" Beginning data clean-up process...")
N NEXTSTOP,OTHREAC,GMRAREAC,GMRAIEN,VALUE,NEWVALUE,CHAR,COMMA,ORIGVAL,FDA,FILEERR,TEXTLINE,LINE
N EXIT,RECIPS,CHGCOUNT,LENGTH
K ^TMP("GMRA MSG",$J)
S OTHREAC=+$O(^GMRD(120.83,"B","OTHER REACTION",0))
I 'OTHREAC D G EXIT
.S ^TMP("GMRA MSG",$J,1,0)="ERROR: Could not find the OTHER REACTION entry in the SIGN/SYMPTOMS file"
.S ^TMP("GMRA MSG",$J,2,0)=" (#120.83)."
.S LINE=3 D RESTEXT(.LINE)
S GMRAREAC=0 F S GMRAREAC=$O(^GMR(120.8,GMRAREAC)) Q:'+GMRAREAC!($G(ZTSTOP))!($G(EXIT)) D
.I $G(NEXTSTOP)=""!($G(NEXTSTOP)=$H) D
..S ZTSTOP=$$S^%ZTLOAD Q:ZTSTOP
..S NEXTSTOP=$$HADD^XLFDT($H,0,0,0,30)
.Q:ZTSTOP
.S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,GMRAREAC,10,"B",OTHREAC,GMRAIEN)) Q:'+GMRAIEN D
..S VALUE=$P($G(^GMR(120.8,GMRAREAC,10,GMRAIEN,0)),U,2),ORIGVAL=VALUE,COMMA=0
..I VALUE[",," D
...S LENGTH=$L(VALUE)
...F CHAR=1:1 Q:CHAR>LENGTH D
....I $E(VALUE,CHAR)=",",'COMMA S COMMA=CHAR
....I COMMA>0&(($E(VALUE,CHAR)'=",")!(CHAR=LENGTH)) D
.....I CHAR>=(COMMA+1) S VALUE=$E(VALUE,1,COMMA)_$S(CHAR'=LENGTH:$E(VALUE,CHAR,LENGTH),1:""),CHAR=COMMA,LENGTH=$L(VALUE)
.....S COMMA=0
..I $E(VALUE,1)="," S VALUE=$E(VALUE,2,$L(VALUE))
..I $E(VALUE,$L(VALUE))="," S VALUE=$E(VALUE,1,$L(VALUE)-1)
..I VALUE'=ORIGVAL D
...S FDA(120.81,GMRAIEN_","_GMRAREAC_",",1)=VALUE
...D FILE^DIE("K","FDA","FILEERR")
...I $D(FILEERR) D ERROR(.FILEERR,.LINE,GMRAREAC) S EXIT=1
...I '$D(FILEERR) D OUTPUT(.LINE,GMRAREAC,VALUE,ORIGVAL) S CHGCOUNT=1+$G(CHGCOUNT)
EXIT ;FINAL ENVIRONMENT CLEAN-UP AND EXIT
K:$G(ZTSTOP)=0 ZTSTOP
S LINE=1+$G(LINE),^TMP("GMRA MSG",$J,LINE,0)=" "
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)="NUMBER OF REACTIONS CHANGED: "_+$G(CHGCOUNT)
N XMMG,XMDUZ,XMZ,XMERR,DIFROM,XMTEXT,XMSUB,XMY
S XMDUZ="GMRA, CLEAN-UP",XMSUB="GMRA*4*53 CLEAN-UP STATUS",XMTEXT="^TMP(""GMRA MSG"",$J,"
S XMY(DUZ)="",XMY("G.OR CACS")=""
D ^XMD
I $D(XMMG)>0 D
.M ^XTMP("GMRA*4*53 CLEAN-UP STATUS")=^TMP("GMRA MSG",$J)
.S ^XTMP("GMRA*4*53 CLEAN-UP STATUS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"PATCH GMRA*4*53 CLEAN-UP STATUS REPORT"
K ^TMP("GMRA MSG",$J)
I $D(ZTQUEUED),'$D(ZTSTOP) S ZTREQ="@"
I '$D(ZTQUEUED) D MES^XPDUTL(" Data clean-up process has exited")
Q
OUTPUT(LINE,IEN,VALUE,ORIGVAL) ;ADD CHANGE TO MESSAGE BODY
I '+$G(LINE) D
.S LINE=1,^TMP("GMRA MSG",$J,LINE,0)=$$LJ^XLFSTR("PATIENT NAME",31)_"REACTANT"
.S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" ORIGINAL VALUE"
.S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" --------------"
.S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" NEW VALUE"
.S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=$$REPEAT^XLFSTR("=",77)
I LINE>5 S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=$$REPEAT^XLFSTR("-*",33)
N DFN
S DFN=+$P($G(^GMR(120.8,IEN,0)),U)
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=$$LJ^XLFSTR($P($G(^DPT(DFN,0)),U),31)_$E($P($G(^GMR(120.8,IEN,0)),U,2),1,45)
Q:$G(ORIGVAL)=""
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" "_ORIGVAL
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" "_$$REPEAT^XLFSTR("-",$L(ORIGVAL))
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" "_VALUE
Q
ERROR(ERRDATA,LINE,DFN) ;ADD FILEMAN ERROR TO MESSAGE BODY
D OUTPUT(.LINE,DFN)
N ERRNUM,ERRORS,ITEM,TEXT,ERROR
S ERRNUM=0 F S ERRNUM=$O(ERRDATA("DIERR",ERRNUM)) Q:'+ERRNUM D
.S ERROR=$G(ERRDATA("DIERR",ERRNUM)) Q:ERROR=""
.Q:$D(ERRORS(ERROR))
.S ITEM=0 F S ITEM=$O(ERRDATA("DIERR",ERRNUM,"TEXT",ITEM)) Q:ITEM="" D
..S TEXT=$S($G(TEXT)'="":TEXT_" ",1:"")_$G(ERRDATA("DIERR",ERRNUM,"TEXT",ITEM))
.S ERRORS(ERROR)=""
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" FILEMAN ERROR:"
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" "_TEXT
D RESTEXT(.LINE)
Q
RESTEXT(LINE) ;ADD RESTART TEXT TO MESSAGE BODY
S LINE=1+$G(LINE),^TMP("GMRA MSG",$J,LINE,0)=" "
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)="Contact the help desk for assistance."
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)="When the issue is resolved, execute the following command from the"
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)="programmer's prompt to complete the clean-up:"
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" "
S LINE=1+LINE,^TMP("GMRA MSG",$J,LINE,0)=" D POST^GMRAP053"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAP053 4802 printed Sep 23, 2025@19:15:46 Page 2
GMRAP053 ;ISP/RFR - PATCH 53 INSTALL CODE ;04/07/2017 12:48
+1 ;;4.0;Adverse Reaction Tracking;**53**;Mar 29, 1996;Build 306
+2 QUIT
POST ;POST-INSTALLATION
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
+2 DO BMES^XPDUTL(" Queueing the data clean-up task...")
+3 SET ZTRTN="CLEAN^GMRAP053"
SET ZTDESC="GMRA*4*53 DATA CLEAN-UP"
+4 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,2)
SET ZTIO=""
+5 DO ^%ZTLOAD
+6 IF +$GET(ZTSK)>0
DO MES^XPDUTL(" Successfully queued the task with task #"_ZTSK)
+7 IF '+$GET(ZTSK)
DO MES^XPDUTL(" Failed to queue the task")
DO CLEAN
+8 QUIT
CLEAN ;STRIP TRAILING COMMA FROM OTHER SIGN/SYMPTOM
+1 IF '$DATA(ZTQUEUED)
DO BMES^XPDUTL(" Beginning data clean-up process...")
+2 NEW NEXTSTOP,OTHREAC,GMRAREAC,GMRAIEN,VALUE,NEWVALUE,CHAR,COMMA,ORIGVAL,FDA,FILEERR,TEXTLINE,LINE
+3 NEW EXIT,RECIPS,CHGCOUNT,LENGTH
+4 KILL ^TMP("GMRA MSG",$JOB)
+5 SET OTHREAC=+$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+6 IF 'OTHREAC
Begin DoDot:1
+7 SET ^TMP("GMRA MSG",$JOB,1,0)="ERROR: Could not find the OTHER REACTION entry in the SIGN/SYMPTOMS file"
+8 SET ^TMP("GMRA MSG",$JOB,2,0)=" (#120.83)."
+9 SET LINE=3
DO RESTEXT(.LINE)
End DoDot:1
GOTO EXIT
+10 SET GMRAREAC=0
FOR
SET GMRAREAC=$ORDER(^GMR(120.8,GMRAREAC))
if '+GMRAREAC!($GET(ZTSTOP))!($GET(EXIT))
QUIT
Begin DoDot:1
+11 IF $GET(NEXTSTOP)=""!($GET(NEXTSTOP)=$HOROLOG)
Begin DoDot:2
+12 SET ZTSTOP=$$S^%ZTLOAD
if ZTSTOP
QUIT
+13 SET NEXTSTOP=$$HADD^XLFDT($HOROLOG,0,0,0,30)
End DoDot:2
+14 if ZTSTOP
QUIT
+15 SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(^GMR(120.8,GMRAREAC,10,"B",OTHREAC,GMRAIEN))
if '+GMRAIEN
QUIT
Begin DoDot:2
+16 SET VALUE=$PIECE($GET(^GMR(120.8,GMRAREAC,10,GMRAIEN,0)),U,2)
SET ORIGVAL=VALUE
SET COMMA=0
+17 IF VALUE[",,"
Begin DoDot:3
+18 SET LENGTH=$LENGTH(VALUE)
+19 FOR CHAR=1:1
if CHAR>LENGTH
QUIT
Begin DoDot:4
+20 IF $EXTRACT(VALUE,CHAR)=","
IF 'COMMA
SET COMMA=CHAR
+21 IF COMMA>0&(($EXTRACT(VALUE,CHAR)'=",")!(CHAR=LENGTH))
Begin DoDot:5
+22 IF CHAR>=(COMMA+1)
SET VALUE=$EXTRACT(VALUE,1,COMMA)_$SELECT(CHAR'=LENGTH:$EXTRACT(VALUE,CHAR,LENGTH),1:"")
SET CHAR=COMMA
SET LENGTH=$LENGTH(VALUE)
+23 SET COMMA=0
End DoDot:5
End DoDot:4
End DoDot:3
+24 IF $EXTRACT(VALUE,1)=","
SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
+25 IF $EXTRACT(VALUE,$LENGTH(VALUE))=","
SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
+26 IF VALUE'=ORIGVAL
Begin DoDot:3
+27 SET FDA(120.81,GMRAIEN_","_GMRAREAC_",",1)=VALUE
+28 DO FILE^DIE("K","FDA","FILEERR")
+29 IF $DATA(FILEERR)
DO ERROR(.FILEERR,.LINE,GMRAREAC)
SET EXIT=1
+30 IF '$DATA(FILEERR)
DO OUTPUT(.LINE,GMRAREAC,VALUE,ORIGVAL)
SET CHGCOUNT=1+$GET(CHGCOUNT)
End DoDot:3
End DoDot:2
End DoDot:1
EXIT ;FINAL ENVIRONMENT CLEAN-UP AND EXIT
+1 if $GET(ZTSTOP)=0
KILL ZTSTOP
+2 SET LINE=1+$GET(LINE)
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "
+3 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)="NUMBER OF REACTIONS CHANGED: "_+$GET(CHGCOUNT)
+4 NEW XMMG,XMDUZ,XMZ,XMERR,DIFROM,XMTEXT,XMSUB,XMY
+5 SET XMDUZ="GMRA, CLEAN-UP"
SET XMSUB="GMRA*4*53 CLEAN-UP STATUS"
SET XMTEXT="^TMP(""GMRA MSG"",$J,"
+6 SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+7 DO ^XMD
+8 IF $DATA(XMMG)>0
Begin DoDot:1
+9 MERGE ^XTMP("GMRA*4*53 CLEAN-UP STATUS")=^TMP("GMRA MSG",$JOB)
+10 SET ^XTMP("GMRA*4*53 CLEAN-UP STATUS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"PATCH GMRA*4*53 CLEAN-UP STATUS REPORT"
End DoDot:1
+11 KILL ^TMP("GMRA MSG",$JOB)
+12 IF $DATA(ZTQUEUED)
IF '$DATA(ZTSTOP)
SET ZTREQ="@"
+13 IF '$DATA(ZTQUEUED)
DO MES^XPDUTL(" Data clean-up process has exited")
+14 QUIT
OUTPUT(LINE,IEN,VALUE,ORIGVAL) ;ADD CHANGE TO MESSAGE BODY
+1 IF '+$GET(LINE)
Begin DoDot:1
+2 SET LINE=1
SET ^TMP("GMRA MSG",$JOB,LINE,0)=$$LJ^XLFSTR("PATIENT NAME",31)_"REACTANT"
+3 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" ORIGINAL VALUE"
+4 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" --------------"
+5 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" NEW VALUE"
+6 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=$$REPEAT^XLFSTR("=",77)
End DoDot:1
+7 IF LINE>5
SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=$$REPEAT^XLFSTR("-*",33)
+8 NEW DFN
+9 SET DFN=+$PIECE($GET(^GMR(120.8,IEN,0)),U)
+10 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=$$LJ^XLFSTR($PIECE($GET(^DPT(DFN,0)),U),31)_$EXTRACT($PIECE($GET(^GMR(120.8,IEN,0)),U,2),1,45)
+11 if $GET(ORIGVAL)=""
QUIT
+12 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "_ORIGVAL
+13 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "_$$REPEAT^XLFSTR("-",$LENGTH(ORIGVAL))
+14 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "_VALUE
+15 QUIT
ERROR(ERRDATA,LINE,DFN) ;ADD FILEMAN ERROR TO MESSAGE BODY
+1 DO OUTPUT(.LINE,DFN)
+2 NEW ERRNUM,ERRORS,ITEM,TEXT,ERROR
+3 SET ERRNUM=0
FOR
SET ERRNUM=$ORDER(ERRDATA("DIERR",ERRNUM))
if '+ERRNUM
QUIT
Begin DoDot:1
+4 SET ERROR=$GET(ERRDATA("DIERR",ERRNUM))
if ERROR=""
QUIT
+5 if $DATA(ERRORS(ERROR))
QUIT
+6 SET ITEM=0
FOR
SET ITEM=$ORDER(ERRDATA("DIERR",ERRNUM,"TEXT",ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+7 SET TEXT=$SELECT($GET(TEXT)'="":TEXT_" ",1:"")_$GET(ERRDATA("DIERR",ERRNUM,"TEXT",ITEM))
End DoDot:2
+8 SET ERRORS(ERROR)=""
End DoDot:1
+9 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" FILEMAN ERROR:"
+10 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "_TEXT
+11 DO RESTEXT(.LINE)
+12 QUIT
RESTEXT(LINE) ;ADD RESTART TEXT TO MESSAGE BODY
+1 SET LINE=1+$GET(LINE)
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "
+2 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)="Contact the help desk for assistance."
+3 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)="When the issue is resolved, execute the following command from the"
+4 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)="programmer's prompt to complete the clean-up:"
+5 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" "
+6 SET LINE=1+LINE
SET ^TMP("GMRA MSG",$JOB,LINE,0)=" D POST^GMRAP053"
+7 QUIT
