FSCRPCF ;SLC/STAFF-NOIS RPC Format ;6/15/98 14:28
;;1.1;NOIS;;Sep 06, 1998
;
CALL(IN,OUT) ; from FSCRPX (RPCCallFormat)
N CALL,FLDS,FMT,NODE,TYPE K FMT
S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1)),FMT=$P($G(^(1)),U,2),FLDS=$P($G(^(1)),U,3)
I 'CALL Q
D INFO(.FMT,FLDS,.NODE,.TYPE)
D BUILD(1,CALL,NODE,.FMT,TYPE,0)
Q
;
LIST(IN,OUT) ; from FSCRPX (RPCListFormat)
N CALL,COLLATE,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,SNUM,TYPE K FMT,^TMP("FSC SELECT",$J),^TMP("FSC STATS",$J)
S LISTFLAG=+$G(^TMP("FSCRPC",$J,"INPUT",1)),FMT=$P($G(^(1)),U,2),FLDS=$P($G(^(1)),U,3),COLLATE=$P($G(^(1)),U,4)
I COLLATE S FMT("COLLATE")=COLLATE
D INFO(.FMT,FLDS,.NODE,.TYPE)
S (LASTNUM,LISTNUM)=0
I LISTFLAG D
.I FMT="STAT" D
..S SNUM=0,CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 S SNUM=SNUM+1,^TMP("FSC SELECT",$J,"VVALUES",SNUM)=""
.S CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 D
..S LISTNUM=LISTNUM+1
..D BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
E D
.I FMT="STAT" D
..S SNUM=0,LNUM=1 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S CALL=+^(LNUM),SNUM=SNUM+1,^TMP("FSC SELECT",$J,"VVALUES",SNUM)=""
.S LNUM=1 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
..S LISTNUM=LISTNUM+1
..D BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
K ^TMP("FSC SELECT",$J),^TMP(NODE,$J)
Q
;
TABLE(IN,OUT) ; from FSCRPX (RPCListTable)
N CALL,COL,COLNUM,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,ROWNUM,TYPE
S LISTFLAG=+$G(^TMP("FSCRPC",$J,"INPUT",1)),FLDS=$P($G(^(1)),U,2)
S FMT="CUSTOM"
D INFO(.FMT,FLDS,.NODE,.TYPE)
S LASTNUM=1,LISTNUM=0,COLNUM=0
S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
.S COLNUM=COLNUM+1
.S LASTNUM=LASTNUM+1
.S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)="0^"_COLNUM_U_$P(FMT(COL),U,2)
S ROWNUM=1
I LISTFLAG D
.S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
..S ROWNUM=ROWNUM+1
..S LASTNUM=LASTNUM+1
..S LISTNUM=LISTNUM+1
..S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$P(^FSCD("CALL",CALL,0),U)
..N FIELD K FIELD
..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
...I '$L($P(FMT(COL),U,7)) S $P(FMT(COL),U,7)=" "
...S FIELD($P(FMT(COL),U,7))=""
..D GET^FSCGET("CUSTOM",CALL,.FIELD)
..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
...S LASTNUM=LASTNUM+1
...I $P(FMT(COL),U,7)="SUBJECT" D
....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($P(FMT(COL),U,7))
...E D
....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$P(FIELD($P(FMT(COL),U,7)),U,2)
.S ^TMP("FSCRPC",$J,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
E D
.S LNUM=1 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
..S ROWNUM=ROWNUM+1
..S LASTNUM=LASTNUM+1
..S LISTNUM=LISTNUM+1
..S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$P(^FSCD("CALL",CALL,0),U)
..N FIELD K FIELD
..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
...I '$L($P(FMT(COL),U,7)) S $P(FMT(COL),U,7)=" "
...S FIELD($P(FMT(COL),U,7))=""
..D GET^FSCGET("CUSTOM",CALL,.FIELD)
..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
...S LASTNUM=LASTNUM+1
...I $P(FMT(COL),U,7)="SUBJECT" D
....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($P(FMT(COL),U,7))
...E D
....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$P(FIELD($P(FMT(COL),U,7)),U,2)
.S ^TMP("FSCRPC",$J,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
Q
;
INFO(FMT,FLDS,NODE,TYPE) ;
N CNT,FIELD,FORMAT,NUM,PIECE
I FMT="BRIEF" S NODE="FSC MULT BRIEF",TYPE="FSC MULT " Q
I FMT="CUSTOM"!(FMT="STAT") D
.S TYPE="FSC VIEW "
.S NODE=TYPE_FMT
.S NUM=0
.I $E(FLDS)="{" D
..S FORMAT=+$P(FLDS,"{",2)
..S CNT=0 F S CNT=$O(^FSC("FORMAT",FORMAT,2,CNT)) Q:CNT<1 S FIELD=+^(CNT,0) D
...S NUM=NUM+1
...S FMT(NUM)=$G(^FSC("FLD",FIELD,0))
.E D
..F PIECE=1:1 S FIELD=$P(FLDS,";",PIECE) Q:FIELD="" D
...S NUM=NUM+1
...S FMT(NUM)=$G(^FSC("FLD",+FIELD,0))
E S NODE="FSC MULT DETAIL",FMT="DETAIL",TYPE="FSC MULT "
Q
;
BUILD(LISTNUM,CALL,NODE,FMT,TYPE,LASTNUM) ;
N FIRSTNUM,LINE,NUM
S FIRSTNUM=LASTNUM+1
K ^TMP(NODE,$J)
D BUILD^FSCFORM(LISTNUM,CALL,.FMT,.LASTNUM,TYPE)
I FMT="BRIEF"!(FMT="DETAIL") D
.S NUM=0 F S NUM=$O(^TMP(NODE,$J,LISTNUM,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
.S LASTNUM=LASTNUM+1,$P(^TMP("FSCRPC",$J,"OUTPUT",LASTNUM),"=",80)=""
I FMT="CUSTOM"!(FMT="STAT") D
.S NUM=0 F S NUM=$O(^TMP(NODE,$J,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
I FMT'="STAT" S ^TMP("FSCRPC",$J,"OUTPUT",FIRSTNUM)=$$SHORT^FSCGETS(CALL,LISTNUM)
K ^TMP(NODE,$J)
Q
;
EDITABLE(IN,OUT) ; from FSCRPX (RPCEditableCall)
N CALL,OLDSTAT
S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I $L($G(^FSCD("CALL",CALL,0))) D ; *** if no status, force to open
.S OLDSTAT=$$STATCALL^FSCESU(CALL)
.I 'OLDSTAT D
..D STATUS^FSCES(CALL,"",1)
..D UPDATE^FSCAUDIT(CALL)
..D UPDATE^FSCTASK(CALL)
S STAT=+$P($G(^FSCD("CALL",CALL,0)),U,2)
D
.I STAT=2 S OPEN=0 Q
.I STAT=99 S OPEN=0 Q
.S OPEN=1
S ^TMP("FSCRPC",$J,"OUTPUT",1)=$$OKTOED(CALL)_U_$$PRIMARY(CALL)_U_OPEN
Q
;
PRIMARY(CALL) ; $$(call) -> 0 or primary ien
Q +$P($G(^FSCD("CALL",+CALL,120)),U,24)
;
OKTOED(CALL) ; $$(call) -> 0 no edit, 1 reopen, 2 edit
N CDATE,CONTACT,DAYS,RESULT,SPEC,STATUS,WKLD,ZERO
S RESULT=0
S ZERO=$G(^FSCD("CALL",+CALL,0)) I '$L(ZERO) Q 0
S CONTACT=$P(ZERO,U,6),STATUS=$P(ZERO,U,2),CDATE=$P(ZERO,U,4),SPEC=$$ACCESS^FSCU(DUZ,"SPEC")
I '(STATUS=2!(STATUS=99)) Q 2
I SPEC D Q RESULT
.I STATUS=99 S RESULT=1 Q
.S DAYS=+$P(^FSC("PARAM",1,0),U,10),WKLD=+$P(^(0),U,9)
.I 'WKLD S RESULT=1 Q
.I 'DAYS S DAYS=30
.I DT>$$FMADD^XLFDT(CDATE,DAYS) S RESULT=1 Q
.S RESULT=2
I CONTACT=DUZ Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCF 5773 printed Apr 09, 2024@21:22:35 Page 2
FSCRPCF ;SLC/STAFF-NOIS RPC Format ;6/15/98 14:28
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
CALL(IN,OUT) ; from FSCRPX (RPCCallFormat)
+1 NEW CALL,FLDS,FMT,NODE,TYPE
KILL FMT
+2 SET CALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET FMT=$PIECE($GET(^(1)),U,2)
SET FLDS=$PIECE($GET(^(1)),U,3)
+3 IF 'CALL
QUIT
+4 DO INFO(.FMT,FLDS,.NODE,.TYPE)
+5 DO BUILD(1,CALL,NODE,.FMT,TYPE,0)
+6 QUIT
+7 ;
LIST(IN,OUT) ; from FSCRPX (RPCListFormat)
+1 NEW CALL,COLLATE,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,SNUM,TYPE
KILL FMT,^TMP("FSC SELECT",$JOB),^TMP("FSC STATS",$JOB)
+2 SET LISTFLAG=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET FMT=$PIECE($GET(^(1)),U,2)
SET FLDS=$PIECE($GET(^(1)),U,3)
SET COLLATE=$PIECE($GET(^(1)),U,4)
+3 IF COLLATE
SET FMT("COLLATE")=COLLATE
+4 DO INFO(.FMT,FLDS,.NODE,.TYPE)
+5 SET (LASTNUM,LISTNUM)=0
+6 IF LISTFLAG
Begin DoDot:1
+7 IF FMT="STAT"
Begin DoDot:2
+8 SET SNUM=0
SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
if CALL<1
QUIT
SET SNUM=SNUM+1
SET ^TMP("FSC SELECT",$JOB,"VVALUES",SNUM)=""
End DoDot:2
+9 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
if CALL<1
QUIT
Begin DoDot:2
+10 SET LISTNUM=LISTNUM+1
+11 DO BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
End DoDot:2
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 IF FMT="STAT"
Begin DoDot:2
+14 SET SNUM=0
SET LNUM=1
FOR
SET LNUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
SET SNUM=SNUM+1
SET ^TMP("FSC SELECT",$JOB,"VVALUES",SNUM)=""
End DoDot:2
+15 SET LNUM=1
FOR
SET LNUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
Begin DoDot:2
+16 SET LISTNUM=LISTNUM+1
+17 DO BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
End DoDot:2
End DoDot:1
+18 KILL ^TMP("FSC SELECT",$JOB),^TMP(NODE,$JOB)
+19 QUIT
+20 ;
TABLE(IN,OUT) ; from FSCRPX (RPCListTable)
+1 NEW CALL,COL,COLNUM,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,ROWNUM,TYPE
+2 SET LISTFLAG=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET FLDS=$PIECE($GET(^(1)),U,2)
+3 SET FMT="CUSTOM"
+4 DO INFO(.FMT,FLDS,.NODE,.TYPE)
+5 SET LASTNUM=1
SET LISTNUM=0
SET COLNUM=0
+6 SET COL=0
FOR
SET COL=$ORDER(FMT(COL))
if COL<1
QUIT
Begin DoDot:1
+7 SET COLNUM=COLNUM+1
+8 SET LASTNUM=LASTNUM+1
+9 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)="0^"_COLNUM_U_$PIECE(FMT(COL),U,2)
End DoDot:1
+10 SET ROWNUM=1
+11 IF LISTFLAG
Begin DoDot:1
+12 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
Begin DoDot:2
+13 SET ROWNUM=ROWNUM+1
+14 SET LASTNUM=LASTNUM+1
+15 SET LISTNUM=LISTNUM+1
+16 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$PIECE(^FSCD("CALL",CALL,0),U)
+17 NEW FIELD
KILL FIELD
+18 SET COL=0
FOR
SET COL=$ORDER(FMT(COL))
if COL<1
QUIT
Begin DoDot:3
+19 IF '$LENGTH($PIECE(FMT(COL),U,7))
SET $PIECE(FMT(COL),U,7)=" "
+20 SET FIELD($PIECE(FMT(COL),U,7))=""
End DoDot:3
+21 DO GET^FSCGET("CUSTOM",CALL,.FIELD)
+22 SET COL=0
FOR
SET COL=$ORDER(FMT(COL))
if COL<1
QUIT
Begin DoDot:3
+23 SET LASTNUM=LASTNUM+1
+24 IF $PIECE(FMT(COL),U,7)="SUBJECT"
Begin DoDot:4
+25 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($PIECE(FMT(COL),U,7))
End DoDot:4
+26 IF '$TEST
Begin DoDot:4
+27 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$PIECE(FIELD($PIECE(FMT(COL),U,7)),U,2)
End DoDot:4
End DoDot:3
End DoDot:2
+28 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET LNUM=1
FOR
SET LNUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
Begin DoDot:2
+31 SET ROWNUM=ROWNUM+1
+32 SET LASTNUM=LASTNUM+1
+33 SET LISTNUM=LISTNUM+1
+34 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$PIECE(^FSCD("CALL",CALL,0),U)
+35 NEW FIELD
KILL FIELD
+36 SET COL=0
FOR
SET COL=$ORDER(FMT(COL))
if COL<1
QUIT
Begin DoDot:3
+37 IF '$LENGTH($PIECE(FMT(COL),U,7))
SET $PIECE(FMT(COL),U,7)=" "
+38 SET FIELD($PIECE(FMT(COL),U,7))=""
End DoDot:3
+39 DO GET^FSCGET("CUSTOM",CALL,.FIELD)
+40 SET COL=0
FOR
SET COL=$ORDER(FMT(COL))
if COL<1
QUIT
Begin DoDot:3
+41 SET LASTNUM=LASTNUM+1
+42 IF $PIECE(FMT(COL),U,7)="SUBJECT"
Begin DoDot:4
+43 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($PIECE(FMT(COL),U,7))
End DoDot:4
+44 IF '$TEST
Begin DoDot:4
+45 SET ^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$PIECE(FIELD($PIECE(FMT(COL),U,7)),U,2)
End DoDot:4
End DoDot:3
End DoDot:2
+46 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
End DoDot:1
+47 QUIT
+48 ;
INFO(FMT,FLDS,NODE,TYPE) ;
+1 NEW CNT,FIELD,FORMAT,NUM,PIECE
+2 IF FMT="BRIEF"
SET NODE="FSC MULT BRIEF"
SET TYPE="FSC MULT "
QUIT
+3 IF FMT="CUSTOM"!(FMT="STAT")
Begin DoDot:1
+4 SET TYPE="FSC VIEW "
+5 SET NODE=TYPE_FMT
+6 SET NUM=0
+7 IF $EXTRACT(FLDS)="{"
Begin DoDot:2
+8 SET FORMAT=+$PIECE(FLDS,"{",2)
+9 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("FORMAT",FORMAT,2,CNT))
if CNT<1
QUIT
SET FIELD=+^(CNT,0)
Begin DoDot:3
+10 SET NUM=NUM+1
+11 SET FMT(NUM)=$GET(^FSC("FLD",FIELD,0))
End DoDot:3
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 FOR PIECE=1:1
SET FIELD=$PIECE(FLDS,";",PIECE)
if FIELD=""
QUIT
Begin DoDot:3
+14 SET NUM=NUM+1
+15 SET FMT(NUM)=$GET(^FSC("FLD",+FIELD,0))
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF '$TEST
SET NODE="FSC MULT DETAIL"
SET FMT="DETAIL"
SET TYPE="FSC MULT "
+17 QUIT
+18 ;
BUILD(LISTNUM,CALL,NODE,FMT,TYPE,LASTNUM) ;
+1 NEW FIRSTNUM,LINE,NUM
+2 SET FIRSTNUM=LASTNUM+1
+3 KILL ^TMP(NODE,$JOB)
+4 DO BUILD^FSCFORM(LISTNUM,CALL,.FMT,.LASTNUM,TYPE)
+5 IF FMT="BRIEF"!(FMT="DETAIL")
Begin DoDot:1
+6 SET NUM=0
FOR
SET NUM=$ORDER(^TMP(NODE,$JOB,LISTNUM,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:2
+7 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=LINE
End DoDot:2
+8 SET LASTNUM=LASTNUM+1
SET $PIECE(^TMP("FSCRPC",$JOB,"OUTPUT",LASTNUM),"=",80)=""
End DoDot:1
+9 IF FMT="CUSTOM"!(FMT="STAT")
Begin DoDot:1
+10 SET NUM=0
FOR
SET NUM=$ORDER(^TMP(NODE,$JOB,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:2
+11 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=LINE
End DoDot:2
End DoDot:1
+12 IF FMT'="STAT"
SET ^TMP("FSCRPC",$JOB,"OUTPUT",FIRSTNUM)=$$SHORT^FSCGETS(CALL,LISTNUM)
+13 KILL ^TMP(NODE,$JOB)
+14 QUIT
+15 ;
EDITABLE(IN,OUT) ; from FSCRPX (RPCEditableCall)
+1 NEW CALL,OLDSTAT
+2 SET CALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 ; *** if no status, force to open
IF $LENGTH($GET(^FSCD("CALL",CALL,0)))
Begin DoDot:1
+4 SET OLDSTAT=$$STATCALL^FSCESU(CALL)
+5 IF 'OLDSTAT
Begin DoDot:2
+6 DO STATUS^FSCES(CALL,"",1)
+7 DO UPDATE^FSCAUDIT(CALL)
+8 DO UPDATE^FSCTASK(CALL)
End DoDot:2
End DoDot:1
+9 SET STAT=+$PIECE($GET(^FSCD("CALL",CALL,0)),U,2)
+10 Begin DoDot:1
+11 IF STAT=2
SET OPEN=0
QUIT
+12 IF STAT=99
SET OPEN=0
QUIT
+13 SET OPEN=1
End DoDot:1
+14 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=$$OKTOED(CALL)_U_$$PRIMARY(CALL)_U_OPEN
+15 QUIT
+16 ;
PRIMARY(CALL) ; $$(call) -> 0 or primary ien
+1 QUIT +$PIECE($GET(^FSCD("CALL",+CALL,120)),U,24)
+2 ;
OKTOED(CALL) ; $$(call) -> 0 no edit, 1 reopen, 2 edit
+1 NEW CDATE,CONTACT,DAYS,RESULT,SPEC,STATUS,WKLD,ZERO
+2 SET RESULT=0
+3 SET ZERO=$GET(^FSCD("CALL",+CALL,0))
IF '$LENGTH(ZERO)
QUIT 0
+4 SET CONTACT=$PIECE(ZERO,U,6)
SET STATUS=$PIECE(ZERO,U,2)
SET CDATE=$PIECE(ZERO,U,4)
SET SPEC=$$ACCESS^FSCU(DUZ,"SPEC")
+5 IF '(STATUS=2!(STATUS=99))
QUIT 2
+6 IF SPEC
Begin DoDot:1
+7 IF STATUS=99
SET RESULT=1
QUIT
+8 SET DAYS=+$PIECE(^FSC("PARAM",1,0),U,10)
SET WKLD=+$PIECE(^(0),U,9)
+9 IF 'WKLD
SET RESULT=1
QUIT
+10 IF 'DAYS
SET DAYS=30
+11 IF DT>$$FMADD^XLFDT(CDATE,DAYS)
SET RESULT=1
QUIT
+12 SET RESULT=2
End DoDot:1
QUIT RESULT
+13 IF CONTACT=DUZ
QUIT 1
+14 QUIT 0
