PXRMUIDR ;SLC/PKR - Taxonomy Use In Dialog report routines. ;03/01/2013
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
;==========================================
REPD ;Inactive UID report driver.
N DIR0,NLINES,OUTPUT,TITLE
D REPTEXT(.NLINES,.OUTPUT)
S TITLE="Inactive UID Report as of "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
D BROWSE^DDBR("OUTPUT","NR",TITLE)
I $D(VALMDDF) S VALMBCK="R"
Q
;
;==========================================
REPTEXT(NLINES,OUTPUT) ;Create inactive UID report text.
N ACTDT,BDESC,CODE,CODESYS,CODESYSN,FMTSTR,IEN,INACTDT,IND,LC
N NAME,NCS,NOUT,TEXT,TEXTOUT
K ^TMP("PXRMUIDR",$J)
S FMTSTR="10L1^10C4^45L"
S IEN=0
F S IEN=+$O(^PXD(811.2,IEN)) Q:IEN=0 D
. S NAME=$P(^PXD(811.2,IEN,0),U,1)
. S CODESYS=""
. F S CODESYS=$O(^PXD(811.2,IEN,20,"AUID",CODESYS)) Q:CODESYS="" D
.. S CODE=""
.. F S CODE=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE)) Q:CODE="" D
... S ACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,""),-1)
... S INACTDT=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,""),-1)
... I (INACTDT>DT)!(INACTDT="DT") Q
... S ^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,INACTDT)=$P(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,INACTDT),U,2)
. I $D(^TMP("PXRMUIDR",$J,NAME)) S ^TMP("PXRMUIDR",$J,NAME)=IEN
;Create the text.
S OUTPUT(1)="The following taxonomies contain the listed inactive codes which are marked as"
S OUTPUT(2)="Use in Dialog:"
S OUTPUT(3)=""
S LC=3,NAME=""
F S NAME=$O(^TMP("PXRMUIDR",$J,NAME)) Q:NAME="" D
. S IEN=^TMP("PXRMUIDR",$J,NAME)
. I LC>3 S LC=LC+1,OUTPUT(LC)=""
. S LC=LC+1,OUTPUT(LC)="Taxonomy: "_NAME_" (IEN="_IEN_")"
. S CODESYS="",NCS=0
. F S CODESYS=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS)) Q:CODESYS="" D
.. S NCS=NCS+1
..;DBIA #5679
.. I '$D(CODESYSN(CODESYS)) S CODESYSN(CODESYS)=$P($$CSYS^LEXU(CODESYS),U,4)
.. I NCS>1 S LC=LC+1,OUTPUT(LC)=""
.. S LC=LC+1,OUTPUT(LC)=" Coding system: "_CODESYSN(CODESYS)
.. S LC=LC+1,OUTPUT(LC)="Code Inactivation Brief Description"
.. S LC=LC+1,OUTPUT(LC)="--------- ------------ -----------------"
.. S CODE=""
.. F S CODE=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE)) Q:CODE="" D
... S INACTDT=$O(^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,""))
... S BDESC=^TMP("PXRMUIDR",$J,NAME,CODESYS,CODE,INACTDT)
... S TEXT=CODE_U_$$FMTE^XLFDT(INACTDT,"5Z")_U_BDESC
... D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
... F IND=1:1:NOUT S LC=LC+1,OUTPUT(LC)=TEXTOUT(IND)
;If no text in addition to the header was created change the header.
I LC=3 D
. S OUTPUT(1)="No taxonomies containing inactive codes which are marked as Use in Dialog"
. S OUTPUT(2)="were found."
. S OUTPUT(3)=""
S NLINES=LC
K ^TMP("PXRMUIDR",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMUIDR 2733 printed Dec 13, 2024@01:49:42 Page 2
PXRMUIDR ;SLC/PKR - Taxonomy Use In Dialog report routines. ;03/01/2013
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 ;==========================================
REPD ;Inactive UID report driver.
+1 NEW DIR0,NLINES,OUTPUT,TITLE
+2 DO REPTEXT(.NLINES,.OUTPUT)
+3 SET TITLE="Inactive UID Report as of "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+4 DO BROWSE^DDBR("OUTPUT","NR",TITLE)
+5 IF $DATA(VALMDDF)
SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;==========================================
REPTEXT(NLINES,OUTPUT) ;Create inactive UID report text.
+1 NEW ACTDT,BDESC,CODE,CODESYS,CODESYSN,FMTSTR,IEN,INACTDT,IND,LC
+2 NEW NAME,NCS,NOUT,TEXT,TEXTOUT
+3 KILL ^TMP("PXRMUIDR",$JOB)
+4 SET FMTSTR="10L1^10C4^45L"
+5 SET IEN=0
+6 FOR
SET IEN=+$ORDER(^PXD(811.2,IEN))
if IEN=0
QUIT
Begin DoDot:1
+7 SET NAME=$PIECE(^PXD(811.2,IEN,0),U,1)
+8 SET CODESYS=""
+9 FOR
SET CODESYS=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS))
if CODESYS=""
QUIT
Begin DoDot:2
+10 SET CODE=""
+11 FOR
SET CODE=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:3
+12 SET ACTDT=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,""),-1)
+13 SET INACTDT=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,""),-1)
+14 IF (INACTDT>DT)!(INACTDT="DT")
QUIT
+15 SET ^TMP("PXRMUIDR",$JOB,NAME,CODESYS,CODE,INACTDT)=$PIECE(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE,ACTDT,INACTDT),U,2)
End DoDot:3
End DoDot:2
+16 IF $DATA(^TMP("PXRMUIDR",$JOB,NAME))
SET ^TMP("PXRMUIDR",$JOB,NAME)=IEN
End DoDot:1
+17 ;Create the text.
+18 SET OUTPUT(1)="The following taxonomies contain the listed inactive codes which are marked as"
+19 SET OUTPUT(2)="Use in Dialog:"
+20 SET OUTPUT(3)=""
+21 SET LC=3
SET NAME=""
+22 FOR
SET NAME=$ORDER(^TMP("PXRMUIDR",$JOB,NAME))
if NAME=""
QUIT
Begin DoDot:1
+23 SET IEN=^TMP("PXRMUIDR",$JOB,NAME)
+24 IF LC>3
SET LC=LC+1
SET OUTPUT(LC)=""
+25 SET LC=LC+1
SET OUTPUT(LC)="Taxonomy: "_NAME_" (IEN="_IEN_")"
+26 SET CODESYS=""
SET NCS=0
+27 FOR
SET CODESYS=$ORDER(^TMP("PXRMUIDR",$JOB,NAME,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:2
+28 SET NCS=NCS+1
+29 ;DBIA #5679
+30 IF '$DATA(CODESYSN(CODESYS))
SET CODESYSN(CODESYS)=$PIECE($$CSYS^LEXU(CODESYS),U,4)
+31 IF NCS>1
SET LC=LC+1
SET OUTPUT(LC)=""
+32 SET LC=LC+1
SET OUTPUT(LC)=" Coding system: "_CODESYSN(CODESYS)
+33 SET LC=LC+1
SET OUTPUT(LC)="Code Inactivation Brief Description"
+34 SET LC=LC+1
SET OUTPUT(LC)="--------- ------------ -----------------"
+35 SET CODE=""
+36 FOR
SET CODE=$ORDER(^TMP("PXRMUIDR",$JOB,NAME,CODESYS,CODE))
if CODE=""
QUIT
Begin DoDot:3
+37 SET INACTDT=$ORDER(^TMP("PXRMUIDR",$JOB,NAME,CODESYS,CODE,""))
+38 SET BDESC=^TMP("PXRMUIDR",$JOB,NAME,CODESYS,CODE,INACTDT)
+39 SET TEXT=CODE_U_$$FMTE^XLFDT(INACTDT,"5Z")_U_BDESC
+40 DO COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
+41 FOR IND=1:1:NOUT
SET LC=LC+1
SET OUTPUT(LC)=TEXTOUT(IND)
End DoDot:3
End DoDot:2
End DoDot:1
+42 ;If no text in addition to the header was created change the header.
+43 IF LC=3
Begin DoDot:1
+44 SET OUTPUT(1)="No taxonomies containing inactive codes which are marked as Use in Dialog"
+45 SET OUTPUT(2)="were found."
+46 SET OUTPUT(3)=""
End DoDot:1
+47 SET NLINES=LC
+48 KILL ^TMP("PXRMUIDR",$JOB)
+49 QUIT
+50 ;
