SDWLE11 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT - WAIT LIST TYPE/INSTUTITION;06/12/2002 ; 20 Aug 2002 2:10 PM  ; Compiled May 25, 2007 16:20:20
 ;;5.3;scheduling;**263,485,497,446**;AUG 13 1993;Build 77
 ;
 ;
 ;******************************************************************
 ; CHANGE LOG
 ; 
 ; DATE PATCH DESCRIPTION
 ; ---- ----- -----------
 ; 05/09/2006 SD*5.3*485 CORRECT ENROLLMENT STATUS. 
 ; 06/05/2006 SD*5.3*446 Scheduling reminder flag 
 ; 
 ; 
NEW ;ADD NEW PATIENT
 K DIC,DIR,DR,DIE N %H,SDWLDS,SDWLE,SDWLNEW,SDWLRNED,SDWLX,SDWLY
 S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN S (SDWLDA,DA)=+Y
 S SDWLNEW=1 K DIC
 L ^SDWL(409.3,SDWLDA)
 S DIE="^SDWL(409.3,",DR="1////^S X=DT"
 D:$G(SDWLACA)  ; 446
 .W !,"Note: you are about to create an EWL entry to be used as a Scheduling Reminder."
 .S DR=DR_";33////^S X=""Y"""
 .Q
 D ^DIE
 ;
 ;DETERMINE ENROLLEE STATUS
 ;
 ;SDWLE=1 = NEW ENROLLEE
 ;SDWLE=2 = ESTABLISHED
 ;SDWLE=3 = PRIOR ENROLLEE
 ;SDWLE=4 = UNDETERMINED
TST ;
EN S SDWLDE=+$H,SDWLE=1,(SDWLEE,SDWLRNED,SDWLDB)=0 D SB1
 G SB0:SDWLE=2
 S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) G SB0:$P(SDWLRNE,U,4)="A" S SDWLRNED=$P(SDWLRNE,U,3)
 I SDWLRNED S X=SDWLRNED D H^%DTC S SDWLDS=%H S SDWLDE=+$H,SDWLDET=SDWLDE-SDWLDS,SDWLDB=2 I SDWLDET<366 S SDWLE=1
 I $D(SDWLDET),SDWLDET>365 S SDWLE=3
 I 'SDWLRNE S SDWLE=4
SB0 I $D(SDWLRNE),$P(SDWLRNE,U,4)="A" D
 .I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=4 Q
 .I 'SDWLEE S SDWLE=4 Q
 S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U",1:"U")
 ;-Code here for filling in 409.3
 S DR="27////^S X=SDWLRNE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
 ;SAVE ENROLLEE CALCULATION DATE
 S DR="27.1////^S X=$S($G(SDWLRNED):SDWLRNED,$G(SDWLD):SDWLD,1:"""")" D ^DIE
 ;SAVE DATABASE FILE
 S DR="27.2////^S X=SDWLDB" D ^DIE
 S DR="9////^S X=DUZ" D ^DIE
 K SDWLRNE,SDWLD,SDWLDE,SDWLEE,SDWLDET,DIC,DIR,DR,DIE,X
 Q
SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) N SDWLDB S SDWLE=3 Q
 S SDWLX="" F  S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX=""  D
 .S SDWLY=$G(^DGCN(391.91,SDWLX,0)) D
 ..;CHECK FOR VALID TF
 ..I $$TF^XUAF4(+$P(SDWLY,U,2)) D
 ...;GET LIST OF DATES FOR TF
 ...S SDWLD=$P(SDWLY,U,3) I SDWLD S SDWLDTF(9999999-SDWLD)=SDWLX
 ;FIND LAST TREATMENT DATE
 I '$D(SDWLDTF) Q
 S SDWLDTF=$O(SDWLDTF(0)) I SDWLDTF S (SDWLD,X)=9999999-SDWLDTF D H^%DTC S SDWLEE=SDWLDE-%H,SDWLDB=1 I SDWLEE<730 S SDWLE=2
 I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=3
 K SDWLDTF
END Q