| 1 | DGRP14 ;ALB/MRL/EG/GAH - REGISTRATION SCREEN 14/APPOINTMENT INFORMATION ; 10/18/06
|
|---|
| 2 | ;;5.3;Registration;**568,585,725,770**;Aug 13, 1993;Build 4
|
|---|
| 3 | S DGRPS=14 D H^DGRPU S (Z,DGRPW)=1 D WW^DGRPV W " Enrollment Clinics: "
|
|---|
| 4 | S I1=""
|
|---|
| 5 | F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I D:$P(^(I,0),U,2)'="I"
|
|---|
| 6 | . S I1=1,X=$S($D(^SC(+^(0),0)):$P(^(0),U,1)_", ",1:"")
|
|---|
| 7 | . W:(79-$X)<$L(X) !?24 W X
|
|---|
| 8 | W:'I1 "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"
|
|---|
| 9 | W ! S Z=2 D WW^DGRPV W " Pending Appt's",?18,": " S I1="",I2=DT_".9999"
|
|---|
| 10 | N DGARRAY,APTDT,CLIFN,CLNAM
|
|---|
| 11 | S DGARRAY("FLDS")="1;2;3",DGARRAY(3)="R;I;NT",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P"
|
|---|
| 12 | S I1=$$SDAPI^SDAMA301(.DGARRAY)
|
|---|
| 13 | ;Check for appointment retrieval error.
|
|---|
| 14 | I I1<0 W $$FAPCHK^DGENRPD2 G Q
|
|---|
| 15 | S APTDT=0
|
|---|
| 16 | F S APTDT=$O(^TMP($J,"SDAMA301",DFN,APTDT)) Q:'APTDT D
|
|---|
| 17 | .;check to see if appointment is cancelled, if so
|
|---|
| 18 | .;ignore this appointment eg 01/25/2005
|
|---|
| 19 | .;I $$CANCEL(DFN,APTDT)="Y" Q TAKEN OUT IN PATCH 770.
|
|---|
| 20 | .S CLNAM=$P($P(^TMP($J,"SDAMA301",DFN,APTDT),U,2),";",2)
|
|---|
| 21 | .S X=$S(CLNAM]"":CLNAM,1:"UNKNOWN CLINIC")_" ("_$$FMTE^DILIBF(APTDT,"5U")_"), " W:(79-$X)<$L(X) !?24 W X
|
|---|
| 22 | .Q
|
|---|
| 23 | I 'I1 W "NO PENDING APPOINTMENTS ON FILE"
|
|---|
| 24 | Q K I,I1,I2,X,Y,DGARRAY,APTDT,CLNAM,^TMP($J,"SDAMA301") G ^DGRPP
|
|---|
| 25 | ;
|
|---|
| 26 | ;input DFN - patient id
|
|---|
| 27 | ; APPDATE - appointment date
|
|---|
| 28 | ;return Y - Yes
|
|---|
| 29 | ; N - No
|
|---|
| 30 | CANCEL(DFN,APPDATE) ;
|
|---|
| 31 | N X,STATUS,U
|
|---|
| 32 | S U="^"
|
|---|
| 33 | S X=$G(^DPT(DFN,"S",APPDATE,0))
|
|---|
| 34 | I X="" Q "Y" ;probably bad data
|
|---|
| 35 | S STATUS=$P(X,U,2)
|
|---|
| 36 | I STATUS="" Q "N"
|
|---|
| 37 | I STATUS="I" Q "N"
|
|---|
| 38 | Q "Y"
|
|---|
