- FSCLDS ;SLC/STAFF-NOIS List Definition Save ;1/3/97 17:03
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- SAVE(FSCLNAME,FSCLNUM,OWNER,DESC,TYPE,NOTIFY) ; from FSCLD
- N CNT,DA,DIC,DIE,DLAYGO,DR,EXT,FCOND,FCV,LINE,NUM,OK,OP,OPER,QDESC,STEP,X,Y K DIC
- S OWNER=$G(OWNER) I 'OWNER S OWNER=DUZ
- I 'FSCLNUM D
- .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
- .S FSCLNUM=+Y
- I 'FSCLNUM Q
- S DA=+FSCLNUM,DIE=7107.1,DR=$S(FSCLNAME'=$P(^FSC("LIST",FSCLNUM,0),U):".01///"_FSCLNAME_";",1:"")
- S DR=DR_"1///`"_OWNER_$S($D(TYPE):";2///"_TYPE,1:"")
- I $L($G(NOTIFY)) S DR=DR_";5///"_$P(NOTIFY,U)_";6///"_$P(NOTIFY,U,2)
- I TYPE="A" S DR=DR_";7///WEEKLY"
- L +^FSC("LIST",FSCLNUM):30 I '$T D BAD Q
- D ^DIE
- I $D(DESC) D
- .K ^FSC("LIST",FSCLNUM,2)
- .S CNT=0 F S CNT=$O(DESC(CNT)) Q:CNT<1 S ^FSC("LIST",FSCLNUM,2,CNT,0)=DESC(CNT,0)
- .I $O(^FSC("LIST",FSCLNUM,2,0)) S ^(0)="^^"_CNT_U_CNT_U_DT_U
- I $G(TYPE)="S"!$D(^TMP("FSC DEFINE",$J)) D
- .K ^FSC("LIST",FSCLNUM,1),^(3)
- .I '($G(TYPE)="A"!($G(TYPE)="M")) Q
- .S (NUM,OP)=0 F S OP=$O(^TMP("FSC DEFINE",$J,OP)) Q:OP<1 S OPER=$E(^(OP,0)) D
- ..Q:'$L(OPER)
- ..S STEP=0 F S STEP=$O(^TMP("FSC DEFINE",$J,OP,STEP)) Q:STEP<1 D
- ...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
- ....S EXT=$S(EXT="and":"A",EXT="or":"O",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)
- ....S ^FSC("LIST",FSCLNUM,1,"B",NUM,NUM)=""
- ....S OPER=""
- .S ^FSC("LIST",FSCLNUM,1,0)="^7107.11^"_NUM_U_NUM
- .S (CNT,LINE)=0 F S LINE=$O(^TMP("FSC DEFINE",$J,"DESC",LINE)) Q:LINE<1 S QDESC=^(LINE) D
- ..S CNT=CNT+1,^FSC("LIST",FSCLNUM,3,CNT,0)=QDESC
- .S ^FSC("LIST",FSCLNUM,3,0)="^^"_CNT_U_CNT_U_DT_U
- L -^FSC("LIST",FSCLNUM)
- L +^XTMP("FSC LIST DEF",FSCLNUM):20 I '$T D BAD Q
- E D BUILD^FSCLDU(FSCLNUM,.OK) I 'OK D BAD
- L -^XTMP("FSC LIST DEF",FSCLNUM)
- I $D(VALMAR) D ENTRY^FSCLMM,HEADER^FSCLMM
- Q
- ;
- BAD ; from FSCLMPMS, FSCLMPS
- W !,"This list appears to be defined incorrectly, please recheck.",!,$C(7)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLDS 2136 printed Feb 18, 2025@23:44:28 Page 2
- FSCLDS ;SLC/STAFF-NOIS List Definition Save ;1/3/97 17:03
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- SAVE(FSCLNAME,FSCLNUM,OWNER,DESC,TYPE,NOTIFY) ; from FSCLD
- +1 NEW CNT,DA,DIC,DIE,DLAYGO,DR,EXT,FCOND,FCV,LINE,NUM,OK,OP,OPER,QDESC,STEP,X,Y
- KILL DIC
- +2 SET OWNER=$GET(OWNER)
- IF 'OWNER
- SET OWNER=DUZ
- +3 IF 'FSCLNUM
- Begin DoDot:1
- +4 SET (DIC,DLAYGO)=7107.1
- SET DIC(0)="L"
- SET X=FSCLNAME
- DO ^DIC
- KILL DIC
- IF '$PIECE(Y,U,3)
- WRITE !,"Not defined.",$CHAR(7)
- HANG 2
- QUIT
- +5 SET FSCLNUM=+Y
- End DoDot:1
- +6 IF 'FSCLNUM
- QUIT
- +7 SET DA=+FSCLNUM
- SET DIE=7107.1
- SET DR=$SELECT(FSCLNAME'=$PIECE(^FSC("LIST",FSCLNUM,0),U):".01///"_FSCLNAME_";",1:"")
- +8 SET DR=DR_"1///`"_OWNER_$SELECT($DATA(TYPE):";2///"_TYPE,1:"")
- +9 IF $LENGTH($GET(NOTIFY))
- SET DR=DR_";5///"_$PIECE(NOTIFY,U)_";6///"_$PIECE(NOTIFY,U,2)
- +10 IF TYPE="A"
- SET DR=DR_";7///WEEKLY"
- +11 LOCK +^FSC("LIST",FSCLNUM):30
- IF '$TEST
- DO BAD
- QUIT
- +12 DO ^DIE
- +13 IF $DATA(DESC)
- Begin DoDot:1
- +14 KILL ^FSC("LIST",FSCLNUM,2)
- +15 SET CNT=0
- FOR
- SET CNT=$ORDER(DESC(CNT))
- if CNT<1
- QUIT
- SET ^FSC("LIST",FSCLNUM,2,CNT,0)=DESC(CNT,0)
- +16 IF $ORDER(^FSC("LIST",FSCLNUM,2,0))
- SET ^(0)="^^"_CNT_U_CNT_U_DT_U
- End DoDot:1
- +17 IF $GET(TYPE)="S"!$DATA(^TMP("FSC DEFINE",$JOB))
- Begin DoDot:1
- +18 KILL ^FSC("LIST",FSCLNUM,1),^(3)
- +19 IF '($GET(TYPE)="A"!($GET(TYPE)="M"))
- QUIT
- +20 SET (NUM,OP)=0
- FOR
- SET OP=$ORDER(^TMP("FSC DEFINE",$JOB,OP))
- if OP<1
- QUIT
- SET OPER=$EXTRACT(^(OP,0))
- Begin DoDot:2
- +21 if '$LENGTH(OPER)
- QUIT
- +22 SET STEP=0
- FOR
- SET STEP=$ORDER(^TMP("FSC DEFINE",$JOB,OP,STEP))
- if STEP<1
- QUIT
- Begin DoDot:3
- +23 SET FCOND=0
- FOR
- SET FCOND=$ORDER(^TMP("FSC DEFINE",$JOB,OP,STEP,FCOND))
- if FCOND<1
- QUIT
- SET FCV=^(FCOND)
- SET EXT=$GET(^(FCOND,1))
- Begin DoDot:4
- +24 SET EXT=$SELECT(EXT="and":"A",EXT="or":"O",1:"")
- +25 SET NUM=NUM+1
- SET ^FSC("LIST",FSCLNUM,1,NUM,0)=NUM_U_OPER_U_EXT_U_$PIECE(FCV,U)_U_+$ORDER(^FSC("COND","C",$PIECE(FCV,U,2),0))_U_$PIECE(FCV,U,3)
- +26 SET ^FSC("LIST",FSCLNUM,1,"B",NUM,NUM)=""
- +27 SET OPER=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +28 SET ^FSC("LIST",FSCLNUM,1,0)="^7107.11^"_NUM_U_NUM
- +29 SET (CNT,LINE)=0
- FOR
- SET LINE=$ORDER(^TMP("FSC DEFINE",$JOB,"DESC",LINE))
- if LINE<1
- QUIT
- SET QDESC=^(LINE)
- Begin DoDot:2
- +30 SET CNT=CNT+1
- SET ^FSC("LIST",FSCLNUM,3,CNT,0)=QDESC
- End DoDot:2
- +31 SET ^FSC("LIST",FSCLNUM,3,0)="^^"_CNT_U_CNT_U_DT_U
- End DoDot:1
- +32 LOCK -^FSC("LIST",FSCLNUM)
- +33 LOCK +^XTMP("FSC LIST DEF",FSCLNUM):20
- IF '$TEST
- DO BAD
- QUIT
- +34 IF '$TEST
- DO BUILD^FSCLDU(FSCLNUM,.OK)
- IF 'OK
- DO BAD
- +35 LOCK -^XTMP("FSC LIST DEF",FSCLNUM)
- +36 IF $DATA(VALMAR)
- DO ENTRY^FSCLMM
- DO HEADER^FSCLMM
- +37 QUIT
- +38 ;
- BAD ; from FSCLMPMS, FSCLMPS
- +1 WRITE !,"This list appears to be defined incorrectly, please recheck.",!,$CHAR(7)
- +2 QUIT
