1 | SCRPW78 ;BP-CIOFO/ESW - Clinic appointment availability extract ; 5/29/03 11:40am
|
---|
2 | ;;5.3;Scheduling;**291**;AUG 13, 1993
|
---|
3 | ;
|
---|
4 | Q ; Must not call this routine directly
|
---|
5 | ;
|
---|
6 | SELECT(SDJN,SDPAT) N SDPT,DIC,Y S SDPT=0 N % S %=0 F Q:(%=1&'SDPT) S DIC=2,DIC(0)="QEAMIZ",DIC("A")="Select PATIENT NAME:" D ^DIC D
|
---|
7 | .S SDPT=+Y
|
---|
8 | .I SDPT>0 W !,"Correct Patient? " S %=1 D YN^DICN D:(%=1) Q
|
---|
9 | ..N SS S SS=$O(^TMP("SDPAT",SDJN,""),-1)
|
---|
10 | ..S ^TMP("SDPAT",SDJN,SS+1)=SDPT_U_$P(^DPT(SDPT,0),U),SDPAT=SDPAT+1
|
---|
11 | .I SDPT<0,SDPAT S %=1,SDPT=0 W !,SDPAT_" patient(s) selected",! Q
|
---|
12 | .I SDPT<0 W !,"No Patient Selected, OK to proceed? " S %=1 D YN^DICN S SDPT=0
|
---|
13 | Q
|
---|
14 | PRT5 ;print SDREPORT=5
|
---|
15 | I $G(SDREPORT)'=5 Q
|
---|
16 | N SC,DFN,SDIV,SDCP,SDDV,SDIVC,SDPNAME S DFN=""
|
---|
17 | S SDPNAME="" F S SDPNAME=$O(^TMP("SDORD",$J,SDPNAME)) Q:SDPNAME=""!SDOUT D
|
---|
18 | .S DFN="" F S DFN=$O(^TMP("SDORD",$J,SDPNAME,DFN)) Q:DFN="" D
|
---|
19 | ..S SDIV="" F S SDIV=$O(^TMP("SDIP",$J,SDIV)) Q:SDIV=""!SDOUT D
|
---|
20 | ...S SC=""
|
---|
21 | ...F S SC=$O(^TMP("SDIP",$J,SDIV,SC)) Q:SC="" I $D(^TMP("SDIPLST",$J,DFN,SC)) D
|
---|
22 | ....S SDCP=$P(^TMP("SDIP",$J,SDIV,SC),U),SDDV=$P(^(SC),U,2)
|
---|
23 | ....S SDIVC=SDDV_U_SDIV
|
---|
24 | ....D HDR^SCRPW76(1,SDREPORT,SDIVC,SDCP,SC) Q:SDOUT
|
---|
25 | ....D OUT5^SCRPW77(DFN,SC) Q
|
---|
26 | Q
|
---|
27 | GEN5A(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG) ;generate ^TMP("SDIPLST" for a selected patient
|
---|
28 | ;SDAP0 - zero node of appointment multiple
|
---|
29 | ; ^DPT(DFN,"S",SDADT,0)
|
---|
30 | ;
|
---|
31 | N SDPNAME,SDATA,SDSSN,SDREB,SDCMPL,SDSCHED,SDAST,SDASTO
|
---|
32 | ;Get appointment status, rebook date, completion date and scheduler
|
---|
33 | S SDAST=$P(SDAP0,U,2) S SDASTO=$S(SDAST="C":"CC",SDAST="CA":"CCA",SDAST="PC":"CP",SDAST="PCA":"CPA",1:SDAST)
|
---|
34 | I SDASTO="" D
|
---|
35 | .N SDATC S SDATC=$$STATUS^SDAM1(DFN,SDADT,SDCL,SDAP0)
|
---|
36 | .I +SDATC=2 D Q
|
---|
37 | ..S SDASTO="CO"
|
---|
38 | ..I $P(SDATC,";",3)["ACT REQ" S SDASTO="COA"
|
---|
39 | .I +SDATC=11 S SDASTO="F" Q
|
---|
40 | .I +SDATC=3 S SDASTO="NT" Q
|
---|
41 | .I +SDATC=1 S SDASTO="CI"
|
---|
42 | S SDREB=$P(SDAP0,U,10),SDCMPL=$P(SDAP0,U,14) S SDSCHED=$P($G(^SC(SDCL,"S",SDADT,1,1,0)),U,6) I SDSCHED="" S SDSCHED=$P(SDAP0,U,18)
|
---|
43 | I SDASTO="CO" D
|
---|
44 | .N SDE S SDE=$P(SDAP0,U,20),SDCMPL=$P(^SCE(SDE,0),U,7)
|
---|
45 | S SDATA=$G(^DPT(DFN,0))
|
---|
46 | S SDSSN=$P(SDATA,U,9),SDPNAME=$P(SDATA,U) Q:'$L(SDPNAME)
|
---|
47 | S SDATA=SDSSN_U_$P(SDAP0,U,25)_U_SDFLAG_U_SDSDDT_U_SDSFU_U_SDWAIT_U_SDSDEV_U_SDREB_U_SDASTO_U_SDCMPL_U_SDSCHED
|
---|
48 | S ^TMP("SDIPLST",$J,DFN,SDCL,SDT,SDPNAME,SDADT)=SDATA
|
---|
49 | Q
|
---|
50 | FOOT(SDTX,SDLINE) ;
|
---|
51 | I $G(SDREPORT(5)) D
|
---|
52 | .S SDTX(5,1)=SDLINE
|
---|
53 | .S SDTX(5,2)="NOTE: 'APPT TYPE' Values--'0' = user indicated 'Not next available' and calculation indicated 'Not next available' used"
|
---|
54 | .S SDTX(5,3)=" '1' = user indicated 'Next available' but calculation indicated next available appt not used"
|
---|
55 | .S SDTX(5,4)=" '2' = user indicated 'Not next available' but calculation indicated next available appointment used"
|
---|
56 | .S SDTX(5,5)=" '3' = user indicated 'Next available' and calculation indicated 'Next available' apppointment used"
|
---|
57 | .S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'DATE DESIRED' and 'APPT DATE/TIME'"
|
---|
58 | .S SDTX(5,7)="TIME TO APPT.: ----------- days from 'DATE SCHEDULED' to 'APPT DATE/TIME'"
|
---|
59 | .S SDTX(5,8)="APPT STATUS: N - No-show, CC - Canceled by Clinic, NA - No Show & Auto Rebook, CCA -Canceled by Clinic & Auto Rebook,"
|
---|
60 | .S SDTX(5,9)=" I - Inpatient, CP - Canceled by Patient, CPA - Canceled by Patient & Auto Rebook, NT - No Action Taken,"
|
---|
61 | .S SDTX(5,10)=" F - Future, CI - Checked In, COA - Checked Out/Action Required, CO - Checked Out"
|
---|
62 | .S SDTX(5,11)=SDLINE Q
|
---|
63 | Q
|
---|