source: FOIAVistA/trunk/r/NOIS-FSC/FSCRX.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1FSCRX ;SLC/STAFF-NOIS Report Extract ;1/29/98 18:51
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4EXTRACT ; from FSCFORMF
5 N ALL
6 I TYPE'["VIEW" Q
7 I CALLNUM=0 W !,"No calls to display." H 2 S DTOUT=1 Q
8 I $G(CALLCNT)=1 D Q
9 .D FULL^VALM1
10 .W !,"This is a special ouput to capture NOIS data using a terminal emulator."
11 .K EXTRACT,CHOICE
12 .;D FIELDS(.EXTRACT,.CHOICE,.OK)
13 .S CNT=0 F S CNT=$O(FORMAT(CNT)) Q:CNT<1 S CHOICE(CNT)=FORMAT(CNT),FIELDS($P(FORMAT(CNT),U,7))=""
14 .N DIR,X,Y K DIR
15 .S DIR(0)="FAO^1:1",DIR("A")="Enter a delimiter: ",DIR("B")=","
16 .S DIR("?",1)="Enter a single character used to delimit the fields."
17 .S DIR("?",2)="If the data contains this delimiter it will be repalced by a space."
18 .S DIR("?",3)="For example: DOE,JOHN with a comma delimiter would appear as DOE JOHN."
19 .S DIR("?",4)="Enter 'E' to exit (NOTE: a '^' will be used as a delimiter)."
20 .S DIR("?",5)="Enter '??' for more help."
21 .S DIR("?")="^D HELP^FSCU(.DIR)"
22 .S DIR("??")="FSC U1 NOIS"
23 .W !,"-- Begin capture after this prompt. --"
24 .D ^DIR K DIR
25 .I Y="E"!$D(DTOUT) S DTOUT=1 Q
26 .S DELIM=$S($L(Y):Y,1:",")
27 .S IOP=";255;9999" D ^%ZIS
28 .W !
29 .S ALL=0 I '$L($O(EXTRACT(""))) S ALL=1
30 .D GET^FSCGET($S('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
31 .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))
32 .S CNT=0 F S CNT=$O(CHOICE(CNT)) Q:CNT<1 S VALUE=$P(CHOICE(CNT),U,7) W $TR(VALUE,DELIM," "),DELIM
33 .W ! D FORMATX
34 .I $G(CALLCNT)=+^TMP("FSC LIST CALLS",$J) W ! D HOME^%ZIS,PAUSE^FSCU(.OK) K EXTRACT
35 I $G(CALLCNT)'=1 D
36 .S ALL=0 I '$L($O(EXTRACT(""))) S ALL=1
37 .D GET^FSCGET($S('ALL:"CUSTOM",1:"DETAIL"),CALLNUM,.EXTRACT)
38 .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))
39 .D FORMATX
40 I $G(CALLCNT)=+^TMP("FSC LIST CALLS",$J) W ! D HOME^%ZIS,PAUSE^FSCU(.OK) K EXTRACT
41 Q
42 ;
43FIELDS(FIELDS,CHOICE,OK) ;
44 S OK=1
45 N DIR,X,Y K DIR
46 S DIR(0)="SAMO^FORMAT:FORMAT;SELECT:SELECT",DIR("A")="Select (F)ormat or (S)elect fields: "
47 S DIR("?",1)="Enter FORMAT to select a format (a collect of fields)."
48 S DIR("?",2)="Enter SELECT to select specific fields to be extracted."
49 S DIR("?")="^D HELP^FSCU(.DIR)"
50 S DIR("??")="FSC U1 NOIS"
51 D ^DIR K DIR
52 I $D(DIRUT) S OK=0 Q
53 I Y="SELECT" D SELECT(.FIELDS,.CHOICE,.OK)
54 I Y="FORMAT" D FORMAT(.FIELDS,.CHOICE,.OK)
55 Q
56 ;
57SELECT(FIELDS,CHOICE,OK) ;
58 K FIELDS,CHOICE S OK=0
59 N CNT,DIC,X,Y K DIC,Y
60 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))=""
61 K DIC
62 Q
63FORMAT(FIELDS,CHOICE,OK) ;
64 K FIELDS,CHOICE S OK=1
65 N CNT,DIC,X,Y K DIC,Y
66 S DIC=7107.6,DIC(0)="AEMOQZ",DIC("A")="Select Format: ",DIC("S")="I $O(^(2,0))" D ^DIC K DIC Q:Y<1
67 Q
68FORMATX ;
69 W !
70 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
71 Q
72 ;
73DATE(DATETIME) ; $$(date) -> M/D/Y HH:MM
74 Q:'DATETIME ""
75 S DATETIME=+$TR($J(DATETIME,$L(DATETIME),4)," ","")
76 Q $TR($$FMTE^XLFDT(DATETIME,2),"@"," ")
Note: See TracBrowser for help on using the repository browser.