SDES2GETELIGCD.m

SDES2GETELIGCD ;ALB/LAB - SDES2 GET ELIGIBILITY CODES ;NOV 22, 2022

 ;;5.3;Scheduling;**869**;Aug 13, 1993;Build 13

 ;;Per VHA Directive 6402, this routine should not be modified

 ;

 Q

 ;

GETELIGCODES(RESULT,SDCONTEXT,SDPARAM) ;

 N ELIGCODES,ERRORS

  ;validate context array for accuracy

 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 I $D(ERRORS) S ERRORS("EligibilityCodes",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q

 D:$G(SDPARAM("EligibilityCodeName"))'="" SINGLECODE(.ELIGCODES,.SDPARAM)

 D:$G(SDPARAM("EligibilityCodeName"))="" ALLCODES(.ELIGCODES)

 ;

 D BUILDJSON^SDES2JSON(.RESULT,.ELIGCODES)

 Q

 ;

SINGLECODE(ELIGCODES,SDPARAM) ;

 N COUNT,ELIGCODEIEN

 S COUNT=1

 S ELIGCODEIEN=$O(^DIC(8,"B",SDPARAM("EligibilityCodeName"),""))

 I ELIGCODEIEN="" S ELIGCODES("EligibilityCodes",1)="",ELIGCODES("Error",1)="Code not Found" Q

 D BUILD(.ELIGCODES,ELIGCODEIEN,COUNT)

 Q

 ;

ALLCODES(ELIGCODES) ;

 N COUNT,ELIGCODEIEN

 ;

 S ELIGCODEIEN=0,COUNT=0

 F  S ELIGCODEIEN=$O(^DIC(8,ELIGCODEIEN)) Q:'ELIGCODEIEN  D

 .S COUNT=COUNT+1

 .D BUILD(.ELIGCODES,ELIGCODEIEN,COUNT)

 Q

 ;

BUILD(ELIGCODES,ELIGCODEIEN,COUNT) ;

 N MASELIGCODE

 S ELIGCODES("EligibilityCodes",COUNT,"IEN")=ELIGCODEIEN

 S ELIGCODES("EligibilityCodes",COUNT,"Name")=$$GET1^DIQ(8,ELIGCODEIEN,.01,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"CardColor")=$$GET1^DIQ(8,ELIGCODEIEN,1,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"Abbreviation")=$$GET1^DIQ(8,ELIGCODEIEN,2,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"VACodeNumber")=$$GET1^DIQ(8,ELIGCODEIEN,3,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"Type")=$$GET1^DIQ(8,ELIGCODEIEN,4,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"PrintName")=$$GET1^DIQ(8,ELIGCODEIEN,5,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"Inactive")=$$GET1^DIQ(8,ELIGCODEIEN,6,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"CardColor")=$$GET1^DIQ(8,ELIGCODEIEN,1,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"SelectAsAdditional")=$$GET1^DIQ(8,ELIGCODEIEN,7,"E")

 S MASELIGCODE=$$GET1^DIQ(8,ELIGCODEIEN,8,"I")

 S ELIGCODES("EligibilityCodes",COUNT,"MASEligibilityCode",1,"IEN")=MASELIGCODE

 S ELIGCODES("EligibilityCodes",COUNT,"MASEligibilityCode",1,"NAME")=$$GET1^DIQ(8.1,ELIGCODEIEN,.01,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"IDFormat")=$$GET1^DIQ(8,ELIGCODEIEN,9,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"Agency")=$$GET1^DIQ(8,ELIGCODEIEN,11,"E")

 S ELIGCODES("EligibilityCodes",COUNT,"MakeRecordSensitive")=$$GET1^DIQ(8,ELIGCODEIEN,.12,"E")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDES2GETELIGCD   2491     printed  Apr 09, 2024@21:46:05                                                                                                                                                                                              Page 2

SDES2GETELIGCD ;ALB/LAB - SDES2 GET ELIGIBILITY CODES ;NOV 22, 2022

 +1       ;;5.3;Scheduling;**869**;Aug 13, 1993;Build 13

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4        QUIT 

 +5       ;

GETELIGCODES(RESULT,SDCONTEXT,SDPARAM) ;

 +1        NEW ELIGCODES,ERRORS

 +2       ;validate context array for accuracy

 +3        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +4        IF $DATA(ERRORS)

               SET ERRORS("EligibilityCodes",1)=""

               DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)

               QUIT 

 +5        if $GET(SDPARAM("EligibilityCodeName"))'=""

               DO SINGLECODE(.ELIGCODES,.SDPARAM)

 +6        if $GET(SDPARAM("EligibilityCodeName"))=""

               DO ALLCODES(.ELIGCODES)

 +7       ;

 +8        DO BUILDJSON^SDES2JSON(.RESULT,.ELIGCODES)

 +9        QUIT 

 +10      ;

