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

DGCOMPACTELIG.m

Go to the documentation of this file.
  1. DGCOMPACTELIG ;ALB/BPA,CMC - Routine for COMPACT Act Eligibility;04/29/2024@11:30AM
  1. ;;5.3;Registration;**1104**;Aug 13, 1993;Build 59
  1. ; *1104* API for COMPACT Act Administrative Eligibility
  1. ; Reference to FILEMANERR^PXCOMPACT1 in ICR #7469
  1. ;
  1. Q
  1. ELIG(DFN,RTN) ;
  1. ;DFN - Internal Patient ID *(required)
  1. ;RTN - original calling routine (required)
  1. N DA,DGXTMPDTTM,ELIG,NOW,VACOM,XTMPSUB
  1. I $G(RTN)="" S RTN="NO ROUTINE"
  1. S DGXTMPDTTM="",NOW=$$NOW^XLFDT,ELIG="UNDETERMINED",XTMPSUB="DGCOMPACTELIG"_DT
  1. ;Determine and return admin eligibility (ELIGIBLE, NOT ELIGIBLE or UNDETERMINED)
  1. D CAI^VADPT
  1. I VACOM("CAI")=1 S ELIG="ELIGIBLE" Q ELIG
  1. D CHECKCACHE(DFN,NOW,XTMPSUB)
  1. I '$D(^XTMP("DGELIG",XTMPSUB,DFN)) S ELIG=$$WEBSRVC(DFN,$G(RTN))
  1. E D
  1. . S DGXTMPDTTM=$O(^XTMP("DGELIG",XTMPSUB,DFN,DGXTMPDTTM))
  1. . S ELIG=$$CHECKDFN(DFN,XTMPSUB,$G(RTN),NOW,DGXTMPDTTM)
  1. Q ELIG
  1. ;
  1. CHECKCACHE(DFN,NOW,XTMPSUB) ;
  1. N DGELIGDTTM,PURGDT,XTMPDT
  1. ; Look for expired cache to clean it up, use $O and removed them
  1. S XTMPDT=""
  1. F S XTMPDT=$O(^XTMP("DGELIG",XTMPDT)) Q:(XTMPDT="") D
  1. . S PURGDT=$P(^XTMP("DGELIG",XTMPDT,0),"^",1)
  1. . I $P(NOW,".")>$P(PURGDT,".") K ^XTMP("DGELIG",XTMPDT)
  1. I '$D(^XTMP("DGELIG",XTMPSUB)) D
  1. . S PURGDT=DT_".1159"
  1. . S ^XTMP("DGELIG",XTMPSUB,0)=PURGDT_U_DT_U_"COMPACT Act administrative eligibility"
  1. Q
  1. ;
  1. CHECKDFN(DFN,XTMPSUB,RTN,NOW,DTTM) ;
  1. ;If the current time is more than two hours (7200 seconds) past the last stored eligibility,
  1. ;kill the stored value and check for changes
  1. I $$FMDIFF^XLFDT(NOW,DTTM,2)>7200 D
  1. . K ^XTMP("DGELIG",XTMPSUB,DFN,DTTM)
  1. . S ELIG=$$WEBSRVC(DFN,RTN)
  1. E S ELIG=$P(^XTMP("DGELIG",XTMPSUB,DFN,DTTM),U,1)
  1. Q ELIG
  1. ;
  1. WEBSRVC(DFN,DGRTN) ;
  1. N DGCOMP,DGKEY,DGREQNAME,DGREQDTTM,DGRESP,DGRESPDTTM,ELIG,PURGDT,PURGSEQ,VAEL
  1. S (DGCOMP,DGKEY,DGREQNAME,DGREQDTTM,DGRESP,DGRESPDTTM,PURGDT,PURGSEQ)="",ELIG="UNDETERMINED"
  1. S DGKEY=$$GETICN^MPIF001(DFN),DGREQNAME="VistADataVTwo"
  1. I $P(DGKEY,"^",1)'=-1 D
  1. . S DGREQDTTM=$$NOW^XLFDT
  1. . S DGRESP=$$EN^DGREGEEWS(DGKEY,DGREQNAME,"","",.DGCOMP)
  1. . S DGRESPDTTM=$$NOW^XLFDT
  1. ;
  1. I $P(DGRESP,"^",1)=1 D
  1. . I DGCOMP="No" S ELIG="NOT ELIGIBLE"
  1. . I DGCOMP="Yes" S ELIG="ELIGIBLE"
  1. ;
  1. S ^XTMP("DGELIG",XTMPSUB,DFN,$$NOW^XLFDT)=ELIG_"^"_DFN_"^"_$G(DGRTN)
  1. ;Processing for Transaction Log here
  1. I $P(DGKEY,"^",1)'=-1 D
  1. . S DGRESP=$TR(DGRESP,"^","~")
  1. . N CMPMSG,DGIEN,TRDATA
  1. . S DGIEN="+1,"
  1. . S TRDATA(33.3,DGIEN,.01)=DGKEY
  1. . S TRDATA(33.3,DGIEN,2)=DGRTN
  1. . S TRDATA(33.3,DGIEN,3)=DGREQDTTM
  1. . S TRDATA(33.3,DGIEN,4)=DGRESP
  1. . S TRDATA(33.3,DGIEN,5)=DGRESPDTTM
  1. . D UPDATE^DIE("","TRDATA","","CMPMSG")
  1. . I $D(CMPMSG("DIERR")) D FILEMANERR^PXCOMPACT1(DFN,.TRDATA,.CMPMSG)
  1. ;
  1. S PURGDT=$O(^DGCOMP(33.3,"C","")) I $$FMDIFF^XLFDT(DT,PURGDT,1)>29 D
  1. . F S PURGSEQ=$O(^DGCOMP(33.3,"C",PURGDT,PURGSEQ)) Q:PURGSEQ="" D
  1. . . ;Loop through the "C" level to purge data
  1. . . S DIK="^DGCOMP(33.3,"
  1. . . S DA=PURGSEQ
  1. . . D ^DIK
  1. . . K DA,DIK
  1. ;
  1. Q ELIG