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

EASMTRP3.m

Go to the documentation of this file.
  1. EASMTRP3 ; ALB/GAH - MEANS TEST ANV DATES BY APPT DATE ; 10/10/2006
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,15,46,64,77**;MAR 15,2001;Build 11
  1. ;
  1. QUE ; Que off the appointment list search by MT anniversary date
  1. N EASDT,ZTSAVE
  1. ;
  1. S DIR(0)="DAO^DT::EX"
  1. S DIR("B")="TODAY",DIR("A")="Run report for date: ",DIR("?")="^D HELP^%DTC"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EASDT=Y
  1. ;
  1. S ZTSAVE("EASDT")=""
  1. D EN^XUTMDEVQ("EN^EASMTRP3","EAS MT DUE BY APPOINTMENT RPT",.ZTSAVE)
  1. Q
  1. ;
  1. EN ; Main entry point for appointment list by MT anniversary date
  1. N EASSC,ERROR,PAGE,ACNT,RCNT,DGARRAY,I,CLARR,SDCNT,DGADDF,DGMSGF,DGREQF
  1. K ^TMP("EASAP",$J)
  1. S PAGE=1,^TMP("EASAP",$J,"APDT")=EASDT
  1. ;
  1. ; Build Array of Valid Clinic IENs
  1. S ACNT=1,(RCNT,EASSC)=0 F S EASSC=$O(^SC(EASSC)) Q:'EASSC D
  1. .Q:'$D(^SC(EASSC,0))
  1. .Q:$P(^SC(EASSC,0),U,3)'="C"
  1. .S RCNT=RCNT+1,CLARR(ACNT)=$G(CLARR(ACNT))_EASSC_";"
  1. .; Group Clinic IENs by no more than thirty
  1. .I RCNT>29 S ACNT=ACNT+1,RCNT=0
  1. ;
  1. ; Call SD API by array of Clinic IENs
  1. S DGARRAY(1)=EASDT_";"_EASDT,DGARRAY("FLDS")="1;3"
  1. F I=1:1 Q:'$D(CLARR(I)) D
  1. .S DGARRAY(2)=CLARR(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",CLARR(I))=^TMP($J,"SDAMA301",ERROR)
  1. .K ^TMP($J,"SDAMA301")
  1. D LOOP,PRINT
  1. K DGARRAY,CLARR,I,^TMP($J,"SDAMA")
  1. Q
  1. ;
  1. LOOP ; Loop through a clinic's appointment list
  1. N DFN,EASANV,EASAPT
  1. ;
  1. S EASSC=0 F S EASSC=$O(^TMP($J,"SDAMA",EASSC)) Q:'EASSC D
  1. .; Check for retrieval error
  1. .I $D(^TMP($J,"SDAMA",EASSC))=1 S ^TMP("EASAP",$J,"CLN",EASSC)=^TMP($J,"SDAMA",EASSC) Q
  1. .S DFN=0 F S DFN=$O(^TMP($J,"SDAMA",EASSC,DFN)) Q:'DFN D
  1. ..S EASAPT=0 F S EASAPT=$O(^TMP($J,"SDAMA",EASSC,DFN,EASAPT)) Q:'EASAPT D
  1. ...; Quit if appointment has been cancelled
  1. ...Q:$P($P(^TMP($J,"SDAMA",EASSC,DFN,EASAPT),U,3),";")["C"
  1. ...S LASTMT=$$LST^DGMTU(DFN) ; Get patient's last Means test
  1. ...; Quit if means test is no longer required or pending
  1. ...Q:"^N^P^"[(U_$P(LASTMT,U,4)_U)
  1. ...; Quit if means test is not required by DGMTR (EAS*1.0*64)
  1. ...I $P(LASTMT,U,4)'="R" S (DGADDF,DGMSGF)=1 D EN^DGMTR I '$G(DGREQF) Q
  1. ...; Quit if Cat C, agreed to pay deduct. and MT was after 10/5/1999
  1. ...I $P(LASTMT,U,4)="C",$$GET1^DIQ(408.31,+LASTMT,.11,"I"),$P(LASTMT,U,2)>2991005 Q
  1. ...; Quit if a Future Dated MT is on file
  1. ...Q:$$FUT^DGMTU(DFN)
  1. ...; If appt dt is later than anniversary dt, add veteran to list.
  1. ...S EASANV=$P(LASTMT,U,2)
  1. ...S:$P(LASTMT,U,4)'="R" EASANV=$$FMADD^XLFDT(EASANV,365)
  1. ...I EASDT'<EASANV S ^TMP("EASAP",$J,"CLN",EASSC,DFN,EASAPT)=""
  1. Q
  1. ;
  1. PRINT ; Print Report
  1. N EACLN,ERROR,DFN,LASTMT,VA,ANVDT,PAGE,EASABRT,APDT,XX
  1. ;
  1. I '$D(^TMP("EASAP",$J,"CLN")) D Q
  1. . S PAGE=1 S XX=$$HDR("")
  1. . W !!?3,"No MT Anniversary dates found for this appointment date."
  1. ;
  1. W !
  1. S (EACLN,ERROR)=0
  1. F S EACLN=$O(^TMP("EASAP",$J,"CLN",EACLN)) Q:'EACLN D Q:$G(EASABRT)!ERROR
  1. . S PAGE=1 S EASABRT=$$HDR(EACLN) Q:$G(EASABRT)
  1. . I $D(^TMP("EASAP",$J,"CLN",EACLN))=1 S ERROR=1 W !,^TMP("EASAP",$J,"CLN",EACLN) Q
  1. . S DFN=0
  1. . F S DFN=$O(^TMP("EASAP",$J,"CLN",EACLN,DFN)) Q:'DFN D Q:$G(EASABRT)
  1. . . S LASTMT=$$LST^DGMTU(DFN),ANVDT=$P(LASTMT,U,2)
  1. . . I $P(LASTMT,U,4)'="R",ANVDT>0 S ANVDT=$$FMADD^XLFDT(ANVDT,365)
  1. . . W !?3,$$GET1^DIQ(2,DFN,.01)
  1. . . D PID^VADPT6
  1. . . W ?30,VA("BID") K VA
  1. . . W ?38,$S(ANVDT>0:$$FMTE^XLFDT(ANVDT),1:"")
  1. . . S APDT=0
  1. . . F S APDT=$O(^TMP("EASAP",$J,"CLN",EACLN,DFN,APDT)) Q:'APDT D Q:$G(EASABRT)
  1. . . . W ?55,$$FMTE^XLFDT(APDT,"2P"),!
  1. . . . I ($Y+5)>IOSL S EASABRT=$$HDR(EACLN)
  1. ;
  1. Q
  1. ;
  1. HDR(EASCLN) ; Report Header
  1. N TAB,LINE,CLINIC,RSLT
  1. ;
  1. S RSLT=0
  1. I $E(IOST,1,2)="C-" D I RSLT Q RSLT
  1. . S DIR(0)="E"
  1. . D ^DIR K DIR
  1. . I 'Y S RSLT=1
  1. ;
  1. W @IOF
  1. S CLINIC=$S(EASCLN>0:$$GET1^DIQ(44,EASCLN,.01),1:"")
  1. W "Means Test Expiration Report by Appt Date "_$S(CLINIC]"":"for "_CLINIC,1:"")
  1. W !!,"For Appointment Date: ",$$FMTE^XLFDT(^TMP("EASAP",$J,"APDT"))
  1. W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
  1. S TAB=IOM-10
  1. W ?TAB,"Page "_PAGE
  1. S PAGE=PAGE+1
  1. ;
  1. W !!?30,"Last",?38,"Anniversary",?55,"Appointment"
  1. W !?3,"Name",?30,"Four",?38,"Date",?55,"Time"
  1. S $P(LINE,"=",IOM)="" W !,LINE,!
  1. ;
  1. Q 0
  1. ;
  1. PAUSE ;
  1. Q