- DGR113 ;ALB/TGH,HM,KUM,BDB,ARF - Health Benefit Plan View History - List Manager Screen ;5/21/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 VIEW list
- ; Input -- DFN Patient IEN
- ;
- D WAIT^DICD
- D EN^VALM("DGEN HBP VIEW")
- 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 View History screen
- N DGPLAN
- D CLEAN^VALM10
- D CLEAR^VALM1
- D GETPLAN
- Q
- ;
- GETPLAN ;Load History from HBP array into TMP(VALMAR global for display
- N DTTIME,CNT,LINEVAR
- S VALMCNT=0
- S LINEVAR="HISTORY"
- D GETHBP^DGHBPUTL
- ; Go thru History and set individual values into Global for display
- S CNT=0
- F S CNT=$O(HBP("HIS",CNT)) Q:CNT="" D
- . S DTTIME=""
- . F S DTTIME=$O(HBP("HIS",CNT,DTTIME)) Q:DTTIME="" D
- . . N DATA,Y
- . . S DATA=HBP("HIS",CNT,DTTIME)
- . . S Y=DTTIME X ^DD("DD")
- . . S VALMCNT=VALMCNT+1
- . . S LINEVAR=$$SETFLD^VALM1("["_VALMCNT_"]",LINEVAR,"NO") ; DG*5.3*987 KUM
- . . S LINEVAR=$$SETFLD^VALM1($S($P(DATA,"^",5)="A":" ASSIGN",1:" UNASSIGN"),LINEVAR,"ACTION") ; DG*5.3*987 HM
- . . S LINEVAR=$$SETFLD^VALM1(Y,LINEVAR,"DATE/TIME") ; DG*5.3*1006 BDB - Time to be displayed along with the date
- . . ; DG*5.3*987 KUM
- . . S LINEVAR=$$SETSTR^VALM1($P(DATA,"^",1),LINEVAR,37,139) ;DG*5.3*1006 BDB - Plan name begins at location 37
- . . D SET^VALM10(VALMCNT,LINEVAR,VALMCNT)
- Q
- ;
- HELP ;Help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ;Exit code
- D CLEAN^VALM10
- D CLEAR^VALM1
- Q
- ;
- ACTION ; Get users entered data and process entry to add HBP
- ; DG*5.3*987 - KUM
- 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=@VALMAR@(ACT,0)
- . ; DG*5.3*966 - Plan name is at position 37
- . S DGACT=$$FIND1^DIC(25.11,,"XQ",$$TRIM^XLFSTR($E(DGNAME,37,999)))
- . 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
- ;
- EXPND ; -- expand code
- ; DG*5.3*987 - KUM - For Expand Functionality
- N CNT,LST,ACT,DGNAME,DGACT
- D ACTION
- S VALMBCK="R"
- I $G(DGACT)="" Q
- D FULL^VALM1
- D EN^DGR1131(DFN,DGNAME,.HBP)
- S VALMBCK="R"
- Q
- ;
- PEXIT ; MENU protocol exit code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGR113 2975 printed Feb 19, 2025@00:20:48 Page 2
- DGR113 ;ALB/TGH,HM,KUM,BDB,ARF - Health Benefit Plan View History - List Manager Screen ;5/21/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 VIEW list
- +1 ; Input -- DFN Patient IEN
- +2 ;
- +3 DO WAIT^DICD
- +4 DO EN^VALM("DGEN HBP VIEW")
- +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 View History screen
- +1 NEW DGPLAN
- +2 DO CLEAN^VALM10
- +3 DO CLEAR^VALM1
- +4 DO GETPLAN
- +5 QUIT
- +6 ;
- GETPLAN ;Load History from HBP array into TMP(VALMAR global for display
- +1 NEW DTTIME,CNT,LINEVAR
- +2 SET VALMCNT=0
- +3 SET LINEVAR="HISTORY"
- +4 DO GETHBP^DGHBPUTL
- +5 ; Go thru History and set individual values into Global for display
- +6 SET CNT=0
- +7 FOR
- SET CNT=$ORDER(HBP("HIS",CNT))
- if CNT=""
- QUIT
- Begin DoDot:1
- +8 SET DTTIME=""
- +9 FOR
- SET DTTIME=$ORDER(HBP("HIS",CNT,DTTIME))
- if DTTIME=""
- QUIT
- Begin DoDot:2
- +10 NEW DATA,Y
- +11 SET DATA=HBP("HIS",CNT,DTTIME)
- +12 SET Y=DTTIME
- XECUTE ^DD("DD")
- +13 SET VALMCNT=VALMCNT+1
- +14 ; DG*5.3*987 KUM
- SET LINEVAR=$$SETFLD^VALM1("["_VALMCNT_"]",LINEVAR,"NO")
- +15 ; DG*5.3*987 HM
- SET LINEVAR=$$SETFLD^VALM1($SELECT($PIECE(DATA,"^",5)="A":" ASSIGN",1:" UNASSIGN"),LINEVAR,"ACTION")
- +16 ; DG*5.3*1006 BDB - Time to be displayed along with the date
- SET LINEVAR=$$SETFLD^VALM1(Y,LINEVAR,"DATE/TIME")
- +17 ; DG*5.3*987 KUM
- +18 ;DG*5.3*1006 BDB - Plan name begins at location 37
- SET LINEVAR=$$SETSTR^VALM1($PIECE(DATA,"^",1),LINEVAR,37,139)
- +19 DO SET^VALM10(VALMCNT,LINEVAR,VALMCNT)
- End DoDot:2
- End DoDot:1
- +20 QUIT
- +21 ;
- HELP ;Help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ;Exit code
- +1 DO CLEAN^VALM10
- +2 DO CLEAR^VALM1
- +3 QUIT
- +4 ;
- ACTION ; Get users entered data and process entry to add HBP
- +1 ; DG*5.3*987 - KUM
- +2 NEW I,VALMY,VALMNOD
- +3 DO FULL^VALM1
- +4 SET VALMNOD="3^4450^Select HBP^1-36"
- +5 DO EN^VALM2(VALMNOD,"S")
- +6 SET I=""
- +7 FOR
- SET I=$ORDER(VALMY(I))
- if I=""
- QUIT
- Begin DoDot:1
- +8 SET ACT=$ORDER(@VALMAR@("IDX",I,""))
- +9 SET DGNAME=@VALMAR@(ACT,0)
- +10 ; DG*5.3*966 - Plan name is at position 37
- +11 SET DGACT=$$FIND1^DIC(25.11,,"XQ",$$TRIM^XLFSTR($EXTRACT(DGNAME,37,999)))
- +12 DO ACT(DGACT)
- End DoDot:1
- +13 QUIT
- +14 ;
- 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 ;
- EXPND ; -- expand code
- +1 ; DG*5.3*987 - KUM - For Expand Functionality
- +2 NEW CNT,LST,ACT,DGNAME,DGACT
- +3 DO ACTION
- +4 SET VALMBCK="R"
- +5 IF $GET(DGACT)=""
- QUIT
- +6 DO FULL^VALM1
- +7 DO EN^DGR1131(DFN,DGNAME,.HBP)
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- PEXIT ; MENU protocol exit code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 QUIT
- +3 ;