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