source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTRP3.m@ 1764

Last change on this file since 1764 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1EASMTRP3 ; ALB/GAH - MEANS TEST ANV DATES BY APPT DATE ; 10/10/2006
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,15,46,64,77**;MAR 15,2001;Build 11
3 ;
4QUE ; Que off the appointment list search by MT anniversary date
5 N EASDT,ZTSAVE
6 ;
7 S DIR(0)="DAO^DT::EX"
8 S DIR("B")="TODAY",DIR("A")="Run report for date: ",DIR("?")="^D HELP^%DTC"
9 D ^DIR K DIR
10 Q:$D(DIRUT)
11 S EASDT=Y
12 ;
13 S ZTSAVE("EASDT")=""
14 D EN^XUTMDEVQ("EN^EASMTRP3","EAS MT DUE BY APPOINTMENT RPT",.ZTSAVE)
15 Q
16 ;
17EN ; Main entry point for appointment list by MT anniversary date
18 N EASSC,ERROR,PAGE,ACNT,RCNT,DGARRAY,I,CLARR,SDCNT,DGADDF,DGMSGF,DGREQF
19 K ^TMP("EASAP",$J)
20 S PAGE=1,^TMP("EASAP",$J,"APDT")=EASDT
21 ;
22 ; Build Array of Valid Clinic IENs
23 S ACNT=1,(RCNT,EASSC)=0 F S EASSC=$O(^SC(EASSC)) Q:'EASSC D
24 .Q:'$D(^SC(EASSC,0))
25 .Q:$P(^SC(EASSC,0),U,3)'="C"
26 .S RCNT=RCNT+1,CLARR(ACNT)=$G(CLARR(ACNT))_EASSC_";"
27 .; Group Clinic IENs by no more than thirty
28 .I RCNT>29 S ACNT=ACNT+1,RCNT=0
29 ;
30 ; Call SD API by array of Clinic IENs
31 S DGARRAY(1)=EASDT_";"_EASDT,DGARRAY("FLDS")="1;3"
32 F I=1:1 Q:'$D(CLARR(I)) D
33 .S DGARRAY(2)=CLARR(I)
34 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
35 . I SDCNT>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
36 . I SDCNT<0 D
37 . . S ERROR=$O(^TMP($J,"SDAMA301",""))
38 . . S ^TMP($J,"SDAMA",CLARR(I))=^TMP($J,"SDAMA301",ERROR)
39 .K ^TMP($J,"SDAMA301")
40 D LOOP,PRINT
41 K DGARRAY,CLARR,I,^TMP($J,"SDAMA")
42 Q
43 ;
44LOOP ; Loop through a clinic's appointment list
45 N DFN,EASANV,EASAPT
46 ;
47 S EASSC=0 F S EASSC=$O(^TMP($J,"SDAMA",EASSC)) Q:'EASSC D
48 .; Check for retrieval error
49 .I $D(^TMP($J,"SDAMA",EASSC))=1 S ^TMP("EASAP",$J,"CLN",EASSC)=^TMP($J,"SDAMA",EASSC) Q
50 .S DFN=0 F S DFN=$O(^TMP($J,"SDAMA",EASSC,DFN)) Q:'DFN D
51 ..S EASAPT=0 F S EASAPT=$O(^TMP($J,"SDAMA",EASSC,DFN,EASAPT)) Q:'EASAPT D
52 ...; Quit if appointment has been cancelled
53 ...Q:$P($P(^TMP($J,"SDAMA",EASSC,DFN,EASAPT),U,3),";")["C"
54 ...S LASTMT=$$LST^DGMTU(DFN) ; Get patient's last Means test
55 ...; Quit if means test is no longer required or pending
56 ...Q:"^N^P^"[(U_$P(LASTMT,U,4)_U)
57 ...; Quit if means test is not required by DGMTR (EAS*1.0*64)
58 ...I $P(LASTMT,U,4)'="R" S (DGADDF,DGMSGF)=1 D EN^DGMTR I '$G(DGREQF) Q
59 ...; Quit if Cat C, agreed to pay deduct. and MT was after 10/5/1999
60 ...I $P(LASTMT,U,4)="C",$$GET1^DIQ(408.31,+LASTMT,.11,"I"),$P(LASTMT,U,2)>2991005 Q
61 ...; Quit if a Future Dated MT is on file
62 ...Q:$$FUT^DGMTU(DFN)
63 ...; If appt dt is later than anniversary dt, add veteran to list.
64 ...S EASANV=$P(LASTMT,U,2)
65 ...S:$P(LASTMT,U,4)'="R" EASANV=$$FMADD^XLFDT(EASANV,365)
66 ...I EASDT'<EASANV S ^TMP("EASAP",$J,"CLN",EASSC,DFN,EASAPT)=""
67 Q
68 ;
69PRINT ; Print Report
70 N EACLN,ERROR,DFN,LASTMT,VA,ANVDT,PAGE,EASABRT,APDT,XX
71 ;
72 I '$D(^TMP("EASAP",$J,"CLN")) D Q
73 . S PAGE=1 S XX=$$HDR("")
74 . W !!?3,"No MT Anniversary dates found for this appointment date."
75 ;
76 W !
77 S (EACLN,ERROR)=0
78 F S EACLN=$O(^TMP("EASAP",$J,"CLN",EACLN)) Q:'EACLN D Q:$G(EASABRT)!ERROR
79 . S PAGE=1 S EASABRT=$$HDR(EACLN) Q:$G(EASABRT)
80 . I $D(^TMP("EASAP",$J,"CLN",EACLN))=1 S ERROR=1 W !,^TMP("EASAP",$J,"CLN",EACLN) Q
81 . S DFN=0
82 . F S DFN=$O(^TMP("EASAP",$J,"CLN",EACLN,DFN)) Q:'DFN D Q:$G(EASABRT)
83 . . S LASTMT=$$LST^DGMTU(DFN),ANVDT=$P(LASTMT,U,2)
84 . . I $P(LASTMT,U,4)'="R",ANVDT>0 S ANVDT=$$FMADD^XLFDT(ANVDT,365)
85 . . W !?3,$$GET1^DIQ(2,DFN,.01)
86 . . D PID^VADPT6
87 . . W ?30,VA("BID") K VA
88 . . W ?38,$S(ANVDT>0:$$FMTE^XLFDT(ANVDT),1:"")
89 . . S APDT=0
90 . . F S APDT=$O(^TMP("EASAP",$J,"CLN",EACLN,DFN,APDT)) Q:'APDT D Q:$G(EASABRT)
91 . . . W ?55,$$FMTE^XLFDT(APDT,"2P"),!
92 . . . I ($Y+5)>IOSL S EASABRT=$$HDR(EACLN)
93 ;
94 Q
95 ;
96HDR(EASCLN) ; Report Header
97 N TAB,LINE,CLINIC,RSLT
98 ;
99 S RSLT=0
100 I $E(IOST,1,2)="C-" D I RSLT Q RSLT
101 . S DIR(0)="E"
102 . D ^DIR K DIR
103 . I 'Y S RSLT=1
104 ;
105 W @IOF
106 S CLINIC=$S(EASCLN>0:$$GET1^DIQ(44,EASCLN,.01),1:"")
107 W "Means Test Expiration Report by Appt Date "_$S(CLINIC]"":"for "_CLINIC,1:"")
108 W !!,"For Appointment Date: ",$$FMTE^XLFDT(^TMP("EASAP",$J,"APDT"))
109 W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
110 S TAB=IOM-10
111 W ?TAB,"Page "_PAGE
112 S PAGE=PAGE+1
113 ;
114 W !!?30,"Last",?38,"Anniversary",?55,"Appointment"
115 W !?3,"Name",?30,"Four",?38,"Date",?55,"Time"
116 S $P(LINE,"=",IOM)="" W !,LINE,!
117 ;
118 Q 0
119 ;
120PAUSE ;
121 Q
Note: See TracBrowser for help on using the repository browser.