- 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**;AUG 13 1993;Build 77
- ;
- ;
- ;******************************************************************
- ; 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLE4 2372 printed Feb 19, 2025@00:29:02 Page 2
- 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**;AUG 13 1993;Build 77
- +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