- 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 Mar 13, 2025@20:44:26 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
