DGR114.m

DGR114 ;ALB/TGH,JAM,BDB,ARF - Health Benefit Plan View Detail - List Manager Screen ;7/8/19 10:56am 

 ;;5.3;Registration;**871,987,1006,1014**;Aug 13, 1993;Build 42

 ;

EN(DFN) ;Main entry point to invoke the DGEN HBP DETAIL list

 ; Input  -- DFN      Patient IEN

 ;

 D WAIT^DICD

 D EN^VALM("DGEN HBP DETAIL")

 Q

 ;

HDR ;Header code

 N X

 D LISTHDR^DGRPU(1) ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array

 ;D PID^VADPT                                             ;DG*5.3*1014 begin comment previous code

 ;S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)

 ;S VALMHDR(1)=VALMHDR(1)_" ("_VA("BID")_")"

 ;S X="PATIENT TYPE UNKNOWN"

 ;I $D(^DPT(DFN,"TYPE")),$D(^DG(391,+^("TYPE"),0)) S X=$P(^(0),U,1)

 ;S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)         ;DG*5.3*1014 end comment previous code

 Q

 ;

INIT ;Build patient HBP current screen

 D CLEAN^VALM10

 D CLEAR^VALM1

 D GETPLAN

 Q

 ;

GETPLAN ;Load Plans from HBP array into TMP(VALMAR global for display

 N DGPLAN,Z,DGHBIEN

 D GETPLAN^DGHBPUTL

 S DGPLAN="",VALMCNT=0

 F  S DGPLAN=$O(HBP("PLAN",DGPLAN)) Q:DGPLAN=""  D

 . ;DG*5.3*987 - JAM - Filter out Inactive Plans

 . S DGHBIEN=HBP("PLAN",DGPLAN)

 . I $P($G(^DGHBP(25.11,DGHBIEN,0)),"^",4)="Y" Q

 .;

 . S VALMCNT=VALMCNT+1

 . S Z="["_VALMCNT_"]"_"  "_DGPLAN

 . D SET^VALM10(VALMCNT,Z,VALMCNT)

 Q

 ;

HELP ;Help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

ACTION ; Get users entered data and process entry to add HBP

 N I,VALMY,VALMNOD

 D FULL^VALM1

 S VALMNOD="3^4450^Select HBP^1-36"

 D EN^VALM2(VALMNOD,"S")

 S I=""

 F  S I=$O(VALMY(I)) Q:I=""  D

 . S ACT=$O(@VALMAR@("IDX",I,""))

 . S DGNAME=$P(@VALMAR@(ACT,0)," ",3,99)

 . S DGACT=HBP("PLAN",DGNAME)

 . D ACT(DGACT)

 Q

 ;

ACT(DGACT) ; Entry point for menu action selection

 ; INPUT: DGACT = Plan number to be assigned

 I $G(DGACT)="" Q

 ; Gather data and send to print in EXPND

 D GETDETL^DGHBPUTL(DGACT)

 Q

 ;

EXIT ;Exit code

 D CLEAN^VALM10

 D CLEAR^VALM1

 Q

 ;

PEXIT ; MENU protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 Q

 ;

EXPND ; -- expand code

 N CNT,LST,ACT,DGNAME,DGACT

 D ACTION

 S VALMBCK="R"   ; CCR 13613 - fix

 I $G(DGACT)="" Q

 S LST=$P(HBP("DETAIL",0),"^",4)

 ;I LST="" W !,"No detail description is available for this Veteran Medical Benefit Plan" ;DG*5.3*987 HM

 I LST="" W !,"No detail description is available for this VHA Profile" ;DG*5.3*1006 BDB;DG*5.3*987 HM 

 F CNT=1:1:LST W !,HBP("DETAIL",DGACT,CNT)

 S VALMBCK="R"

 D PAUSE^VALM1

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGR114   2579     printed  Feb 19, 2025@00:20:49                                                                                                                                                                                                      Page 2

DGR114    ;ALB/TGH,JAM,BDB,ARF - Health Benefit Plan View Detail - List Manager Screen ;7/8/19 10:56am 

 +1       ;;5.3;Registration;**871,987,1006,1014**;Aug 13, 1993;Build 42

 +2       ;

EN(DFN)   ;Main entry point to invoke the DGEN HBP DETAIL list

 +1       ; Input  -- DFN      Patient IEN

 +2       ;

 +3        DO WAIT^DICD

 +4        DO EN^VALM("DGEN HBP DETAIL")

 +5        QUIT 

 +6       ;

HDR       ;Header code

 +1        NEW X

 +2       ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array

           DO LISTHDR^DGRPU(1)

 +3       ;D PID^VADPT                                             ;DG*5.3*1014 begin comment previous code

 +4       ;S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)

 +5       ;S VALMHDR(1)=VALMHDR(1)_" ("_VA("BID")_")"

 +6       ;S X="PATIENT TYPE UNKNOWN"

 +7       ;I $D(^DPT(DFN,"TYPE")),$D(^DG(391,+^("TYPE"),0)) S X=$P(^(0),U,1)

 +8       ;S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)         ;DG*5.3*1014 end comment previous code

 +9        QUIT 

 +10      ;

