| 1 | 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
|
|---|
| 2 | ;;5.3;scheduling;**263,485,497,446**;AUG 13 1993;Build 77
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ; 05/09/2006 SD*5.3*485 CORRECT ENROLLMENT STATUS.
|
|---|
| 11 | ; 06/05/2006 SD*5.3*446 Scheduling reminder flag
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | NEW ;ADD NEW PATIENT
|
|---|
| 15 | K DIC,DIR,DR,DIE N %H,SDWLDS,SDWLE,SDWLNEW,SDWLRNED,SDWLX,SDWLY
|
|---|
| 16 | S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN S (SDWLDA,DA)=+Y
|
|---|
| 17 | S SDWLNEW=1 K DIC
|
|---|
| 18 | L ^SDWL(409.3,SDWLDA)
|
|---|
| 19 | S DIE="^SDWL(409.3,",DR="1////^S X=DT"
|
|---|
| 20 | D:$G(SDWLACA) ; 446
|
|---|
| 21 | .W !,"Note: you are about to create an EWL entry to be used as a Scheduling Reminder."
|
|---|
| 22 | .S DR=DR_";33////^S X=""Y"""
|
|---|
| 23 | .Q
|
|---|
| 24 | D ^DIE
|
|---|
| 25 | ;
|
|---|
| 26 | ;DETERMINE ENROLLEE STATUS
|
|---|
| 27 | ;
|
|---|
| 28 | ;SDWLE=1 = NEW ENROLLEE
|
|---|
| 29 | ;SDWLE=2 = ESTABLISHED
|
|---|
| 30 | ;SDWLE=3 = PRIOR ENROLLEE
|
|---|
| 31 | ;SDWLE=4 = UNDETERMINED
|
|---|
| 32 | TST ;
|
|---|
| 33 | EN S SDWLDE=+$H,SDWLE=1,(SDWLEE,SDWLRNED,SDWLDB)=0 D SB1
|
|---|
| 34 | G SB0:SDWLE=2
|
|---|
| 35 | S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) G SB0:$P(SDWLRNE,U,4)="A" S SDWLRNED=$P(SDWLRNE,U,3)
|
|---|
| 36 | 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
|
|---|
| 37 | I $D(SDWLDET),SDWLDET>365 S SDWLE=3
|
|---|
| 38 | I 'SDWLRNE S SDWLE=4
|
|---|
| 39 | SB0 I $D(SDWLRNE),$P(SDWLRNE,U,4)="A" D
|
|---|
| 40 | .I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=4 Q
|
|---|
| 41 | .I 'SDWLEE S SDWLE=4 Q
|
|---|
| 42 | S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U",1:"U")
|
|---|
| 43 | ;-Code here for filling in 409.3
|
|---|
| 44 | S DR="27////^S X=SDWLRNE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE
|
|---|
| 45 | ;SAVE ENROLLEE CALCULATION DATE
|
|---|
| 46 | S DR="27.1////^S X=$S($G(SDWLRNED):SDWLRNED,$G(SDWLD):SDWLD,1:"""")" D ^DIE
|
|---|
| 47 | ;SAVE DATABASE FILE
|
|---|
| 48 | S DR="27.2////^S X=SDWLDB" D ^DIE
|
|---|
| 49 | S DR="9////^S X=DUZ" D ^DIE
|
|---|
| 50 | K SDWLRNE,SDWLD,SDWLDE,SDWLEE,SDWLDET,DIC,DIR,DR,DIE,X
|
|---|
| 51 | Q
|
|---|
| 52 | SB1 I '$D(^DGCN(391.91,"B",SDWLDFN)) N SDWLDB S SDWLE=3 Q
|
|---|
| 53 | S SDWLX="" F S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX="" D
|
|---|
| 54 | .S SDWLY=$G(^DGCN(391.91,SDWLX,0)) D
|
|---|
| 55 | ..;CHECK FOR VALID TF
|
|---|
| 56 | ..I $$TF^XUAF4(+$P(SDWLY,U,2)) D
|
|---|
| 57 | ...;GET LIST OF DATES FOR TF
|
|---|
| 58 | ...S SDWLD=$P(SDWLY,U,3) I SDWLD S SDWLDTF(9999999-SDWLD)=SDWLX
|
|---|
| 59 | ;FIND LAST TREATMENT DATE
|
|---|
| 60 | I '$D(SDWLDTF) Q
|
|---|
| 61 | 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
|
|---|
| 62 | I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=3
|
|---|
| 63 | K SDWLDTF
|
|---|
| 64 | END Q
|
|---|
