source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCLDS.m@ 1450

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1FSCLDS ;SLC/STAFF-NOIS List Definition Save ;1/3/97 17:03
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4SAVE(FSCLNAME,FSCLNUM,OWNER,DESC,TYPE,NOTIFY) ; from FSCLD
5 N CNT,DA,DIC,DIE,DLAYGO,DR,EXT,FCOND,FCV,LINE,NUM,OK,OP,OPER,QDESC,STEP,X,Y K DIC
6 S OWNER=$G(OWNER) I 'OWNER S OWNER=DUZ
7 I 'FSCLNUM D
8 .S (DIC,DLAYGO)=7107.1,DIC(0)="L",X=FSCLNAME D ^DIC K DIC I '$P(Y,U,3) W !,"Not defined.",$C(7) H 2 Q
9 .S FSCLNUM=+Y
10 I 'FSCLNUM Q
11 S DA=+FSCLNUM,DIE=7107.1,DR=$S(FSCLNAME'=$P(^FSC("LIST",FSCLNUM,0),U):".01///"_FSCLNAME_";",1:"")
12 S DR=DR_"1///`"_OWNER_$S($D(TYPE):";2///"_TYPE,1:"")
13 I $L($G(NOTIFY)) S DR=DR_";5///"_$P(NOTIFY,U)_";6///"_$P(NOTIFY,U,2)
14 I TYPE="A" S DR=DR_";7///WEEKLY"
15 L +^FSC("LIST",FSCLNUM):30 I '$T D BAD Q
16 D ^DIE
17 I $D(DESC) D
18 .K ^FSC("LIST",FSCLNUM,2)
19 .S CNT=0 F S CNT=$O(DESC(CNT)) Q:CNT<1 S ^FSC("LIST",FSCLNUM,2,CNT,0)=DESC(CNT,0)
20 .I $O(^FSC("LIST",FSCLNUM,2,0)) S ^(0)="^^"_CNT_U_CNT_U_DT_U
21 I $G(TYPE)="S"!$D(^TMP("FSC DEFINE",$J)) D
22 .K ^FSC("LIST",FSCLNUM,1),^(3)
23 .I '($G(TYPE)="A"!($G(TYPE)="M")) Q
24 .S (NUM,OP)=0 F S OP=$O(^TMP("FSC DEFINE",$J,OP)) Q:OP<1 S OPER=$E(^(OP,0)) D
25 ..Q:'$L(OPER)
26 ..S STEP=0 F S STEP=$O(^TMP("FSC DEFINE",$J,OP,STEP)) Q:STEP<1 D
27 ...S FCOND=0 F S FCOND=$O(^TMP("FSC DEFINE",$J,OP,STEP,FCOND)) Q:FCOND<1 S FCV=^(FCOND),EXT=$G(^(FCOND,1)) D
28 ....S EXT=$S(EXT="and":"A",EXT="or":"O",1:"")
29 ....S NUM=NUM+1,^FSC("LIST",FSCLNUM,1,NUM,0)=NUM_U_OPER_U_EXT_U_$P(FCV,U)_U_+$O(^FSC("COND","C",$P(FCV,U,2),0))_U_$P(FCV,U,3)
30 ....S ^FSC("LIST",FSCLNUM,1,"B",NUM,NUM)=""
31 ....S OPER=""
32 .S ^FSC("LIST",FSCLNUM,1,0)="^7107.11^"_NUM_U_NUM
33 .S (CNT,LINE)=0 F S LINE=$O(^TMP("FSC DEFINE",$J,"DESC",LINE)) Q:LINE<1 S QDESC=^(LINE) D
34 ..S CNT=CNT+1,^FSC("LIST",FSCLNUM,3,CNT,0)=QDESC
35 .S ^FSC("LIST",FSCLNUM,3,0)="^^"_CNT_U_CNT_U_DT_U
36 L -^FSC("LIST",FSCLNUM)
37 L +^XTMP("FSC LIST DEF",FSCLNUM):20 I '$T D BAD Q
38 E D BUILD^FSCLDU(FSCLNUM,.OK) I 'OK D BAD
39 L -^XTMP("FSC LIST DEF",FSCLNUM)
40 I $D(VALMAR) D ENTRY^FSCLMM,HEADER^FSCLMM
41 Q
42 ;
43BAD ; from FSCLMPMS, FSCLMPS
44 W !,"This list appears to be defined incorrectly, please recheck.",!,$C(7)
45 Q
Note: See TracBrowser for help on using the repository browser.