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

PXRMVSIN.m

Go to the documentation of this file.
  1. PXRMVSIN ;SLC/PKR - Value set inquiry for general use. ;01/27/2015
  1. ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
  1. ;==========================================
  1. BVSALL ;Value set inquiry, return the formatted text OUTPUT.
  1. N BOP,IEN,INQTYPE,NAME,OUTPUT
  1. S INQTYPE=$$GTYPE
  1. S BOP=$$BORP^PXRMUTIL("B")
  1. I BOP="" Q
  1. S NAME=""
  1. F S NAME=$O(^PXRM(802.2,"B",NAME)) Q:NAME="" D
  1. . S IEN=$O(^PXRM(802.2,"B",NAME,""))
  1. . D VSINQ(INQTYPE,IEN,.OUTPUT)
  1. . I BOP="B" D BROWSE^DDBR("OUTPUT","NR","Value Set Inquiry")
  1. . I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
  1. Q
  1. ;
  1. ;==========================================
  1. BVSINQ(IEN) ;Display a value set inquiry, defaults to the Browswer.
  1. N BOP,DIR0,INQTYPE,OUTPUT,TITLE
  1. I '$D(^PXRM(802.2,IEN)) Q
  1. S INQTYPE=$$GTYPE
  1. S TITLE="Value Set Inquiry - "_$S(INQTYPE="C":"Condensed",INQTYPE="F":"Full",1:"")
  1. D VSINQ(INQTYPE,IEN,.OUTPUT)
  1. S BOP=$$BORP^PXRMUTIL("B")
  1. I BOP="" Q
  1. I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
  1. I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
  1. Q
  1. ;
  1. ;==========================================
  1. CODESLC(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the condensed listing.
  1. N CODE,DESC,IND,NPAD
  1. S NL=NL+1,OUTPUT(NL)=CHDR(1)
  1. S NL=NL+1,OUTPUT(NL)=CHDR(2)
  1. S (IND,NCODES)=0
  1. F S IND=+$O(^PXRM(802.2,VSIEN,2,CSIND,1,IND)) Q:IND=0 D
  1. . S NCODES=NCODES+1
  1. . S CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
  1. . I $L(CODE)<5 S CODE=$$RJ^XLFSTR(CODE,5," ")
  1. . S DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
  1. . I $L(DESC)>60 S DESC=$E(DESC,1,57)_"..."
  1. . S NPAD=20-$L(CODE)
  1. . S NL=NL+1,OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
  1. Q
  1. ;
  1. ;==========================================
  1. CODESLF(VSIEN,CSIND,CHDR,NCODES,NL,OUTPUT) ;Produce the full listing.
  1. N CODE,DESC,FMTSTR,IND,JND,NIN,NOUT,NPAD,TEXTIN,TEXTOUT
  1. S FMTSTR="18L2^60L"
  1. S NL=NL+1,OUTPUT(NL)=CHDR(1)
  1. S NL=NL+1,OUTPUT(NL)=CHDR(2)
  1. S (IND,NCODES)=0
  1. F S IND=+$O(^PXRM(802.2,VSIEN,2,CSIND,1,IND)) Q:IND=0 D
  1. . S NCODES=NCODES+1
  1. . S CODE=^PXRM(802.2,VSIEN,2,CSIND,1,IND,0)
  1. . I $L(CODE)<5 S CODE=$$RJ^XLFSTR(CODE,5," ")
  1. . S NIN=$P(^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,0),U,3)
  1. . I (NIN=1) D Q
  1. .. S DESC=^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
  1. .. I $L(DESC)<61 S NPAD=20-$L(CODE),NL=NL+1,OUTPUT(NL)=CODE_$$INSCHR^PXRMEXLC(NPAD," ")_DESC
  1. .. E D
  1. ... S TEXTIN=CODE_U_DESC
  1. ... D COLFMT^PXRMTEXT(FMTSTR,TEXTIN," ",.NOUT,.TEXTOUT)
  1. ... F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(JND)
  1. .;
  1. .;Multiple line code description.
  1. . K ^TMP($J,"INTEXT"),^TMP($J,"OUTTEXT")
  1. . S ^TMP($J,"INTEXT",1)=CODE_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,1,0)
  1. . F JND=2:1:NIN D
  1. .. S ^TMP($J,"INTEXT",JND)=" "_U_^PXRM(802.2,VSIEN,2,CSIND,1,IND,1,JND,0)
  1. . D COLFMTA^PXRMTEXT(FMTSTR,"INTEXT"," ",.NOUT,"OUTTEXT")
  1. . F JND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=^TMP($J,"OUTTEXT",JND)
  1. K ^TMP($J,"INTEXT"),^TMP($J,"OUTTEXT")
  1. Q
  1. ;
  1. ;==========================================
  1. GTYPE() ;Prompt the user for the type of output.
  1. N DIR,POP,X,Y
  1. S DIR(0)="SA"_U_"C:Condensed;F:Full"
  1. S DIR("A")="Condensed or full inquiry? "
  1. S DIR("B")="C"
  1. D ^DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q "F"
  1. Q Y
  1. ;
  1. ;==========================================
  1. MLISTC(NUM,MIEN,NL,OUTPUT) ;Produce the condensed measure list.
  1. N IND,NOUT,TEXTIN,TEXTOUT
  1. S TEXTIN=NUM_". "_$P(^PXRM(802.3,MIEN,0),U,1)
  1. D FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
  1. F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. Q
  1. ;
  1. ;==========================================
  1. MLISTF(NUM,MIEN,NL,OUTPUT) ;Produce the full measure list.
  1. N IND,NIN,NOUT,STEWARD,TEMP,TEXTIN,TEXTOUT
  1. S TEXTIN=NUM_". "_$P(^PXRM(802.3,MIEN,0),U,1)
  1. D FORMATS^PXRMTEXT(2,78,TEXTIN,.NOUT,.TEXTOUT)
  1. F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. S TEMP=^PXRM(802.3,MIEN,1)
  1. S NL=NL+1,OUTPUT(NL)=" CMS ID: "_$P(TEMP,U,1)
  1. S NL=NL+1,OUTPUT(NL)=" Version number: "_$P(TEMP,U,2)
  1. S NL=NL+1,OUTPUT(NL)=" GUID: "_$P(TEMP,U,3)
  1. S NL=NL+1,OUTPUT(NL)=" NQF number: "_$P(TEMP,U,4)
  1. S TEXTIN="Steward: "_$G(^PXRM(802.3,MIEN,5))
  1. D FORMATS^PXRMTEXT(3,78,TEXTIN,.NOUT,.TEXTOUT)
  1. F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. K TEXTIN,TEXTOUT
  1. S NIN=$P(^PXRM(802.3,MIEN,2,0),U,3)
  1. S TEXTIN(1)="Description: "_^PXRM(802.3,MIEN,2,1,0)
  1. F IND=2:1:NIN S TEXTIN(IND)=^PXRM(802.3,MIEN,2,IND,0)
  1. D FORMAT^PXRMTEXT(2,78,NIN,.TEXTIN,.NOUT,.TEXTOUT)
  1. F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. S NL=NL+1,OUTPUT(NL)=""
  1. Q
  1. ;
  1. ;==========================================
  1. VSINQ(INQTYPE,IEN,OUTPUT) ;Value set inquiry, return the formatted text OUTPUT.
  1. ;Use 80 column output.
  1. N CHDR,CODESYSN,CODESYSP,DUPL,IENSTR,IND,OCL,NL
  1. N LEXSAB,MIEN,MNAME,NCODES,NCODESA,NCS,NOUT,NPAD,NUCODES,RM
  1. N TCODES,TEMP,TERM,TEXT,TEXTOUT,UID,WPARRAY
  1. S RM=80
  1. S CHDR(1)=" Code"_$$INSCHR^PXRMEXLC(15," ")_"Description"
  1. S CHDR(2)=" ----"_$$INSCHR^PXRMEXLC(15," ")_"-----------"
  1. S IENSTR="No. "_IEN
  1. S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
  1. S TEXT=$P(^PXRM(802.2,IEN,0),U,1)
  1. D FORMATS^PXRMTEXT(1,70,TEXT,.NOUT,.TEXTOUT)
  1. S NPAD=RM-$L(TEXTOUT(1))-1
  1. S OUTPUT(2)=TEXTOUT(1)_$$RJ^XLFSTR(IENSTR,NPAD," ")
  1. S NL=2
  1. I NOUT>1 F IND=2:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. S NL=NL+1,OUTPUT(NL)=$$REPEAT^XLFSTR("-",RM)
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S TEMP=^PXRM(802.2,IEN,1)
  1. S NL=NL+1,OUTPUT(NL)="OID: "_$P(TEMP,U,1)
  1. S NL=NL+1,OUTPUT(NL)="Short ID: "_$P(TEMP,U,2)
  1. S NL=NL+1,OUTPUT(NL)="Version date: "_$$FMTE^XLFDT($P(TEMP,U,3))
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)=$$CJ^XLFSTR("Code List",80," ")
  1. ;Coding systems and codes.
  1. S (IND,NCS,TCODES)=0
  1. F S IND=+$O(^PXRM(802.2,IEN,2,IND)) Q:IND=0 D
  1. . S CODESYSP=^PXRM(802.2,IEN,2,IND,0)
  1. . S TEMP=^PXRM(802.1,CODESYSP,0)
  1. . S NCS=NCS+1
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S CODESYSN=$P(TEMP,U,1)
  1. . S NL=NL+1,OUTPUT(NL)="NLM Coding System: "_CODESYSN
  1. . S NL=NL+1,OUTPUT(NL)="Code System OID: "_$P(TEMP,U,2)
  1. . S NL=NL+1,OUTPUT(NL)="Version: "_$P(TEMP,U,3)
  1. . S LEXSAB=$P(TEMP,U,4)
  1. . S TEXT="Lexicon equivalent: "
  1. . I LEXSAB="" S TEXT=TEXT_"None"
  1. . I LEXSAB'="" S TEXT=TEXT_$P($$CSYS^LEXU(LEXSAB),U,4)
  1. . S NL=NL+1,OUTPUT(NL)=TEXT
  1. . I INQTYPE="C" D CODESLC(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
  1. . I INQTYPE="F" D CODESLF(IEN,IND,.CHDR,.NCODES,.NL,.OUTPUT)
  1. . S NCODESA(CODESYSP)=NCODES_U_CODESYSN
  1. . S TCODES=TCODES+NCODES
  1. ;Code summary
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)="There are "_NCS_" coding systems."
  1. S NL=NL+1,OUTPUT(NL)="Coding System"_$$INSCHR^PXRMEXLC(10," ")_"Number of Codes"
  1. S NL=NL+1,OUTPUT(NL)="-------------"_$$INSCHR^PXRMEXLC(10," ")_"----------------"
  1. S CODESYSP=""
  1. F S CODESYSP=$O(NCODESA(CODESYSP)) Q:CODESYSP="" D
  1. . S TEMP=NCODESA(CODESYSP)
  1. . S CODESYSN=$P(TEMP,U,2)
  1. . S NPAD=23-$L(CODESYSN)
  1. . S NL=NL+1,OUTPUT(NL)=" "_CODESYSN_$$INSCHR^PXRMEXLC(NPAD," ")_$P(TEMP,U,1)
  1. S NL=NL+1,OUTPUT(NL)=" "
  1. S NL=NL+1,OUTPUT(NL)="There are "_TCODES_" total codes."
  1. ;Measures
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)="Clinical Quality Measures that use this Value Set:"
  1. S IND=0
  1. F S IND=+$O(^PXRM(802.2,IEN,3,IND)) Q:IND=0 D
  1. . S MIEN=$P(^PXRM(802.2,IEN,3,IND,0),U,1)
  1. . I INQTYPE="C" D MLISTC(IND,MIEN,.NL,.OUTPUT)
  1. . I INQTYPE="F" D MLISTF(IND,MIEN,.NL,.OUTPUT)
  1. Q
  1. ;