source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLE11.m@ 1780

Last change on this file since 1780 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SDWLE11 ;;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 ;
14NEW ;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
32TST ;
33EN 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
39SB0 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
52SB1 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
64END Q
Note: See TracBrowser for help on using the repository browser.