DGR1131 ;ALB/KUM,BDB,ARF - Health Benefit Plan View History Expanded - List Manager Screen for screen 11.3.1 ;5/30/19 10:56am
;;5.3;Registration;**987,1006,1014**;Aug 13, 1993;Build 42
;
EN(DFN,DGNAME,HBP) ;Main entry point to invoke the DGEN HBP VIEWEXP list
; Input -- DFN Patient ID
; DGNAME Text for plan selected from the list in screen 11.3
; HBP Patient Plan Details array
;
D WAIT^DICD
D EN^VALM("DGEN HBP VIEWEXP")
Q
;
HDR ;Header code
N X,DGSTR,DGWD,DGSPC,DGPLAN
D LISTHDR^DGRPU(1) ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array
;S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30) ;DG*5.3*1014 begin comment previous code
;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(^DG(391,+^DPT(DFN,"TYPE"),0),U,1)
;S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
;S VALMHDR(2)=" "
;S VALMHDR(3)="Action Date/Time Profile" ;DG*5.3*1006 BDB ; Time is now displayed with the date
;S VALMHDR(4)="------ --------- -------" ;DG*5.3*1006 BDB
;S DGSTR=$$TRIM^XLFSTR($E(DGNAME,6,999)),DGWD=80,DGSPC=" "
;D FSTRING(DGSTR,DGWD,.DGPLAN)
;S VALMHDR(5)=DGPLAN(1,0)
;I DGPLAN=2 D
;.S VALMHDR(6)=DGSPC_DGPLAN(2,0)
;S VALMHDR(7)=" "
;S VALMSG="+ Next Screen - Prev Screen ?? More Actions" ;DG*5.3*1014 end -increased following VALAMHDR subscripts ;DG*5.3*1014 end comment previous code
S VALMHDR(3)=" "
S VALMHDR(4)="Action Date/Time Profile" ;DG*5.3*1006 BDB ; Time is now displayed with the date
S VALMHDR(5)="------ --------- -------" ;DG*5.3*1006 BDB
S DGSTR=$$TRIM^XLFSTR($E(DGNAME,6,999)),DGWD=80,DGSPC=" "
D FSTRING(DGSTR,DGWD,.DGPLAN)
S VALMHDR(6)=DGPLAN(1,0)
I DGPLAN=2 D
.S VALMHDR(7)=DGSPC_DGPLAN(2,0)
S VALMHDR(8)=" "
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
INIT ; -- init variables and list array
N DGACT,LST,CNT
D CLEAN^VALM10
D CLEAR^VALM1
S LST=$P(HBP("DETAIL",0),"^",4)
;I LST="" W !,"No detail description is available for this Veteran Medical Benefit Plan"
I LST="" W !,"No detail description is available for this VHA Profile" ;DG*5.3*1006 BDB
S DGACT=$$FIND1^DIC(25.11,,"XQ",$$TRIM^XLFSTR($E(DGNAME,37,999))) ;DG*5.3*1006 ; BDB; Plan name is at location 37
F CNT=1:1:LST D SET^VALM10(CNT," "_HBP("DETAIL",DGACT,CNT))
S VALMCNT=CNT
S VALMBCK="R"
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
PEXIT ; MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
FSTRING(DGSTR,DGWD,DGARRAY) ;Parse text string into lines of length DGWD
; Input:
; DGSTR - (required) Text string to be parsed
; DGWD - Length of parsed lines (default =80)
;
; Output:
; DGARRAY - (required) Result array of formatted output text, passed by reference
;
N X,DGI,DIWL,DIWR,DIWF
K DGARRAY,^UTILITY($J,"W")
S X=$G(DGSTR)
I X'="" S DIWL=1,DIWR=$G(DGWD,80),DIWF="" D ^DIWP
I $D(^UTILITY($J,"W")) M DGARRAY=^UTILITY($J,"W",1)
K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGR1131 3273 printed Apr 09, 2024@22:03:07 Page 2
DGR1131 ;ALB/KUM,BDB,ARF - Health Benefit Plan View History Expanded - List Manager Screen for screen 11.3.1 ;5/30/19 10:56am
+1 ;;5.3;Registration;**987,1006,1014**;Aug 13, 1993;Build 42
+2 ;
EN(DFN,DGNAME,HBP) ;Main entry point to invoke the DGEN HBP VIEWEXP list
+1 ; Input -- DFN Patient ID
+2 ; DGNAME Text for plan selected from the list in screen 11.3
+3 ; HBP Patient Plan Details array
+4 ;
+5 DO WAIT^DICD
+6 DO EN^VALM("DGEN HBP VIEWEXP")
+7 QUIT
+8 ;
HDR ;Header code
+1 NEW X,DGSTR,DGWD,DGSPC,DGPLAN
+2 ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array
DO LISTHDR^DGRPU(1)
+3 ;S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30) ;DG*5.3*1014 begin comment previous code
+4 ;S VALMHDR(1)=VALMHDR(1)_" ("_VA("BID")_")"
+5 ;S X="PATIENT TYPE UNKNOWN"
+6 ;I $D(^DPT(DFN,"TYPE")),$D(^DG(391,+^("TYPE"),0)) S X=$P(^DG(391,+^DPT(DFN,"TYPE"),0),U,1)
+7 ;S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80)
+8 ;S VALMHDR(2)=" "
+9 ;S VALMHDR(3)="Action Date/Time Profile" ;DG*5.3*1006 BDB ; Time is now displayed with the date
+10 ;S VALMHDR(4)="------ --------- -------" ;DG*5.3*1006 BDB
+11 ;S DGSTR=$$TRIM^XLFSTR($E(DGNAME,6,999)),DGWD=80,DGSPC=" "
+12 ;D FSTRING(DGSTR,DGWD,.DGPLAN)
+13 ;S VALMHDR(5)=DGPLAN(1,0)
+14 ;I DGPLAN=2 D
+15 ;.S VALMHDR(6)=DGSPC_DGPLAN(2,0)
+16 ;S VALMHDR(7)=" "
+17 ;S VALMSG="+ Next Screen - Prev Screen ?? More Actions" ;DG*5.3*1014 end -increased following VALAMHDR subscripts ;DG*5.3*1014 end comment previous code
+18 SET VALMHDR(3)=" "
+19 ;DG*5.3*1006 BDB ; Time is now displayed with the date
SET VALMHDR(4)="Action Date/Time Profile"
+20 ;DG*5.3*1006 BDB
SET VALMHDR(5)="------ --------- -------"
+21 SET DGSTR=$$TRIM^XLFSTR($EXTRACT(DGNAME,6,999))
SET DGWD=80
SET DGSPC=" "
+22 DO FSTRING(DGSTR,DGWD,.DGPLAN)
+23 SET VALMHDR(6)=DGPLAN(1,0)
+24 IF DGPLAN=2
Begin DoDot:1
+25 SET VALMHDR(7)=DGSPC_DGPLAN(2,0)
End DoDot:1
+26 SET VALMHDR(8)=" "
+27 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+28 QUIT
+29 ;
INIT ; -- init variables and list array
+1 NEW DGACT,LST,CNT
+2 DO CLEAN^VALM10
+3 DO CLEAR^VALM1
+4 SET LST=$PIECE(HBP("DETAIL",0),"^",4)
+5 ;I LST="" W !,"No detail description is available for this Veteran Medical Benefit Plan"
+6 ;DG*5.3*1006 BDB
IF LST=""
WRITE !,"No detail description is available for this VHA Profile"
+7 ;DG*5.3*1006 ; BDB; Plan name is at location 37
SET DGACT=$$FIND1^DIC(25.11,,"XQ",$$TRIM^XLFSTR($EXTRACT(DGNAME,37,999)))
+8 FOR CNT=1:1:LST
DO SET^VALM10(CNT," "_HBP("DETAIL",DGACT,CNT))
+9 SET VALMCNT=CNT
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PEXIT ; MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 QUIT
+3 ;
FSTRING(DGSTR,DGWD,DGARRAY) ;Parse text string into lines of length DGWD
+1 ; Input:
+2 ; DGSTR - (required) Text string to be parsed
+3 ; DGWD - Length of parsed lines (default =80)
+4 ;
+5 ; Output:
+6 ; DGARRAY - (required) Result array of formatted output text, passed by reference
+7 ;
+8 NEW X,DGI,DIWL,DIWR,DIWF
+9 KILL DGARRAY,^UTILITY($JOB,"W")
+10 SET X=$GET(DGSTR)
+11 IF X'=""
SET DIWL=1
SET DIWR=$GET(DGWD,80)
SET DIWF=""
DO ^DIWP
+12 IF $DATA(^UTILITY($JOB,"W"))
MERGE DGARRAY=^UTILITY($JOB,"W",1)
+13 KILL ^UTILITY($JOB,"W")
+14 QUIT
