FSCRX ;SLC/STAFF-NOIS Report Extract ;1/29/98 18:51
;;1.1;NOIS;;Sep 06, 1998
;
N ALL
I TYPE'["VIEW" Q
I CALLNUM=0 W !,"No calls to display." H 2 S DTOUT=1 Q
I $G(CALLCNT)=1 D Q
.D FULL^VALM1
.W !,"This is a special ouput to capture NOIS data using a terminal emulator."
.K EXTRACT,CHOICE
.;D FIELDS(.EXTRACT,.CHOICE,.OK)
.S CNT=0 F S CNT=$O(FORMAT(CNT)) Q:CNT<1 S CHOICE(CNT)=FORMAT(CNT),FIELDS($P(FORMAT(CNT),U,7))=""
.N DIR,X,Y K DIR
.S DIR(0)="FAO^1:1",DIR("A")="Enter a delimiter: ",DIR("B")=","
.S DIR("?",1)="Enter a single character used to delimit the fields."
.S DIR("?",2)="If the data contains this delimiter it will be repalced by a space."
.S DIR("?",3)="For example: DOE,JOHN with a comma delimiter would appear as DOE JOHN."
.S DIR("?",4)="Enter 'E' to exit (NOTE: a '^' will be used as a delimiter)."
.S DIR("?",5)="Enter '??' for more help."
.S DIR("?")="^D HELP^FSCU(.DIR)"
.S DIR("??")="FSC U1 NOIS"
.W !,"-- Begin capture after this prompt. --"
.D ^DIR K DIR
.I Y="E"!$D(DTOUT) S DTOUT=1 Q
.S DELIM=$S($L(Y):Y,1:",")
.S IOP=";255;9999" D ^%ZIS
.W !
.S ALL=0 I '$L($O(EXTRACT(""))) S ALL=1
.D GET^FSCGET($S('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
.S:$D(EXTRACT("REF"))!ALL EXTRACT("REF")=U_$P($G(^FSCD("CALL",CALLNUM,0)),U) S:$D(EXTRACT("SUBJECT"))!ALL EXTRACT("SUBJECT")=U_$G(^(1))
.S CNT=0 F S CNT=$O(CHOICE(CNT)) Q:CNT<1 S VALUE=$P(CHOICE(CNT),U,7) W $TR(VALUE,DELIM," "),DELIM
.W ! D FORMATX
.I $G(CALLCNT)=+^TMP("FSC LIST CALLS",$J) W ! D HOME^%ZIS,PAUSE^FSCU(.OK) K EXTRACT
I $G(CALLCNT)'=1 D
.S ALL=0 I '$L($O(EXTRACT(""))) S ALL=1
.D GET^FSCGET($S('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
.S:$D(EXTRACT("REF"))!ALL EXTRACT("REF")=U_$P($G(^FSCD("CALL",CALLNUM,0)),U) S:$D(EXTRACT("SUBJECT"))!ALL EXTRACT("SUBJECT")=U_$G(^(1))
.D FORMATX
I $G(CALLCNT)=+^TMP("FSC LIST CALLS",$J) W ! D HOME^%ZIS,PAUSE^FSCU(.OK) K EXTRACT
Q
;
FIELDS(FIELDS,CHOICE,OK) ;
S OK=1
N DIR,X,Y K DIR
S DIR(0)="SAMO^FORMAT:FORMAT;SELECT:SELECT",DIR("A")="Select (F)ormat or (S)elect fields: "
S DIR("?",1)="Enter FORMAT to select a format (a collect of fields)."
S DIR("?",2)="Enter SELECT to select specific fields to be extracted."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) S OK=0 Q
I Y="SELECT" D SELECT(.FIELDS,.CHOICE,.OK)
I Y="FORMAT" D FORMAT(.FIELDS,.CHOICE,.OK)
Q
;
SELECT(FIELDS,CHOICE,OK) ;
K FIELDS,CHOICE S OK=0
N CNT,DIC,X,Y K DIC,Y
S DIC=7107.2,DIC(0)="AEMOQZ",DIC("A")="Select Field: " F CNT=1:1 D ^DIC Q:Y<1 S CHOICE(CNT)=Y(0),FIELDS($P(Y(0),U,7))=""
K DIC
Q
FORMAT(FIELDS,CHOICE,OK) ;
K FIELDS,CHOICE S OK=1
N CNT,DIC,X,Y K DIC,Y
S DIC=7107.6,DIC(0)="AEMOQZ",DIC("A")="Select Format: ",DIC("S")="I $O(^(2,0))" D ^DIC K DIC Q:Y<1
Q
FORMATX ;
W !
S CNT=0 F S CNT=$O(CHOICE(CNT)) Q:CNT<1 S VALUE=$P(CHOICE(CNT),U,7) S:$P(CHOICE(CNT),U,3)="D" $P(EXTRACT(VALUE),U,2)=$$DATE(+EXTRACT(VALUE)) W $TR($P(EXTRACT(VALUE),U,2),DELIM," "),DELIM
Q
;
DATE(DATETIME) ; $$(date) -> M/D/Y HH:MM
Q:'DATETIME ""
S DATETIME=+$TR($J(DATETIME,$L(DATETIME),4)," ","")
Q $TR($$FMTE^XLFDT(DATETIME,2),"@"," ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRX 3227 printed Apr 09, 2024@21:22:20 Page 2
FSCRX ;SLC/STAFF-NOIS Report Extract ;1/29/98 18:51
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
+1 NEW ALL
+2 IF TYPE'["VIEW"
QUIT
+3 IF CALLNUM=0
WRITE !,"No calls to display."
HANG 2
SET DTOUT=1
QUIT
+4 IF $GET(CALLCNT)=1
Begin DoDot:1
+5 DO FULL^VALM1
+6 WRITE !,"This is a special ouput to capture NOIS data using a terminal emulator."
+7 KILL EXTRACT,CHOICE
+8 ;D FIELDS(.EXTRACT,.CHOICE,.OK)
+9 SET CNT=0
FOR
SET CNT=$ORDER(FORMAT(CNT))
if CNT<1
QUIT
SET CHOICE(CNT)=FORMAT(CNT)
SET FIELDS($PIECE(FORMAT(CNT),U,7))=""
+10 NEW DIR,X,Y
KILL DIR
+11 SET DIR(0)="FAO^1:1"
SET DIR("A")="Enter a delimiter: "
SET DIR("B")=","
+12 SET DIR("?",1)="Enter a single character used to delimit the fields."
+13 SET DIR("?",2)="If the data contains this delimiter it will be repalced by a space."
+14 SET DIR("?",3)="For example: DOE,JOHN with a comma delimiter would appear as DOE JOHN."
+15 SET DIR("?",4)="Enter 'E' to exit (NOTE: a '^' will be used as a delimiter)."
+16 SET DIR("?",5)="Enter '??' for more help."
+17 SET DIR("?")="^D HELP^FSCU(.DIR)"
+18 SET DIR("??")="FSC U1 NOIS"
+19 WRITE !,"-- Begin capture after this prompt. --"
+20 DO ^DIR
KILL DIR
+21 IF Y="E"!$DATA(DTOUT)
SET DTOUT=1
QUIT
+22 SET DELIM=$SELECT($LENGTH(Y):Y,1:",")
+23 SET IOP=";255;9999"
DO ^%ZIS
+24 WRITE !
+25 SET ALL=0
IF '$LENGTH($ORDER(EXTRACT("")))
SET ALL=1
+26 DO GET^FSCGET($SELECT('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
+27 if $DATA(EXTRACT("REF"))!ALL
SET EXTRACT("REF")=U_$PIECE($GET(^FSCD("CALL",CALLNUM,0)),U)
if $DATA(EXTRACT("SUBJECT"))!ALL
SET EXTRACT("SUBJECT")=U_$GET(^(1))
+28 SET CNT=0
FOR
SET CNT=$ORDER(CHOICE(CNT))
if CNT<1
QUIT
SET VALUE=$PIECE(CHOICE(CNT),U,7)
WRITE $TRANSLATE(VALUE,DELIM," "),DELIM
+29 WRITE !
DO FORMATX
+30 IF $GET(CALLCNT)=+^TMP("FSC LIST CALLS",$JOB)
WRITE !
DO HOME^%ZIS
DO PAUSE^FSCU(.OK)
KILL EXTRACT
End DoDot:1
QUIT
+31 IF $GET(CALLCNT)'=1
Begin DoDot:1
+32 SET ALL=0
IF '$LENGTH($ORDER(EXTRACT("")))
SET ALL=1
+33 DO GET^FSCGET($SELECT('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
+34 if $DATA(EXTRACT("REF"))!ALL
SET EXTRACT("REF")=U_$PIECE($GET(^FSCD("CALL",CALLNUM,0)),U)
if $DATA(EXTRACT("SUBJECT"))!ALL
SET EXTRACT("SUBJECT")=U_$GET(^(1))
+35 DO FORMATX
End DoDot:1
+36 IF $GET(CALLCNT)=+^TMP("FSC LIST CALLS",$JOB)
WRITE !
DO HOME^%ZIS
DO PAUSE^FSCU(.OK)
KILL EXTRACT
+37 QUIT
+38 ;
FIELDS(FIELDS,CHOICE,OK) ;
+1 SET OK=1
+2 NEW DIR,X,Y
KILL DIR
+3 SET DIR(0)="SAMO^FORMAT:FORMAT;SELECT:SELECT"
SET DIR("A")="Select (F)ormat or (S)elect fields: "
+4 SET DIR("?",1)="Enter FORMAT to select a format (a collect of fields)."
+5 SET DIR("?",2)="Enter SELECT to select specific fields to be extracted."
+6 SET DIR("?")="^D HELP^FSCU(.DIR)"
+7 SET DIR("??")="FSC U1 NOIS"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
SET OK=0
QUIT
+10 IF Y="SELECT"
DO SELECT(.FIELDS,.CHOICE,.OK)
+11 IF Y="FORMAT"
DO FORMAT(.FIELDS,.CHOICE,.OK)
+12 QUIT
+13 ;
SELECT(FIELDS,CHOICE,OK) ;
+1 KILL FIELDS,CHOICE
SET OK=0
+2 NEW CNT,DIC,X,Y
KILL DIC,Y
+3 SET DIC=7107.2
SET DIC(0)="AEMOQZ"
SET DIC("A")="Select Field: "
FOR CNT=1:1
DO ^DIC
if Y<1
QUIT
SET CHOICE(CNT)=Y(0)
SET FIELDS($PIECE(Y(0),U,7))=""
+4 KILL DIC
+5 QUIT
FORMAT(FIELDS,CHOICE,OK) ;
+1 KILL FIELDS,CHOICE
SET OK=1
+2 NEW CNT,DIC,X,Y
KILL DIC,Y
+3 SET DIC=7107.6
SET DIC(0)="AEMOQZ"
SET DIC("A")="Select Format: "
SET DIC("S")="I $O(^(2,0))"
DO ^DIC
KILL DIC
if Y<1
QUIT
+4 QUIT
FORMATX ;
+1 WRITE !
+2 SET CNT=0
FOR
SET CNT=$ORDER(CHOICE(CNT))
if CNT<1
QUIT
SET VALUE=$PIECE(CHOICE(CNT),U,7)
if $PIECE(CHOICE(CNT),U,3)="D"
SET $PIECE(EXTRACT(VALUE),U,2)=$$DATE(+EXTRACT(VALUE))
WRITE $TRANSLATE($PIECE(EXTRACT(VALUE),U,2),DELIM," "),DELIM
+3 QUIT
+4 ;
DATE(DATETIME) ; $$(date) -> M/D/Y HH:MM
+1 if 'DATETIME
QUIT ""
+2 SET DATETIME=+$TRANSLATE($JUSTIFY(DATETIME,$LENGTH(DATETIME),4)," ","")
+3 QUIT $TRANSLATE($$FMTE^XLFDT(DATETIME,2),"@"," ")
