Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMPLCLN

GMPLCLN.m

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