SDWLE4 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM ; Compiled May 1, 2007 15:18:53
;;5.3;scheduling;**263,446,1015**;AUG 13 1993;Build 21
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;CLINIC (409.32)
;
EN K DIR,DIC,DIE,DR
I $D(SDWLSC) S X=$$EXTERNAL^DILFD(409.3,8,,SDWLSC),DIC("B")=$S($D(SDWLSC):X,1:"") I DIC("B")="" K DIC("B")
I $D(^SDWL(409.3,SDWLDA,0)),$P(^(0),U,9) S DIC("B")=$$EXTERNAL^DILFD(409.3,8,,$P(^(0),U,9))
S SDWLERR=0
K X,Y
S DIC(0)="QEMNZA",DIC("A")="Select Clinic: ",DIC("S")="I $P(^SDWL(409.32,+Y,0),U,6)=SDWLINE,'$P(^(0),U,4),$P(^(0),U,2)'=""""",DIC=409.32 D ^DIC
I X="^" S DUOUT=1 G END
I X="" W *7," Required" G EN
I Y<0 S DUOUT=1 G END
I $D(DTOUT) S DUOUT=1
I $D(SDWLSC),Y<0 G END
I Y<0 W " Required or ""^"" to Quit" G EN
EN1 S SDWLSC=+Y
;disply already created appointments
N SDCL S SDCL=$$GET1^DIQ(409.32,SDWLSC,.01,"I") ; get pointer to 44
N SDD,SDSP,SDORG S SDSP="",SDORG=DT S SDD=$$CHKENC^SDWLQSC1(DFN,SDORG,SDCL,SDSP,1)
I SDD D APPTDIS N DIR,Y D I Y["^"!'Y S DUOUT=1 Q
.W !!,"This patient already has scheduled appointments which may match",!,"the Wait List Entry."
.S DIR(0)="Y^A0",DIR("B")="NO",DIR("A")="Are you sure you want to continue"
.D ^DIR
Q:$G(DUOUT) S DA=SDWLDA,DIE="^SDWL(409.3,",DR="8////^S X=SDWLSC" D ^DIE
K DIR,DIC,DIE,DR
END Q
APPTDIS ;display already created appt/encounters
;from ^TMP($J,"APPT")
N STR,SCNT
Q:'$D(^TMP($J,"APPT"))
S SCNT="" F S SCNT=$O(^TMP($J,"APPT",SCNT)) Q:SCNT="" D
.S STR=^TMP($J,"APPT",SCNT)
.N ZZ F ZZ=2,3,4,15 S SDD(ZZ)=$P($P(STR,"^",ZZ),";",2)
.N SD S SD=$P(STR,U) D S Y=SD D D^DIQ S SDD(1)=Y ; date conv
..I SDD(3)="SCHEDULED/KEPT" S SDD(3)=$S(SD<DT:"KEPT",1:"SCHEDULED")
.;DISPLAY
.I SCNT=1 D DPH(SCNT,.SDD)
.D DPHD(SCNT,.SDD)
Q
DPH(SCNT,SDD) ;display appt header
W !!,"Appointment(s) for: "_SDD(4)
W !?3,"Appt Date/Time",?23,"Clinic",?48,"Status",?60,"Institution",! N SDL S $P(SDL,"-",79)="" W SDL,!
Q
DPHD(SCNT,SDD) ;
W !,SCNT,?3,SDD(1),?23,$E(SDD(2),1,23),?48,$E(SDD(3),1,10),?60,SDD(15)
Q
SDWLE4 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM ; Compiled May 1, 2007 15:18:53
+1 ;;5.3;scheduling;**263,446,1015**;AUG 13 1993;Build 21
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;CLINIC (409.32)
+11 ;
EN KILL DIR,DIC,DIE,DR
+1 IF $DATA(SDWLSC)
SET X=$$EXTERNAL^DILFD(409.3,8,,SDWLSC)
SET DIC("B")=$SELECT($DATA(SDWLSC):X,1:"")
IF DIC("B")=""
KILL DIC("B")
+2 IF $DATA(^SDWL(409.3,SDWLDA,0))
IF $PIECE(^(0),U,9)
SET DIC("B")=$$EXTERNAL^DILFD(409.3,8,,$PIECE(^(0),U,9))
+3 SET SDWLERR=0
+4 KILL X,Y
+5 SET DIC(0)="QEMNZA"
SET DIC("A")="Select Clinic: "
SET DIC("S")="I $P(^SDWL(409.32,+Y,0),U,6)=SDWLINE,'$P(^(0),U,4),$P(^(0),U,2)'="""""
SET DIC=409.32
DO ^DIC
+6 IF X="^"
SET DUOUT=1
GOTO END
+7 IF X=""
WRITE *7," Required"
GOTO EN
+8 IF Y<0
SET DUOUT=1
GOTO END
+9 IF $DATA(DTOUT)
SET DUOUT=1
+10 IF $DATA(SDWLSC)
IF Y<0
GOTO END
+11 IF Y<0
WRITE " Required or ""^"" to Quit"
GOTO EN
EN1 SET SDWLSC=+Y
+1 ;disply already created appointments
+2 ; get pointer to 44
NEW SDCL
SET SDCL=$$GET1^DIQ(409.32,SDWLSC,.01,"I")
+3 NEW SDD,SDSP,SDORG
SET SDSP=""
SET SDORG=DT
SET SDD=$$CHKENC^SDWLQSC1(DFN,SDORG,SDCL,SDSP,1)
+4 IF SDD
DO APPTDIS
NEW DIR,Y
Begin DoDot:1
+5 WRITE !!,"This patient already has scheduled appointments which may match",!,"the Wait List Entry."
+6 SET DIR(0)="Y^A0"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to continue"
+7 DO ^DIR
End DoDot:1
IF Y["^"!'Y
SET DUOUT=1
QUIT
+8 IF $GET(DUOUT)
QUIT
SET DA=SDWLDA
SET DIE="^SDWL(409.3,"
SET DR="8////^S X=SDWLSC"
DO ^DIE
+9 KILL DIR,DIC,DIE,DR
END QUIT
APPTDIS ;display already created appt/encounters
+1 ;from ^TMP($J,"APPT")
+2 NEW STR,SCNT
+3 IF '$DATA(^TMP($JOB,"APPT"))
QUIT
+4 SET SCNT=""
FOR
SET SCNT=$ORDER(^TMP($JOB,"APPT",SCNT))
IF SCNT=""
QUIT
Begin DoDot:1
+5 SET STR=^TMP($JOB,"APPT",SCNT)
+6 NEW ZZ
FOR ZZ=2,3,4,15
SET SDD(ZZ)=$PIECE($PIECE(STR,"^",ZZ),";",2)
+7 ; date conv
NEW SD
SET SD=$PIECE(STR,U)
Begin DoDot:2
+8 IF SDD(3)="SCHEDULED/KEPT"
SET SDD(3)=$SELECT(SD<DT:"KEPT",1:"SCHEDULED")
End DoDot:2
SET Y=SD
DO D^DIQ
SET SDD(1)=Y
+9 ;DISPLAY
+10 IF SCNT=1
DO DPH(SCNT,.SDD)
+11 DO DPHD(SCNT,.SDD)
End DoDot:1
+12 QUIT
DPH(SCNT,SDD) ;display appt header
+1 WRITE !!,"Appointment(s) for: "_SDD(4)
+2 WRITE !?3,"Appt Date/Time",?23,"Clinic",?48,"Status",?60,"Institution",!
NEW SDL
SET $PIECE(SDL,"-",79)=""
WRITE SDL,!
+3 QUIT
DPHD(SCNT,SDD) ;
+1 WRITE !,SCNT,?3,SDD(1),?23,$EXTRACT(SDD(2),1,23),?48,$EXTRACT(SDD(3),1,10),?60,SDD(15)
+2 QUIT
