DGR111 ;ALB/TGH,LMD,JAM,BDB,ARF - Health Benefit Plan Main Menu - List Manager Screen ;4/11/13 10:56am
;;5.3;Registration;**871,987,985,1006,1014**;Aug 13, 1993;Build 42
;
EN(DFN) ;Main entry point to invoke the DGEN HBP PATIENT list
; Input -- DFN Patient IEN
;
; Set up to use two ListMan Menus dependent upon HBP source
N HBP,DGHBP,HBPSRC,MENU
D GETHBP^DGHBPUTL(DFN)
S MENU="DGEN HBP PATIENT"
D WAIT^DICD
D EN^VALM(MENU)
Q
;
HDR ;Header code
D LISTHDR^DGRPU(1) ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array
I $O(^DPT(DFN,"HBP",0))<1 S VALMHDR(3)="No Currently Stored VHAP Data" ;ARF/DG*5.3*1014
;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*987; JAM; check for at least 1 plan and modify the message text
;I '$D(^DPT(DFN,"HBP",1)) S VALMHDR(2)="No Currently Stored VMBP Data"
; DG*5.3*985; JAM; correct check for at least 1 plan
;I $O(^DPT(DFN,"HBP",0))<1 S VALMHDR(2)="No Currently Stored VHAP Data" ;DG*5.3*1006 BDB ;DG*5.3*1014 end comment previous code
Q
;
INIT ;Build patient HBP current screen
D CLEAN^VALM10
D CLEAR^VALM1
D GETHBP(DFN)
Q
;
GETHBP(DFN) ;Load HBPs from HBP array into TMP(VALMAR global for display
; INPUT: DFN = Patient IEN
N DGHBP,DGSEL,DGDATA,Z,HBPSRC,BRACKET,DGHBIEN,DGPNAME
S VALMCNT=0,(DGDATA,HBPSRC)=""
D GETHBP^DGHBPUTL(DFN)
S DGHBP=""
F S DGHBP=$O(HBP("CUR",DGHBP)) Q:DGHBP="" D
. S HBPSRC=$S(HBPSRC="E":"E",1:$P(HBP("CUR",DGHBP),"^",5))
S BRACKET=$S(HBPSRC="E":"<>",1:"[]")
F S DGHBP=$O(HBP("CUR",DGHBP)) Q:DGHBP="" D
. S DGDATA=HBP("CUR",DGHBP)
. ; DG*5.3*987; jam; Place "zz" before the plan name for inactive plans
. S DGHBIEN=+DGDATA
. I $P($G(^DGHBP(25.11,DGHBIEN,0)),"^",4)="Y" S DGPNAME="zz "_DGHBP
. E S DGPNAME=DGHBP
. S VALMCNT=VALMCNT+1
. S Z=$E(BRACKET)_VALMCNT_$E(BRACKET,2)_" "_DGPNAME
. S DGSEL(VALMCNT)=DGPNAME
. D SET^VALM10(VALMCNT,Z,VALMCNT)
Q
;
HELP ;Help code
S X="?" D DISP^XQORM1 W !!
; DG*53*987; jam; Add this to the help screen.
W "Profile name preceded by 'zz' indicates the profile is inactive.",!
Q
;
EXIT ;Exit code
D CLEAN^VALM10
D CLEAR^VALM1
;K ^TMP("DGRP111",$J)
Q
;
PEXIT ;DGEN MSDS MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
ACT(DGACT) ; Entry point for menu action selection
; = "VH" - View History - DGEN HBP View History protocol
; = "VD" - View Detail of HBP
N DGACTU,DA,DIE,DIC,DIK,DIPA,DR,X,Y,DGHBP,HPSRC,HBP
I $G(DGACT)="" G ACTQ
I $G(DGACT)="Q" Q
; Determine if any HBPs were processed by ESR
S (DGDATA,HBPSRC)=""
D GETHBP^DGHBPUTL(DFN)
S DGHBP=""
F S DGHBP=$O(HBP("CUR",DGHBP)) Q:DGHBP="" D
. S HBPSRC=$S(HBPSRC="E":"E",1:$P(HBP("CUR",DGHBP),"^",5))
;
D FULL^VALM1
; If action is a VH then View History display screen (DGR113) then return to main screen
I DGACT="VH" D EN^DGR113(DFN) G ACTQ
; If action is a VD then View Detail display screen (DGR114) then return to main screen
I DGACT="VD" D EN^DGR114(DFN) G ACTQ
; If user does not choose VH or VD return to main screen
W !,"Health Profiles can only be edited/modified by an ESC user,"
W !,"please contact HEC to request changes/edits."
D PAUSE^VALM1
;
ACTQ D INIT S VALMBCK="R" Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGR111 3666 printed Oct 16, 2024@18:55:18 Page 2
DGR111 ;ALB/TGH,LMD,JAM,BDB,ARF - Health Benefit Plan Main Menu - List Manager Screen ;4/11/13 10:56am
+1 ;;5.3;Registration;**871,987,985,1006,1014**;Aug 13, 1993;Build 42
+2 ;
EN(DFN) ;Main entry point to invoke the DGEN HBP PATIENT list
+1 ; Input -- DFN Patient IEN
+2 ;
+3 ; Set up to use two ListMan Menus dependent upon HBP source
+4 NEW HBP,DGHBP,HBPSRC,MENU
+5 DO GETHBP^DGHBPUTL(DFN)
+6 SET MENU="DGEN HBP PATIENT"
+7 DO WAIT^DICD
+8 DO EN^VALM(MENU)
+9 QUIT
+10 ;
HDR ;Header code
+1 ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array
DO LISTHDR^DGRPU(1)
+2 ;ARF/DG*5.3*1014
IF $ORDER(^DPT(DFN,"HBP",0))<1
SET VALMHDR(3)="No Currently Stored VHAP Data"
+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)
+9 ; DG*5.3*987; JAM; check for at least 1 plan and modify the message text
+10 ;I '$D(^DPT(DFN,"HBP",1)) S VALMHDR(2)="No Currently Stored VMBP Data"
+11 ; DG*5.3*985; JAM; correct check for at least 1 plan
+12 ;I $O(^DPT(DFN,"HBP",0))<1 S VALMHDR(2)="No Currently Stored VHAP Data" ;DG*5.3*1006 BDB ;DG*5.3*1014 end comment previous code
+13 QUIT
+14 ;
INIT ;Build patient HBP current screen
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 DO GETHBP(DFN)
+4 QUIT
+5 ;
GETHBP(DFN) ;Load HBPs from HBP array into TMP(VALMAR global for display
+1 ; INPUT: DFN = Patient IEN
+2 NEW DGHBP,DGSEL,DGDATA,Z,HBPSRC,BRACKET,DGHBIEN,DGPNAME
+3 SET VALMCNT=0
SET (DGDATA,HBPSRC)=""
+4 DO GETHBP^DGHBPUTL(DFN)
+5 SET DGHBP=""
+6 FOR
SET DGHBP=$ORDER(HBP("CUR",DGHBP))
if DGHBP=""
QUIT
Begin DoDot:1
+7 SET HBPSRC=$SELECT(HBPSRC="E":"E",1:$PIECE(HBP("CUR",DGHBP),"^",5))
End DoDot:1
+8 SET BRACKET=$SELECT(HBPSRC="E":"<>",1:"[]")
+9 FOR
SET DGHBP=$ORDER(HBP("CUR",DGHBP))
if DGHBP=""
QUIT
Begin DoDot:1
+10 SET DGDATA=HBP("CUR",DGHBP)
+11 ; DG*5.3*987; jam; Place "zz" before the plan name for inactive plans
+12 SET DGHBIEN=+DGDATA
+13 IF $PIECE($GET(^DGHBP(25.11,DGHBIEN,0)),"^",4)="Y"
SET DGPNAME="zz "_DGHBP
+14 IF '$TEST
SET DGPNAME=DGHBP
+15 SET VALMCNT=VALMCNT+1
+16 SET Z=$EXTRACT(BRACKET)_VALMCNT_$EXTRACT(BRACKET,2)_" "_DGPNAME
+17 SET DGSEL(VALMCNT)=DGPNAME
+18 DO SET^VALM10(VALMCNT,Z,VALMCNT)
End DoDot:1
+19 QUIT
+20 ;
HELP ;Help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 ; DG*53*987; jam; Add this to the help screen.
+3 WRITE "Profile name preceded by 'zz' indicates the profile is inactive.",!
+4 QUIT
+5 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO CLEAR^VALM1
+3 ;K ^TMP("DGRP111",$J)
+4 QUIT
+5 ;
PEXIT ;DGEN MSDS MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 QUIT
+3 ;
ACT(DGACT) ; Entry point for menu action selection
+1 ; = "VH" - View History - DGEN HBP View History protocol
+2 ; = "VD" - View Detail of HBP
+3 NEW DGACTU,DA,DIE,DIC,DIK,DIPA,DR,X,Y,DGHBP,HPSRC,HBP
+4 IF $GET(DGACT)=""
GOTO ACTQ
+5 IF $GET(DGACT)="Q"
QUIT
+6 ; Determine if any HBPs were processed by ESR
+7 SET (DGDATA,HBPSRC)=""
+8 DO GETHBP^DGHBPUTL(DFN)
+9 SET DGHBP=""
+10 FOR
SET DGHBP=$ORDER(HBP("CUR",DGHBP))
if DGHBP=""
QUIT
Begin DoDot:1
+11 SET HBPSRC=$SELECT(HBPSRC="E":"E",1:$PIECE(HBP("CUR",DGHBP),"^",5))
End DoDot:1
+12 ;
+13 DO FULL^VALM1
+14 ; If action is a VH then View History display screen (DGR113) then return to main screen
+15 IF DGACT="VH"
DO EN^DGR113(DFN)
GOTO ACTQ
+16 ; If action is a VD then View Detail display screen (DGR114) then return to main screen
+17 IF DGACT="VD"
DO EN^DGR114(DFN)
GOTO ACTQ
+18 ; If user does not choose VH or VD return to main screen
+19 WRITE !,"Health Profiles can only be edited/modified by an ESC user,"
+20 WRITE !,"please contact HEC to request changes/edits."
+21 DO PAUSE^VALM1
+22 ;
ACTQ DO INIT
SET VALMBCK="R"
QUIT
+1 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
