FSCRPTS ;SLC/STAFF-NOIS Report ;1/13/98 16:31
;;1.1;NOIS;;Sep 06, 1998
;
REPORTS ; from FSCOPT
N CHOICE,CNT,DFORM,DIC,DIR,DISPLAY,FIELD,FIELDS,FORMAT,FSCLIMIT,FSCSTYLE,FSCINDX,FSCSORT,LIST,OK,REPORT,X,Y K DIC,DIR,DFORM,FIELDS,FORMAT,FSCSTYLE
S DIR(0)="SAMO^REPORT:REPORT;CUSTOM:CUSTOM",DIR("A")="Select (R)eport or (C)ustom: "
S DIR("?",1)="Enter REPORT to select reports (a report is a list with a sort and format)."
S DIR("?",2)="Enter CUSTOM to select a list, sort, and format."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) Q
S CHOICE=Y
I CHOICE="REPORT" D
.D LOOKUP^FSCULOOK("RPT",.REPORT,"AEMOQ",.OK)
.I 'OK Q
.D PARTS(+REPORT,.LIST,.FSCSORT,.FORMAT,.DFORM)
.Q:'$L(LIST) S FSCLNUM=+LIST,FSCL0=$G(^FSC("LIST",FSCLNUM,0)),FSCLNAME=$P(FSCL0,U)
.I $P(FSCL0,U,5) W !,"For the list ",FSCLNAME D INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0) I '$G(FSCINDX) K LIST
.S FSCSTYLE=$P(DFORM(0),U,2),FSCSTYLE(0)=DFORM(0),OK=1 D
..I FSCSTYLE="BRIEF" S FSCSTYLE="B" Q
..I FSCSTYLE="DETAIL" S FSCSTYLE="D" Q
..I 'FORMAT S OK=0 Q
..I FSCSTYLE="FM" D Q
...I '$L($P(FORMAT(0),U,3)) S OK=0 Q
...S FSCSTYLE("T")="["_$P(FORMAT(0),U,3)_"]"
..I FSCSTYLE="EXECUTE" S FSCSTYLE("F")=FORMAT_U_$P(FORMAT(0),U)
..I FSCSTYLE="EXTRACT" S FSCSTYLE("E")=""
..S CNT=0 F S CNT=$O(^FSC("FORMAT",FORMAT,2,CNT)) Q:CNT<1 S FIELD=+^(CNT,0),FSCSTYLE(CNT)=^FSC("FLD",FIELD,0)
..S FSCSTYLE=$$CHOICE^FSCUX(FSCSTYLE)
.I 'OK D OTHER^FSCUX(.FSCSTYLE,.OK)
.S FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
I CHOICE="CUSTOM" D
.D LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
.I 'OK Q
.S FSCLNAME=$P(LIST,U,2),FSCLNUM=+LIST,FSCL0=$G(^FSC("LIST",FSCLNUM,0))
.I $P(FSCL0,U,5) D INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0) Q:'$G(FSCINDX)
.S DIC=7107.6,DIC(0)="AEMOQ",DIC("A")="Select Sort (optional): ",DIC("S")="I $P(^(0),U,2)=""S"""
.D ^DIC K DIC
.Q:$D(DUOUT) Q:$D(DTOUT)
.S FSCSORT=+Y
.D EXPAND^FSCUX(.FSCSTYLE,.OK)
.I 'OK Q
.S FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
Q:'$D(LIST) Q:'$D(FSCSTYLE)
S DISPLAY="" I '($D(FSCSTYLE("E"))!$D(FSCSTYLE("T"))) D DISPLAY^FSCRU(.DISPLAY,.OK) I 'OK Q
I DISPLAY="DEVICE" D DEV^FSCRU("","^TMP(""FSC LIST"",$J,","DQ^FSCRUDQ","NOIS Report",.OK) Q
D SETUP I $D(VALMQUIT) Q
D VIEW^FSCLM(VALMAR,"VVALUES",.FSCSTYLE)
Q
;
SETUP ; from FSCOPT, FSCRUDQ
N CALLNUM,CNT
K VALMQUIT D ENTRY^FSCLML I $D(VALMQUIT) Q
S VALMAR="^TMP(""FSC LIST CALLS"",$J)"
;I '^TMP("FSC LIST CALLS",$J) W !,"No calls to View." H 2 Q
I $G(FSCSORT) D SETSORT(FSCSORT,.FIELDS),SORT^FSCUS(.FIELDS)
I FSCSTYLE="FM" D Q
.I '$L($G(FSCSTYLE("T"))) Q
.S CNT=0 F S CNT=$O(^TMP("FSC LIST CALLS",$J,"ICX",CNT)) Q:CNT<1 D
..S CALLNUM=0 F S CALLNUM=$O(^TMP("FSC LIST CALLS",$J,"ICX",CNT,CALLNUM)) Q:CALLNUM<1 D TEMP^FSCFORMP
K ^TMP("FSC SELECT",$J,"VVALUES") S ^("VVALUES")=1_"-"_VALMCNT
F CNT=1:1:VALMCNT S ^TMP("FSC SELECT",$J,"VVALUES",CNT)=""
Q
;
SETSORT(SORT,FIELDS) ;
N CNT,FIELD K FIELDS
K FIELDS S CNT=0 F S CNT=$O(^FSC("FORMAT",SORT,2,CNT)) Q:CNT<1 S FIELD=^(CNT,0),FIELDS(CNT)=$G(^FSC("FLD",+FIELD,0)) I $P(FIELD,U,8) S FIELDS(CNT,"D")=""
Q
;
PARTS(REPORT,LIST,SORT,FORMAT,DFORM) ;
N ZERO
S ZERO=$G(^FSC("RPT",+REPORT,0)),LIST=$P(ZERO,U,3),SORT=$P(ZERO,U,5),FORMAT=$P(ZERO,U,4),DFORM=$P(ZERO,U,6)
S FORMAT(0)=$G(^FSC("FORMAT",+FORMAT,0)),DFORM(0)=$G(^FSC("FTYPE",+DFORM,0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPTS 3377 printed Dec 13, 2024@02:20:01 Page 2
FSCRPTS ;SLC/STAFF-NOIS Report ;1/13/98 16:31
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
REPORTS ; from FSCOPT
+1 NEW CHOICE,CNT,DFORM,DIC,DIR,DISPLAY,FIELD,FIELDS,FORMAT,FSCLIMIT,FSCSTYLE,FSCINDX,FSCSORT,LIST,OK,REPORT,X,Y
KILL DIC,DIR,DFORM,FIELDS,FORMAT,FSCSTYLE
+2 SET DIR(0)="SAMO^REPORT:REPORT;CUSTOM:CUSTOM"
SET DIR("A")="Select (R)eport or (C)ustom: "
+3 SET DIR("?",1)="Enter REPORT to select reports (a report is a list with a sort and format)."
+4 SET DIR("?",2)="Enter CUSTOM to select a list, sort, and format."
+5 SET DIR("?")="^D HELP^FSCU(.DIR)"
+6 SET DIR("??")="FSC U1 NOIS"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
QUIT
+9 SET CHOICE=Y
+10 IF CHOICE="REPORT"
Begin DoDot:1
+11 DO LOOKUP^FSCULOOK("RPT",.REPORT,"AEMOQ",.OK)
+12 IF 'OK
QUIT
+13 DO PARTS(+REPORT,.LIST,.FSCSORT,.FORMAT,.DFORM)
+14 if '$LENGTH(LIST)
QUIT
SET FSCLNUM=+LIST
SET FSCL0=$GET(^FSC("LIST",FSCLNUM,0))
SET FSCLNAME=$PIECE(FSCL0,U)
+15 IF $PIECE(FSCL0,U,5)
WRITE !,"For the list ",FSCLNAME
DO INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0)
IF '$GET(FSCINDX)
KILL LIST
+16 SET FSCSTYLE=$PIECE(DFORM(0),U,2)
SET FSCSTYLE(0)=DFORM(0)
SET OK=1
Begin DoDot:2
+17 IF FSCSTYLE="BRIEF"
SET FSCSTYLE="B"
QUIT
+18 IF FSCSTYLE="DETAIL"
SET FSCSTYLE="D"
QUIT
+19 IF 'FORMAT
SET OK=0
QUIT
+20 IF FSCSTYLE="FM"
Begin DoDot:3
+21 IF '$LENGTH($PIECE(FORMAT(0),U,3))
SET OK=0
QUIT
+22 SET FSCSTYLE("T")="["_$PIECE(FORMAT(0),U,3)_"]"
End DoDot:3
QUIT
+23 IF FSCSTYLE="EXECUTE"
SET FSCSTYLE("F")=FORMAT_U_$PIECE(FORMAT(0),U)
+24 IF FSCSTYLE="EXTRACT"
SET FSCSTYLE("E")=""
+25 SET CNT=0
FOR
SET CNT=$ORDER(^FSC("FORMAT",FORMAT,2,CNT))
if CNT<1
QUIT
SET FIELD=+^(CNT,0)
SET FSCSTYLE(CNT)=^FSC("FLD",FIELD,0)
+26 SET FSCSTYLE=$$CHOICE^FSCUX(FSCSTYLE)
End DoDot:2
+27 IF 'OK
DO OTHER^FSCUX(.FSCSTYLE,.OK)
+28 SET FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
End DoDot:1
+29 IF CHOICE="CUSTOM"
Begin DoDot:1
+30 DO LIST^FSCULOOK(.LIST,.FSCLIMIT,.OK)
+31 IF 'OK
QUIT
+32 SET FSCLNAME=$PIECE(LIST,U,2)
SET FSCLNUM=+LIST
SET FSCL0=$GET(^FSC("LIST",FSCLNUM,0))
+33 IF $PIECE(FSCL0,U,5)
DO INDEX^FSCLM(.FSCLNAME,.FSCINDX,FSCL0)
if '$GET(FSCINDX)
QUIT
+34 SET DIC=7107.6
SET DIC(0)="AEMOQ"
SET DIC("A")="Select Sort (optional): "
SET DIC("S")="I $P(^(0),U,2)=""S"""
+35 DO ^DIC
KILL DIC
+36 if $DATA(DUOUT)
QUIT
if $DATA(DTOUT)
QUIT
+37 SET FSCSORT=+Y
+38 DO EXPAND^FSCUX(.FSCSTYLE,.OK)
+39 IF 'OK
QUIT
+40 SET FSCSTYLE=$$STYLE^FSCU(FSCSTYLE)
End DoDot:1
+41 if '$DATA(LIST)
QUIT
if '$DATA(FSCSTYLE)
QUIT
+42 SET DISPLAY=""
IF '($DATA(FSCSTYLE("E"))!$DATA(FSCSTYLE("T")))
DO DISPLAY^FSCRU(.DISPLAY,.OK)
IF 'OK
QUIT
+43 IF DISPLAY="DEVICE"
DO DEV^FSCRU("","^TMP(""FSC LIST"",$J,","DQ^FSCRUDQ","NOIS Report",.OK)
QUIT
+44 DO SETUP
IF $DATA(VALMQUIT)
QUIT
+45 DO VIEW^FSCLM(VALMAR,"VVALUES",.FSCSTYLE)
+46 QUIT
+47 ;
SETUP ; from FSCOPT, FSCRUDQ
+1 NEW CALLNUM,CNT
+2 KILL VALMQUIT
DO ENTRY^FSCLML
IF $DATA(VALMQUIT)
QUIT
+3 SET VALMAR="^TMP(""FSC LIST CALLS"",$J)"
+4 ;I '^TMP("FSC LIST CALLS",$J) W !,"No calls to View." H 2 Q
+5 IF $GET(FSCSORT)
DO SETSORT(FSCSORT,.FIELDS)
DO SORT^FSCUS(.FIELDS)
+6 IF FSCSTYLE="FM"
Begin DoDot:1
+7 IF '$LENGTH($GET(FSCSTYLE("T")))
QUIT
+8 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",CNT))
if CNT<1
QUIT
Begin DoDot:2
+9 SET CALLNUM=0
FOR
SET CALLNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",CNT,CALLNUM))
if CALLNUM<1
QUIT
DO TEMP^FSCFORMP
End DoDot:2
End DoDot:1
QUIT
+10 KILL ^TMP("FSC SELECT",$JOB,"VVALUES")
SET ^("VVALUES")=1_"-"_VALMCNT
+11 FOR CNT=1:1:VALMCNT
SET ^TMP("FSC SELECT",$JOB,"VVALUES",CNT)=""
+12 QUIT
+13 ;
SETSORT(SORT,FIELDS) ;
+1 NEW CNT,FIELD
KILL FIELDS
+2 KILL FIELDS
SET CNT=0
FOR
SET CNT=$ORDER(^FSC("FORMAT",SORT,2,CNT))
if CNT<1
QUIT
SET FIELD=^(CNT,0)
SET FIELDS(CNT)=$GET(^FSC("FLD",+FIELD,0))
IF $PIECE(FIELD,U,8)
SET FIELDS(CNT,"D")=""
+3 QUIT
+4 ;
PARTS(REPORT,LIST,SORT,FORMAT,DFORM) ;
+1 NEW ZERO
+2 SET ZERO=$GET(^FSC("RPT",+REPORT,0))
SET LIST=$PIECE(ZERO,U,3)
SET SORT=$PIECE(ZERO,U,5)
SET FORMAT=$PIECE(ZERO,U,4)
SET DFORM=$PIECE(ZERO,U,6)
+3 SET FORMAT(0)=$GET(^FSC("FORMAT",+FORMAT,0))
SET DFORM(0)=$GET(^FSC("FTYPE",+DFORM,0))
+4 QUIT