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

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1DGMTO1 ;ALB/CAW,AEG/EG - AGREED TO PAY DEDUCTIBLE PRINT (CON'T) ; 1/21/05 8:08am
2 ;;5.3;Registration;**33,182,358,568,585**;Aug 13, 1993
3 ;
4START ;
5 ; loop through cat Cs for active ones
6 S (DGPAGE,DGSTOP)=0
7 F DGCAT=2,6 F DFN=0:0 S DFN=$O(^DPT("ACS",DGCAT,DFN)) Q:DFN'>0 D CATCLST
8 D ACTIVE
9 D CATCOUT
10 K ^TMP("DGMTO",$J,"CNULL"),DFN
11 D CLOSE^DGMTUTL
12 Q
13 ;
14CATCLST N DGDT,IEN,NODE0
15 S NODE0=$G(^DPT(DFN,0)) Q:(+$G(^(.35)))!($P(NODE0,U,14)'=DGCAT)
16 F DGDT=0:0 S DGDT=$O(^DGMT(408.31,"AD",1,DFN,DGDT)) Q:'DGDT S IEN=$$MTIEN^DGMTU3(1,DFN,-DGDT) I IEN,(DGDT'<DGYRAGO)&(DGDT'>DGTODAY) D
17 .Q:DGCAT'[$P($G(^DGMT(408.31,+IEN,0)),U,3)
18 .Q:$P($G(^DGMT(408.31,+IEN,0)),U,11)=1
19 .S ^TMP("DGMTO",$J,"CNULL",$P(NODE0,U,1),DFN)=";;"_$P(NODE0,U,1)_";;"_DGCAT_";;"_$$SR^DGMTAUD1($G(^DGMT(408.31,+IEN,0)))
20QTC Q
21 ;
22ACTIVE ;
23 N APWHEN,I,VETARRAY,PIEN,PNAME,RCNT,ACNT,DGARRAY,SDCNT,APT,CK1,CK3,PATNAM
24 S ACNT=1,RCNT=0
25 S PNAME="" F S PNAME=$O(^TMP("DGMTO",$J,"CNULL",PNAME)) Q:PNAME="" D
26 .S PIEN=0 F S PIEN=$O(^TMP("DGMTO",$J,"CNULL",PNAME,PIEN)) Q:'PIEN D
27 ..S RCNT=RCNT+1,VETARRAY(ACNT)=$G(VETARRAY(ACNT))_PIEN_";"
28 ..; Group DFNs by no more than twenty records
29 ..I RCNT>19 S ACNT=ACNT+1,RCNT=0
30 ;
31 ; Call SD API by array of Patient DFNs
32 F I=1:1 Q:'$D(VETARRAY(I)) D
33 .S DGARRAY("FLDS")="1",DGARRAY(4)=VETARRAY(I)
34 .S SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
35 .M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
36 .K DGARRAY,^TMP($J,"SDAMA301")
37 ;
38 ;if there is data hanging from the 101 subscript,
39 ;then it is a valid appointment, otherwise
40 ;it is an error eg 01/20/2005
41 ; Appointment Database was unavailable
42 I $D(^TMP($J,"SDAMA",101))=1 K ^TMP("DGMTO",$J,"CNULL") S ^TMP("DGMTO",$J,"CNULL",101)="" Q
43 ;
44 ; Complete ^TMP entries for report
45 N PATIEN,CLIEN,APPTDT,PATAPPT,APWHEN
46 S PATNAM="" F S PATNAM=$O(^TMP("DGMTO",$J,"CNULL",PATNAM)) Q:PATNAM="" D
47 .S PATIEN=0 F S PATIEN=$O(^TMP("DGMTO",$J,"CNULL",PATNAM,PATIEN)) Q:'PATIEN D
48 ..;
49 ..S CLIEN=0 F S CLIEN=$O(^TMP($J,"SDAMA",PATIEN,CLIEN)) Q:'CLIEN D
50 ...S APPTDT=0 F S APPTDT=$O(^TMP($J,"SDAMA",PATIEN,CLIEN,APPTDT)) Q:'APPTDT D
51 ....; Get list of appointments for vet
52 ....S PATAPPT(APPTDT)=PATNAM
53 ..; Update or Delete ^TMP for Report
54 ..S APT=$O(^DPT(PATIEN,"DIS",(9999999-DGTODAY))),APWHEN=""
55 ..I APT,(APT<(9999999-DGYRAGO)) S $P(APWHEN,U,1)="X"
56 ..I +$G(^DPT(PATIEN,.105)) S $P(APWHEN,U,2)="X"
57 ..I $O(PATAPPT(""),-1)>DT S $P(APWHEN,U,3)="X"
58 ..K PATAPPT
59 ..I APWHEN']"" D
60 ...S CK1=$O(^DGPM("APRD",PATIEN,DGYRAGO)) I (+CK1)&(+CK1<DGTODAY) S $P(APWHEN,U,1)="X"
61 ...S CK3=$O(^DGPM("APRD",PATIEN,DGTODAY)) I (+CK3) S $P(APWHEN,U,3)="X"
62 ..S:APWHEN]"" $P(^TMP("DGMTO",$J,"CNULL",PATNAM,PATIEN),";;")=APWHEN
63 ..I APWHEN']"" K ^TMP("DGMTO",$J,"CNULL",PATNAM,PATIEN)
64 K ^TMP($J,"SDAMA")
65 Q
66CATCOUT ;
67 U IO D HDR
68 I $D(^TMP("DGMTO",$J,"CNULL")) D PRINT,LEGEND Q
69 W:$D(^TMP("DGMTO",$J,"CNULL",101)) !,?5,"Appointment Database is Unavailable --- Unable to generate report" Q
70 W:'$D(^TMP("DGMTO",$J,"CNULL")) !,?5,"NO ACTIVE PATIENTS WHO HAVE NOT AGREED TO PAY DEDUCTIBLE",!?5," ------",!
71 Q
72PRINT ;
73 S DGNAME=""
74 F S DGNAME=$O(^TMP("DGMTO",$J,"CNULL",DGNAME)) Q:DGNAME']"" D Q:DGSTOP
75 .F DFN=0:0 S DFN=$O(^TMP("DGMTO",$J,"CNULL",DGNAME,DFN)) Q:DFN'>0 S DGX=^(DFN) D Q:DGSTOP
76 ..D PID^VADPT6
77 ..W !,$P(DGX,";;",2),?25,$S($P(DGX,";;",3)=2:"Pend Adj",1:"Cat. C"),?35,VA("PID"),?50,$P(DGX,";;",4),?59,$P($P(DGX,";;",1),U,1),?67,$P($P(DGX,";;",1),U,2),?75,$P($P(DGX,";;",1),U,3)
78 ..D CHK
79 K VA,VAPTYP,DGNAME
80 Q
81 ;
82HDR ;
83 S DGPAGE=DGPAGE+1
84 W:$E(IOST,1,2)["C-" @IOF W "Active Patients Who Have Not Agreed To Pay Deductible",?70,"Page: "_DGPAGE
85 W !,"Date Range: "_$$FDATE^DGMTUTL(DGYRAGO)_" to "_$$FDATE^DGMTUTL(DGTODAY) D NOW^%DTC W ?51,"Run Date: "_$E($$FTIME^DGMTUTL(%),1,18)
86 W !,""
87 W !,?37,"PATIENT",?47,"MEANS TEST"
88 W !,"PATIENT NAME",?25,"STATUS",?40,"ID",?49,"SOURCE",?58,"PAST",?64,"INHOUSE",?73,"FUTURE"
89 S DGLINE="",$P(DGLINE,"=",IOM)=""
90 W !,DGLINE
91 Q
92CHK ;Check to pause on screen
93 I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE S DGP=Y D:DGP HDR I 'DGP S DGSTOP=1 Q
94 I $E(IOST,1,2)="P-",($Y+5)>IOSL,$O(^TMP("DGMTO",$J,DGNAME,DFN)) D HDR Q
95 Q
96PAUSE ;
97 W ! S DIR(0)="E" D ^DIR K DIR W !
98 Q
99LEGEND ;Legend at end of report
100 W !!,"ACTIVE= Sched. Admissions, Dispositions, Pt. Movements, or Clinic Appts."
101 W !!,?10,"INHOUSE = Current Inpatient"
102 W !,?10,"PAST = ",$$FDATE^DGMTUTL(DGYRAGO)," to ",$$FDATE^DGMTUTL(DGTODAY)
103 W !,?10,"FUTURE = After ",$$FDATE^DGMTUTL(DGTODAY)
104 Q
Note: See TracBrowser for help on using the repository browser.