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

PXMCODES.m

Go to the documentation of this file.
  1. PXMCODES ;SLC/PKR - Mapped codes listing for inquire. ;02/26/2016
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;
  1. ;Reference to LEXU supported by ICR #5679.
  1. ;
  1. ;==========================================
  1. MCDISP(CODELIST,NL,OUTPUT) ;Mapped codes display.
  1. N ACTDT,CHDR,CODE,CODESYS,DATE,DESC,FMTSTR,INACTDT,IND,INDXDT
  1. N MAPDT,NOLEX,NOUT,NP,PDATA,RESULT,TEXT,TEXTOUT
  1. S FMTSTR(1)="10L1^10C2^10C2^19C2^19C2"
  1. S FMTSTR(2)="15L1^60L"
  1. S CHDR(1)="Code Activation Inactivation Mapped Linked"
  1. S CHDR(2)="---------- ---------- ------------ ------------------- -------------------"
  1. S CHDR(3)="Code Description"
  1. S CHDR(4)="-------------- -----------"
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)=" Code Mappings"
  1. I '$D(CODELIST) S NL=NL+1,OUTPUT(NL)="No codes are mapped" Q
  1. S CODESYS=""
  1. F S CODESYS=$O(CODELIST(CODESYS)) Q:CODESYS="" D
  1. . K DESC
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. .;ICR #5679
  1. . S NL=NL+1,OUTPUT(NL)="Coding System: "_CODESYS_" = "_$P($$CSYS^LEXU(CODESYS),U,4)
  1. . S NL=NL+1,OUTPUT(NL)=CHDR(1)
  1. . S NL=NL+1,OUTPUT(NL)=CHDR(2)
  1. . S CODE=""
  1. . F S CODE=$O(CODELIST(CODESYS,CODE)) Q:CODE="" D
  1. .. S MAPDT=$$FMTE^XLFDT($P(CODELIST(CODESYS,CODE),U,1),"5Z")
  1. .. S INDXDT=$$FMTE^XLFDT($P(CODELIST(CODESYS,CODE),U,2),"5Z")
  1. ..;DBIA #5679
  1. .. K PDATA
  1. .. S NOLEX=0
  1. .. S RESULT=$$PERIOD^LEXU(CODE,CODESYS,.PDATA)
  1. .. I +RESULT=-1 D
  1. ... S NOLEX=1
  1. ...;DBIA #1997, #3991
  1. ... I (CODESYS="CPC")!(CODESYS="CPT") D PERIOD^ICPTAPIU(CODE,.PDATA)
  1. ... I (CODESYS="ICD")!(CODESYS="ICP") D PERIOD^ICDAPIU(CODE,.PDATA)
  1. .. S ACTDT=1000101,NP=0
  1. .. F S ACTDT=$O(PDATA(ACTDT)) Q:ACTDT="" D
  1. ... S NP=NP+1
  1. ... S INACTDT=$$FMTE^XLFDT($P(PDATA(ACTDT),U,1),"5Z")
  1. ... S DESC(CODE)=CODE_U_$S(NOLEX=1:$P(PDATA(ACTDT),U,2),1:PDATA(ACTDT,0))
  1. ... I CODESYS="SCT" S DESC(CODE)=DESC(CODE)_" "_$$SCTHIER(CODE,ACTDT)
  1. ... I NP=1 S TEXT=CODE_U_$$FMTE^XLFDT(ACTDT,"5Z")_U_INACTDT_U_MAPDT_U_INDXDT
  1. ... I NP>1 S TEXT=U_$$FMTE^XLFDT(ACTDT,"5Z")_U_INACTDT
  1. ... D COLFMT^PXRMTEXT(FMTSTR(1),TEXT," ",.NOUT,.TEXTOUT)
  1. ... F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. .;Display the code descriptions.
  1. . S CODE="",NP=0
  1. . F S CODE=$O(DESC(CODE)) Q:CODE="" D
  1. .. S NP=NP+1
  1. .. I NP=1 D
  1. ... S NL=NL+1,OUTPUT(NL)=""
  1. ... S NL=NL+1,OUTPUT(NL)=CHDR(3)
  1. ... S NL=NL+1,OUTPUT(NL)=CHDR(4)
  1. .. D COLFMT^PXRMTEXT(FMTSTR(2),DESC(CODE)," ",.NOUT,.TEXTOUT)
  1. .. F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
  1. Q
  1. ;
  1. ;==========================================
  1. SCTHIER(CODE,ACTDT) ;Return the SNOMED hierarchy.
  1. N FSN,HE,HIER,HS
  1. ;DBIA #5007
  1. S FSN=$$GETFSN^LEXTRAN1("SCT",CODE,ACTDT)
  1. S HS=$F(FSN,"(")
  1. S HE=$F(FSN,")",HS)
  1. S HIER=$E(FSN,HS-1,HE-1)
  1. Q HIER
  1. ;