source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTOFA.m@ 1365

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1DGMTOFA ;ALB/CAW/AEG - Future Appointments who will require MT ; 03/19/2004
2 ;;5.3;Registration;**3,50,182,326,426,568,725**;Aug 13, 1993;Build 12
3 ;
4EN ;
5 I '$$RANGE^DGMTUTL("F") G ENQ
6 I '$$DIV^DGMTUTL G ENQ
7 I '$$CLINIC^DGMTUTL G ENQ
8 ;I '$$LETTER G ENQ
9 W !! S %ZIS="PMQ" D ^%ZIS I POP G ENQ
10 I '$D(IO("Q")) D MAIN G ENQ
11 S Y=$$QUE
12ENQ ;
13 D:'$D(ZTQUEUED) ^%ZISC
14 K DFN,DGAPT,DGBEG,DGCLN,DGDATE,DGDFN,DGDIV,DGEND,DGFLG,DGINFO,DGLINE,DGLST,DGMT,DGMT1,DGPAGE,DGSTOP,DGTMP,DGTMP1,DGTMP2,DGMTYPT,DGYN,DIW,DIWF,DIWR,DIWT,DN,SDFORM,SDLET,VA,VAERR,VAUTC,VAUTD,^TMP("DGMTO",$J),^TMP("DGMTL",$J)
15 K DGARRAY,CLNARRAY,^TMP($J,"SDAMA"),I,DGTMP,SDCNT
16 Q
17 ;
18QUE() ; -- que job
19 ; return: did job que [ 1|yes 0|no ]
20 ;
21 K ZTSK,IO("Q")
22 S ZTDESC="Future Appt. w/ Means Test",ZTRTN="MAIN^DGMTOFA"
23 F X="DGBEG","DGEND","DGYN","DGMTYPT","SDFORM","SDLET","VAUTC","VAUTD","VAUTC(","VAUTD(" S ZTSAVE(X)=""
24 D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
25 Q $D(ZTSK)
26 ;
27MAIN ;
28 K ^TMP("DGMTO",$J) S I=1
29 I VAUTC=1,VAUTD=1 S DGCLN=0 F S DGCLN=$O(^SC(DGCLN)) Q:'DGCLN I $P(^(DGCLN,0),U,3)="C" D CBLD3(DGCLN)
30 ;
31 I VAUTC=1,VAUTD=0 S DGDIV="" F S DGDIV=$O(VAUTD(DGDIV)) Q:'DGDIV S DGCLN=0 F S DGCLN=$O(^SC(DGCLN)) Q:'DGCLN I $P(^SC(DGCLN,0),U,3)="C",$P(^SC(DGCLN,0),U,15)=DGDIV D CBLD3(DGCLN)
32 I VAUTC=0 S DGCLN="" F S DGCLN=$O(VAUTC(DGCLN)) Q:'DGCLN D CBLD3(DGCLN)
33 D SDAM,CLN1
34 D ^DGMTOFA1
35 D CLOSE^DGMTUTL
36 Q
37 ;
38CBLD3(DGCLN) ; Build array of specified Clinics for specified Divisions
39 S CLNARRAY(I)=$G(CLNARRAY(I))_DGCLN_";"
40 I $L(CLNARRAY(I))>120 S I=I+1
41 Q
42 ;
43SDAM ; Build TMP Global with Appointment API Data for Report
44 S DGARRAY(1)=DGBEG_";"_DGEND
45 S DGARRAY("FLDS")="1;3;10"
46 F I=1:1 Q:'$D(CLNARRAY(I)) D
47 .S DGARRAY(2)=CLNARRAY(I)
48 .I $$SDAPI^SDAMA301(.DGARRAY)>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
49 .K ^TMP($J,"SDAMA301")
50 Q
51 ;
52CLN1 ; Loop through appointments
53 ;
54 N DGTMP S DGDATE=DGBEG-.1,DGLST=DGEND+.9
55 S DGCLN=0 F S DGCLN=$O(^TMP($J,"SDAMA",DGCLN)) Q:'DGCLN D
56 .S DGDFN=0 F S DGDFN=$O(^TMP($J,"SDAMA",DGCLN,DGDFN)) Q:'DGDFN D
57 ..S DGDATE=0 F S DGDATE=$O(^TMP($J,"SDAMA",DGCLN,DGDFN,DGDATE)) Q:'DGDATE D
58 ...S DGTMP=^TMP($J,"SDAMA",DGCLN,DGDFN,DGDATE)
59 ...Q:$$DOM(DGDFN,DGDATE)
60 ...Q:"^NS^NSR^CC^CCR^CP^CPR^"[(U_$P($P(DGTMP,U,3),";")_U)
61 ...D MT
62 Q
63MT ; Is patient going to need to complete a MT/Copay by appt?
64 S DGMT=$$LST^DGMTU(DGDFN,$P(DGDATE,"."),DGMTYPT),DGMT1=$P($G(^DGMT(408.31,+DGMT,0)),U,3) I DGMT1,"^3^10^"'[("^"_DGMT1_"^") D
65 .S X1=$P(DGMT,U,2),X2=365 D C^%DTC I $P(DGDATE,".")<X,$S(DGMT1=1:0,DGMT1=9:0,1:1) Q
66 .;Check to see if Cat C/Pend Adj agreed to pay with test date >10/5/99
67 .I $P(DGMT,U,2)>2991005,$P($G(^DGMT(408.31,+DGMT,0)),U,11)=1,((DGMT1=6)!(DGMT1=2)) Q
68 .;Check to see if Cat C, declined to provide income info but agreed to
69 .;pay -- no date restrictions on these types.
70 .I $G(DGMT1)=6,+$P($G(^DGMT(408.31,+DGMT,0)),U,14),+$P($G(^DGMT(408.31,+DGMT,0)),U,11) Q
71 .; checking for future means test based on DT
72 .N DGNXTMT
73 .S DGNXTMT=$O(^IVM(301.5,"AE",DGDFN,DT))
74 .I 'DGNXTMT S DGNXTMT=""
75 .S ^TMP("DGMTO",$J,$S(+$P(^SC(DGCLN,0),U,15):$P(^(0),U,15),1:$O(^DG(40.8,0))),$P(^SC(DGCLN,0),U),$P(^DPT(DGDFN,0),U),DGDATE)=DGDFN_U_$P(DGMT,U,1,4)_U_$P($P(DGTMP,U,10),";")_U_DGNXTMT,^TMP("DGMTL",$J,$P(^DPT(DGDFN,0),U),DGDFN)=""
76 Q
77 ;
78LETTER() ;
79 ; Input - none
80 ; Output - DGYN - yes/no
81 ;
82 N %
83LTR W !!,"Do you want to generate letters" S %=2 D YN^DICN
84 ;I %=1 D START^DGMTLTR S DGYN=$S('$D(DGFLG):1,1:0)
85 I %=2 S DGYN=0
86 I %=0 W !!,"Enter 'Y'es to generate letters from the listing or",!,"Enter 'N'o to produce the listing, but not the letters." G LTR
87 Q $D(DGYN)
88 ;
89DOM(DFN,DGT) ; Screen out dom patient
90 ; Input: DFN - Patient IEN
91 ; DGT - Date of visit
92 ;
93 N Y,DGI,DGXFR0,DGA1,DGINP
94 S Y=0
95 D ^DGINPW I DG1 I $P(^DG(43,1,0),U,21),$D(^DIC(42,+DG1,0)),$P(^(0),U,3)="D" S Y=1
96 Q Y
Note: See TracBrowser for help on using the repository browser.