DGENCDU.m

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 ---DGENCDU   1902     printed  Apr 09, 2024@21:39:58                                                                                                                                                                                                     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