DGHBPUTL ;ALB/PWC,JAM - Health Benefit Plan Utility Routine ;5/22/13 11:50am
;;5.3;Registration;**871,987**;08/13/93;Build 22
;
;
GETHBP(DFN) ;Return all records in HBP sub-file #25.01 in HBP array
; returns current information in HBP("CUR",PLAN NAME)=ENTIRE DATA FROM 25.01 DA
; returns current information in HBP("CUR",PLAN NAME,"IEN")=PLAN CODE
; returns history information in HBP("HIS",DA,DTTM)=PLAN NAME^ENTIRE DATA FROM 25.02 DA
I '$G(DFN) Q
N SDT,HBDATA,HBCODE,HBNAME K HBP("CUR"),HBP("HIS")
S SDT=0,(HBDATA,HBCODE)=""
F S SDT=$O(^DPT(DFN,"HBP",SDT)) Q:SDT<1 D
. S HBDATA=$G(^DPT(DFN,"HBP",SDT,0)),HBCODE=$P(HBDATA,"^",1)
. S HBNAME=$P($G(^DGHBP(25.11,HBCODE,0)),"^",1) Q:HBNAME=""
. S HBP("CUR",HBNAME)=HBDATA
. S HBP("CUR",HBNAME,"IEN")=HBCODE
HBP1 S SDT=0,(HBDATA,HBCODE)=""
F S SDT=$O(^DPT(DFN,"HBP1",SDT)) Q:SDT<1 D
. S HBDATA=$G(^DPT(DFN,"HBP1",SDT,0)),HBCODE=$P(HBDATA,"^",2)
. S HBNAME=$P($G(^DGHBP(25.11,HBCODE,0)),"^",1) Q:HBNAME=""
. S HBP("HIS",SDT,$P(HBDATA,"^",1))=HBNAME_"^"_$P(HBDATA,"^",2,99)
Q
;
GETDETL(HBPNUM) ;Return detail for each HBP in an array for display purposes
I $G(HBPNUM)="" Q
N DATA,CNT,LAST K HBP("DETAIL")
S HBP("DETAIL",0)=$G(^DGHBP(25.11,HBPNUM,2,0))
I HBP("DETAIL",0)="" S HBP("DETAIL",0)="0^No Detail Available." Q
S LAST=$P(HBP("DETAIL",0),"^",4)
M DATA=^DGHBP(25.11,HBPNUM,2)
F CNT=1:1:LAST S HBP("DETAIL",HBPNUM,CNT)=DATA(CNT,0)
Q
;
GETPLAN ; Return all Health Benefit Plans from file #25.11 in array
N HBPLAN,HBIEN,PLAN S HBPLAN="" K HBP("PLAN")
F S HBPLAN=$O(^DGHBP(25.11,"B",HBPLAN)) Q:HBPLAN="" D
. ; DG*5.3*987; jam; Fix for DGHBP array - "B" xref can have multiple IENs under a plan name
. S HBIEN=""
. F S HBIEN=$O(^DGHBP(25.11,"B",HBPLAN,HBIEN)) Q:HBIEN="" D
. . S PLAN=$P(^DGHBP(25.11,HBIEN,0),"^",1)
. . S HBP("PLAN",PLAN)=HBIEN
Q
;
SETPLAN(DFN,PLAN,SITE) ;Set Health Benefit Plan and History into file 25.01 and 25.02 for input DFN
; Current data plans will also be filed into the history so that history will contain all
; additions and deletions for the patient
;
N DATETIME,DGENDA,DATA,SUCCESS
; Gather and save DATETIME for both files
D NOW^%DTC S DATETIME=%
S DGENDA(1)=DFN
S DATA(.01)=PLAN ;Current HBP Code
S DATA(1)=DATETIME ;Assigned Date/Time
S DATA(2)=DUZ ;Assigned Entered By
S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;Assigned Entered Site
S DATA(4)=$S($G(SITE)="":"V",1:"E") ;Current Source
; Update Current Health Benefit Plan into DB
S SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA) ;DG*5.3*871 modified 25.01 to 2.511
I SUCCESS D EVENT^IVMPLOG(DFN) ;trigger for HL7
;
; Reset Data for History - DGENDA remains unchanged
N DGENDA,DATA,SUCCESS
S DGENDA(1)=DFN
S DATA(.01)=DATETIME ;History HBP Date/Time
S DATA(1)=PLAN ;History HBP Code
S DATA(2)=DUZ ;Assigned Entered By
S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;Assigned Entered Site
S DATA(4)="A" ;History Assignment
S DATA(5)=$S($G(SITE)="":"V",1:"E") ;History Source
; Update History into DB
S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
Q
;
DELPLAN(DFN,PLAN,SITE) ;Delete Health Benefit Plan and set History into file 25.01 and 25.02 for input DFN
N DATETIME,DGENDA,DA,DIK,DATA,SUCCESS
; Gather and save DATETIME for both files
D NOW^%DTC S DATETIME=%
S (DGENDA(1),DA(1))=DFN
S DA=$O(^DPT(DA(1),"HBP","B",PLAN,""))
; Delete Health Benefit Plan from DB
S DIK="^DPT("_DA(1)_","_"""HBP"""_","
D ^DIK K DIK
;
; Reset Data for History - DGENDA remains unchanged
S DATA(.01)=DATETIME ;History HBP Date/Time
S DATA(1)=PLAN ;History HBP Code
S DATA(2)=DUZ ;History Entered By
S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;History Entered Site
S DATA(4)="U" ;History Assignment - CCR 13614 - Change D to U
S DATA(5)=$S($G(SITE)="":"V",1:"E") ;History Source
; Update History into DB
; DG*5.3*871
S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
Q
;
HL7UPD(DFN,DGHBP,MSHDATE) ; Store HL7 Health Benefit Plan (HBP) data in PATIENT file (#2)
N OCC,HBPNOD,HL7DATA,ADDHBP
;
; Build an array of HBP codes to be added or retained in VistA - saving the date/time for storage
S OCC=0 F S OCC=$O(DGHBP(OCC)) Q:OCC="" S ADDHBP($P(DGHBP(OCC),U,1))=""
;
S OCC=0 F S OCC=$O(^DPT(DFN,"HBP",OCC)) Q:OCC<1 D
. S HBPNOD=$G(^DPT(DFN,"HBP",OCC,0))
. ; If HBP code exists on Z11 and VistA, Source to "E", and do not delete or store history
. I $D(ADDHBP($P(HBPNOD,U,1))) S $P(^DPT(DFN,"HBP",OCC,0),U,5)="E" Q
. ; Change Date/Time for deletion History to MSHDATE
. I $G(MSHDATE)'="" S $P(HBPNOD,U,2)=$$FMDATE^HLFNC(MSHDATE)
. D STORHIS(DFN,HBPNOD,"U") ;CCR 13614 - Change D to U (delete to unassigned)
. D DELCUR(DFN,$P(HBPNOD,U))
;
; Add Z11 HBP data to PATIENT file (#2)
I $D(DGHBP) D
. S OCC=0 F S OCC=$O(DGHBP(OCC)) Q:OCC="" D
. . S HL7DATA=DGHBP(OCC)
. . ; Quit if the HBP Code is already set for patient (would have been set by loop above)
. . I $D(^DPT(DFN,"HBP","B",$P(HL7DATA,U,1))) Q
. . D STORCUR(DFN,HL7DATA)
. . D STORHIS(DFN,HL7DATA,"A")
Q
;
STORCUR(DFN,STORDATA) ; Store Current data
N DGENDA,DATA,SUCCESS
S DGENDA(1)=DFN ;Patient DFN
S DATA(.01)=$P(STORDATA,U) ;Current HBP Code
S DATA(1)=$P(STORDATA,U,2) ;Assigned Date/Time
S DATA(2)=$P(STORDATA,U,3) ;Assigned Entered By
S DATA(3)=$P(STORDATA,U,4) ;Assigned Entered Site
S DATA(4)=$P(STORDATA,U,5) ;Current Source
S SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA) ;DG*5.3*871 modified 25.01 to 2.511
Q
;
STORHIS(DFN,STORDATA,ACTION) ; Store History data
N DGENDA,DATA,SUCCESS
S DGENDA(1)=DFN ;Patient DFN
S DATA(.01)=$P(STORDATA,U,2) ;History HBP Date/Time
S DATA(1)=$P(STORDATA,U) ;History HBP Code
S DATA(2)=$P(STORDATA,U,3) ;History Entered By
S DATA(3)=$P(STORDATA,U,4) ;History Entered Site
S DATA(4)=$G(ACTION) ;History Assignment
S DATA(5)=$P(STORDATA,U,5) ;History Source
S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
Q
;
DELCUR(DFN,HBPCODE) ; Delete entry from Current data
N DGENDA,DA,DIK
S (DGENDA(1),DA(1))=DFN
S DA=$O(^DPT(DA(1),"HBP","B",HBPCODE,""))
S DIK="^DPT("_DA(1)_","_"""HBP"""_","
D ^DIK K DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGHBPUTL 7286 printed Dec 13, 2024@02:43:40 Page 2
DGHBPUTL ;ALB/PWC,JAM - Health Benefit Plan Utility Routine ;5/22/13 11:50am
+1 ;;5.3;Registration;**871,987**;08/13/93;Build 22
+2 ;
+3 ;
GETHBP(DFN) ;Return all records in HBP sub-file #25.01 in HBP array
+1 ; returns current information in HBP("CUR",PLAN NAME)=ENTIRE DATA FROM 25.01 DA
+2 ; returns current information in HBP("CUR",PLAN NAME,"IEN")=PLAN CODE
+3 ; returns history information in HBP("HIS",DA,DTTM)=PLAN NAME^ENTIRE DATA FROM 25.02 DA
+4 IF '$GET(DFN)
QUIT
+5 NEW SDT,HBDATA,HBCODE,HBNAME
KILL HBP("CUR"),HBP("HIS")
+6 SET SDT=0
SET (HBDATA,HBCODE)=""
+7 FOR
SET SDT=$ORDER(^DPT(DFN,"HBP",SDT))
if SDT<1
QUIT
Begin DoDot:1
+8 SET HBDATA=$GET(^DPT(DFN,"HBP",SDT,0))
SET HBCODE=$PIECE(HBDATA,"^",1)
+9 SET HBNAME=$PIECE($GET(^DGHBP(25.11,HBCODE,0)),"^",1)
if HBNAME=""
QUIT
+10 SET HBP("CUR",HBNAME)=HBDATA
+11 SET HBP("CUR",HBNAME,"IEN")=HBCODE
End DoDot:1
HBP1 SET SDT=0
SET (HBDATA,HBCODE)=""
+1 FOR
SET SDT=$ORDER(^DPT(DFN,"HBP1",SDT))
if SDT<1
QUIT
Begin DoDot:1
+2 SET HBDATA=$GET(^DPT(DFN,"HBP1",SDT,0))
SET HBCODE=$PIECE(HBDATA,"^",2)
+3 SET HBNAME=$PIECE($GET(^DGHBP(25.11,HBCODE,0)),"^",1)
if HBNAME=""
QUIT
+4 SET HBP("HIS",SDT,$PIECE(HBDATA,"^",1))=HBNAME_"^"_$PIECE(HBDATA,"^",2,99)
End DoDot:1
+5 QUIT
+6 ;
GETDETL(HBPNUM) ;Return detail for each HBP in an array for display purposes
+1 IF $GET(HBPNUM)=""
QUIT
+2 NEW DATA,CNT,LAST
KILL HBP("DETAIL")
+3 SET HBP("DETAIL",0)=$GET(^DGHBP(25.11,HBPNUM,2,0))
+4 IF HBP("DETAIL",0)=""
SET HBP("DETAIL",0)="0^No Detail Available."
QUIT
+5 SET LAST=$PIECE(HBP("DETAIL",0),"^",4)
+6 MERGE DATA=^DGHBP(25.11,HBPNUM,2)
+7 FOR CNT=1:1:LAST
SET HBP("DETAIL",HBPNUM,CNT)=DATA(CNT,0)
+8 QUIT
+9 ;
GETPLAN ; Return all Health Benefit Plans from file #25.11 in array
+1 NEW HBPLAN,HBIEN,PLAN
SET HBPLAN=""
KILL HBP("PLAN")
+2 FOR
SET HBPLAN=$ORDER(^DGHBP(25.11,"B",HBPLAN))
if HBPLAN=""
QUIT
Begin DoDot:1
+3 ; DG*5.3*987; jam; Fix for DGHBP array - "B" xref can have multiple IENs under a plan name
+4 SET HBIEN=""
+5 FOR
SET HBIEN=$ORDER(^DGHBP(25.11,"B",HBPLAN,HBIEN))
if HBIEN=""
QUIT
Begin DoDot:2
+6 SET PLAN=$PIECE(^DGHBP(25.11,HBIEN,0),"^",1)
+7 SET HBP("PLAN",PLAN)=HBIEN
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SETPLAN(DFN,PLAN,SITE) ;Set Health Benefit Plan and History into file 25.01 and 25.02 for input DFN
+1 ; Current data plans will also be filed into the history so that history will contain all
+2 ; additions and deletions for the patient
+3 ;
+4 NEW DATETIME,DGENDA,DATA,SUCCESS
+5 ; Gather and save DATETIME for both files
+6 DO NOW^%DTC
SET DATETIME=%
+7 SET DGENDA(1)=DFN
+8 ;Current HBP Code
SET DATA(.01)=PLAN
+9 ;Assigned Date/Time
SET DATA(1)=DATETIME
+10 ;Assigned Entered By
SET DATA(2)=DUZ
+11 ;Assigned Entered Site
SET DATA(3)=$SELECT($GET(SITE)="":$PIECE($$SITE^VASITE(),"^",1),1:SITE)
+12 ;Current Source
SET DATA(4)=$SELECT($GET(SITE)="":"V",1:"E")
+13 ; Update Current Health Benefit Plan into DB
+14 ;DG*5.3*871 modified 25.01 to 2.511
SET SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA)
+15 ;trigger for HL7
IF SUCCESS
DO EVENT^IVMPLOG(DFN)
+16 ;
+17 ; Reset Data for History - DGENDA remains unchanged
+18 NEW DGENDA,DATA,SUCCESS
+19 SET DGENDA(1)=DFN
+20 ;History HBP Date/Time
SET DATA(.01)=DATETIME
+21 ;History HBP Code
SET DATA(1)=PLAN
+22 ;Assigned Entered By
SET DATA(2)=DUZ
+23 ;Assigned Entered Site
SET DATA(3)=$SELECT($GET(SITE)="":$PIECE($$SITE^VASITE(),"^",1),1:SITE)
+24 ;History Assignment
SET DATA(4)="A"
+25 ;History Source
SET DATA(5)=$SELECT($GET(SITE)="":"V",1:"E")
+26 ; Update History into DB
+27 ;DG*5.3*871 modified 25.02 to 2.512
SET SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA)
+28 QUIT
+29 ;
DELPLAN(DFN,PLAN,SITE) ;Delete Health Benefit Plan and set History into file 25.01 and 25.02 for input DFN
+1 NEW DATETIME,DGENDA,DA,DIK,DATA,SUCCESS
+2 ; Gather and save DATETIME for both files
+3 DO NOW^%DTC
SET DATETIME=%
+4 SET (DGENDA(1),DA(1))=DFN
+5 SET DA=$ORDER(^DPT(DA(1),"HBP","B",PLAN,""))
+6 ; Delete Health Benefit Plan from DB
+7 SET DIK="^DPT("_DA(1)_","_"""HBP"""_","
+8 DO ^DIK
KILL DIK
+9 ;
+10 ; Reset Data for History - DGENDA remains unchanged
+11 ;History HBP Date/Time
SET DATA(.01)=DATETIME
+12 ;History HBP Code
SET DATA(1)=PLAN
+13 ;History Entered By
SET DATA(2)=DUZ
+14 ;History Entered Site
SET DATA(3)=$SELECT($GET(SITE)="":$PIECE($$SITE^VASITE(),"^",1),1:SITE)
+15 ;History Assignment - CCR 13614 - Change D to U
SET DATA(4)="U"
+16 ;History Source
SET DATA(5)=$SELECT($GET(SITE)="":"V",1:"E")
+17 ; Update History into DB
+18 ; DG*5.3*871
+19 ;DG*5.3*871 modified 25.02 to 2.512
SET SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA)
+20 QUIT
+21 ;
HL7UPD(DFN,DGHBP,MSHDATE) ; Store HL7 Health Benefit Plan (HBP) data in PATIENT file (#2)
+1 NEW OCC,HBPNOD,HL7DATA,ADDHBP
+2 ;
+3 ; Build an array of HBP codes to be added or retained in VistA - saving the date/time for storage
+4 SET OCC=0
FOR
SET OCC=$ORDER(DGHBP(OCC))
if OCC=""
QUIT
SET ADDHBP($PIECE(DGHBP(OCC),U,1))=""
+5 ;
+6 SET OCC=0
FOR
SET OCC=$ORDER(^DPT(DFN,"HBP",OCC))
if OCC<1
QUIT
Begin DoDot:1
+7 SET HBPNOD=$GET(^DPT(DFN,"HBP",OCC,0))
+8 ; If HBP code exists on Z11 and VistA, Source to "E", and do not delete or store history
+9 IF $DATA(ADDHBP($PIECE(HBPNOD,U,1)))
SET $PIECE(^DPT(DFN,"HBP",OCC,0),U,5)="E"
QUIT
+10 ; Change Date/Time for deletion History to MSHDATE
+11 IF $GET(MSHDATE)'=""
SET $PIECE(HBPNOD,U,2)=$$FMDATE^HLFNC(MSHDATE)
+12 ;CCR 13614 - Change D to U (delete to unassigned)
DO STORHIS(DFN,HBPNOD,"U")
+13 DO DELCUR(DFN,$PIECE(HBPNOD,U))
End DoDot:1
+14 ;
+15 ; Add Z11 HBP data to PATIENT file (#2)
+16 IF $DATA(DGHBP)
Begin DoDot:1
+17 SET OCC=0
FOR
SET OCC=$ORDER(DGHBP(OCC))
if OCC=""
QUIT
Begin DoDot:2
+18 SET HL7DATA=DGHBP(OCC)
+19 ; Quit if the HBP Code is already set for patient (would have been set by loop above)
+20 IF $DATA(^DPT(DFN,"HBP","B",$PIECE(HL7DATA,U,1)))
QUIT
+21 DO STORCUR(DFN,HL7DATA)
+22 DO STORHIS(DFN,HL7DATA,"A")
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
STORCUR(DFN,STORDATA) ; Store Current data
+1 NEW DGENDA,DATA,SUCCESS
+2 ;Patient DFN
SET DGENDA(1)=DFN
+3 ;Current HBP Code
SET DATA(.01)=$PIECE(STORDATA,U)
+4 ;Assigned Date/Time
SET DATA(1)=$PIECE(STORDATA,U,2)
+5 ;Assigned Entered By
SET DATA(2)=$PIECE(STORDATA,U,3)
+6 ;Assigned Entered Site
SET DATA(3)=$PIECE(STORDATA,U,4)
+7 ;Current Source
SET DATA(4)=$PIECE(STORDATA,U,5)
+8 ;DG*5.3*871 modified 25.01 to 2.511
SET SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA)
+9 QUIT
+10 ;
STORHIS(DFN,STORDATA,ACTION) ; Store History data
+1 NEW DGENDA,DATA,SUCCESS
+2 ;Patient DFN
SET DGENDA(1)=DFN
+3 ;History HBP Date/Time
SET DATA(.01)=$PIECE(STORDATA,U,2)
+4 ;History HBP Code
SET DATA(1)=$PIECE(STORDATA,U)
+5 ;History Entered By
SET DATA(2)=$PIECE(STORDATA,U,3)
+6 ;History Entered Site
SET DATA(3)=$PIECE(STORDATA,U,4)
+7 ;History Assignment
SET DATA(4)=$GET(ACTION)
+8 ;History Source
SET DATA(5)=$PIECE(STORDATA,U,5)
+9 ;DG*5.3*871 modified 25.02 to 2.512
SET SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA)
+10 QUIT
+11 ;
DELCUR(DFN,HBPCODE) ; Delete entry from Current data
+1 NEW DGENDA,DA,DIK
+2 SET (DGENDA(1),DA(1))=DFN
+3 SET DA=$ORDER(^DPT(DA(1),"HBP","B",HBPCODE,""))
+4 SET DIK="^DPT("_DA(1)_","_"""HBP"""_","
+5 DO ^DIK
KILL DIK
+6 QUIT
