Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDWLE2

SDWLE2.m

Go to the documentation of this file. 
  1. SDWLE2 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002  2:10 PM  ; Compiled May 25, 2007 16:37:21
  1.  ;;5.3;scheduling;**263,397,424,446,1015**;AUG 13 1993;Build 21
  1.  ;
  1.  ;
  1.  ;******************************************************************
  1.  ;                             CHANGE LOG
  1.  ;                                               
  1.  ;   DATE                        PATCH                   DESCRIPTION
  1.  ;   ----                        -----                   -----------
  1.  ;   06/06/06                    SD*5.3*446              Allow selection of a clinic after specialty is entered
  1.  ;   
  1.  ;   
  1.  ;      
  1.  ;Service/Specialty sub-routine
  1.  ;
  1. EN ;
  1.  N SDWLSSX  ; sd/446
  1.  K DIR,DIC,DR I $D(SDWLSS) S X=$$EXTERNAL^DILFD(409.3,7,,SDWLSS)
  1.  S SDWLERR=0 I $D(SDWLSS) S DIC("B")=$S($D(SDWLSS):X,1:"") I DIC("B")="" K DIC("B")
  1.  S DIC(0)="AEQ",DIC=409.31,DIC("A")="Select Service/Specialty: "
  1.  S DIC("S")="I $D(^SDWL(409.31,""E"",SDWLINE,+Y)),$D(^SDWL(409.31,+Y,""I"")),$P(^SDWL(409.31,+Y,""I"",($O(^SDWL(409.31,+Y,""I"",""B"",SDWLINE,""""))),0),U,4)=""""" D ^DIC
  1.  I X["^" S DUOUT=1 G END
  1.  I Y<0 W *7," Required" G EN
  1.  S SDWLSSX=+Y  ; sd/446
  1.  N SDSP S SDSP=$$GET1^DIQ(409.31,SDWLSSX,.01,"I") ; get pointer to 40.7
  1.  N SDD,SDCL,SDORG S SDCL="",SDORG=DT S SDD=$$CHKENC^SDWLQSC1(DFN,SDORG,SDCL,SDSP,1)
  1.  I SDD D APPTDIS N DIR,Y D  I Y["^"!'Y S DUOUT=1 Q
  1.  .W !!,"This patient already has scheduled appointments which may match",!,"the Wait List Entry."
  1.  .S DIR(0)="Y^A0",DIR("B")="NO",DIR("A")="Are you sure you want to continue"
  1.  .D ^DIR
  1.  ;
  1.  I '$$CLIN() Q:$G(DUOUT)  S DIE="^SDWL(409.3,",DR="7////^S X=SDWLSSX" D ^DIE  ; sd/446
  1.  K DIR,DIC,DIE,DR,Y,DUOUT
  1. END Q
  1. APPTDIS ;display already created appt/encounters
  1.  ;from ^TMP($J,"APPT")
  1.  N STR,SCNT
  1.  Q:'$D(^TMP($J,"APPT"))
  1.  S SCNT="" F  S SCNT=$O(^TMP($J,"APPT",SCNT)) Q:SCNT=""  D
  1.  .S STR=^TMP($J,"APPT",SCNT)
  1.  .N ZZ F ZZ=2,3,4,10,15 S SDD(ZZ)=$P($P(STR,"^",ZZ),";",2)
  1.  .N SD S SD=$P(STR,U) D  S Y=SD D D^DIQ S SDD(1)=Y ; date conv
  1.  ..I SDD(3)="SCHEDULED/KEPT" S SDD(3)=$S(SD<DT:"KEPT",1:"SCHEDULED")
  1.  .;DISPLAY
  1.  .I SCNT=1 D DPH(SCNT,.SDD)
  1.  .D DPHD(SCNT,.SDD)
  1.  Q
  1. DPH(SCNT,SDD) ;display appt header
  1.  W !!,"Appointment(s) for: "_SDD(4)
  1.  W !?3,"Appt Date/Time",?23,"Clinic",?48,"Status",?60,"Institution",! N SDL S $P(SDL,"-",79)="" W SDL,!
  1.  Q
  1. DPHD(SCNT,SDD) ;
  1.  W !,SCNT,?3,SDD(1),?23,$E(SDD(2),1,23),?48,$E(SDD(10),1,10),?60,SDD(15)
  1.  Q
  1.  ;
  1. CLIN() ; sd/446
  1.  N DA,DIC,DIE,DIK,DR,SDWLCL,SDWLEST,X,Y
  1.  S DIC=409.32,DIC(0)="AEQ",DIC("A")="WL SPECIFIC CLINIC related to this SPECIALTY (optional): ",DIC("S")="I $$VAL^SDWLE2(+Y)"
  1.  D ^DIC
  1.  I X["^" S DUOUT=1 Q 0
  1.  Q:X="" 0
  1.  S SDWLCL=+Y
  1.  ; Need to delete the old entry and create anew to change the wait list type
  1.  S SDWLEST=$$GET1^DIQ(409.3,SDWLDA,27,"I")
  1.  S DIK="^SDWL(409.3,",DA=SDWLDA
  1.  D ^DIK
  1.  S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN
  1.  L:DA'=SDWLDA +^SDWL(409.3,DA),-^SDWL(409.3,SDWLDA)
  1.  S SDWLDA=DA
  1.  S DIE="^SDWL(409.3,",DR="1////^S X=DT;2////^S X=SDWLINE;4////^S X=4;8////^S X=SDWLCL;9////^S X=DUZ;27////^S X=SDWLEST"
  1.  S:$G(SDWLACA) DR=DR_";33////^S X=""Y"""  ; 446
  1.  D ^DIE
  1.  Q 1
  1. VAL(Y) ; sd/446
  1.  N TMP
  1.  D GETS^DIQ(409.32,Y,".01;.02;2;4","I","TMP")
  1.  Q:TMP(409.32,Y_",",.02,"I")'=SDWLINE 0  ; Wrong institution
  1.  Q:TMP(409.32,Y_",",2,"I")="" 0  ; No activation date entered
  1.  Q:TMP(409.32,Y_",",4,"I")'="" 0  ; Inactivation date entered
  1.  Q $$GET1^DIQ(44,TMP(409.32,Y_",",.01,"I"),8,"I")=$$GET1^DIQ(409.31,SDWLSSX,.01,"I")  ; Does the clinic have the right stop code?