- 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 Mar 13, 2025@21:25:07 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),"@"," ")
