source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB1B.m@ 873

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

initial load of FOIAVistA 6/30/08 version
File size: 2.5 KB
Line 
1DVBAB1B ;ALB/SPH - CAPRI UTILITIES ;01/01/00
2 ;;2.7;AMIE;**104**;Apr 10, 1995
3 ;
4DPA(LIST,DFN,CHOICE) ;Display Patient Appointments
5 N DVBABCNT,CKCHOICE
6 S LIST="",DVBABCNT=1,CKCHOICE="A,F,P",DFN=$G(DFN),CHOICE=$G(CHOICE) K ^TMP("DVBAAPPT",$J)
7 I DFN="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING PATIENT NAME",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
8 I CHOICE="" S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="MISSING ALL, PAST, OR FUTURE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
9 I CKCHOICE'[CHOICE S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="INVALID SELECTION",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
10 I CHOICE["A" D
11 .S SDT=0
12 .S X="T+730" D ^%DT
13 .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
14 .S EDT=Y+.9
15 I CHOICE["F" D
16 .S X="T+1" D ^%DT
17 .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING START DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
18 .S SDT=Y
19 .K X,Y
20 .S X="T+730" D ^%DT
21 .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
22 .S EDT=Y+.9
23 I CHOICE["P" D
24 .S X="T" D ^%DT
25 .I Y<0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="ERROR IN CALCULATING ENDING DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
26 .S EDT=Y+.9
27 .K X,Y
28 .S SDT=0
29 Q:LIST["ERROR"
30 I $O(^DPT(DFN,"S",SDT))'>0 S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)="NO APPOINTMENTS FOUND FOR YOUR DATE RANGE",LIST=$NA(^TMP("DVBAAPPT",$J,DUZ)) Q
31 F S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>EDT) D
32 .S CLN=$P(^DPT(DFN,"S",SDT,0),"^") Q:'CLN
33 .Q:'$D(^SC(CLN,0))
34 .S CLN=$P(^SC(CLN,0),"^")
35 .S ZZ=$L(CLN)
36 .I ZZ<31 D
37 ..F ZZZ=ZZ:1:30 S CLN=CLN_" "
38 .S Y=SDT X ^DD("DD")
39 .S ZZ2=$L(Y)
40 .I ZZ2<21 D
41 ..F ZZZ2=ZZ2:1:20 S Y=Y_" "
42 .S STATUS=$P(^DPT(DFN,"S",SDT,0),"^",2)
43 .I STATUS'="" D
44 ..I STATUS="N" S STATUS="NO-SHOW"
45 ..I STATUS="C" S STATUS="CANCELLED BY CLINIC"
46 ..I STATUS="CA" S STATUS="CANCELLED BY CLINIC & AUTO RE-BOOK"
47 ..I STATUS="NA" S STATUS="NO-SHOW & AUTO-REBOOK"
48 ..I STATUS="I" S STATUS="INPATIENT APPOINTMENT"
49 ..I STATUS="PC" S STATUS="CANCELLED BY PATIENT"
50 ..I STATUS="PCA" S STATUS="CANCELLED BY PATIENT & AUTO RE-BOOK"
51 ..I STATUS="NT" S STATUS="NO ACTION TAKEN"
52 . I $D(^DPT(DFN,"S",SDT,"R")) S REMARK=$P(^DPT(DFN,"S",SDT,"R"),"^",1) ;ADDED
53 .S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=CLN_" "_Y_" "_STATUS,DVBABCNT=DVBABCNT+1
54 . I $D(REMARK) S ^TMP("DVBAAPPT",$J,DUZ,DVBABCNT)=" Cancellation Remarks: "_REMARK,DVBABCNT=DVBABCNT+1
55 . I $D(REMARK) K REMARK
56 .S LIST=$NA(^TMP("DVBAAPPT",$J,DUZ))
57 K DFN,X,%DT,CLN,CHOICE,Y,SDT,EDT
58 Q
Note: See TracBrowser for help on using the repository browser.