- 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 Feb 19, 2025@00:09:43 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