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