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