INIT      ;Build patient HBP current screen

 +1        DO CLEAN^VALM10

 +2        DO CLEAR^VALM1

 +3        DO GETPLAN

 +4        QUIT 

 +5       ;

GETPLAN   ;Load Plans from HBP array into TMP(VALMAR global for display

 +1        NEW DGPLAN,Z,DGHBIEN

 +2        DO GETPLAN^DGHBPUTL

 +3        SET DGPLAN=""

           SET VALMCNT=0

 +4        FOR 

               SET DGPLAN=$ORDER(HBP("PLAN",DGPLAN))

               if DGPLAN=""

                   QUIT 

               Begin DoDot:1

 +5       ;DG*5.3*987 - JAM - Filter out Inactive Plans

 +6                SET DGHBIEN=HBP("PLAN",DGPLAN)

 +7                IF $PIECE($GET(^DGHBP(25.11,DGHBIEN,0)),"^",4)="Y"

                       QUIT 

 +8       ;

 +9                SET VALMCNT=VALMCNT+1

 +10               SET Z="["_VALMCNT_"]"_"  "_DGPLAN

 +11               DO SET^VALM10(VALMCNT,Z,VALMCNT)

               End DoDot:1

 +12       QUIT 

 +13      ;

HELP      ;Help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

ACTION    ; Get users entered data and process entry to add HBP

 +1        NEW I,VALMY,VALMNOD

 +2        DO FULL^VALM1

 +3        SET VALMNOD="3^4450^Select HBP^1-36"

 +4        DO EN^VALM2(VALMNOD,"S")

 +5        SET I=""

 +6        FOR 

               SET I=$ORDER(VALMY(I))

               if I=""

                   QUIT 

               Begin DoDot:1

 +7                SET ACT=$ORDER(@VALMAR@("IDX",I,""))

 +8                SET DGNAME=$PIECE(@VALMAR@(ACT,0)," ",3,99)

 +9                SET DGACT=HBP("PLAN",DGNAME)

 +10               DO ACT(DGACT)

               End DoDot:1

 +11       QUIT 

 +12      ;

ACT(DGACT) ; Entry point for menu action selection

 +1       ; INPUT: DGACT = Plan number to be assigned

 +2        IF $GET(DGACT)=""

               QUIT 

 +3       ; Gather data and send to print in EXPND

 +4        DO GETDETL^DGHBPUTL(DGACT)

 +5        QUIT 

 +6       ;

EXIT      ;Exit code

 +1        DO CLEAN^VALM10

 +2        DO CLEAR^VALM1

 +3        QUIT 

 +4       ;

PEXIT     ; MENU protocol exit code

 +1        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        NEW CNT,LST,ACT,DGNAME,DGACT

 +2        DO ACTION

 +3       ; CCR 13613 - fix

           SET VALMBCK="R"

 +4        IF $GET(DGACT)=""

               QUIT 

 +5        SET LST=$PIECE(HBP("DETAIL",0),"^",4)

 +6       ;I LST="" W !,"No detail description is available for this Veteran Medical Benefit Plan" ;DG*5.3*987 HM

 +7       ;DG*5.3*1006 BDB;DG*5.3*987 HM 

           IF LST=""

               WRITE !,"No detail description is available for this VHA Profile"

 +8        FOR CNT=1:1:LST

               WRITE !,HBP("DETAIL",DGACT,CNT)

 +9        SET VALMBCK="R"

 +10       DO PAUSE^VALM1

 +11       QUIT 

 +12      ;