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

PXMCICHK.m

Go to the documentation of this file.
  1. PXMCICHK ;SLC/PKR - Search for and display inactive mapped codes. ;04/12/2017
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;
  1. ;==========================================
  1. CSU(TYPE) ;Entry point for code set update, called by CPTE and ICDE^PXCSPE.
  1. N IND,NL,PTYPE,SUBJECT,TEXT,TMPNODE
  1. S PTYPE=$S(TYPE="CPT":"a CPT",TYPE="ICD":"an ICD")
  1. S TMPNODE="PXINMC"
  1. D MCICHK(TMPNODE,.TEXT)
  1. K ^TMP("PXXMZ",$J)
  1. S ^TMP("PXXMZ",$J,1,0)="There was "_PTYPE_" code set update on "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. S ^TMP("PXXMZ",$J,2,0)="Please review the affected code mappings and take appropriate action."
  1. S ^TMP("PXXMZ",$J,3,0)=""
  1. S IND=0,NL=3
  1. F S IND=+$O(TEXT(IND)) Q:IND=0 S NL=NL+1,^TMP("PXXMZ",$J,NL,0)=TEXT(IND)
  1. S SUBJECT="PCE inactive mapped codes report"
  1. D SEND^PXMSG("PXXMZ",SUBJECT)
  1. Q
  1. ;
  1. ;==========================================
  1. BROWSE ;Display the inactive mapped codes in the Browser.
  1. N TEXT,TMPNODE,X
  1. S TMPNODE="PXINMC"
  1. D MCICHK(TMPNODE,.TEXT)
  1. S X="IORESET"
  1. D ENDR^%ZISS
  1. D BROWSE^DDBR("TEXT","NR","Inactive Mapped Codes")
  1. W IORESET
  1. D KILL^%ZISS
  1. K ^TMP($J,TMPNODE)
  1. Q
  1. ;
  1. ;==========================================
  1. EDU(NODE) ;Search Education Topics for mapped codes that are inactive and
  1. ;produce a list.
  1. N CODE,CODESYS,IEN,INACTDT,IND,NAME,TEMP
  1. S NAME=""
  1. F S NAME=$O(^AUTTEDT("B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^AUTTEDT("B",NAME,""))
  1. . I '$D(^AUTTEDT(IEN,210)) Q
  1. . S IND=0
  1. . F S IND=+$O(^AUTTEDT(IEN,210,IND)) Q:IND=0 D
  1. .. S TEMP=^AUTTEDT(IEN,210,IND,0)
  1. .. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .. I CODE'="" D
  1. ... S INACTDT=$$INACTDT(CODESYS,CODE)
  1. ... I INACTDT'="" S ^TMP($J,NODE,"EDU",NAME,IEN,CODESYS,CODE)=INACTDT
  1. Q
  1. ;
  1. ;==========================================
  1. EXAM(NODE) ;Search Exams for mapped codes that are inactive and produce a list.
  1. N CODE,CODESYS,IEN,INACTDT,IND,NAME,TEMP
  1. S NAME=""
  1. F S NAME=$O(^AUTTEXAM("B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^AUTTEXAM("B",NAME,""))
  1. . I '$D(^AUTTEXAM(IEN,210)) Q
  1. . S IND=0
  1. . F S IND=+$O(^AUTTEXAM(IEN,210,IND)) Q:IND=0 D
  1. .. S TEMP=^AUTTEXAM(IEN,210,IND,0)
  1. .. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .. I CODE'="" D
  1. ... S INACTDT=$$INACTDT(CODESYS,CODE)
  1. ... I INACTDT'="" S ^TMP($J,NODE,"EXAM",NAME,IEN,CODESYS,CODE)=INACTDT
  1. Q
  1. ;
  1. ;==========================================
  1. HF(NODE) ;Search Health Factors for mapped codes that are inactive and produce
  1. ;a list.
  1. N CODE,CODESYS,IEN,INACTDT,IND,NAME,TEMP
  1. S NAME=""
  1. F S NAME=$O(^AUTTHF("B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^AUTTHF("B",NAME,""))
  1. . I '$D(^AUTTHF(IEN,210)) Q
  1. . S IND=0
  1. . F S IND=+$O(^AUTTHF(IEN,210,IND)) Q:IND=0 D
  1. .. S TEMP=^AUTTHF(IEN,210,IND,0)
  1. .. S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. .. I CODE'="" D
  1. ... S INACTDT=$$INACTDT(CODESYS,CODE)
  1. ... I INACTDT'="" S ^TMP($J,NODE,"HF",NAME,IEN,CODESYS,CODE)=INACTDT
  1. Q
  1. ;
  1. ;==========================================
  1. IMM(NODE) ;Search Immunizations for mapped codes that are inactive and produce
  1. ;a list.
  1. N CODE,CODESYS,IEN,INACTDT,IND,JND,NAME,TEMP
  1. S NAME=""
  1. F S NAME=$O(^AUTTIMM("B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^AUTTIMM("B",NAME,""))
  1. . S IND=0
  1. . F S IND=+$O(^AUTTIMM(IEN,3,IND)) Q:IND=0 D
  1. .. S CODESYS=^AUTTIMM(IEN,3,IND,0)
  1. .. S JND=0
  1. .. F S JND=+$O(^AUTTIMM(IEN,3,IND,1,JND)) Q:JND=0 D
  1. ... S CODE=^AUTTIMM(IEN,3,IND,1,JND,0)
  1. ... S INACTDT=$$INACTDT(CODESYS,CODE)
  1. ... I INACTDT'="" S ^TMP($J,NODE,"IMM",NAME,IEN,CODESYS,CODE)=INACTDT
  1. Q
  1. ;
  1. ;==========================================
  1. INACTDT(CODESYS,CODE) ;Given a coding system and a code, check and if the
  1. ;code is inactive return the inactivation date otherwise return null.
  1. N ACTDT,INACTDT,RESULT,PDATA
  1. ;ICR #5679
  1. S RESULT=$$PERIOD^LEXU(CODE,CODESYS,.PDATA)
  1. I +RESULT=-1 D
  1. .;DBIA #1997, #3991
  1. . I (CODESYS="CPC")!(CODESYS="CPT") D PERIOD^ICPTAPIU(CODE,.PDATA)
  1. . I (CODESYS="ICD")!(CODESYS="ICP") D PERIOD^ICDAPIU(CODE,.PDATA)
  1. S ACTDT=1000101,INACTDT=""
  1. F S ACTDT=$O(PDATA(ACTDT)) Q:(ACTDT="")!(INACTDT'="") D
  1. . S INACTDT=$P(PDATA(ACTDT),U,1)
  1. Q INACTDT
  1. ;
  1. ;==========================================
  1. MCICHK(TMPNODE,TEXT) ;Search Education Topics, Exams, Health Factors,
  1. ;Immunizations, and Skin Tests for mapped codes that are inactive
  1. ;and produce a list.
  1. N CODE,CODESYS,FILE,FNAME,IEN,INACTDT,NAME,NL
  1. S FNAME("EDU")="EDUCATION TOPICS",FNAME("EXAM")="EXAM"
  1. S FNAME("HF")="HEALTH FACTORS",FNAME("IMM")="IMMUNIZATION"
  1. S FNAME("SKIN")="SKIN TEST"
  1. K ^TMP($J,TMPNODE)
  1. D EDU(TMPNODE),EXAM(TMPNODE),HF(TMPNODE),IMM(TMPNODE),SKIN(TMPNODE)
  1. ;Create the report.
  1. S FILE="",NL=0
  1. F S FILE=$O(^TMP($J,TMPNODE,FILE)) Q:FILE="" D
  1. . I NL>0 S NL=NL+1,TEXT(NL)="",NL=NL+1,TEXT(NL)="-----------------------------"
  1. . S NL=NL+1,TEXT(NL)=FNAME(FILE)_" inactive mapped codes."
  1. . S NAME=""
  1. . F S NAME=$O(^TMP($J,TMPNODE,FILE,NAME)) Q:NAME="" D
  1. .. S IEN=$O(^TMP($J,TMPNODE,FILE,NAME,""))
  1. .. S NL=NL+1,TEXT(NL)=""
  1. .. S NL=NL+1,TEXT(NL)=" "_NAME_" (IEN="_IEN_")"
  1. .. S CODESYS=""
  1. .. F S CODESYS=$O(^TMP($J,TMPNODE,FILE,NAME,IEN,CODESYS)) Q:CODESYS="" D
  1. ... S CODE=""
  1. ... F S CODE=$O(^TMP($J,TMPNODE,FILE,NAME,IEN,CODESYS,CODE)) Q:CODE="" D
  1. .... S INACTDT=^TMP($J,TMPNODE,FILE,NAME,IEN,CODESYS,CODE)
  1. .... S NL=NL+1,TEXT(NL)=" "_CODESYS_" "_CODE_", inactivated: "_$$FMTE^XLFDT(INACTDT,"5Z")
  1. K ^TMP($J,TMPNODE)
  1. Q
  1. ;
  1. ;==========================================
  1. SKIN(NODE) ;Search Skin Tests for mapped codes that are inactive and produce
  1. ;a list.
  1. N CODE,CODESYS,IEN,INACTDT,IND,JND,NAME,TEMP
  1. S NAME=""
  1. F S NAME=$O(^AUTTSK("B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^AUTTSK("B",NAME,""))
  1. . S IND=0
  1. . F S IND=+$O(^AUTTSK(IEN,3,IND)) Q:IND=0 D
  1. .. S CODESYS=^AUTTSK(IEN,3,IND,0)
  1. .. S JND=0
  1. .. F S JND=+$O(^AUTTSK(IEN,3,IND,1,JND)) Q:JND=0 D
  1. ... S CODE=^AUTTSK(IEN,3,IND,1,JND,0)
  1. ... S INACTDT=$$INACTDT(CODESYS,CODE)
  1. ... I INACTDT'="" S ^TMP($J,NODE,"SKIN",NAME,IEN,CODESYS,CODE)=INACTDT
  1. Q
  1. ;