PXRMVSIN ;SLC/PKR - Value set inquiry for general use. ;01/27/2015
;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
;==========================================
BVSALL ;Value set inquiry, return the formatted text OUTPUT.
N BOP,IEN,INQTYPE,NAME,OUTPUT
S INQTYPE=$$GTYPE
S BOP=$$BORP^PXRMUTIL("B")
I BOP="" Q
S NAME=""
F S NAME=$O(^PXRM(802.2,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXRM(802.2,"B",NAME,""))
. D VSINQ(INQTYPE,IEN,.OUTPUT)
. I BOP="B" D BROWSE^DDBR("OUTPUT","NR","Value Set Inquiry")
. I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
Q
;
;==========================================
BVSINQ(IEN) ;Display a value set inquiry, defaults to the Browswer.
N BOP,DIR0,INQTYPE,OUTPUT,TITLE
I '$D(^PXRM(802.2,IEN)) Q
S INQTYPE=$$GTYPE
S TITLE="Value Set Inquiry - "_$S(INQTYPE="C":"Condensed",INQTYPE="F":"Full",1:"")
D VSINQ(INQTYPE,IEN,.OUTPUT)
S BOP=$$BORP^PXRMUTIL("B")
I BOP="" Q
I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
Q
;
;==========================================
CODESLC(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the condensed listing.
N CODE,DESC,IND,NPAD
S NL=NL+1,OUTPUT(NL)=CHDR(1)
S NL=NL+1,OUTPUT(NL)=CHDR(2)
S (IND,NCODES)=0
F S IND=+$O(^PXRM(802.2,VSIEN,2,CSIND,1,IND)) Q:IND=0 D
. S NCODES=NCODES+1
. S CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
. I $L(CODE)<5 S CODE=$$RJ^XLFSTR(CODE,5," ")
. S DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
. I $L(DESC)>60 S DESC=$E(DESC,1,57)_"..."
. S NPAD=20-$L(CODE)
. S NL=NL+1,OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
Q
;
;==========================================
CODESLF(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the full listing.
N CODE,DESC,FMTSTR,IND,JND,NIN,NOUT,NPAD,TEXTIN,TEXTOUT
S FMTSTR="18L2^60L"
S NL=NL+1,OUTPUT(NL)=CHDR(1)
S NL=NL+1,OUTPUT(NL)=CHDR(2)
S (IND,NCODES)=0
F S IND=+$O(^PXRM(802.2,VSIEN,2,CSIND,1,IND)) Q:IND=0 D
. S NCODES=NCODES+1
. S CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
. I $L(CODE)<5 S CODE=$$RJ^XLFSTR(CODE,5," ")
. S NIN=$P(^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,0),U,3)
. I (NIN=1) D Q
.. S DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
.. I $L(DESC)<61 S NPAD=20-$L(CODE),NL=NL+1,OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
.. E D
... S TEXTIN=CODE_U_DESC
... D COLFMT^PXRMTEXT(FMTSTR,TEXTIN," ",.NOUT,.TEXTOUT)
... F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(JND)
.;
.;Multiple line code description.
. K ^TMP($J,"INTEXT"),^TMP($J,"OUTTEXT")
. S ^TMP($J,"INTEXT",1)=CODE_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
. F JND=2:1:NIN D
.. S ^TMP($J,"INTEXT",JND)=" "_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,JND,0)
. D COLFMTA^PXRMTEXT(FMTSTR,"INTEXT"," ",.NOUT,"OUTTEXT")
. F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=^TMP($J,"OUTTEXT",JND)
K ^TMP($J,"INTEXT"),^TMP($J,"OUTTEXT")
Q
;
;==========================================
GTYPE() ;Prompt the user for the type of output.
N DIR,POP,X,Y
S DIR(0)="SA"_U_"C:Condensed;F:Full"
S DIR("A")="Condensed or full inquiry? "
S DIR("B")="C"
D ^DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q "F"
Q Y
;
;==========================================
MLISTC(NUM,MIEN,NL,OUTPUT) ;Produce the condensed measure list.
N IND,NOUT,TEXTIN,TEXTOUT
S TEXTIN=NUM_". "_$P(^PXRM(802.3,MIEN,0),U,1)
D FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
Q
;
;==========================================
MLISTF(NUM,MIEN,NL,OUTPUT) ;Produce the full measure list.
N IND,NIN,NOUT,STEWARD,TEMP,TEXTIN,TEXTOUT
S TEXTIN=NUM_". "_$P(^PXRM(802.3,MIEN,0),U,1)
D FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
S TEMP=^PXRM(802.3,MIEN,1)
S NL=NL+1,OUTPUT(NL)=" CMS ID: "_$P(TEMP,U,1)
S NL=NL+1,OUTPUT(NL)=" Version number: "_$P(TEMP,U,2)
S NL=NL+1,OUTPUT(NL)=" GUID: "_$P(TEMP,U,3)
S NL=NL+1,OUTPUT(NL)=" NQF number: "_$P(TEMP,U,4)
S TEXTIN="Steward: "_$G(^PXRM(802.3,MIEN,5))
D FORMATS^PXRMTEXT(3,78,TEXTIN,.NOUT,.TEXTOUT)
F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
K TEXTIN,TEXTOUT
S NIN=$P(^PXRM(802.3,MIEN,2,0),U,3)
S TEXTIN(1)="Description: "_^PXRM(802.3,MIEN,2,1,0)
F IND=2:1:NIN S TEXTIN(IND)=^PXRM(802.3,MIEN,2,IND,0)
D FORMAT^PXRMTEXT(2,78,NIN,.TEXTIN,.NOUT,.TEXTOUT)
F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
S NL=NL+1,OUTPUT(NL)=""
Q
;
;==========================================
VSINQ(INQTYPE,IEN,OUTPUT) ;Value set inquiry, return the formatted text OUTPUT.
;Use 80 column output.
N CHDR,CODESYSN,CODESYSP,DUPL,IENSTR,IND,OCL,NL
N LEXSAB,MIEN,MNAME,NCODES,NCODESA,NCS,NOUT,NPAD,NUCODES,RM
N TCODES,TEMP,TERM,TEXT,TEXTOUT,UID,WPARRAY
S RM=80
S CHDR(1)=" Code"_$$INSCHR^PXRMEXLC(15," ")_"Description"
S CHDR(2)=" ----"_$$INSCHR^PXRMEXLC(15," ")_"-----------"
S IENSTR="No. "_IEN
S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
S TEXT=$P(^PXRM(802.2,IEN,0),U,1)
D FORMATS^PXRMTEXT(1,70,TEXT,.NOUT,.TEXTOUT)
S NPAD=RM-$L(TEXTOUT(1))-1
S OUTPUT(2)=TEXTOUT(1)_$$RJ^XLFSTR(IENSTR,NPAD," ")
S NL=2
I NOUT>1 F IND=2:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
S NL=NL+1,OUTPUT(NL)=$$REPEAT^XLFSTR("-",RM)
S NL=NL+1,OUTPUT(NL)=""
S TEMP=^PXRM(802.2,IEN,1)
S NL=NL+1,OUTPUT(NL)="OID: "_$P(TEMP,U,1)
S NL=NL+1,OUTPUT(NL)="Short ID: "_$P(TEMP,U,2)
S NL=NL+1,OUTPUT(NL)="Version date: "_$$FMTE^XLFDT($P(TEMP,U,3))
S NL=NL+1,OUTPUT(NL)=""
S NL=NL+1,OUTPUT(NL)=$$CJ^XLFSTR("Code List",80," ")
;Coding systems and codes.
S (IND,NCS,TCODES)=0
F S IND=+$O(^PXRM(802.2,IEN,2,IND)) Q:IND=0 D
. S CODESYSP=^PXRM(802.2,IEN,2,IND,0)
. S TEMP=^PXRM(802.1,CODESYSP,0)
. S NCS=NCS+1
. S NL=NL+1,OUTPUT(NL)=""
. S CODESYSN=$P(TEMP,U,1)
. S NL=NL+1,OUTPUT(NL)="NLM Coding System: "_CODESYSN
. S NL=NL+1,OUTPUT(NL)="Code System OID: "_$P(TEMP,U,2)
. S NL=NL+1,OUTPUT(NL)="Version: "_$P(TEMP,U,3)
. S LEXSAB=$P(TEMP,U,4)
. S TEXT="Lexicon equivalent: "
. I LEXSAB="" S TEXT=TEXT_"None"
. I LEXSAB'="" S TEXT=TEXT_$P($$CSYS^LEXU(LEXSAB),U,4)
. S NL=NL+1,OUTPUT(NL)=TEXT
. I INQTYPE="C" D CODESLC(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
. I INQTYPE="F" D CODESLF(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
. S NCODESA(CODESYSP)=NCODES_U_CODESYSN
. S TCODES=TCODES+NCODES
;Code summary
S NL=NL+1,OUTPUT(NL)=""
S NL=NL+1,OUTPUT(NL)="There are "_NCS_" coding systems."
S NL=NL+1,OUTPUT(NL)="Coding System"_$$INSCHR^PXRMEXLC(10," ")_"Number of Codes"
S NL=NL+1,OUTPUT(NL)="-------------"_$$INSCHR^PXRMEXLC(10," ")_"----------------"
S CODESYSP=""
F S CODESYSP=$O(NCODESA(CODESYSP)) Q:CODESYSP="" D
. S TEMP=NCODESA(CODESYSP)
. S CODESYSN=$P(TEMP,U,2)
. S NPAD=23-$L(CODESYSN)
. S NL=NL+1,OUTPUT(NL)=" "_CODESYSN_$$INSCHR^PXRMEXLC(NPAD," ")_$P(TEMP,U,1)
S NL=NL+1,OUTPUT(NL)=" "
S NL=NL+1,OUTPUT(NL)="There are "_TCODES_" total codes."
;Measures
S NL=NL+1,OUTPUT(NL)=""
S NL=NL+1,OUTPUT(NL)="Clinical Quality Measures that use this Value Set:"
S IND=0
F S IND=+$O(^PXRM(802.2,IEN,3,IND)) Q:IND=0 D
. S MIEN=$P(^PXRM(802.2,IEN,3,IND,0),U,1)
. I INQTYPE="C" D MLISTC(IND,MIEN,.NL,.OUTPUT)
. I INQTYPE="F" D MLISTF(IND,MIEN,.NL,.OUTPUT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMVSIN 7211 printed Apr 09, 2024@20:48:10 Page 2
PXRMVSIN ;SLC/PKR - Value set inquiry for general use. ;01/27/2015
+1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
+2 ;==========================================
BVSALL ;Value set inquiry, return the formatted text OUTPUT.
+1 NEW BOP,IEN,INQTYPE,NAME,OUTPUT
+2 SET INQTYPE=$$GTYPE
+3 SET BOP=$$BORP^PXRMUTIL("B")
+4 IF BOP=""
QUIT
+5 SET NAME=""
+6 FOR
SET NAME=$ORDER(^PXRM(802.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+7 SET IEN=$ORDER(^PXRM(802.2,"B",NAME,""))
+8 DO VSINQ(INQTYPE,IEN,.OUTPUT)
+9 IF BOP="B"
DO BROWSE^DDBR("OUTPUT","NR","Value Set Inquiry")
+10 IF BOP="P"
DO GPRINT^PXRMUTIL("OUTPUT")
End DoDot:1
+11 QUIT
+12 ;
+13 ;==========================================
BVSINQ(IEN) ;Display a value set inquiry, defaults to the Browswer.
+1 NEW BOP,DIR0,INQTYPE,OUTPUT,TITLE
+2 IF '$DATA(^PXRM(802.2,IEN))
QUIT
+3 SET INQTYPE=$$GTYPE
+4 SET TITLE="Value Set Inquiry - "_$SELECT(INQTYPE="C":"Condensed",INQTYPE="F":"Full",1:"")
+5 DO VSINQ(INQTYPE,IEN,.OUTPUT)
+6 SET BOP=$$BORP^PXRMUTIL("B")
+7 IF BOP=""
QUIT
+8 IF BOP="B"
DO BROWSE^DDBR("OUTPUT","NR",TITLE)
+9 IF BOP="P"
DO GPRINT^PXRMUTIL("OUTPUT")
+10 QUIT
+11 ;
+12 ;==========================================
CODESLC(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the condensed listing.
+1 NEW CODE,DESC,IND,NPAD
+2 SET NL=NL+1
SET OUTPUT(NL)=CHDR(1)
+3 SET NL=NL+1
SET OUTPUT(NL)=CHDR(2)
+4 SET (IND,NCODES)=0
+5 FOR
SET IND=+$ORDER(^PXRM(802.2,VSIEN,2,CSIND,1,IND))
if IND=0
QUIT
Begin DoDot:1
+6 SET NCODES=NCODES+1
+7 SET CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
+8 IF $LENGTH(CODE)<5
SET CODE=$$RJ^XLFSTR(CODE,5," ")
+9 SET DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
+10 IF $LENGTH(DESC)>60
SET DESC=$EXTRACT(DESC,1,57)_"..."
+11 SET NPAD=20-$LENGTH(CODE)
+12 SET NL=NL+1
SET OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================
CODESLF(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the full listing.
+1 NEW CODE,DESC,FMTSTR,IND,JND,NIN,NOUT,NPAD,TEXTIN,TEXTOUT
+2 SET FMTSTR="18L2^60L"
+3 SET NL=NL+1
SET OUTPUT(NL)=CHDR(1)
+4 SET NL=NL+1
SET OUTPUT(NL)=CHDR(2)
+5 SET (IND,NCODES)=0
+6 FOR
SET IND=+$ORDER(^PXRM(802.2,VSIEN,2,CSIND,1,IND))
if IND=0
QUIT
Begin DoDot:1
+7 SET NCODES=NCODES+1
+8 SET CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
+9 IF $LENGTH(CODE)<5
SET CODE=$$RJ^XLFSTR(CODE,5," ")
+10 SET NIN=$PIECE(^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,0),U,3)
+11 IF (NIN=1)
Begin DoDot:2
+12 SET DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
+13 IF $LENGTH(DESC)<61
SET NPAD=20-$LENGTH(CODE)
SET NL=NL+1
SET OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
+14 IF '$TEST
Begin DoDot:3
+15 SET TEXTIN=CODE_U_DESC
+16 DO COLFMT^PXRMTEXT(FMTSTR,TEXTIN," ",.NOUT,.TEXTOUT)
+17 FOR JND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(JND)
End DoDot:3
End DoDot:2
QUIT
+18 ;
+19 ;Multiple line code description.
+20 KILL ^TMP($JOB,"INTEXT"),^TMP($JOB,"OUTTEXT")
+21 SET ^TMP($JOB,"INTEXT",1)=CODE_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
+22 FOR JND=2:1:NIN
Begin DoDot:2
+23 SET ^TMP($JOB,"INTEXT",JND)=" "_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,JND,0)
End DoDot:2
+24 DO COLFMTA^PXRMTEXT(FMTSTR,"INTEXT"," ",.NOUT,"OUTTEXT")
+25 FOR JND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=^TMP($JOB,"OUTTEXT",JND)
End DoDot:1
+26 KILL ^TMP($JOB,"INTEXT"),^TMP($JOB,"OUTTEXT")
+27 QUIT
+28 ;
+29 ;==========================================
GTYPE() ;Prompt the user for the type of output.
+1 NEW DIR,POP,X,Y
+2 SET DIR(0)="SA"_U_"C:Condensed;F:Full"
+3 SET DIR("A")="Condensed or full inquiry? "
+4 SET DIR("B")="C"
+5 DO ^DIR
+6 IF $DATA(DIROUT)
SET DTOUT=1
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT "F"
+8 QUIT Y
+9 ;
+10 ;==========================================
MLISTC(NUM,MIEN,NL,OUTPUT) ;Produce the condensed measure list.
+1 NEW IND,NOUT,TEXTIN,TEXTOUT
+2 SET TEXTIN=NUM_". "_$PIECE(^PXRM(802.3,MIEN,0),U,1)
+3 DO FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
+4 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
+5 QUIT
+6 ;
+7 ;==========================================
MLISTF(NUM,MIEN,NL,OUTPUT) ;Produce the full measure list.
+1 NEW IND,NIN,NOUT,STEWARD,TEMP,TEXTIN,TEXTOUT
+2 SET TEXTIN=NUM_". "_$PIECE(^PXRM(802.3,MIEN,0),U,1)
+3 DO FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
+4 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
+5 SET TEMP=^PXRM(802.3,MIEN,1)
+6 SET NL=NL+1
SET OUTPUT(NL)=" CMS ID: "_$PIECE(TEMP,U,1)
+7 SET NL=NL+1
SET OUTPUT(NL)=" Version number: "_$PIECE(TEMP,U,2)
+8 SET NL=NL+1
SET OUTPUT(NL)=" GUID: "_$PIECE(TEMP,U,3)
+9 SET NL=NL+1
SET OUTPUT(NL)=" NQF number: "_$PIECE(TEMP,U,4)
+10 SET TEXTIN="Steward: "_$GET(^PXRM(802.3,MIEN,5))
+11 DO FORMATS^PXRMTEXT(3,78,TEXTIN,.NOUT,.TEXTOUT)
+12 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
+13 KILL TEXTIN,TEXTOUT
+14 SET NIN=$PIECE(^PXRM(802.3,MIEN,2,0),U,3)
+15 SET TEXTIN(1)="Description: "_^PXRM(802.3,MIEN,2,1,0)
+16 FOR IND=2:1:NIN
SET TEXTIN(IND)=^PXRM(802.3,MIEN,2,IND,0)
+17 DO FORMAT^PXRMTEXT(2,78,NIN,.TEXTIN,.NOUT,.TEXTOUT)
+18 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
+19 SET NL=NL+1
SET OUTPUT(NL)=""
+20 QUIT
+21 ;
+22 ;==========================================
VSINQ(INQTYPE,IEN,OUTPUT) ;Value set inquiry, return the formatted text OUTPUT.
+1 ;Use 80 column output.
+2 NEW CHDR,CODESYSN,CODESYSP,DUPL,IENSTR,IND,OCL,NL
+3 NEW LEXSAB,MIEN,MNAME,NCODES,NCODESA,NCS,NOUT,NPAD,NUCODES,RM
+4 NEW TCODES,TEMP,TERM,TEXT,TEXTOUT,UID,WPARRAY
+5 SET RM=80
+6 SET CHDR(1)=" Code"_$$INSCHR^PXRMEXLC(15," ")_"Description"
+7 SET CHDR(2)=" ----"_$$INSCHR^PXRMEXLC(15," ")_"-----------"
+8 SET IENSTR="No. "_IEN
+9 SET OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
+10 SET TEXT=$PIECE(^PXRM(802.2,IEN,0),U,1)
+11 DO FORMATS^PXRMTEXT(1,70,TEXT,.NOUT,.TEXTOUT)
+12 SET NPAD=RM-$LENGTH(TEXTOUT(1))-1
+13 SET OUTPUT(2)=TEXTOUT(1)_$$RJ^XLFSTR(IENSTR,NPAD," ")
+14 SET NL=2
+15 IF NOUT>1
FOR IND=2:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
+16 SET NL=NL+1
SET OUTPUT(NL)=$$REPEAT^XLFSTR("-",RM)
+17 SET NL=NL+1
SET OUTPUT(NL)=""
+18 SET TEMP=^PXRM(802.2,IEN,1)
+19 SET NL=NL+1
SET OUTPUT(NL)="OID: "_$PIECE(TEMP,U,1)
+20 SET NL=NL+1
SET OUTPUT(NL)="Short ID: "_$PIECE(TEMP,U,2)
+21 SET NL=NL+1
SET OUTPUT(NL)="Version date: "_$$FMTE^XLFDT($PIECE(TEMP,U,3))
+22 SET NL=NL+1
SET OUTPUT(NL)=""
+23 SET NL=NL+1
SET OUTPUT(NL)=$$CJ^XLFSTR("Code List",80," ")
+24 ;Coding systems and codes.
+25 SET (IND,NCS,TCODES)=0
+26 FOR
SET IND=+$ORDER(^PXRM(802.2,IEN,2,IND))
if IND=0
QUIT
Begin DoDot:1
+27 SET CODESYSP=^PXRM(802.2,IEN,2,IND,0)
+28 SET TEMP=^PXRM(802.1,CODESYSP,0)
+29 SET NCS=NCS+1
+30 SET NL=NL+1
SET OUTPUT(NL)=""
+31 SET CODESYSN=$PIECE(TEMP,U,1)
+32 SET NL=NL+1
SET OUTPUT(NL)="NLM Coding System: "_CODESYSN
+33 SET NL=NL+1
SET OUTPUT(NL)="Code System OID: "_$PIECE(TEMP,U,2)
+34 SET NL=NL+1
SET OUTPUT(NL)="Version: "_$PIECE(TEMP,U,3)
+35 SET LEXSAB=$PIECE(TEMP,U,4)
+36 SET TEXT="Lexicon equivalent: "
+37 IF LEXSAB=""
SET TEXT=TEXT_"None"
+38 IF LEXSAB'=""
SET TEXT=TEXT_$PIECE($$CSYS^LEXU(LEXSAB),U,4)
+39 SET NL=NL+1
SET OUTPUT(NL)=TEXT
+40 IF INQTYPE="C"
DO CODESLC(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
+41 IF INQTYPE="F"
DO CODESLF(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
+42 SET NCODESA(CODESYSP)=NCODES_U_CODESYSN
+43 SET TCODES=TCODES+NCODES
End DoDot:1
+44 ;Code summary
+45 SET NL=NL+1
SET OUTPUT(NL)=""
+46 SET NL=NL+1
SET OUTPUT(NL)="There are "_NCS_" coding systems."
+47 SET NL=NL+1
SET OUTPUT(NL)="Coding System"_$$INSCHR^PXRMEXLC(10," ")_"Number of Codes"
+48 SET NL=NL+1
SET OUTPUT(NL)="-------------"_$$INSCHR^PXRMEXLC(10," ")_"----------------"
+49 SET CODESYSP=""
+50 FOR
SET CODESYSP=$ORDER(NCODESA(CODESYSP))
if CODESYSP=""
QUIT
Begin DoDot:1
+51 SET TEMP=NCODESA(CODESYSP)
+52 SET CODESYSN=$PIECE(TEMP,U,2)
+53 SET NPAD=23-$LENGTH(CODESYSN)
+54 SET NL=NL+1
SET OUTPUT(NL)=" "_CODESYSN_$$INSCHR^PXRMEXLC(NPAD," ")_$PIECE(TEMP,U,1)
End DoDot:1
+55 SET NL=NL+1
SET OUTPUT(NL)=" "
+56 SET NL=NL+1
SET OUTPUT(NL)="There are "_TCODES_" total codes."
+57 ;Measures
+58 SET NL=NL+1
SET OUTPUT(NL)=""
+59 SET NL=NL+1
SET OUTPUT(NL)="Clinical Quality Measures that use this Value Set:"
+60 SET IND=0
+61 FOR
SET IND=+$ORDER(^PXRM(802.2,IEN,3,IND))
if IND=0
QUIT
Begin DoDot:1
+62 SET MIEN=$PIECE(^PXRM(802.2,IEN,3,IND,0),U,1)
+63 IF INQTYPE="C"
DO MLISTC(IND,MIEN,.NL,.OUTPUT)
+64 IF INQTYPE="F"
DO MLISTF(IND,MIEN,.NL,.OUTPUT)
End DoDot:1
+65 QUIT
+66 ;
