source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCEN10.m@ 862

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1YSCEN10 ;DALISC/LJA - MH Census File Utility(s) ;08/02/93 17:01
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4CKWT ; Check that MH Census entry's Team's Ward Location matches
5 ; that entry's Ward...
6 ; YSCENDA -- req
7 S YSCENOK=0
8 QUIT:$G(YSCENDA)'>0 ;->
9 N YSCENDO,YSCENDTA,YSCENI,YSCENLP,YSCENPB,YSCENRNO,YSCENX,YSCENWNO
10 S YSCENRT=0 ;# Rotating Teams
11 K DIQ
12 S DIC=618,DA=+YSCENDA,DIQ="YSCENDTA",DIQ(0)="IE",DR=".01;2.8:3.4"
13 D EN^DIQ1
14 ;
15SETVAR ; Ward information
16 S YSCENWNO=$G(YSCENDTA(618,+YSCENDA,.01,"I"))_U_$G(YSCENDTA(618,+YSCENDA,.01,"E"))
17 ;
18 ; Default Team information
19 S YSCENDNO=$G(YSCENDTA(618,+YSCENDA,2.8,"I"))_U_$G(YSCENDTA(618,+YSCENDA,2.8,"E"))
20 ;
21 ; Team Rotation 1
22 S YSCENX=$G(YSCENDTA(618,+YSCENDA,3,"I"))_U_$G(YSCENDTA(618,+YSCENDA,3,"E"))
23 I +YSCENX S YSCENRNO(1)=YSCENX
24 ;
25 ; Team Rotation 2
26 S YSCENX=$G(YSCENDTA(618,+YSCENDA,3.1,"I"))_U_$G(YSCENDTA(618,+YSCENDA,.01,"E"))
27 I +YSCENX S YSCENRNO(2)=YSCENX
28 ;
29 ; Team Rotation 3
30 S YSCENX=$G(YSCENDTA(618,+YSCENDA,3.2,"I"))_U_$G(YSCENDTA(618,+YSCENDA,3.2,"E"))
31 I +YSCENX S YSCENRNO(3)=YSCENX
32 ;
33 ; Team Rotation 4
34 S YSCENX=$G(YSCENDTA(618,+YSCENDA,3.3,"I"))_U_$G(YSCENDTA(618,+YSCENDA,3.3,"E"))
35 I +YSCENX S YSCENRNO(4)=YSCENX
36 ;
37 ; Team Rotation 5
38 S YSCENX=$G(YSCENDTA(618,+YSCENDA,3.4,"I"))_U_$G(YSCENDTA(618,+YSCENDA,3.4,"E"))
39 I +YSCENX S YSCENRNO(5)=YSCENX
40 ;
41LOOPCK ; Loop and check
42 S YSCENLP=1 ;Assume no problems exist
43 K YSCENPB
44 I +YSCENWNO'=+YSCENDNO S YSCENPB(1)="" ; Default team check
45 ;
46 ; Loop thru Team Rotations...
47 S YSCENI=0
48 F S YSCENI=$O(YSCENRNO(YSCENI)) QUIT:+YSCENI'>0 D
49 . I +YSCENWNO'=+YSCENRNO(+YSCENI) S YSCENPB(+YSCENI)=""
50 ;
51CHECK ; Check results
52 I '$D(YSCENPB) S YSCENOK=1 QUIT ;->
53 ;
54 QUIT
55 ;
56EOR ;YSCEN10 - MH Census File Utility(s) ;8/2/93 15:30
Note: See TracBrowser for help on using the repository browser.