GMPLCLN ;ISP/TC - Problem File Cleanup Utilities ;03/07/17 08:51
;;2.0;Problem List;**40,49**;Aug 25, 1994;Build 43
;
;
; External References
; BROWSE^DDBR ICR 2607
; $$NOW^XLFDT ICR 10103
; $$FMADD^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$REPEAT^XLFSTR ICR 10104
; $$LJ^XLFSTR ICR 10104
; MES^XPDUTL ICR 10141
;
BLDLEMSG(GMPLMSG,GMPLNERR,GMPLFROM,GMPLNODE) ; Build Lock Error MailMan message and send to installer
N GMPLTO,GMPXMSUB,SUB,GMPMAXER,GMPLEND,GMPI,GMPJ,GMPK,GMPCNT,GMPCNTR
S GMPCNT=4,GMPK=""
I GMPLNERR=0 Q
S GMPMAXER=200
K ^TMP("GMPXMZLE",$J)
S SUB="GMPXMZLE"
S ^TMP(SUB,$J,1,0)="A lock on the following record entries could not be obtained because another"
S ^TMP(SUB,$J,2,0)="user was editing the entry. As a result these entries could not be corrected/"
S ^TMP(SUB,$J,3,0)="updated."
S ^TMP(SUB,$J,4,0)=""
I $D(GMPLMSG) D
. F S GMPK=$O(GMPLMSG(GMPK)) Q:'GMPK D
. . S GMPCNT=GMPCNT+1
. . S ^TMP(SUB,$J,GMPCNT,0)=$G(GMPLMSG(GMPK))
S GMPCNT=GMPCNT+1
I $D(GMPLMSG) S ^TMP(SUB,$J,GMPCNT,0)=""
S GMPLEND=$S(GMPLNERR'>GMPMAXER:GMPLNERR+GMPCNT,1:GMPMAXER)
S GMPLEND=$S(GMPLNERR'>GMPMAXER:GMPLEND-1,1:GMPLEND)
S GMPJ=GMPLNERR+1
F GMPI=GMPCNT:1:GMPLEND D
. S GMPJ=GMPJ-1,GMPCNTR=$S($D(GMPLMSG):GMPI+1,1:GMPI)
. S ^TMP(SUB,$J,GMPCNTR,0)=^TMP(GMPLNODE,$J,GMPJ,0)
I GMPLEND=GMPMAXER S ^TMP(SUB,$J,GMPMAXER+1,0)="Maximum number of errors reached, will not report anymore."
K ^TMP(GMPLNODE,$J)
S GMPXMSUB="Lock Errors during Problem File Cleanup"
S GMPLTO(DUZ)=""
D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
Q
BLDNEMSG(GMPLMSG,GMPLSUB,GMPLFROM,GMPLRNTM) ; Build No Error Found MailMan message and send to installer
N GMPLTO,SUB,GMPJ,GMPCNT S GMPJ="",GMPCNT=3
K ^TMP("GMPXMZNE",$J)
S SUB="GMPXMZNE"
S GMPLTO(DUZ)=""
S ^TMP(SUB,$J,1,0)="A scan of your system's Problem file #9000011 has been performed on:"
S ^TMP(SUB,$J,2,0)=""_$$FMTE^XLFDT(GMPLRNTM,1)_""
S ^TMP(SUB,$J,3,0)=""
I $D(GMPLMSG) D
. F S GMPJ=$O(GMPLMSG(GMPJ)) Q:'GMPJ D
. . S GMPCNT=GMPCNT+1
. . S ^TMP(SUB,$J,GMPCNT,0)=$G(GMPLMSG(GMPJ))
D SEND^GMPLUTL4(SUB,GMPLSUB,.GMPLTO,GMPLFROM)
Q
BLDERMSG(GMPLNERR) ; Build MailMan error message content and send to installer
N GMPLTO,GMPLFROM,GMPXMSUB,SUB
K ^TMP("GMPLXMZE",$J)
S SUB="GMPLXMZE"
S GMPXMSUB="Problem File Error Scan Complete"
S GMPLFROM="GMPL*2.0*40 INSTALL"
S GMPLTO(DUZ)=""
S ^TMP(SUB,$J,1,0)="A scan of your system's Problem file #9000011 has been performed for possible"
S ^TMP(SUB,$J,2,0)="errors. There are "_GMPLNERR_" record entries that contain a SNOMED CT concept code"
S ^TMP(SUB,$J,3,0)="in the Diagnosis field #.01."
S ^TMP(SUB,$J,4,0)=""
S ^TMP(SUB,$J,5,0)="To see a report of these records, please access the SNOMED in Diagnosis Field"
S ^TMP(SUB,$J,6,0)="Error Report [GMPL DIAG ERROR REPORT] which is attached to the Problem List Mgt"
S ^TMP(SUB,$J,7,0)="Menu [GMPL MGT MENU]."
S ^TMP(SUB,$J,8,0)=""
S ^TMP(SUB,$J,9,0)="These record entries will initially be corrected with the installation of"
S ^TMP(SUB,$J,10,0)="GMPL*2.0*40 or by running the Generate SNOMED in Diagnosis Field Err/Cleanup"
S ^TMP(SUB,$J,11,0)="Rpt [GMPL GENERATE DIAG RPTS] menu option off the Problem List Mgt Menu."
S ^TMP(SUB,$J,12,0)=""
S ^TMP(SUB,$J,13,0)="Once the cleanup is complete, a separate MailMan message will be sent to the"
S ^TMP(SUB,$J,14,0)="installer containing instructions on how to access the cleanup report."
D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
Q
BLDCLMSG(GMPLMSG,GMPLSUB,GMPLFROM,GMPLNCLN) ; Build MailMan cleanup message content and send to installer
N GMPLTO,SUB,GMPJ,GMPCNT S GMPJ="",GMPCNT=3
K ^TMP("GMPLXMZC",$J)
S SUB="GMPLXMZC"
S GMPLTO(DUZ)=""
S ^TMP(SUB,$J,1,0)="A cleanup of the Problem file has been performed and "_GMPLNCLN_" record"
S ^TMP(SUB,$J,2,0)="entries have been corrected."
S ^TMP(SUB,$J,3,0)=""
I $D(GMPLMSG) D
. F S GMPJ=$O(GMPLMSG(GMPJ)) Q:'GMPJ D
. . S GMPCNT=GMPCNT+1
. . S ^TMP(SUB,$J,GMPCNT,0)=$G(GMPLMSG(GMPJ))
D SEND^GMPLUTL4(SUB,GMPLSUB,.GMPLTO,GMPLFROM)
Q
BLDRPMSG(GMPLNERR,GMPLRNTM) ; Build Error Report Mailman Message and send to installer
N GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLREC,GMPLCNT,GMPLDA S GMPLCNT=20,GMPLDA=""
K ^TMP("GMPLXMZR",$J)
S SUB="GMPLXMZR"
S GMPXMSUB="Incorrect Mapping Report"
S GMPLFROM="GMPL*2.0*40 INSTALL"
S GMPLTO(DUZ)=""
S ^TMP(SUB,$J,1,0)=""
S ^TMP(SUB,$J,2,0)="Problem file scan runtime: "_$$FMTE^XLFDT(GMPLRNTM,1)
S ^TMP(SUB,$J,3,0)=""
S ^TMP(SUB,$J,4,0)="A scan of your system's Problem file #9000011 has been performed for possible"
S ^TMP(SUB,$J,5,0)="errors. There are "_GMPLNERR_" record entries that contain an incorrect SNOMED CT"
S ^TMP(SUB,$J,6,0)="428283002 to ICD-9-CM V15.89 code mapping for the term ""History of polyp of"
S ^TMP(SUB,$J,7,0)="colon"". As a result the V15.89 code is incorrectly stored in the Diagnosis"
S ^TMP(SUB,$J,8,0)="field #.01."
S ^TMP(SUB,$J,9,0)=""
S ^TMP(SUB,$J,10,0)="This report contains a list of these erroneous record entries which will be"
S ^TMP(SUB,$J,11,0)="corrected after the installation of GMPL*2.0*40. Once the cleanup is complete,"
S ^TMP(SUB,$J,12,0)="the correct V12.72 code will be stored in the Diagnosis field."
S ^TMP(SUB,$J,13,0)=""
S ^TMP(SUB,$J,14,0)="**ATTENTION CACs!!**: Once the cleanup is complete, please also review the"
S ^TMP(SUB,$J,15,0)="Colonoscopy clinical reminders for the corresponding patients and verify that"
S ^TMP(SUB,$J,16,0)="the corrections have been updated appropriately for those as well."
S ^TMP(SUB,$J,17,0)=""
S ^TMP(SUB,$J,18,0)=""
S ^TMP(SUB,$J,19,0)="IEN"_$J("PATIENT",22)_$J("PROVIDER NARRATIVE",44)
S ^TMP(SUB,$J,20,0)=$$REPEAT^XLFSTR("-",15)_$J($$REPEAT^XLFSTR("-",30),33)_$J($$REPEAT^XLFSTR("-",28),31)
F S GMPLDA=$O(^TMP("GMPLVCDE",$J,GMPLDA)) Q:'GMPLDA D
. S GMPLREC=$G(^TMP("GMPLVCDE",$J,GMPLDA)),GMPLCNT=GMPLCNT+1
. S ^TMP(SUB,$J,GMPLCNT,0)=$$LJ^XLFSTR($G(GMPLDA),18)_$$LJ^XLFSTR($P(GMPLREC,U,1),33)_$$LJ^XLFSTR($P(GMPLREC,U,2),28)
D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
Q
BLDERRPT(GMPLNERR,GMPLRNTM) ; Build Error Report
N GMPDLM,GMPDA,GMPX,GMPJ,SUB,GMPLPSUB S (GMPDLM,GMPDA)="",GMPJ=20
S GMPLPSUB=$O(^XTMP("GMPLERPT;"))
I GMPLPSUB["GMPLERPT" K ^XTMP(GMPLPSUB)
S SUB="GMPLERPT;"_$H
S ^XTMP(SUB,0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT()_U_"SNOMED in Diagnosis Field Error Rpt"
S ^XTMP(SUB,1,0)=""
S ^XTMP(SUB,2,0)="**NOTE**: This report is retroactive as of the last Problem file scan runtime:"
S ^XTMP(SUB,3,0)=""_$$FMTE^XLFDT(GMPLRNTM,1)_". This report will expire and be purged from the system in"
S ^XTMP(SUB,4,0)="30 days. If the Generate SNOMED in Diagnosis Field Err/Cleanup Rpt [GMPL"
S ^XTMP(SUB,5,0)="GENERATE DIAG RPTS] menu option is run prior to the 30 days, then this report"
S ^XTMP(SUB,6,0)="will expire on the date/time the option is run. Whichever comes first."
S ^XTMP(SUB,7,0)=""
S ^XTMP(SUB,8,0)="A scan of your system's Problem file #9000011 has been performed for possible"
S ^XTMP(SUB,9,0)="errors. The following "_GMPLNERR_" record entries contain a SNOMED CT concept code"
S ^XTMP(SUB,10,0)="in the Diagnosis field #.01. This report contains 4 columns. Please scroll to"
S ^XTMP(SUB,11,0)="the right to see a full display of the Problem text."
S ^XTMP(SUB,12,0)=""
S ^XTMP(SUB,13,0)="These record entries will be corrected and upon completion, a separate MailMan"
S ^XTMP(SUB,14,0)="message will be sent to the installer containing instructions on how to access"
S ^XTMP(SUB,15,0)="the cleanup report."
S ^XTMP(SUB,16,0)=""
S ^XTMP(SUB,17,0)=""
S ^XTMP(SUB,18,0)=$J("DATE LAST",27)
S ^XTMP(SUB,19,0)="IEN"_$J("MODIFIED",23)_$J("DIAGNOSIS",16)_$J("PROBLEM",19)
S ^XTMP(SUB,20,0)=$$REPEAT^XLFSTR("-",15)_$J($$REPEAT^XLFSTR("-",12),15)_$J($$REPEAT^XLFSTR("-",18),21)_$J($$REPEAT^XLFSTR("-",25),28)
F S GMPDLM=$O(^TMP("GMPLSCT",$J,GMPDLM)) Q:'GMPDLM D
. F S GMPDA=$O(^TMP("GMPLSCT",$J,GMPDLM,GMPDA)) Q:'GMPDA D
. . S GMPX=$G(^TMP("GMPLSCT",$J,GMPDLM,GMPDA)),GMPJ=GMPJ+1
. . S ^XTMP(SUB,GMPJ,0)=$$LJ^XLFSTR($G(GMPDA),18)_$$LJ^XLFSTR($P(GMPX,U,1),15)_$$LJ^XLFSTR($P(GMPX,U,2),21)_$$LJ^XLFSTR($P(GMPX,U,3),$L($P(GMPX,U,3)))
Q
;
BLDCLRPT(GMPLNCLN,GMPLRNTM) ; Build Cleanup Report
N GMPLDLM,GMPLDA,GMPX,GMPJ,SUB,GMPLPSUB S (GMPLDLM,GMPLDA)="",GMPJ=21
S GMPLPSUB=$O(^XTMP("GMPLCRPT;"))
I GMPLPSUB["GMPLCRPT" K ^XTMP(GMPLPSUB)
S SUB="GMPLCRPT;"_$H
S ^XTMP(SUB,0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT()_U_"SNOMED in Diagnosis Field Cleanup Rpt"
S ^XTMP(SUB,1,0)=""
S ^XTMP(SUB,2,0)="**NOTE**: This report is retroactive as of the last Problem file cleanup runtime"
S ^XTMP(SUB,3,0)=":"_$$FMTE^XLFDT(GMPLRNTM,1)_". This report will expire and be purged from the system in"
S ^XTMP(SUB,4,0)="30 days. If the Generate SNOMED in Diagnosis Field Err/Cleanup Rpt [GMPL"
S ^XTMP(SUB,5,0)="GENERATE DIAG RPTS] menu option is run prior to the 30 days, then this report"
S ^XTMP(SUB,6,0)="will expire on the date/time the option is run. Whichever comes first."
S ^XTMP(SUB,7,0)=""
S ^XTMP(SUB,8,0)="A cleanup of the Problem file has been performed and the following "_GMPLNCLN
S ^XTMP(SUB,9,0)="record entries have been corrected. This report contains 7 columns."
S ^XTMP(SUB,10,0)="Please scroll to the right for more information."
S ^XTMP(SUB,11,0)=""
S ^XTMP(SUB,12,0)="These entries no longer contain a SNOMED CT concept code in the Diagnosis field"
S ^XTMP(SUB,13,0)="#.01. The correct primary ICD diagnosis and secondary diagnosis code(s) is now"
S ^XTMP(SUB,14,0)="stored in the appropriate fields. The corresponding SNOMED CT concept and"
S ^XTMP(SUB,15,0)="designation codes have also been correctly filed in their respective fields. The "
S ^XTMP(SUB,16,0)="provider narrative and problem fields were also updated accordingly as well."
S ^XTMP(SUB,17,0)=""
S ^XTMP(SUB,18,0)=""
S ^XTMP(SUB,19,0)=$J("DATE LAST",27)_$J("PRIMARY",13)_$J("SNOMED CT",44)_$J("SNOMED CT",21)
S ^XTMP(SUB,20,0)="IEN"_$J("MODIFIED",23)_$J("DIAGNOSIS",16)_$J("SECONDARY DIAGNOSIS",22)_$J("CONCEPT CODE",23)_$J("DESIGNATION CODE",25)_$J("PROBLEM",12)
S ^XTMP(SUB,21,0)=$$REPEAT^XLFSTR("-",15)_$J($$REPEAT^XLFSTR("-",12),15)_$J($$REPEAT^XLFSTR("-",9),12)_$J($$REPEAT^XLFSTR("-",27),30)_$J($$REPEAT^XLFSTR("-",18),21)_$J($$REPEAT^XLFSTR("-",18),21)_$J($$REPEAT^XLFSTR("-",33),36)
F S GMPLDLM=$O(^TMP("GMPLCLNP",$J,GMPLDLM)) Q:'GMPLDLM D
. F S GMPLDA=$O(^TMP("GMPLCLNP",$J,GMPLDLM,GMPLDA)) Q:'GMPLDA D
. . S GMPX=$G(^TMP("GMPLCLNP",$J,GMPLDLM,GMPLDA)),GMPJ=GMPJ+1
. . S ^XTMP(SUB,GMPJ,0)=$$LJ^XLFSTR($G(GMPLDA),18)_$$LJ^XLFSTR($P(GMPX,U,1),15)_$$LJ^XLFSTR($P($P(GMPX,U,2),"/"),12)_$$LJ^XLFSTR($P($P(GMPX,U,2),"/",2,$L($P(GMPX,U,2),"/")),30)
. . S ^XTMP(SUB,GMPJ,0)=^XTMP(SUB,GMPJ,0)_$$LJ^XLFSTR($P(GMPX,U,3),21)_$$LJ^XLFSTR($P(GMPX,U,4),21)_$$LJ^XLFSTR($P(GMPX,U,5),$L($P(GMPX,U,5)))
K ^TMP("GMPLCLNP",$J)
Q
;
VWERRPT ; View Error Report
N GMPLX
S GMPLX=$O(^XTMP("GMPLERPT;"))
I GMPLX["GMPLERPT",$D(^XTMP(GMPLX)) D BROWSE^DDBR("^XTMP("""_GMPLX_""")","NR","Erroneous Problem File Record Entries Report")
E D
. N GMPLTEXT
. S GMPLTEXT(1)="There are currently no Problem File entries that contain this error."
. D MES^XPDUTL(.GMPLTEXT)
Q
VWCLRPT ; View Cleanup Report
N GMPLX
S GMPLX=$O(^XTMP("GMPLCRPT;"))
I GMPLX["GMPLCRPT",$D(^XTMP(GMPLX)) D BROWSE^DDBR("^XTMP("""_GMPLX_""")","NR","Problem File Cleanup Report")
E D
. N GMPLTEXT
. S GMPLTEXT(1)="There are currently no Problem File entries that need correction."
. D MES^XPDUTL(.GMPLTEXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLCLN 11786 printed Sep 23, 2025@20:05:59 Page 2
GMPLCLN ;ISP/TC - Problem File Cleanup Utilities ;03/07/17 08:51
+1 ;;2.0;Problem List;**40,49**;Aug 25, 1994;Build 43
+2 ;
+3 ;
+4 ; External References
+5 ; BROWSE^DDBR ICR 2607
+6 ; $$NOW^XLFDT ICR 10103
+7 ; $$FMADD^XLFDT ICR 10103
+8 ; $$FMTE^XLFDT ICR 10103
+9 ; $$REPEAT^XLFSTR ICR 10104
+10 ; $$LJ^XLFSTR ICR 10104
+11 ; MES^XPDUTL ICR 10141
+12 ;
BLDLEMSG(GMPLMSG,GMPLNERR,GMPLFROM,GMPLNODE) ; Build Lock Error MailMan message and send to installer
+1 NEW GMPLTO,GMPXMSUB,SUB,GMPMAXER,GMPLEND,GMPI,GMPJ,GMPK,GMPCNT,GMPCNTR
+2 SET GMPCNT=4
SET GMPK=""
+3 IF GMPLNERR=0
QUIT
+4 SET GMPMAXER=200
+5 KILL ^TMP("GMPXMZLE",$JOB)
+6 SET SUB="GMPXMZLE"
+7 SET ^TMP(SUB,$JOB,1,0)="A lock on the following record entries could not be obtained because another"
+8 SET ^TMP(SUB,$JOB,2,0)="user was editing the entry. As a result these entries could not be corrected/"
+9 SET ^TMP(SUB,$JOB,3,0)="updated."
+10 SET ^TMP(SUB,$JOB,4,0)=""
+11 IF $DATA(GMPLMSG)
Begin DoDot:1
+12 FOR
SET GMPK=$ORDER(GMPLMSG(GMPK))
if 'GMPK
QUIT
Begin DoDot:2
+13 SET GMPCNT=GMPCNT+1
+14 SET ^TMP(SUB,$JOB,GMPCNT,0)=$GET(GMPLMSG(GMPK))
End DoDot:2
End DoDot:1
+15 SET GMPCNT=GMPCNT+1
+16 IF $DATA(GMPLMSG)
SET ^TMP(SUB,$JOB,GMPCNT,0)=""
+17 SET GMPLEND=$SELECT(GMPLNERR'>GMPMAXER:GMPLNERR+GMPCNT,1:GMPMAXER)
+18 SET GMPLEND=$SELECT(GMPLNERR'>GMPMAXER:GMPLEND-1,1:GMPLEND)
+19 SET GMPJ=GMPLNERR+1
+20 FOR GMPI=GMPCNT:1:GMPLEND
Begin DoDot:1
+21 SET GMPJ=GMPJ-1
SET GMPCNTR=$SELECT($DATA(GMPLMSG):GMPI+1,1:GMPI)
+22 SET ^TMP(SUB,$JOB,GMPCNTR,0)=^TMP(GMPLNODE,$JOB,GMPJ,0)
End DoDot:1
+23 IF GMPLEND=GMPMAXER
SET ^TMP(SUB,$JOB,GMPMAXER+1,0)="Maximum number of errors reached, will not report anymore."
+24 KILL ^TMP(GMPLNODE,$JOB)
+25 SET GMPXMSUB="Lock Errors during Problem File Cleanup"
+26 SET GMPLTO(DUZ)=""
+27 DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
+28 QUIT
BLDNEMSG(GMPLMSG,GMPLSUB,GMPLFROM,GMPLRNTM) ; Build No Error Found MailMan message and send to installer
+1 NEW GMPLTO,SUB,GMPJ,GMPCNT
SET GMPJ=""
SET GMPCNT=3
+2 KILL ^TMP("GMPXMZNE",$JOB)
+3 SET SUB="GMPXMZNE"
+4 SET GMPLTO(DUZ)=""
+5 SET ^TMP(SUB,$JOB,1,0)="A scan of your system's Problem file #9000011 has been performed on:"
+6 SET ^TMP(SUB,$JOB,2,0)=""_$$FMTE^XLFDT(GMPLRNTM,1)_""
+7 SET ^TMP(SUB,$JOB,3,0)=""
+8 IF $DATA(GMPLMSG)
Begin DoDot:1
+9 FOR
SET GMPJ=$ORDER(GMPLMSG(GMPJ))
if 'GMPJ
QUIT
Begin DoDot:2
+10 SET GMPCNT=GMPCNT+1
+11 SET ^TMP(SUB,$JOB,GMPCNT,0)=$GET(GMPLMSG(GMPJ))
End DoDot:2
End DoDot:1
+12 DO SEND^GMPLUTL4(SUB,GMPLSUB,.GMPLTO,GMPLFROM)
+13 QUIT
BLDERMSG(GMPLNERR) ; Build MailMan error message content and send to installer
+1 NEW GMPLTO,GMPLFROM,GMPXMSUB,SUB
+2 KILL ^TMP("GMPLXMZE",$JOB)
+3 SET SUB="GMPLXMZE"
+4 SET GMPXMSUB="Problem File Error Scan Complete"
+5 SET GMPLFROM="GMPL*2.0*40 INSTALL"
+6 SET GMPLTO(DUZ)=""
+7 SET ^TMP(SUB,$JOB,1,0)="A scan of your system's Problem file #9000011 has been performed for possible"
+8 SET ^TMP(SUB,$JOB,2,0)="errors. There are "_GMPLNERR_" record entries that contain a SNOMED CT concept code"
+9 SET ^TMP(SUB,$JOB,3,0)="in the Diagnosis field #.01."
+10 SET ^TMP(SUB,$JOB,4,0)=""
+11 SET ^TMP(SUB,$JOB,5,0)="To see a report of these records, please access the SNOMED in Diagnosis Field"
+12 SET ^TMP(SUB,$JOB,6,0)="Error Report [GMPL DIAG ERROR REPORT] which is attached to the Problem List Mgt"
+13 SET ^TMP(SUB,$JOB,7,0)="Menu [GMPL MGT MENU]."
+14 SET ^TMP(SUB,$JOB,8,0)=""
+15 SET ^TMP(SUB,$JOB,9,0)="These record entries will initially be corrected with the installation of"
+16 SET ^TMP(SUB,$JOB,10,0)="GMPL*2.0*40 or by running the Generate SNOMED in Diagnosis Field Err/Cleanup"
+17 SET ^TMP(SUB,$JOB,11,0)="Rpt [GMPL GENERATE DIAG RPTS] menu option off the Problem List Mgt Menu."
+18 SET ^TMP(SUB,$JOB,12,0)=""
+19 SET ^TMP(SUB,$JOB,13,0)="Once the cleanup is complete, a separate MailMan message will be sent to the"
+20 SET ^TMP(SUB,$JOB,14,0)="installer containing instructions on how to access the cleanup report."
+21 DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
+22 QUIT
BLDCLMSG(GMPLMSG,GMPLSUB,GMPLFROM,GMPLNCLN) ; Build MailMan cleanup message content and send to installer
+1 NEW GMPLTO,SUB,GMPJ,GMPCNT
SET GMPJ=""
SET GMPCNT=3
+2 KILL ^TMP("GMPLXMZC",$JOB)
+3 SET SUB="GMPLXMZC"
+4 SET GMPLTO(DUZ)=""
+5 SET ^TMP(SUB,$JOB,1,0)="A cleanup of the Problem file has been performed and "_GMPLNCLN_" record"
+6 SET ^TMP(SUB,$JOB,2,0)="entries have been corrected."
+7 SET ^TMP(SUB,$JOB,3,0)=""
+8 IF $DATA(GMPLMSG)
Begin DoDot:1
+9 FOR
SET GMPJ=$ORDER(GMPLMSG(GMPJ))
if 'GMPJ
QUIT
Begin DoDot:2
+10 SET GMPCNT=GMPCNT+1
+11 SET ^TMP(SUB,$JOB,GMPCNT,0)=$GET(GMPLMSG(GMPJ))
End DoDot:2
End DoDot:1
+12 DO SEND^GMPLUTL4(SUB,GMPLSUB,.GMPLTO,GMPLFROM)
+13 QUIT
BLDRPMSG(GMPLNERR,GMPLRNTM) ; Build Error Report Mailman Message and send to installer
+1 NEW GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLREC,GMPLCNT,GMPLDA
SET GMPLCNT=20
SET GMPLDA=""
+2 KILL ^TMP("GMPLXMZR",$JOB)
+3 SET SUB="GMPLXMZR"
+4 SET GMPXMSUB="Incorrect Mapping Report"
+5 SET GMPLFROM="GMPL*2.0*40 INSTALL"
+6 SET GMPLTO(DUZ)=""
+7 SET ^TMP(SUB,$JOB,1,0)=""
+8 SET ^TMP(SUB,$JOB,2,0)="Problem file scan runtime: "_$$FMTE^XLFDT(GMPLRNTM,1)
+9 SET ^TMP(SUB,$JOB,3,0)=""
+10 SET ^TMP(SUB,$JOB,4,0)="A scan of your system's Problem file #9000011 has been performed for possible"
+11 SET ^TMP(SUB,$JOB,5,0)="errors. There are "_GMPLNERR_" record entries that contain an incorrect SNOMED CT"
+12 SET ^TMP(SUB,$JOB,6,0)="428283002 to ICD-9-CM V15.89 code mapping for the term ""History of polyp of"
+13 SET ^TMP(SUB,$JOB,7,0)="colon"". As a result the V15.89 code is incorrectly stored in the Diagnosis"
+14 SET ^TMP(SUB,$JOB,8,0)="field #.01."
+15 SET ^TMP(SUB,$JOB,9,0)=""
+16 SET ^TMP(SUB,$JOB,10,0)="This report contains a list of these erroneous record entries which will be"
+17 SET ^TMP(SUB,$JOB,11,0)="corrected after the installation of GMPL*2.0*40. Once the cleanup is complete,"
+18 SET ^TMP(SUB,$JOB,12,0)="the correct V12.72 code will be stored in the Diagnosis field."
+19 SET ^TMP(SUB,$JOB,13,0)=""
+20 SET ^TMP(SUB,$JOB,14,0)="**ATTENTION CACs!!**: Once the cleanup is complete, please also review the"
+21 SET ^TMP(SUB,$JOB,15,0)="Colonoscopy clinical reminders for the corresponding patients and verify that"
+22 SET ^TMP(SUB,$JOB,16,0)="the corrections have been updated appropriately for those as well."
+23 SET ^TMP(SUB,$JOB,17,0)=""
+24 SET ^TMP(SUB,$JOB,18,0)=""
+25 SET ^TMP(SUB,$JOB,19,0)="IEN"_$JUSTIFY("PATIENT",22)_$JUSTIFY("PROVIDER NARRATIVE",44)
+26 SET ^TMP(SUB,$JOB,20,0)=$$REPEAT^XLFSTR("-",15)_$JUSTIFY($$REPEAT^XLFSTR("-",30),33)_$JUSTIFY($$REPEAT^XLFSTR("-",28),31)
+27 FOR
SET GMPLDA=$ORDER(^TMP("GMPLVCDE",$JOB,GMPLDA))
if 'GMPLDA
QUIT
Begin DoDot:1
+28 SET GMPLREC=$GET(^TMP("GMPLVCDE",$JOB,GMPLDA))
SET GMPLCNT=GMPLCNT+1
+29 SET ^TMP(SUB,$JOB,GMPLCNT,0)=$$LJ^XLFSTR($GET(GMPLDA),18)_$$LJ^XLFSTR($PIECE(GMPLREC,U,1),33)_$$LJ^XLFSTR($PIECE(GMPLREC,U,2),28)
End DoDot:1
+30 DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
+31 QUIT
BLDERRPT(GMPLNERR,GMPLRNTM) ; Build Error Report
+1 NEW GMPDLM,GMPDA,GMPX,GMPJ,SUB,GMPLPSUB
SET (GMPDLM,GMPDA)=""
SET GMPJ=20
+2 SET GMPLPSUB=$ORDER(^XTMP("GMPLERPT;"))
+3 IF GMPLPSUB["GMPLERPT"
KILL ^XTMP(GMPLPSUB)
+4 SET SUB="GMPLERPT;"_$HOROLOG
+5 SET ^XTMP(SUB,0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT()_U_"SNOMED in Diagnosis Field Error Rpt"
+6 SET ^XTMP(SUB,1,0)=""
+7 SET ^XTMP(SUB,2,0)="**NOTE**: This report is retroactive as of the last Problem file scan runtime:"
+8 SET ^XTMP(SUB,3,0)=""_$$FMTE^XLFDT(GMPLRNTM,1)_". This report will expire and be purged from the system in"
+9 SET ^XTMP(SUB,4,0)="30 days. If the Generate SNOMED in Diagnosis Field Err/Cleanup Rpt [GMPL"
+10 SET ^XTMP(SUB,5,0)="GENERATE DIAG RPTS] menu option is run prior to the 30 days, then this report"
+11 SET ^XTMP(SUB,6,0)="will expire on the date/time the option is run. Whichever comes first."
+12 SET ^XTMP(SUB,7,0)=""
+13 SET ^XTMP(SUB,8,0)="A scan of your system's Problem file #9000011 has been performed for possible"
+14 SET ^XTMP(SUB,9,0)="errors. The following "_GMPLNERR_" record entries contain a SNOMED CT concept code"
+15 SET ^XTMP(SUB,10,0)="in the Diagnosis field #.01. This report contains 4 columns. Please scroll to"
+16 SET ^XTMP(SUB,11,0)="the right to see a full display of the Problem text."
+17 SET ^XTMP(SUB,12,0)=""
+18 SET ^XTMP(SUB,13,0)="These record entries will be corrected and upon completion, a separate MailMan"
+19 SET ^XTMP(SUB,14,0)="message will be sent to the installer containing instructions on how to access"
+20 SET ^XTMP(SUB,15,0)="the cleanup report."
+21 SET ^XTMP(SUB,16,0)=""
+22 SET ^XTMP(SUB,17,0)=""
+23 SET ^XTMP(SUB,18,0)=$JUSTIFY("DATE LAST",27)
+24 SET ^XTMP(SUB,19,0)="IEN"_$JUSTIFY("MODIFIED",23)_$JUSTIFY("DIAGNOSIS",16)_$JUSTIFY("PROBLEM",19)
+25 SET ^XTMP(SUB,20,0)=$$REPEAT^XLFSTR("-",15)_$JUSTIFY($$REPEAT^XLFSTR("-",12),15)_$JUSTIFY($$REPEAT^XLFSTR("-",18),21)_$JUSTIFY($$REPEAT^XLFSTR("-",25),28)
+26 FOR
SET GMPDLM=$ORDER(^TMP("GMPLSCT",$JOB,GMPDLM))
if 'GMPDLM
QUIT
Begin DoDot:1
+27 FOR
SET GMPDA=$ORDER(^TMP("GMPLSCT",$JOB,GMPDLM,GMPDA))
if 'GMPDA
QUIT
Begin DoDot:2
+28 SET GMPX=$GET(^TMP("GMPLSCT",$JOB,GMPDLM,GMPDA))
SET GMPJ=GMPJ+1
+29 SET ^XTMP(SUB,GMPJ,0)=$$LJ^XLFSTR($GET(GMPDA),18)_$$LJ^XLFSTR($PIECE(GMPX,U,1),15)_$$LJ^XLFSTR($PIECE(GMPX,U,2),21)_$$LJ^XLFSTR($PIECE(GMPX,U,3),$LENGTH($PIECE(GMPX,U,3)))
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
BLDCLRPT(GMPLNCLN,GMPLRNTM) ; Build Cleanup Report
+1 NEW GMPLDLM,GMPLDA,GMPX,GMPJ,SUB,GMPLPSUB
SET (GMPLDLM,GMPLDA)=""
SET GMPJ=21
+2 SET GMPLPSUB=$ORDER(^XTMP("GMPLCRPT;"))
+3 IF GMPLPSUB["GMPLCRPT"
KILL ^XTMP(GMPLPSUB)
+4 SET SUB="GMPLCRPT;"_$HOROLOG
+5 SET ^XTMP(SUB,0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT()_U_"SNOMED in Diagnosis Field Cleanup Rpt"
+6 SET ^XTMP(SUB,1,0)=""
+7 SET ^XTMP(SUB,2,0)="**NOTE**: This report is retroactive as of the last Problem file cleanup runtime"
+8 SET ^XTMP(SUB,3,0)=":"_$$FMTE^XLFDT(GMPLRNTM,1)_". This report will expire and be purged from the system in"
+9 SET ^XTMP(SUB,4,0)="30 days. If the Generate SNOMED in Diagnosis Field Err/Cleanup Rpt [GMPL"
+10 SET ^XTMP(SUB,5,0)="GENERATE DIAG RPTS] menu option is run prior to the 30 days, then this report"
+11 SET ^XTMP(SUB,6,0)="will expire on the date/time the option is run. Whichever comes first."
+12 SET ^XTMP(SUB,7,0)=""
+13 SET ^XTMP(SUB,8,0)="A cleanup of the Problem file has been performed and the following "_GMPLNCLN
+14 SET ^XTMP(SUB,9,0)="record entries have been corrected. This report contains 7 columns."
+15 SET ^XTMP(SUB,10,0)="Please scroll to the right for more information."
+16 SET ^XTMP(SUB,11,0)=""
+17 SET ^XTMP(SUB,12,0)="These entries no longer contain a SNOMED CT concept code in the Diagnosis field"
+18 SET ^XTMP(SUB,13,0)="#.01. The correct primary ICD diagnosis and secondary diagnosis code(s) is now"
+19 SET ^XTMP(SUB,14,0)="stored in the appropriate fields. The corresponding SNOMED CT concept and"
+20 SET ^XTMP(SUB,15,0)="designation codes have also been correctly filed in their respective fields. The "
+21 SET ^XTMP(SUB,16,0)="provider narrative and problem fields were also updated accordingly as well."
+22 SET ^XTMP(SUB,17,0)=""
+23 SET ^XTMP(SUB,18,0)=""
+24 SET ^XTMP(SUB,19,0)=$JUSTIFY("DATE LAST",27)_$JUSTIFY("PRIMARY",13)_$JUSTIFY("SNOMED CT",44)_$JUSTIFY("SNOMED CT",21)
+25 SET ^XTMP(SUB,20,0)="IEN"_$JUSTIFY("MODIFIED",23)_$JUSTIFY("DIAGNOSIS",16)_$JUSTIFY("SECONDARY DIAGNOSIS",22)_$JUSTIFY("CONCEPT CODE",23)_$JUSTIFY("DESIGNATION CODE",25)_$JUSTIFY("PROBLEM",12)
+26 SET ^XTMP(SUB,21,0)=$$REPEAT^XLFSTR("-",15)_$JUSTIFY($$REPEAT^XLFSTR("-",12),15)_$JUSTIFY($$REPEAT^XLFSTR("-",9),12)_$JUSTIFY($$REPEAT^XLFSTR("-",27),30)_$JUSTIFY($$REPEAT^XLFSTR("-",18),21)_...
... $JUSTIFY($$REPEAT^XLFSTR("-",18),21)_$JUSTIFY($$REPEAT^XLFSTR("-",33),36)
+27 FOR
SET GMPLDLM=$ORDER(^TMP("GMPLCLNP",$JOB,GMPLDLM))
if 'GMPLDLM
QUIT
Begin DoDot:1
+28 FOR
SET GMPLDA=$ORDER(^TMP("GMPLCLNP",$JOB,GMPLDLM,GMPLDA))
if 'GMPLDA
QUIT
Begin DoDot:2
+29 SET GMPX=$GET(^TMP("GMPLCLNP",$JOB,GMPLDLM,GMPLDA))
SET GMPJ=GMPJ+1
+30 SET ^XTMP(SUB,GMPJ,0)=$$LJ^XLFSTR($GET(GMPLDA),18)_$$LJ^XLFSTR($PIECE(GMPX,U,1),15)_$$LJ^XLFSTR($PIECE($PIECE(GMPX,U,2),"/"),12)_$$LJ^XLFSTR($PIECE($PIECE(GMPX,U,2),"/",2,$LENGTH($PIECE(GMPX,U,2),"/")),30)
+31 SET ^XTMP(SUB,GMPJ,0)=^XTMP(SUB,GMPJ,0)_$$LJ^XLFSTR($PIECE(GMPX,U,3),21)_$$LJ^XLFSTR($PIECE(GMPX,U,4),21)_$$LJ^XLFSTR($PIECE(GMPX,U,5),$LENGTH($PIECE(GMPX,U,5)))
End DoDot:2
End DoDot:1
+32 KILL ^TMP("GMPLCLNP",$JOB)
+33 QUIT
+34 ;
VWERRPT ; View Error Report
+1 NEW GMPLX
+2 SET GMPLX=$ORDER(^XTMP("GMPLERPT;"))
+3 IF GMPLX["GMPLERPT"
IF $DATA(^XTMP(GMPLX))
DO BROWSE^DDBR("^XTMP("""_GMPLX_""")","NR","Erroneous Problem File Record Entries Report")
+4 IF '$TEST
Begin DoDot:1
+5 NEW GMPLTEXT
+6 SET GMPLTEXT(1)="There are currently no Problem File entries that contain this error."
+7 DO MES^XPDUTL(.GMPLTEXT)
End DoDot:1
+8 QUIT
VWCLRPT ; View Cleanup Report
+1 NEW GMPLX
+2 SET GMPLX=$ORDER(^XTMP("GMPLCRPT;"))
+3 IF GMPLX["GMPLCRPT"
IF $DATA(^XTMP(GMPLX))
DO BROWSE^DDBR("^XTMP("""_GMPLX_""")","NR","Problem File Cleanup Report")
+4 IF '$TEST
Begin DoDot:1
+5 NEW GMPLTEXT
+6 SET GMPLTEXT(1)="There are currently no Problem File entries that need correction."
+7 DO MES^XPDUTL(.GMPLTEXT)
End DoDot:1
+8 QUIT