SINGLECODE(ELIGCODES,SDPARAM) ;

 +1        NEW COUNT,ELIGCODEIEN

 +2        SET COUNT=1

 +3        SET ELIGCODEIEN=$ORDER(^DIC(8,"B",SDPARAM("EligibilityCodeName"),""))

 +4        IF ELIGCODEIEN=""

               SET ELIGCODES("EligibilityCodes",1)=""

               SET ELIGCODES("Error",1)="Code not Found"

               QUIT 

 +5        DO BUILD(.ELIGCODES,ELIGCODEIEN,COUNT)

 +6        QUIT 

 +7       ;

ALLCODES(ELIGCODES) ;

 +1        NEW COUNT,ELIGCODEIEN

 +2       ;

 +3        SET ELIGCODEIEN=0

           SET COUNT=0

 +4        FOR 

               SET ELIGCODEIEN=$ORDER(^DIC(8,ELIGCODEIEN))

               if 'ELIGCODEIEN

                   QUIT 

               Begin DoDot:1

 +5                SET COUNT=COUNT+1

 +6                DO BUILD(.ELIGCODES,ELIGCODEIEN,COUNT)

               End DoDot:1

 +7        QUIT 

 +8       ;

BUILD(ELIGCODES,ELIGCODEIEN,COUNT) ;

 +1        NEW MASELIGCODE

 +2        SET ELIGCODES("EligibilityCodes",COUNT,"IEN")=ELIGCODEIEN

 +3        SET ELIGCODES("EligibilityCodes",COUNT,"Name")=$$GET1^DIQ(8,ELIGCODEIEN,.01,"E")

 +4        SET ELIGCODES("EligibilityCodes",COUNT,"CardColor")=$$GET1^DIQ(8,ELIGCODEIEN,1,"E")

 +5        SET ELIGCODES("EligibilityCodes",COUNT,"Abbreviation")=$$GET1^DIQ(8,ELIGCODEIEN,2,"E")

 +6        SET ELIGCODES("EligibilityCodes",COUNT,"VACodeNumber")=$$GET1^DIQ(8,ELIGCODEIEN,3,"E")

 +7        SET ELIGCODES("EligibilityCodes",COUNT,"Type")=$$GET1^DIQ(8,ELIGCODEIEN,4,"E")

 +8        SET ELIGCODES("EligibilityCodes",COUNT,"PrintName")=$$GET1^DIQ(8,ELIGCODEIEN,5,"E")

 +9        SET ELIGCODES("EligibilityCodes",COUNT,"Inactive")=$$GET1^DIQ(8,ELIGCODEIEN,6,"E")

 +10       SET ELIGCODES("EligibilityCodes",COUNT,"CardColor")=$$GET1^DIQ(8,ELIGCODEIEN,1,"E")

 +11       SET ELIGCODES("EligibilityCodes",COUNT,"SelectAsAdditional")=$$GET1^DIQ(8,ELIGCODEIEN,7,"E")

 +12       SET MASELIGCODE=$$GET1^DIQ(8,ELIGCODEIEN,8,"I")

 +13       SET ELIGCODES("EligibilityCodes",COUNT,"MASEligibilityCode",1,"IEN")=MASELIGCODE

 +14       SET ELIGCODES("EligibilityCodes",COUNT,"MASEligibilityCode",1,"NAME")=$$GET1^DIQ(8.1,ELIGCODEIEN,.01,"E")

 +15       SET ELIGCODES("EligibilityCodes",COUNT,"IDFormat")=$$GET1^DIQ(8,ELIGCODEIEN,9,"E")

 +16       SET ELIGCODES("EligibilityCodes",COUNT,"Agency")=$$GET1^DIQ(8,ELIGCODEIEN,11,"E")

 +17       SET ELIGCODES("EligibilityCodes",COUNT,"MakeRecordSensitive")=$$GET1^DIQ(8,ELIGCODEIEN,.12,"E")

 +18       QUIT 

 +19      ;