Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGHBPUTL

DGHBPUTL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. 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
  1. ; returns current information in HBP("CUR",PLAN NAME,"IEN")=PLAN CODE
  1. ; returns history information in HBP("HIS",DA,DTTM)=PLAN NAME^ENTIRE DATA FROM 25.02 DA
  1. I '$G(DFN) Q
  1. N SDT,HBDATA,HBCODE,HBNAME K HBP("CUR"),HBP("HIS")
  1. S SDT=0,(HBDATA,HBCODE)=""
  1. F S SDT=$O(^DPT(DFN,"HBP",SDT)) Q:SDT<1 D
  1. . S HBDATA=$G(^DPT(DFN,"HBP",SDT,0)),HBCODE=$P(HBDATA,"^",1)
  1. . S HBNAME=$P($G(^DGHBP(25.11,HBCODE,0)),"^",1) Q:HBNAME=""
  1. . S HBP("CUR",HBNAME)=HBDATA
  1. . S HBP("CUR",HBNAME,"IEN")=HBCODE
  1. HBP1 S SDT=0,(HBDATA,HBCODE)=""
  1. F S SDT=$O(^DPT(DFN,"HBP1",SDT)) Q:SDT<1 D
  1. . S HBDATA=$G(^DPT(DFN,"HBP1",SDT,0)),HBCODE=$P(HBDATA,"^",2)
  1. . S HBNAME=$P($G(^DGHBP(25.11,HBCODE,0)),"^",1) Q:HBNAME=""
  1. . S HBP("HIS",SDT,$P(HBDATA,"^",1))=HBNAME_"^"_$P(HBDATA,"^",2,99)
  1. Q
  1. ;
  1. GETDETL(HBPNUM) ;Return detail for each HBP in an array for display purposes
  1. I $G(HBPNUM)="" Q
  1. N DATA,CNT,LAST K HBP("DETAIL")
  1. S HBP("DETAIL",0)=$G(^DGHBP(25.11,HBPNUM,2,0))
  1. I HBP("DETAIL",0)="" S HBP("DETAIL",0)="0^No Detail Available." Q
  1. S LAST=$P(HBP("DETAIL",0),"^",4)
  1. M DATA=^DGHBP(25.11,HBPNUM,2)
  1. F CNT=1:1:LAST S HBP("DETAIL",HBPNUM,CNT)=DATA(CNT,0)
  1. Q
  1. ;
  1. GETPLAN ; Return all Health Benefit Plans from file #25.11 in array
  1. N HBPLAN,HBIEN,PLAN S HBPLAN="" K HBP("PLAN")
  1. F S HBPLAN=$O(^DGHBP(25.11,"B",HBPLAN)) Q:HBPLAN="" D
  1. . ; DG*5.3*987; jam; Fix for DGHBP array - "B" xref can have multiple IENs under a plan name
  1. . S HBIEN=""
  1. . F S HBIEN=$O(^DGHBP(25.11,"B",HBPLAN,HBIEN)) Q:HBIEN="" D
  1. . . S PLAN=$P(^DGHBP(25.11,HBIEN,0),"^",1)
  1. . . S HBP("PLAN",PLAN)=HBIEN
  1. Q
  1. ;
  1. 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
  1. ; additions and deletions for the patient
  1. ;
  1. N DATETIME,DGENDA,DATA,SUCCESS
  1. ; Gather and save DATETIME for both files
  1. D NOW^%DTC S DATETIME=%
  1. S DGENDA(1)=DFN
  1. S DATA(.01)=PLAN ;Current HBP Code
  1. S DATA(1)=DATETIME ;Assigned Date/Time
  1. S DATA(2)=DUZ ;Assigned Entered By
  1. S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;Assigned Entered Site
  1. S DATA(4)=$S($G(SITE)="":"V",1:"E") ;Current Source
  1. ; Update Current Health Benefit Plan into DB
  1. S SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA) ;DG*5.3*871 modified 25.01 to 2.511
  1. I SUCCESS D EVENT^IVMPLOG(DFN) ;trigger for HL7
  1. ;
  1. ; Reset Data for History - DGENDA remains unchanged
  1. N DGENDA,DATA,SUCCESS
  1. S DGENDA(1)=DFN
  1. S DATA(.01)=DATETIME ;History HBP Date/Time
  1. S DATA(1)=PLAN ;History HBP Code
  1. S DATA(2)=DUZ ;Assigned Entered By
  1. S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;Assigned Entered Site
  1. S DATA(4)="A" ;History Assignment
  1. S DATA(5)=$S($G(SITE)="":"V",1:"E") ;History Source
  1. ; Update History into DB
  1. S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
  1. Q
  1. ;
  1. DELPLAN(DFN,PLAN,SITE) ;Delete Health Benefit Plan and set History into file 25.01 and 25.02 for input DFN
  1. N DATETIME,DGENDA,DA,DIK,DATA,SUCCESS
  1. ; Gather and save DATETIME for both files
  1. D NOW^%DTC S DATETIME=%
  1. S (DGENDA(1),DA(1))=DFN
  1. S DA=$O(^DPT(DA(1),"HBP","B",PLAN,""))
  1. ; Delete Health Benefit Plan from DB
  1. S DIK="^DPT("_DA(1)_","_"""HBP"""_","
  1. D ^DIK K DIK
  1. ;
  1. ; Reset Data for History - DGENDA remains unchanged
  1. S DATA(.01)=DATETIME ;History HBP Date/Time
  1. S DATA(1)=PLAN ;History HBP Code
  1. S DATA(2)=DUZ ;History Entered By
  1. S DATA(3)=$S($G(SITE)="":$P($$SITE^VASITE(),"^",1),1:SITE) ;History Entered Site
  1. S DATA(4)="U" ;History Assignment - CCR 13614 - Change D to U
  1. S DATA(5)=$S($G(SITE)="":"V",1:"E") ;History Source
  1. ; Update History into DB
  1. ; DG*5.3*871
  1. S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
  1. Q
  1. ;
  1. HL7UPD(DFN,DGHBP,MSHDATE) ; Store HL7 Health Benefit Plan (HBP) data in PATIENT file (#2)
  1. N OCC,HBPNOD,HL7DATA,ADDHBP
  1. ;
  1. ; Build an array of HBP codes to be added or retained in VistA - saving the date/time for storage
  1. S OCC=0 F S OCC=$O(DGHBP(OCC)) Q:OCC="" S ADDHBP($P(DGHBP(OCC),U,1))=""
  1. ;
  1. S OCC=0 F S OCC=$O(^DPT(DFN,"HBP",OCC)) Q:OCC<1 D
  1. . S HBPNOD=$G(^DPT(DFN,"HBP",OCC,0))
  1. . ; If HBP code exists on Z11 and VistA, Source to "E", and do not delete or store history
  1. . I $D(ADDHBP($P(HBPNOD,U,1))) S $P(^DPT(DFN,"HBP",OCC,0),U,5)="E" Q
  1. . ; Change Date/Time for deletion History to MSHDATE
  1. . I $G(MSHDATE)'="" S $P(HBPNOD,U,2)=$$FMDATE^HLFNC(MSHDATE)
  1. . D STORHIS(DFN,HBPNOD,"U") ;CCR 13614 - Change D to U (delete to unassigned)
  1. . D DELCUR(DFN,$P(HBPNOD,U))
  1. ;
  1. ; Add Z11 HBP data to PATIENT file (#2)
  1. I $D(DGHBP) D
  1. . S OCC=0 F S OCC=$O(DGHBP(OCC)) Q:OCC="" D
  1. . . S HL7DATA=DGHBP(OCC)
  1. . . ; Quit if the HBP Code is already set for patient (would have been set by loop above)
  1. . . I $D(^DPT(DFN,"HBP","B",$P(HL7DATA,U,1))) Q
  1. . . D STORCUR(DFN,HL7DATA)
  1. . . D STORHIS(DFN,HL7DATA,"A")
  1. Q
  1. ;
  1. STORCUR(DFN,STORDATA) ; Store Current data
  1. N DGENDA,DATA,SUCCESS
  1. S DGENDA(1)=DFN ;Patient DFN
  1. S DATA(.01)=$P(STORDATA,U) ;Current HBP Code
  1. S DATA(1)=$P(STORDATA,U,2) ;Assigned Date/Time
  1. S DATA(2)=$P(STORDATA,U,3) ;Assigned Entered By
  1. S DATA(3)=$P(STORDATA,U,4) ;Assigned Entered Site
  1. S DATA(4)=$P(STORDATA,U,5) ;Current Source
  1. S SUCCESS=$$ADD^DGENDBS(2.2511,.DGENDA,.DATA) ;DG*5.3*871 modified 25.01 to 2.511
  1. Q
  1. ;
  1. STORHIS(DFN,STORDATA,ACTION) ; Store History data
  1. N DGENDA,DATA,SUCCESS
  1. S DGENDA(1)=DFN ;Patient DFN
  1. S DATA(.01)=$P(STORDATA,U,2) ;History HBP Date/Time
  1. S DATA(1)=$P(STORDATA,U) ;History HBP Code
  1. S DATA(2)=$P(STORDATA,U,3) ;History Entered By
  1. S DATA(3)=$P(STORDATA,U,4) ;History Entered Site
  1. S DATA(4)=$G(ACTION) ;History Assignment
  1. S DATA(5)=$P(STORDATA,U,5) ;History Source
  1. S SUCCESS=$$ADD^DGENDBS(2.2512,.DGENDA,.DATA) ;DG*5.3*871 modified 25.02 to 2.512
  1. Q
  1. ;
  1. DELCUR(DFN,HBPCODE) ; Delete entry from Current data
  1. N DGENDA,DA,DIK
  1. S (DGENDA(1),DA(1))=DFN
  1. S DA=$O(^DPT(DA(1),"HBP","B",HBPCODE,""))
  1. S DIK="^DPT("_DA(1)_","_"""HBP"""_","
  1. D ^DIK K DIK
  1. Q