SCRPW78 ;BP-CIOFO/ESW - Clinic appointment availability extract ;1/5/16 12:24pm
;;5.3;Scheduling;**291,645**;AUG 13, 1993;Build 7
;
Q ; Must not call this routine directly
;
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
.S SDPT=+Y
.I SDPT>0 W !,"Correct Patient? " S %=1 D YN^DICN D:(%=1) Q
..N SS S SS=$O(^TMP("SDPAT",SDJN,""),-1)
..S ^TMP("SDPAT",SDJN,SS+1)=SDPT_U_$P(^DPT(SDPT,0),U),SDPAT=SDPAT+1
.I SDPT<0,SDPAT S %=1,SDPT=0 W !,SDPAT_" patient(s) selected",! Q
.I SDPT<0 W !,"No Patient Selected, OK to proceed? " S %=1 D YN^DICN S SDPT=0
Q
PRT5 ;print SDREPORT=5
I $G(SDREPORT)'=5 Q
N SC,DFN,SDIV,SDCP,SDDV,SDIVC,SDPNAME S DFN=""
S SDPNAME="" F S SDPNAME=$O(^TMP("SDORD",$J,SDPNAME)) Q:SDPNAME=""!SDOUT D
.S DFN="" F S DFN=$O(^TMP("SDORD",$J,SDPNAME,DFN)) Q:DFN="" D
..S SDIV="" F S SDIV=$O(^TMP("SDIP",$J,SDIV)) Q:SDIV=""!SDOUT D
...S SC=""
...F S SC=$O(^TMP("SDIP",$J,SDIV,SC)) Q:SC="" I $D(^TMP("SDIPLST",$J,DFN,SC)) D
....S SDCP=$P(^TMP("SDIP",$J,SDIV,SC),U),SDDV=$P(^(SC),U,2)
....S SDIVC=SDDV_U_SDIV
....D HDR^SCRPW76(1,SDREPORT,SDIVC,SDCP,SC) Q:SDOUT
....D OUT5^SCRPW77(DFN,SC) Q
Q
GEN5A(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG) ;generate ^TMP("SDIPLST" for a selected patient
;SDAP0 - zero node of appointment multiple
; ^DPT(DFN,"S",SDADT,0)
;
N SDPNAME,SDATA,SDSSN,SDREB,SDCMPL,SDSCHED,SDAST,SDASTO
;Get appointment status, rebook date, completion date and scheduler
S SDAST=$P(SDAP0,U,2) S SDASTO=$S(SDAST="C":"CC",SDAST="CA":"CCA",SDAST="PC":"CP",SDAST="PCA":"CPA",1:SDAST)
I SDASTO="" D
.N SDATC S SDATC=$$STATUS^SDAM1(DFN,SDADT,SDCL,SDAP0)
.I +SDATC=2 D Q
..S SDASTO="CO"
..I $P(SDATC,";",3)["ACT REQ" S SDASTO="COA"
.I +SDATC=11 S SDASTO="F" Q
.I +SDATC=3 S SDASTO="NT" Q
.I +SDATC=1 S SDASTO="CI"
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)
I SDASTO="CO" D
.N SDE S SDE=$P(SDAP0,U,20),SDCMPL=$P(^SCE(SDE,0),U,7)
S SDATA=$G(^DPT(DFN,0))
S SDSSN=$P(SDATA,U,9),SDPNAME=$P(SDATA,U) Q:'$L(SDPNAME)
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
S ^TMP("SDIPLST",$J,DFN,SDCL,SDT,SDPNAME,SDADT)=SDATA
Q
I $G(SDREPORT(5)) D
.S SDTX(5,1)=SDLINE
.S SDTX(5,2)="NOTE: 'APPT TYPE' Values--'0' = user indicated 'Not next available' and calculation indicated 'Not next available' used"
.S SDTX(5,3)=" '1' = user indicated 'Next available' but calculation indicated next available appt not used"
.S SDTX(5,4)=" '2' = user indicated 'Not next available' but calculation indicated next available appointment used"
.S SDTX(5,5)=" '3' = user indicated 'Next available' and calculation indicated 'Next available' appointment used"
.; SD*5.3*645 - replaced 'DATE DESIRED' with 'CID/PREFERRED DATE' when presented to the user
.;S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'DATE DESIRED' and 'APPT DATE/TIME'"
.S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'CID/PREFERRED DATE' and 'APPT DATE/TIME'"
.S SDTX(5,7)="TIME TO APPT.: ----------- days from 'DATE SCHEDULED' to 'APPT DATE/TIME'"
.S SDTX(5,8)="APPT STATUS: N - No-show, CC - Canceled by Clinic, NA - No Show & Auto Rebook, CCA -Canceled by Clinic & Auto Rebook,"
.S SDTX(5,9)=" I - Inpatient, CP - Canceled by Patient, CPA - Canceled by Patient & Auto Rebook, NT - No Action Taken,"
.S SDTX(5,10)=" F - Future, CI - Checked In, COA - Checked Out/Action Required, CO - Checked Out"
.S SDTX(5,11)=SDLINE Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW78 3849 printed Sep 23, 2025@20:20:32 Page 2
SCRPW78 ;BP-CIOFO/ESW - Clinic appointment availability extract ;1/5/16 12:24pm
+1 ;;5.3;Scheduling;**291,645**;AUG 13, 1993;Build 7
+2 ;
+3 ; Must not call this routine directly
QUIT
+4 ;
SELECT(SDJN,SDPAT) NEW SDPT,DIC,Y
SET SDPT=0
NEW %
SET %=0
FOR
if (%=1&'SDPT)
QUIT
SET DIC=2
SET DIC(0)="QEAMIZ"
SET DIC("A")="Select PATIENT NAME:"
DO ^DIC
Begin DoDot:1
+1 SET SDPT=+Y
+2 IF SDPT>0
WRITE !,"Correct Patient? "
SET %=1
DO YN^DICN
if (%=1)
Begin DoDot:2
+3 NEW SS
SET SS=$ORDER(^TMP("SDPAT",SDJN,""),-1)
+4 SET ^TMP("SDPAT",SDJN,SS+1)=SDPT_U_$PIECE(^DPT(SDPT,0),U)
SET SDPAT=SDPAT+1
End DoDot:2
QUIT
+5 IF SDPT<0
IF SDPAT
SET %=1
SET SDPT=0
WRITE !,SDPAT_" patient(s) selected",!
QUIT
+6 IF SDPT<0
WRITE !,"No Patient Selected, OK to proceed? "
SET %=1
DO YN^DICN
SET SDPT=0
End DoDot:1
+7 QUIT
PRT5 ;print SDREPORT=5
+1 IF $GET(SDREPORT)'=5
QUIT
+2 NEW SC,DFN,SDIV,SDCP,SDDV,SDIVC,SDPNAME
SET DFN=""
+3 SET SDPNAME=""
FOR
SET SDPNAME=$ORDER(^TMP("SDORD",$JOB,SDPNAME))
if SDPNAME=""!SDOUT
QUIT
Begin DoDot:1
+4 SET DFN=""
FOR
SET DFN=$ORDER(^TMP("SDORD",$JOB,SDPNAME,DFN))
if DFN=""
QUIT
Begin DoDot:2
+5 SET SDIV=""
FOR
SET SDIV=$ORDER(^TMP("SDIP",$JOB,SDIV))
if SDIV=""!SDOUT
QUIT
Begin DoDot:3
+6 SET SC=""
+7 FOR
SET SC=$ORDER(^TMP("SDIP",$JOB,SDIV,SC))
if SC=""
QUIT
IF $DATA(^TMP("SDIPLST",$JOB,DFN,SC))
Begin DoDot:4
+8 SET SDCP=$PIECE(^TMP("SDIP",$JOB,SDIV,SC),U)
SET SDDV=$PIECE(^(SC),U,2)
+9 SET SDIVC=SDDV_U_SDIV
+10 DO HDR^SCRPW76(1,SDREPORT,SDIVC,SDCP,SC)
if SDOUT
QUIT
+11 DO OUT5^SCRPW77(DFN,SC)
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
GEN5A(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG) ;generate ^TMP("SDIPLST" for a selected patient
+1 ;SDAP0 - zero node of appointment multiple
+2 ; ^DPT(DFN,"S",SDADT,0)
+3 ;
+4 NEW SDPNAME,SDATA,SDSSN,SDREB,SDCMPL,SDSCHED,SDAST,SDASTO
+5 ;Get appointment status, rebook date, completion date and scheduler
+6 SET SDAST=$PIECE(SDAP0,U,2)
SET SDASTO=$SELECT(SDAST="C":"CC",SDAST="CA":"CCA",SDAST="PC":"CP",SDAST="PCA":"CPA",1:SDAST)
+7 IF SDASTO=""
Begin DoDot:1
+8 NEW SDATC
SET SDATC=$$STATUS^SDAM1(DFN,SDADT,SDCL,SDAP0)
+9 IF +SDATC=2
Begin DoDot:2
+10 SET SDASTO="CO"
+11 IF $PIECE(SDATC,";",3)["ACT REQ"
SET SDASTO="COA"
End DoDot:2
QUIT
+12 IF +SDATC=11
SET SDASTO="F"
QUIT
+13 IF +SDATC=3
SET SDASTO="NT"
QUIT
+14 IF +SDATC=1
SET SDASTO="CI"
End DoDot:1
+15 SET SDREB=$PIECE(SDAP0,U,10)
SET SDCMPL=$PIECE(SDAP0,U,14)
SET SDSCHED=$PIECE($GET(^SC(SDCL,"S",SDADT,1,1,0)),U,6)
IF SDSCHED=""
SET SDSCHED=$PIECE(SDAP0,U,18)
+16 IF SDASTO="CO"
Begin DoDot:1
+17 NEW SDE
SET SDE=$PIECE(SDAP0,U,20)
SET SDCMPL=$PIECE(^SCE(SDE,0),U,7)
End DoDot:1
+18 SET SDATA=$GET(^DPT(DFN,0))
+19 SET SDSSN=$PIECE(SDATA,U,9)
SET SDPNAME=$PIECE(SDATA,U)
if '$LENGTH(SDPNAME)
QUIT
+20 SET SDATA=SDSSN_U_$PIECE(SDAP0,U,25)_U_SDFLAG_U_SDSDDT_U_SDSFU_U_SDWAIT_U_SDSDEV_U_SDREB_U_SDASTO_U_SDCMPL_U_SDSCHED
+21 SET ^TMP("SDIPLST",$JOB,DFN,SDCL,SDT,SDPNAME,SDADT)=SDATA
+22 QUIT
+1 IF $GET(SDREPORT(5))
Begin DoDot:1
+2 SET SDTX(5,1)=SDLINE
+3 SET SDTX(5,2)="NOTE: 'APPT TYPE' Values--'0' = user indicated 'Not next available' and calculation indicated 'Not next available' used"
+4 SET SDTX(5,3)=" '1' = user indicated 'Next available' but calculation indicated next available appt not used"
+5 SET SDTX(5,4)=" '2' = user indicated 'Not next available' but calculation indicated next available appointment used"
+6 SET SDTX(5,5)=" '3' = user indicated 'Next available' and calculation indicated 'Next available' appointment used"
+7 ; SD*5.3*645 - replaced 'DATE DESIRED' with 'CID/PREFERRED DATE' when presented to the user
+8 ;S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'DATE DESIRED' and 'APPT DATE/TIME'"
+9 SET SDTX(5,6)="WAIT TIME: -------------- the difference between the 'CID/PREFERRED DATE' and 'APPT DATE/TIME'"
+10 SET SDTX(5,7)="TIME TO APPT.: ----------- days from 'DATE SCHEDULED' to 'APPT DATE/TIME'"
+11 SET SDTX(5,8)="APPT STATUS: N - No-show, CC - Canceled by Clinic, NA - No Show & Auto Rebook, CCA -Canceled by Clinic & Auto Rebook,"
+12 SET SDTX(5,9)=" I - Inpatient, CP - Canceled by Patient, CPA - Canceled by Patient & Auto Rebook, NT - No Action Taken,"
+13 SET SDTX(5,10)=" F - Future, CI - Checked In, COA - Checked Out/Action Required, CO - Checked Out"
+14 SET SDTX(5,11)=SDLINE
QUIT
End DoDot:1
+15 QUIT
