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

GMPLCLNP.m

Go to the documentation of this file. 
  1. GMPLCLNP ;ISP/TC - Problem File Cleanup Routine ;01/14/16  13:41
  1.  ;;2.0;Problem List;**40**;Aug 25, 1994;Build 9
  1.  ;
  1.  ;
  1.  ; External References
  1.  ;    ^%ZTLOAD              ICR  10063
  1.  ;    MES^XPDUTL            ICR  10141
  1.  ;    FILE^DIE              ICR   2053
  1.  ;    UPDATE^DIE            ICR   2053
  1.  ;    $$GET1^DIQ            ICR   2056
  1.  ;    $$NOW^XLFDT           ICR  10103
  1.  ;    $$FMTE^XLFDT          ICR  10103
  1.  ;    $$SAB^ICDEX           ICR   5747
  1.  ;    $$CODEC^ICDEX         ICR   5747
  1.  ;    $$CODECS^ICDEX        ICR   5747
  1.  ;    $$CODEN^ICDEX         ICR   5747
  1.  ;    $$GETSYN^LEXTRAN1     ICR   5006
  1.  ;
  1.  ;
  1. EN ; Main entry point to task off SCT error scan & cleanup
  1.  ;
  1.  N GMPLTEXT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
  1.  S ZTRTN="SCANSCT^GMPLCLNP"
  1.  S ZTDESC="Problem File SNOMED Error Scan and Cleanup"
  1.  S ZTDTH=$H,ZTIO=""
  1.  D ^%ZTLOAD
  1.  S GMPLTEXT(1)=""
  1.  S GMPLTEXT(2)=" Problem File SNOMED Error Scan and Cleanup queued."
  1.  S GMPLTEXT(3)=" The task number is "_ZTSK_"."
  1.  D MES^XPDUTL(.GMPLTEXT)
  1.  Q
  1. EN1 ; Main entry point to task off incorrect mapping scan & cleanup
  1.  ;
  1.  N GMPLTEXT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
  1.  S ZTRTN="SCANVCDE^GMPLCLNP"
  1.  S ZTDESC="Problem File Incorrect Mapping Scan and Cleanup"
  1.  S ZTDTH=$H,ZTIO=""
  1.  D ^%ZTLOAD
  1.  S GMPLTEXT(1)=""
  1.  S GMPLTEXT(2)=" Problem File Incorrect Mapping Scan and Cleanup queued."
  1.  S GMPLTEXT(3)=" The task number is "_ZTSK_"."
  1.  D MES^XPDUTL(.GMPLTEXT)
  1.  Q
  1. SCANSCT ; Scan Problem file for SCT in Diagnosis field errors
  1.  N GMPLDIAG,GMPLDA,GMPLDLM,GMPLNERR,GMPLPROB,GMPLNARR,GMPLNIEN
  1.  N GMPLPIEN,GMPLRNTM,GMPL0,GMPL1,GMPLSUB,GMPLFROM,GMPLMSG
  1.  S (GMPLDIAG,GMPLDA,GMPLDLM)="",GMPLNERR=0
  1.  K ^TMP("GMPLSCT",$J)
  1.  S GMPLRNTM=$$NOW^XLFDT
  1.  F  S GMPLDIAG=$O(^AUPNPROB("B",GMPLDIAG),-1) Q:GMPLDIAG=""  D
  1.  . F  S GMPLDA=$O(^AUPNPROB("B",GMPLDIAG,GMPLDA),-1) Q:'GMPLDA  D
  1.  . . I ($L(GMPLDIAG)>5),($L(GMPLDIAG)<19),($P($$CODEC^ICDEX(80,GMPLDIAG),U,1)=-1) D
  1.  . . . S GMPL0=$G(^AUPNPROB(GMPLDA,0)),GMPL1=$G(^AUPNPROB(GMPLDA,1))
  1.  . . . S GMPLDLM=$P(GMPL0,U,3)   ;Date Last Modified of erroneous record
  1.  . . . S GMPLNIEN=$P(GMPL0,U,5)  ;IEN of Provider Narrative entry
  1.  . . . S GMPLPROB=$$GET1^DIQ(9000011,""_GMPLDA_",",1.01,"E") ;Problem description
  1.  . . . S GMPLNERR=GMPLNERR+1
  1.  . . . S ^TMP("GMPLSCT",$J,GMPLDLM,GMPLDA)=$$FMTE^XLFDT(GMPLDLM,"1D")_U_GMPLDIAG_U_GMPLPROB_U_GMPLNIEN
  1.  I GMPLNERR>0 D
  1.  . D BLDERRPT^GMPLCLN(GMPLNERR,GMPLRNTM)
  1.  . D BLDERMSG^GMPLCLN(GMPLNERR)
  1.  . D CLNSCTE
  1.  E  D
  1.  . S GMPLSUB="Problem File Error Scan: No Errors Found"
  1.  . S GMPLFROM="GMPL*2.0*40 INSTALL"
  1.  . S GMPLMSG(1)="No errors were found that contain a SNOMED CT concept code in the"
  1.  . S GMPLMSG(2)="Diagnosis field #.01."
  1.  . D BLDNEMSG^GMPLCLN(.GMPLMSG,GMPLSUB,GMPLFROM,GMPLRNTM)
  1.  Q
  1. CLNSCTE ; Clean up erroneous PL entries in ^TMP("GMPLSCT")
  1.  N GMPLDLM,GMPLDA,GMPLSCTC,GMPLSCTD,GMPLNARR,GMPLICD,GMPLNCLN,GMPLFDA,GMPLFROM
  1.  N GMPLFDA1,GMPLREC,GMPLNIEN,GMPLPROB,GMPSYN,GMPLRNTM,GMPCNT,GMPLDIEN,GMPLIEN
  1.  K ^TMP("GMPLCLNP",$J),^TMP("GMPLCLER",$J)
  1.  S (GMPLDLM,GMPLDA)="",GMPLNCLN=0,GMPLRNTM=$$NOW^XLFDT,GMPCNT=0
  1.  S GMPLFROM="GMPL*2.0*40 INSTALL"
  1.  F  S GMPLDLM=$O(^TMP("GMPLSCT",$J,GMPLDLM)) Q:'GMPLDLM  D
  1.  . F  S GMPLDA=$O(^TMP("GMPLSCT",$J,GMPLDLM,GMPLDA)) Q:'GMPLDA  D
  1.  . . L +^AUPNPROB(GMPLDA):5 I '$T D  Q
  1.  . . . S GMPCNT=GMPCNT+1
  1.  . . . S ^TMP("GMPLCLER",$J,GMPCNT,0)="Error updating record #"_GMPLDA_" in File #9000011."
  1.  . . . Q
  1.  . . S GMPLREC=$G(^TMP("GMPLSCT",$J,GMPLDLM,GMPLDA))
  1.  . . S GMPLSCTC=$P(GMPLREC,U,2),GMPLNIEN=$P(GMPLREC,U,4)
  1.  . . S GMPLICD=$$GETDX^GMPLUTL(GMPLSCTC,GMPLDLM)
  1.  . . S GMPLDIEN=$P($$CODEN^ICDEX($P(GMPLICD,"/"),80),"~",1)
  1.  . . I $G(GMPLICD)["/" D FILEMT(GMPLDA,GMPLICD,GMPLDLM)
  1.  . . I $P($$GETSYN^LEXTRAN1("SCT",GMPLSCTC,GMPLDLM,"GMPSYN",1,1),U)>0 D
  1.  . . . S GMPLNARR=$P(GMPSYN("P"),U),GMPLPROB=$P(GMPSYN("P"),U,2),GMPLSCTD=$P(GMPSYN("P"),U,3)
  1.  . . E  D
  1.  . . . S GMPLNARR="Unresolved",GMPLPROB="1",GMPLSCTD="@"
  1.  . . S GMPLIEN=""_GMPLDA_","
  1.  . . S GMPLFDA(9000011,GMPLIEN,.01)=$S($G(GMPLICD)["/":$P(GMPLICD,"/"),1:$G(GMPLICD)) ; Primary Diagnosis (#.01)
  1.  . . S GMPLFDA(9999999.27,""_GMPLNIEN_",",.01)=GMPLNARR ; Provider Narrative (#.05)
  1.  . . S GMPLFDA1(9000011,GMPLIEN,1.01)=GMPLPROB ; Problem (#1.01)
  1.  . . S GMPLFDA(9000011,GMPLIEN,80001)=GMPLSCTC ; SNOMED CT Concept code (#80001)
  1.  . . S GMPLFDA(9000011,GMPLIEN,80002)=GMPLSCTD ; SNOMED CT Designation code (#80002)
  1.  . . D FILE^DIE("E","GMPLFDA")
  1.  . . D FILE^DIE("","GMPLFDA1")
  1.  . . D CLNAUD(GMPLDLM,GMPLDA,GMPLDIEN)
  1.  . . L -^AUPNPROB(GMPLDA)
  1.  . . S GMPLNCLN=GMPLNCLN+1
  1.  . . S ^TMP("GMPLCLNP",$J,GMPLDLM,GMPLDA)=$$FMTE^XLFDT(GMPLDLM,"1D")_U_GMPLICD_U_GMPLSCTC_U_GMPLSCTD_U_GMPLNARR
  1.  K ^TMP("GMPLSCT",$J)
  1.  I GMPCNT>0,$D(^TMP("GMPLCLER")) D
  1.  . N GMPLMSG,GMPLNODE
  1.  . S GMPLNODE="GMPLCLER"
  1.  . S GMPLMSG(1)="Please run the Generate SNOMED in Diagnosis Field Err/Cleanup Rpt [GMPL"
  1.  . S GMPLMSG(2)="GENERATE DIAG RPTS] menu option again to rerun the file scan and clean up"
  1.  . S GMPLMSG(3)="these missed entries."
  1.  . D BLDLEMSG^GMPLCLN(.GMPLMSG,GMPCNT,GMPLFROM,GMPLNODE)
  1.  I GMPLNCLN>0 D
  1.  . N GMPMSG,GMPSUB
  1.  . S GMPSUB="SNOMED Error Cleanup Complete"
  1.  . S GMPMSG(1)="These entries no longer contain a SNOMED CT concept code in the Diagnosis"
  1.  . S GMPMSG(2)="field #.01. To see a report of these corrected records, please access the"
  1.  . S GMPMSG(3)="SNOMED in Diagnosis Field Cleanup Report [GMPL DIAG CLEANUP REPORT] which is"
  1.  . S GMPMSG(4)="attached to the Problem List Mgt Menu [GMPL MGT MENU]."
  1.  . D BLDCLRPT^GMPLCLN(GMPLNCLN,GMPLRNTM)
  1.  . D BLDCLMSG^GMPLCLN(.GMPMSG,GMPSUB,GMPLFROM,GMPLNCLN)
  1.  Q
  1. FILEMT(GMPDA,GMPICD,GMPDLM) ; File the associating Mapping Target codes
  1.  N GMPN,GMPI,GMPCSYS,GMPNCNT,GMPFDA,GMPLFDA,GMPJ
  1.  S GMPCSYS=$$SAB^ICDEX(+$$CODECS^ICDEX($P(GMPICD,"/"),80,GMPDLM),GMPDLM)
  1.  ; Remove previous entries
  1.  S GMPNCNT=+$P($G(^AUPNPROB(GMPDA,803,0)),U,4)
  1.  I GMPNCNT>0 D
  1.  . F GMPJ=1:1:GMPNCNT D
  1.  . . S GMPLFDA(9000011.803,""_GMPJ_","_GMPDA_",",.01)="@"
  1.  . . D FILE^DIE("","GMPLFDA")
  1.  ; File new entries so that ACRMT xref is updated
  1.  S GMPN=$L(GMPICD,"/")-1
  1.  F GMPI=1:1:GMPN D
  1.  . N GMPCODE,GMPNOS,GMPFDA,GMPDT S GMPNOS=$$NOS^GMPLX(GMPCSYS)
  1.  . S GMPCODE=$P(GMPICD,"/",(GMPI+1)) Q:(GMPCODE="")
  1.  . I GMPCODE=$P(GMPNOS,U,2) Q
  1.  . S GMPDT=$$FMTE^XLFDT(GMPDLM,"1D")
  1.  . S GMPFDA(9000011.803,"+2,"_GMPDA_",",.01)=GMPCODE
  1.  . S GMPFDA(9000011.803,"+2,"_GMPDA_",",.02)=GMPCSYS
  1.  . S GMPFDA(9000011.803,"+2,"_GMPDA_",",.03)=GMPDT
  1.  . D UPDATE^DIE("E","GMPFDA")
  1.  Q
  1. CLNAUD(GMPLDLM,GMPLDA,GMPLDIEN) ; Cleanup audit history for Diagnosis field
  1.  N GMPLAIEN,GMPLINVD,GMPLFLDN,GMPLNVAL,GMPQT,GMPL0
  1.  S (GMPLINVD,GMPLAIEN)="",GMPQT=0,GMPLDA=GMPLDA-1
  1.  F  S GMPLDA=$O(^GMPL(125.8,"AD",GMPLDA)) Q:'GMPLDA  D
  1.  . F  S GMPLINVD=$O(^GMPL(125.8,"AD",GMPLDA,GMPLINVD)) Q:'GMPLINVD  D
  1.  . . I $$CNVTFMDT(GMPLINVD)=GMPLDLM D
  1.  . . . F  S GMPLAIEN=$O(^GMPL(125.8,"AD",GMPLDA,GMPLINVD,GMPLAIEN)) Q:'GMPLAIEN!GMPQT  D
  1.  . . . . S GMPL0=$G(^GMPL(125.8,GMPLAIEN,0))
  1.  . . . . S GMPLFLDN=$P(GMPL0,U,2),GMPLNVAL=$P(GMPL0,U,6)
  1.  . . . . I (GMPLFLDN=".01"),($L(GMPLNVAL)>5),($L(GMPLNVAL)<19),($P($$CODEC^ICDEX(80,GMPLNVAL),U,1)=-1) D
  1.  . . . . . N GMPFDA
  1.  . . . . . S GMPFDA(125.8,""_GMPLAIEN_",",5)=GMPLDIEN,GMPQT=1
  1.  . . . . . D FILE^DIE("K","GMPFDA")
  1.  Q
  1. CNVTFMDT(GMPLINVD) ; Convert an inverted date into FileMan format
  1.  N GMPLFMDT
  1.  S GMPLFMDT=9999999-GMPLINVD
  1.  S GMPLFMDT=$P(GMPLFMDT,".")
  1.  Q GMPLFMDT
  1. SCANVCDE ; Scan Problem file for incorrect mapping (SCT 428283002, ICD-9 V15.89)
  1.  N GMPLDA,GMPLNERR,GMPLNARR,GMPLSCTC,GMPLRNTM,GMPLPAT,GMPLICD,GMPL0,GMPLDIEN,GMPL1,GMPLPROV
  1.  N GMPLSUB,GMPLFROM,GMPLMSG
  1.  S GMPLDA="",GMPLNERR=0
  1.  K ^TMP("GMPLVCDE",$J)
  1.  S GMPLRNTM=$$NOW^XLFDT,GMPLSCTC="428283002"
  1.  F  S GMPLDA=$O(^AUPNPROB("ASCT",GMPLSCTC,GMPLDA)) Q:'GMPLDA  D
  1.  . S GMPL0=$G(^AUPNPROB(GMPLDA,0)),GMPL1=$G(^AUPNPROB(GMPLDA,1))
  1.  . S GMPLDIEN=$P(GMPL0,U,1)
  1.  . S GMPLICD=$$CODEC^ICDEX(80,GMPLDIEN) I $G(GMPLICD)="V15.89" D
  1.  . . S GMPLPAT=$P($G(^DPT($P(GMPL0,U,2),0)),U)   ;Patient Name - ICR 10035
  1.  . . S GMPLNARR=$$GET1^DIQ(9000011,""_GMPLDA_",",.05,"E")  ;Provider Narrative Text - ICR 1593
  1.  . . S GMPLPROV=$P(GMPL1,U,4) ;Recording Provider
  1.  . . S GMPLNERR=GMPLNERR+1
  1.  . . S ^TMP("GMPLVCDE",$J,GMPLDA)=GMPLPAT_U_GMPLNARR_U_GMPLDIEN_U_GMPLPROV
  1.  I GMPLNERR>0 D
  1.  . D BLDRPMSG^GMPLCLN(GMPLNERR,GMPLRNTM)
  1.  . D CLNVCDE
  1.  E  D
  1.  . S GMPLSUB="Incorrect Mapping Scan: No Errors Found"
  1.  . S GMPLFROM="GMPL*2.0*40 INSTALL"
  1.  . S GMPLMSG(1)="No incorrect SNOMED CT 428283002 to ICD-9-CM V15.89 code mappings"
  1.  . S GMPLMSG(2)="for the term ""History of polyp of colon"" were found."
  1.  . D BLDNEMSG^GMPLCLN(.GMPLMSG,GMPLSUB,GMPLFROM,GMPLRNTM)
  1.  Q
  1. CLNVCDE ; Clean up erroneous PL entries in ^TMP("GMPLVCDE")
  1.  N GMPLDA,GMPLFDA,GMPCNT,GMPFDA,GMPLREC,GMPLPROV,GMPLDIEN,GMPLNCLN,GMPLFROM
  1.  S GMPLDA="",GMPCNT=0,GMPLNCLN=0
  1.  S GMPLFROM="GMPL*2.0*40 INSTALL"
  1.  K ^TMP("GMPLLKER",$J)
  1.  F  S GMPLDA=$O(^TMP("GMPLVCDE",$J,GMPLDA)) Q:'GMPLDA  D
  1.  . L +^AUPNPROB(GMPLDA):5 I '$T D  Q
  1.  . . S GMPCNT=GMPCNT+1
  1.  . . S ^TMP("GMPLLKER",$J,GMPCNT,0)="Error updating record #"_GMPLDA_" in File #9000011."
  1.  . . Q
  1.  . S GMPLFDA(9000011,""_GMPLDA_",",.01)="V12.72"
  1.  . D FILE^DIE("E","GMPLFDA")
  1.  . L -^AUPNPROB(GMPLDA)
  1.  . S GMPLNCLN=GMPLNCLN+1
  1.  . ; Create audit history entry for modified Diagnosis field
  1.  . S GMPLREC=$G(^TMP("GMPLVCDE",$J,GMPLDA))
  1.  . S GMPLPROV=$P(GMPLREC,U,4),GMPLDIEN=$P(GMPLREC,U,3)
  1.  . S GMPFDA(125.8,"+1,",.01)=GMPLDA
  1.  . S GMPFDA(125.8,"+1,",1)=".01"
  1.  . S GMPFDA(125.8,"+1,",2)=$$NOW^XLFDT
  1.  . S GMPFDA(125.8,"+1,",3)=GMPLPROV
  1.  . S GMPFDA(125.8,"+1,",4)=GMPLDIEN
  1.  . S GMPFDA(125.8,"+1,",5)=$P($$CODEN^ICDEX("V12.72",80),"~")
  1.  . S GMPFDA(125.8,"+1,",6)="DIAGNOSIS CORRECTION"
  1.  . S GMPFDA(125.8,"+1,",7)=GMPLPROV
  1.  . D UPDATE^DIE("","GMPFDA")
  1.  K ^TMP("GMPLVCDE",$J)
  1.  I GMPCNT>0,$D(^TMP("GMPLLKER")) D
  1.  . N GMPLNODE S GMPLNODE="GMPLLKER"
  1.  . D BLDLEMSG^GMPLCLN(,GMPCNT,GMPLFROM,GMPLNODE)
  1.  I GMPLNCLN>0 D
  1.  . N GMPMSG,GMPSUB
  1.  . S GMPSUB="Incorrect Mapping Cleanup Complete"
  1.  . S GMPMSG(1)="These entries no longer contain an incorrect mapping and a V15.89 code in the"
  1.  . S GMPMSG(2)="Diagnosis field #.01. The correct code of V12.82 is now stored in this field."
  1.  . D BLDCLMSG^GMPLCLN(.GMPMSG,GMPSUB,GMPLFROM,GMPLNCLN)
  1.  Q