Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCLDS

FSCLDS.m

Go to the documentation of this file.
  1. FSCLDS ;SLC/STAFF-NOIS List Definition Save ;1/3/97 17:03
  1. ;;1.1;NOIS;;Sep 06, 1998
  1. ;
  1. SAVE(FSCLNAME,FSCLNUM,OWNER,DESC,TYPE,NOTIFY) ; from FSCLD
  1. N CNT,DA,DIC,DIE,DLAYGO,DR,EXT,FCOND,FCV,LINE,NUM,OK,OP,OPER,QDESC,STEP,X,Y K DIC
  1. S OWNER=$G(OWNER) I 'OWNER S OWNER=DUZ
  1. I 'FSCLNUM D
  1. .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
  1. .S FSCLNUM=+Y
  1. I 'FSCLNUM Q
  1. S DA=+FSCLNUM,DIE=7107.1,DR=$S(FSCLNAME'=$P(^FSC("LIST",FSCLNUM,0),U):".01///"_FSCLNAME_";",1:"")
  1. S DR=DR_"1///`"_OWNER_$S($D(TYPE):";2///"_TYPE,1:"")
  1. I $L($G(NOTIFY)) S DR=DR_";5///"_$P(NOTIFY,U)_";6///"_$P(NOTIFY,U,2)
  1. I TYPE="A" S DR=DR_";7///WEEKLY"
  1. L +^FSC("LIST",FSCLNUM):30 I '$T D BAD Q
  1. D ^DIE
  1. I $D(DESC) D
  1. .K ^FSC("LIST",FSCLNUM,2)
  1. .S CNT=0 F S CNT=$O(DESC(CNT)) Q:CNT<1 S ^FSC("LIST",FSCLNUM,2,CNT,0)=DESC(CNT,0)
  1. .I $O(^FSC("LIST",FSCLNUM,2,0)) S ^(0)="^^"_CNT_U_CNT_U_DT_U
  1. I $G(TYPE)="S"!$D(^TMP("FSC DEFINE",$J)) D
  1. .K ^FSC("LIST",FSCLNUM,1),^(3)
  1. .I '($G(TYPE)="A"!($G(TYPE)="M")) Q
  1. .S (NUM,OP)=0 F S OP=$O(^TMP("FSC DEFINE",$J,OP)) Q:OP<1 S OPER=$E(^(OP,0)) D
  1. ..Q:'$L(OPER)
  1. ..S STEP=0 F S STEP=$O(^TMP("FSC DEFINE",$J,OP,STEP)) Q:STEP<1 D
  1. ...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
  1. ....S EXT=$S(EXT="and":"A",EXT="or":"O",1:"")
  1. ....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)
  1. ....S ^FSC("LIST",FSCLNUM,1,"B",NUM,NUM)=""
  1. ....S OPER=""
  1. .S ^FSC("LIST",FSCLNUM,1,0)="^7107.11^"_NUM_U_NUM
  1. .S (CNT,LINE)=0 F S LINE=$O(^TMP("FSC DEFINE",$J,"DESC",LINE)) Q:LINE<1 S QDESC=^(LINE) D
  1. ..S CNT=CNT+1,^FSC("LIST",FSCLNUM,3,CNT,0)=QDESC
  1. .S ^FSC("LIST",FSCLNUM,3,0)="^^"_CNT_U_CNT_U_DT_U
  1. L -^FSC("LIST",FSCLNUM)
  1. L +^XTMP("FSC LIST DEF",FSCLNUM):20 I '$T D BAD Q
  1. E D BUILD^FSCLDU(FSCLNUM,.OK) I 'OK D BAD
  1. L -^XTMP("FSC LIST DEF",FSCLNUM)
  1. I $D(VALMAR) D ENTRY^FSCLMM,HEADER^FSCLMM
  1. Q
  1. ;
  1. BAD ; from FSCLMPMS, FSCLMPS
  1. W !,"This list appears to be defined incorrectly, please recheck.",!,$C(7)
  1. Q