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

PXRMUIDR.m

Go to the documentation of this file.
  1. PXRMUIDR ;SLC/PKR - Taxonomy Use In Dialog report routines. ;03/01/2013
  1. ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
  1. ;==========================================
  1. REPD ;Inactive UID report driver.
  1. N DIR0,NLINES,OUTPUT,TITLE
  1. D REPTEXT(.NLINES,.OUTPUT)
  1. S TITLE="Inactive UID Report as of "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. D BROWSE^DDBR("OUTPUT","NR",TITLE)
  1. I $D(VALMDDF) S VALMBCK="R"
  1. Q
  1. ;
  1. ;==========================================
  1. REPTEXT(NLINES,OUTPUT) ;Create inactive UID report text.
  1. N ACTDT,BDESC,CODE,CODESYS,CODESYSN,FMTSTR,IEN,INACTDT,IND,LC
  1. N NAME,NCS,NOUT,TEXT,TEXTOUT
  1. K ^TMP("PXRMUIDR",$J)
  1. S FMTSTR="10L1^10C4^45L"
  1. S IEN=0
  1. F S IEN=+$O(^PXD(811.2,IEN)) Q:IEN=0 D
  1. . S NAME=$P(^PXD(811.2,IEN,0),U,1)
  1. . S CODESYS=""
  1. . F S CODESYS=$O(^PXD(811.2,IEN,20,"AUID",CODESYS)) Q:CODESYS="" D
  1. .. S CODE=""
  1. .. F S CODE=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE)) Q:CODE="" D
  1. ... S ACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,""),-1)
  1. ... S INACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,""),-1)
  1. ... I (INACTDT>DT)!(INACTDT="DT") Q
  1. ... S ^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,INACTDT)=$P(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,INACTDT),U,2)
  1. . I $D(^TMP("PXRMUIDR",$J,NAME)) S ^TMP("PXRMUIDR",$J,NAME)=IEN
  1. ;Create the text.
  1. S OUTPUT(1)="The following taxonomies contain the listed inactive codes which are marked as"
  1. S OUTPUT(2)="Use in Dialog:"
  1. S OUTPUT(3)=""
  1. S LC=3,NAME=""
  1. F S NAME=$O(^TMP("PXRMUIDR",$J,NAME)) Q:NAME="" D
  1. . S IEN=^TMP("PXRMUIDR",$J,NAME)
  1. . I LC>3 S LC=LC+1,OUTPUT(LC)=""
  1. . S LC=LC+1,OUTPUT(LC)="Taxonomy: "_NAME_" (IEN="_IEN_")"
  1. . S CODESYS="",NCS=0
  1. . F S CODESYS=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS)) Q:CODESYS="" D
  1. .. S NCS=NCS+1
  1. ..;DBIA #5679
  1. .. I '$D(CODESYSN(CODESYS)) S CODESYSN(CODESYS)=$P($$CSYS^LEXU(CODESYS),U,4)
  1. .. I NCS>1 S LC=LC+1,OUTPUT(LC)=""
  1. .. S LC=LC+1,OUTPUT(LC)=" Coding system: "_CODESYSN(CODESYS)
  1. .. S LC=LC+1,OUTPUT(LC)="Code Inactivation Brief Description"
  1. .. S LC=LC+1,OUTPUT(LC)="--------- ------------ -----------------"
  1. .. S CODE=""
  1. .. F S CODE=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE)) Q:CODE="" D
  1. ... S INACTDT=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,""))
  1. ... S BDESC=^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,INACTDT)
  1. ... S TEXT=CODE_U_$$FMTE^XLFDT(INACTDT,"5Z")_U_BDESC
  1. ... D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
  1. ... F IND=1:1:NOUT S LC=LC+1,OUTPUT(LC)=TEXTOUT(IND)
  1. ;If no text in addition to the header was created change the header.
  1. I LC=3 D
  1. . S OUTPUT(1)="No taxonomies containing inactive codes which are marked as Use in Dialog"
  1. . S OUTPUT(2)="were found."
  1. . S OUTPUT(3)=""
  1. S NLINES=LC
  1. K ^TMP("PXRMUIDR",$J)
  1. Q
  1. ;