- 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 Mar 13, 2025@21:49:04 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