- 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 Feb 18, 2025@23:16:05 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 ;