DGENCDU ;ALB/CJM,Zoltan,TGH - Catastrophic Disability Utilities;May 24, 1999
;;5.3;Registration;**121,232,894**;Aug 13,1993;Build 48
;
; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
;
EXT(SUB,VAL) ;
;Description: Given the subscript used in the Catastrophic Disability
; array and a field value, returns the external representation of the
; value, as defined in the fields output transform of the PATIENT
; file.
;Input:
; SUB - array subscript defined for the Catastrophic Disability object
; VAL - field value
;Output:
; Function Value - returns the external value of the field
;
Q:$G(SUB)=""!($G(VAL)="")!($G(SUB)[";") ""
;
N FLD,FILE
S FLD=$$FLD(SUB)
Q:FLD="" ""
S FILE=$$FILE(SUB)
Q:FILE="" ""
Q $$EXTERNAL^DILFD(FILE,FLD,"F",VAL)
FILE(SUB) ; Return file/subfile number associated with this subscript.
; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.)
N SUBLST,FLDLST,FILELST,FILE,PC
D SETVARS
S SUB=";"_SUB_";"
I SUBLST'[SUB Q ""
S PC=$L($P(SUBLST,SUB),";")
S FILE=$P(FILELST,";",PC)
Q FILE
FLD(SUB) ; Return field/subfield number associated with this subscript.
; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.)
N SUBLST,FLDLST,FILELST,FLD,PC
D SETVARS
S SUB=";"_SUB_";"
I SUBLST'[SUB Q ""
S PC=$L($P(SUBLST,SUB),";")
S FLD=$P(FLDLST,";",PC)
Q FLD
SUB(FLD,FILE) ; Return subscript for this field (and file) number.
S:'$G(FILE) FILE=2
N SUBLST,FLDLST,FILELST,PC,SUB
D SETVARS
F PC=1:1:$L(FLDLST,";") I $P(FLDLST,";",PC)=FLD,$P(FILELST,";",PC)=FILE S SUB=$P(SUBLST,";",PC+1) Q
Q SUB
SETVARS ; NOTE -- for easy future maintenance, just modify the following 3 variables.
S SUBLST=";VCD;BY;DATE;FACDET;REVDTE;METDET;DESCR;"
S FILELST="2;2;2;2;2;2;2.401"
S FLDLST=".39;.391;.392;.393;.394;.395;.01"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCDU 1902 printed Nov 22, 2024@17:52:30 Page 2
DGENCDU ;ALB/CJM,Zoltan,TGH - Catastrophic Disability Utilities;May 24, 1999
+1 ;;5.3;Registration;**121,232,894**;Aug 13,1993;Build 48
+2 ;
+3 ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
+4 ;
EXT(SUB,VAL) ;
+1 ;Description: Given the subscript used in the Catastrophic Disability
+2 ; array and a field value, returns the external representation of the
+3 ; value, as defined in the fields output transform of the PATIENT
+4 ; file.
+5 ;Input:
+6 ; SUB - array subscript defined for the Catastrophic Disability object
+7 ; VAL - field value
+8 ;Output:
+9 ; Function Value - returns the external value of the field
+10 ;
+11 if $GET(SUB)=""!($GET(VAL)="")!($GET(SUB)[";")
QUIT ""
+12 ;
+13 NEW FLD,FILE
+14 SET FLD=$$FLD(SUB)
+15 if FLD=""
QUIT ""
+16 SET FILE=$$FILE(SUB)
+17 if FILE=""
QUIT ""
+18 QUIT $$EXTERNAL^DILFD(FILE,FLD,"F",VAL)
FILE(SUB) ; Return file/subfile number associated with this subscript.
+1 ; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.)
+2 NEW SUBLST,FLDLST,FILELST,FILE,PC
+3 DO SETVARS
+4 SET SUB=";"_SUB_";"
+5 IF SUBLST'[SUB
QUIT ""
+6 SET PC=$LENGTH($PIECE(SUBLST,SUB),";")
+7 SET FILE=$PIECE(FILELST,";",PC)
+8 QUIT FILE
FLD(SUB) ; Return field/subfield number associated with this subscript.
+1 ; SUB = text subscript (such as VCD, BY, DATE, FACDET, etc.)
+2 NEW SUBLST,FLDLST,FILELST,FLD,PC
+3 DO SETVARS
+4 SET SUB=";"_SUB_";"
+5 IF SUBLST'[SUB
QUIT ""
+6 SET PC=$LENGTH($PIECE(SUBLST,SUB),";")
+7 SET FLD=$PIECE(FLDLST,";",PC)
+8 QUIT FLD
SUB(FLD,FILE) ; Return subscript for this field (and file) number.
+1 if '$GET(FILE)
SET FILE=2
+2 NEW SUBLST,FLDLST,FILELST,PC,SUB
+3 DO SETVARS
+4 FOR PC=1:1:$LENGTH(FLDLST,";")
IF $PIECE(FLDLST,";",PC)=FLD
IF $PIECE(FILELST,";",PC)=FILE
SET SUB=$PIECE(SUBLST,";",PC+1)
QUIT
+5 QUIT SUB
SETVARS ; NOTE -- for easy future maintenance, just modify the following 3 variables.
+1 SET SUBLST=";VCD;BY;DATE;FACDET;REVDTE;METDET;DESCR;"
+2 SET FILELST="2;2;2;2;2;2;2.401"
+3 SET FLDLST=".39;.391;.392;.393;.394;.395;.01"
+4 QUIT
