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

EASMTRP1.m

Go to the documentation of this file.
  1. EASMTRP1 ;ALB/GAH - MEANS TEST DAILY EXPIRATION REPORT ; 10/10/2006
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,13,46,77**;MAR 15,2001;Build 11
  1. ;
  1. EN ; Interactive report generation, select date range
  1. N EDATE,ERROR,MTREC,PIEN,VARR,RCNT,ACNT,DGARRAY,SDCNT,I
  1. ;
  1. D HOME^%ZIS
  1. W @IOF
  1. ;
  1. ; Get beginning date of date range, default to TODAY
  1. W !,$CHAR(7),"Enter date range for anniversary date search"
  1. S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
  1. S DIR("A")=" Start Date"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EASBEG=Y
  1. ;
  1. ; Get ending date of date range, default to TODAY
  1. S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
  1. S DIR("A")=" End Date"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EASEND=Y
  1. ;
  1. S EAX=$$GET1^DIQ(713,1,5)
  1. S:EAX]"" %ZIS("B")=EAX
  1. S ZTSAVE("EASBEG")="",ZTSAVE("EASEND")=""
  1. D EN^XUTMDEVQ("BLD^EASMTRP1","EAS MT EXPIRATION RPT",.ZTSAVE,.%ZIS)
  1. Q
  1. ;
  1. QUE ; Queued report generation
  1. N ZTSAVE,ZTRTN,ZTDESC,EAX,%ZIS
  1. ;
  1. S (EASBEG,EASEND)=$$FMADD^XLFDT($$DT^XLFDT,-1)
  1. S ZTSAVE("EASBEG")="",ZTSAVE("EASEND")=""
  1. S IOP=""
  1. D EN^XUTMDEVQ("BLD^EASMTRP1","EAS MT EXPIRATION RPT",.ZTSAVE)
  1. Q
  1. ;
  1. BLD ; Build the list of MT expirations to TMP global
  1. N EASIEN,EASANV,EASLST,EASENDT,DFN,EASTMP,EASDT,EASENDT
  1. ;
  1. K ^TMP("EASEXP",$J)
  1. ;
  1. S EASENDT=$$FMADD^XLFDT(EASEND,-365)
  1. S EASANV=$$FMADD^XLFDT(EASBEG,-365,"",-1) ; Subtract 1 minute to capture the 1st day
  1. F S EASANV=$O(^DGMT(408.31,"B",EASANV)) Q:'EASANV!(EASANV>EASENDT) D
  1. . S EASIEN=0
  1. . F S EASIEN=$O(^DGMT(408.31,"B",EASANV,EASIEN)) Q:'EASIEN D
  1. . . S DFN=$$GET1^DIQ(408.31,EASIEN,.02,"I") Q:+DFN=0
  1. . . S EASLST=$$LST^DGMTU(DFN)
  1. . . Q:+EASLST'=EASIEN ; Quit it this MT is not the last MT on file
  1. . . Q:$$DECEASED^EASMTUTL("",DFN) ; Quit if patient is deceased
  1. . . Q:"N,P"[$P(EASLST,U,4) ; Quit if MT No longer Required or Pending Adjudication
  1. . . ; Quit if Cat C, agrees to deductible and MT later the 10-5-99
  1. . . I $P(EASLST,U,4)="C",$$GET1^DIQ(408.31,+EASLST,.11,"I"),$P(EASLST,U,2)>2991005 Q
  1. . . ;;Q:$$FUTMT^EASMTUTL("","",DFN) ; Quit if future MT on file
  1. . . S ^TMP("EASEXP",$J,EASANV,EASIEN)=DFN_U_EASLST
  1. ;
  1. S EASTMP="^TMP(""EASEXP"","_$J_")"
  1. S EASDT("BEG")=EASBEG,EASDT("END")=EASEND
  1. D BLDSD ; Call Scheduling API
  1. D PRT(EASTMP,.EASDT) ; Call print report
  1. K DGARRAY,SDCNT,VARR,I,^TMP($J,"SDAMA")
  1. Q
  1. ;
  1. BLDSD ;
  1. N EDATE,ERROR,MTREC,PIEN,VARR,RCNT,ACNT,DGARRAY,SDCNT,I
  1. S ACNT=1,RCNT=0
  1. S EDATE=0 F S EDATE=$O(^TMP("EASEXP",$J,EDATE)) Q:'EDATE D
  1. .S MTREC=0 F S MTREC=$O(^TMP("EASEXP",$J,EDATE,MTREC)) Q:'MTREC D
  1. ..S PIEN=+^TMP("EASEXP",$J,EDATE,MTREC)
  1. ..Q:'$D(^DPT(PIEN,0))
  1. ..S RCNT=RCNT+1,VARR(ACNT)=$G(VARR(ACNT))_PIEN_";"
  1. ..; Group DFNs by no more than twenty records
  1. ..I RCNT>19 S ACNT=ACNT+1,RCNT=0
  1. ;
  1. ; Call SD API by array of Patient DFNs
  1. S ERROR=""
  1. K DGARRAY
  1. S DGARRAY(1)=DT,DGARRAY("SORT")="P",DGARRAY("FLDS")="1;2"
  1. F I=1:1 Q:'$D(VARR(I))!(ERROR'="") D
  1. .S DGARRAY(4)=VARR(I)
  1. .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
  1. . I SDCNT>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
  1. . I SDCNT<0 D
  1. . . S ERROR=$O(^TMP($J,"SDAMA301",""))
  1. . . S ^TMP($J,"SDAMA","ERROR")=^TMP($J,"SDAMA301",ERROR)
  1. .K ^TMP($J,"SDAMA301")
  1. Q
  1. ;
  1. PRT(EASTMP,EASDT) ;
  1. N EASANV,EASIEN,PAGE,DFN,EASP,EASABRT
  1. ;
  1. S EASANV=0,PAGE=0
  1. D HDR(.EASDT)
  1. ;
  1. I '$D(@EASTMP) D Q
  1. . W !!?3,">> No Means Test expirations for the selected date range."
  1. ;
  1. F S EASANV=$O(@EASTMP@(EASANV)) Q:'EASANV D Q:$G(EASABRT)
  1. . S EASIEN=0
  1. . F S EASIEN=$O(@EASTMP@(EASANV,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
  1. . . S EASDAT=@EASTMP@(EASANV,EASIEN)
  1. . . D PRTLINE(EASANV,EASDAT) ; Get data and format print line
  1. . . I $E(IOST,1,2)="C-",($Y+5)>IOSL D
  1. . . . S DIR(0)="E"
  1. . . . D ^DIR K DIR
  1. . . . I 'Y S EASABRT=1 Q
  1. . . . D HDR(.EASDT)
  1. Q
  1. ;
  1. PRTLINE(EASANV,EASDAT) ; Format and print report line
  1. N DFN,EASNAME,EASTAT,EASAPT,EASF,EACL
  1. ;
  1. S DFN=$P(EASDAT,U)
  1. S EASNAME=$$GET1^DIQ(2,DFN,.01)
  1. W !,$E(EASNAME,1,20)
  1. ;
  1. D PID^VADPT6
  1. W ?22,VA("PID")
  1. ;
  1. W ?35,$TR($$FMTE^XLFDT($$FMADD^XLFDT(EASANV,365),"2F")," ","0")
  1. S EASTAT=$P(EASDAT,U,5)
  1. W ?46,$S(EASTAT="C":"MT CPR",EASTAT="A":"MT CPE",EASTAT="R":"REQD",EASTAT="N":"NA",EASTAT="P":"PEND",EASTAT="G":"GMT CPR",1:"")
  1. ;
  1. I $D(^TMP($J,"SDAMA","ERROR")) Q
  1. D GETAPT(DFN,.EASAPT)
  1. I $D(EASAPT) D
  1. . S EACL=0 F S EACL=$O(EASAPT(EACL)) Q:'EACL D
  1. . . W:$G(EASF) !
  1. . . W ?55,$E($$GET1^DIQ(44,EACL,.01),1,15)," ",$$FMTE^XLFDT(EASAPT(EACL),"2D")
  1. . . S EASF=1
  1. ;
  1. D KVA^VADPT
  1. Q
  1. ;
  1. GETAPT(DFN,EASAPT) ; Get future appointments for patient
  1. N EASAP,EASND,EASCL
  1. Q:'$D(^TMP($J,"SDAMA",DFN))
  1. S EASAP=0 F S EASAP=$O(^TMP($J,"SDAMA",DFN,EASAP)) Q:'EASAP D
  1. .S EASND=^TMP($J,"SDAMA",DFN,EASAP)
  1. .S EASCL=+$P(EASND,U,2),EASAPT(EASCL)=+EASND
  1. Q
  1. ;
  1. HDR(EASDT) ; Print report header
  1. N ERROR,LINE,SPACE,TXT,HDR,TAB
  1. ;
  1. I $E(IOST,1,2)="C-" W @IOF
  1. S TXT="Means Test Expiration Report"
  1. S SPACE=(IOM-$L(TXT))/2
  1. S $P(HDR," ",SPACE)="",HDR=HDR_TXT
  1. W !,HDR K HDR
  1. ;
  1. S TXT="Anniversary Date(s): "_$$FMTE^XLFDT(EASDT("BEG"),"5D")_" - "_$$FMTE^XLFDT(EASDT("END"),"5D")
  1. S SPACE=(IOM-$L(TXT))/2
  1. S $P(HDR," ",SPACE)="",HDR=HDR_TXT
  1. W !,HDR K HDR
  1. ;
  1. W !!,"Printed: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. S PAGE=$G(PAGE)+1
  1. S TAB=IOM-8
  1. W ?TAB,"Page "_PAGE
  1. S ERROR=$G(^TMP($J,"SDAMA","ERROR"))
  1. W:ERROR'="" !,"Appointment Error: ",ERROR
  1. ;
  1. W !,"Patient",?25,"SSN",?35,"MT Expired",?46,"Status",?57,"Future Appts"
  1. S $P(LINE,"=",IOM)="" W !,LINE
  1. Q