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

PXDXUTL.m

Go to the documentation of this file.
  1. PXDXUTL ;HP/TJH - DX CODE SET UTILITIES FOR PCE ;15 Aug 2012 9:22 AM
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**199**;Aug 12, 1996;Build 51
  1. ;
  1. Q ; Library utilities, do not enter from top.
  1. ;
  1. ACTIVE(PXCS) ; Return start date for requested coding system
  1. ; Input: Coding system abbreviation from #80.4 or #757.03
  1. ; ICD, ICP, 10D, 10P
  1. ;
  1. ; Output: n^FM date where
  1. ; n = 0 ; requested coding system is not active
  1. ; n = 1 ; requested coding system is active
  1. ; FM date = starting date of requested code type
  1. ; or
  1. ; -1^error message ; coding system not valid
  1. ;
  1. N PXICDD,PXOUT,X,Y
  1. S X=PXCS,DIC=80.4,DIC(0)="",D="C" D IX^DIC
  1. I Y<0 Q "-1^Invalid Coding System"
  1. S PXICDD=$$IMPDATE^LEXU(PXCS)
  1. S PXOUT=$S(PXICDD'<DT:0,1:1)_U_PXICDD
  1. K D,DIC
  1. Q PXOUT
  1. ;
  1. AVDX ; Build array of available Diagnosis Sets (Dx only, not Procedure Sets) in PXDXA("DX SET",fm-date)
  1. ; [1] = IEN in #80.4
  1. ; [2] = Code Set name
  1. ; [3] = Code Set abbreviation
  1. ; [4] = File number holding code set values (always 80 in this function)
  1. ; [5] = Date that code set becomes active (FM format)
  1. N PXMSG,PXI,PXD,PXR
  1. K PXDXA
  1. D LIST^DIC(80.4,"",".02;.03I;.04I","P","","","","","I $P(^(0),U,3)=80","","PXDXA","PXMSG")
  1. Q:'$D(PXDXA("DILIST",0))
  1. F PXI=1:1:$P(PXDXA("DILIST",0),U,1) D
  1. . S PXR=PXDXA("DILIST",PXI,0),PXD=$P(PXR,U,5)
  1. . S PXDXA("DX SET",PXD)=PXR
  1. K PXDXA("DILIST")
  1. Q
  1. ;
  1. AVDXT ; AVDX TEST SET
  1. ;S PXDXA("DX SET",2781001)="1^ICD-9-CM^ICD^80^2781001"
  1. ;S PXDXA("DX SET",3131001)="30^ICD-10-CM^10D^80^3131001"
  1. ;S PXDXA("DX SET",3201001)="47^ICD-11-CM^11D^80^3201001"
  1. ;S PXDXA("DX SET",3501001)="50^ICD-12-CM^12D^80^3501001"
  1. Q
  1. ;
  1. ACTDT(PXTRXD) ; Active Dx Code Set for date supplied
  1. ; Input - a FileMan date
  1. ; Returns 4 piece value:
  1. ; [1] = Code Set abbreviation
  1. ; [2] = IEN into file #80.4
  1. ; [3] = Long name
  1. ; [4] = Activation Date (FM)
  1. ; or
  1. ; 0 if no active Dx code set is found for the date supplied
  1. ;
  1. N PXDT,PXOUT,PXREC
  1. D AVDX
  1. I '$D(PXDXA("DX SET")) Q 0
  1. S PXDT=0,PXOUT=0
  1. F S PXDT=$O(PXDXA("DX SET",PXDT)) Q:PXDT="" D
  1. . S PXREC=PXDXA("DX SET",PXDT)
  1. . I PXTRXD'<PXDT S PXOUT=$P(PXREC,U,3)_U_$P(PXREC,U,1)_U_$P(PXREC,U,2)_U_$P(PXREC,U,5)
  1. K PXDXA
  1. Q PXOUT
  1. ;
  1. SDESC(PXPOVIEN) ; Return short description for Computed field .019 - ICD NARRATIVE of file [#9000010.07]
  1. ; This function is not intended for general use.
  1. ; Input: a pointer to V POV [#9000010.07]
  1. ;
  1. ; Output: the versioned DIAGNOSIS field from ICD DIAGNOSIS file [#80]
  1. ; based on the associated Visit Date
  1. I 'PXPOVIEN Q PXPOVIEN ; if it's not a numeric IEN just send back the input value
  1. N PXDX,PXVISD,PXVISIEN,X
  1. S X="DX not found because Visit Date is not available."
  1. Q:'$P($G(^AUPNVPOV(PXPOVIEN,0)),U,3) X ; Quit with error message; must have a visit date ptr.
  1. S PXDX=$P(^AUPNVPOV(PXPOVIEN,0),U,1) ; get the file #80 IEN for the diagnosis
  1. S PXVISIEN=$P(^AUPNVPOV(PXPOVIEN,0),U,3) ; get the Visit IEN
  1. S PXVISD=$$CSDATE(PXVISIEN) ; get Visit Date from VISIT file
  1. S X=$$ICDDATA^ICDXCODE("DIAG",PXDX,PXVISD,"I") ; feed data to ICDDATA function
  1. Q $S($P(X,U,1)=-1:$P(X,U,2),1:$P(X,U,4)) ; return error msg or description
  1. ;
  1. CSDATE(VSITIEN) ; Determine date to be used with diagnosis code look-ups when making ^ICDXCODE calls
  1. ; Input - Visit IEN for file #9000010
  1. ; Output - FileMan date (Time element is removed if it exists)
  1. ; Returns Visit Date unless this is an "E" record, in which case it returns Data Entry Date.
  1. ; If, for some unknown reason, the Visit record doesn't exist the output will default to Today's date.
  1. ;
  1. N PXVREC
  1. S PXVREC=$S($L(VSITIEN):$G(^AUPNVSIT(VSITIEN,0)),1:"")
  1. Q $S(PXVREC="":DT,$P(PXVREC,U,7)="E":$P($P(PXVREC,U,2),".",1),1:$P($P(PXVREC,U,1),".",1))
  1. ;