source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCF.m@ 1150

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1FSCRPCF ;SLC/STAFF-NOIS RPC Format ;6/15/98 14:28
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4CALL(IN,OUT) ; from FSCRPX (RPCCallFormat)
5 N CALL,FLDS,FMT,NODE,TYPE K FMT
6 S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1)),FMT=$P($G(^(1)),U,2),FLDS=$P($G(^(1)),U,3)
7 I 'CALL Q
8 D INFO(.FMT,FLDS,.NODE,.TYPE)
9 D BUILD(1,CALL,NODE,.FMT,TYPE,0)
10 Q
11 ;
12LIST(IN,OUT) ; from FSCRPX (RPCListFormat)
13 N CALL,COLLATE,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,SNUM,TYPE K FMT,^TMP("FSC SELECT",$J),^TMP("FSC STATS",$J)
14 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)
15 I COLLATE S FMT("COLLATE")=COLLATE
16 D INFO(.FMT,FLDS,.NODE,.TYPE)
17 S (LASTNUM,LISTNUM)=0
18 I LISTFLAG D
19 .I FMT="STAT" D
20 ..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)=""
21 .S CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 D
22 ..S LISTNUM=LISTNUM+1
23 ..D BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
24 E D
25 .I FMT="STAT" D
26 ..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)=""
27 .S LNUM=1 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
28 ..S LISTNUM=LISTNUM+1
29 ..D BUILD(LISTNUM,CALL,NODE,.FMT,TYPE,.LASTNUM)
30 K ^TMP("FSC SELECT",$J),^TMP(NODE,$J)
31 Q
32 ;
33TABLE(IN,OUT) ; from FSCRPX (RPCListTable)
34 N CALL,COL,COLNUM,FLDS,FMT,LASTNUM,LISTNUM,LISTFLAG,LNUM,NODE,ROWNUM,TYPE
35 S LISTFLAG=+$G(^TMP("FSCRPC",$J,"INPUT",1)),FLDS=$P($G(^(1)),U,2)
36 S FMT="CUSTOM"
37 D INFO(.FMT,FLDS,.NODE,.TYPE)
38 S LASTNUM=1,LISTNUM=0,COLNUM=0
39 S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
40 .S COLNUM=COLNUM+1
41 .S LASTNUM=LASTNUM+1
42 .S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)="0^"_COLNUM_U_$P(FMT(COL),U,2)
43 S ROWNUM=1
44 I LISTFLAG D
45 .S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
46 ..S ROWNUM=ROWNUM+1
47 ..S LASTNUM=LASTNUM+1
48 ..S LISTNUM=LISTNUM+1
49 ..S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$P(^FSCD("CALL",CALL,0),U)
50 ..N FIELD K FIELD
51 ..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
52 ...I '$L($P(FMT(COL),U,7)) S $P(FMT(COL),U,7)=" "
53 ...S FIELD($P(FMT(COL),U,7))=""
54 ..D GET^FSCGET("CUSTOM",CALL,.FIELD)
55 ..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
56 ...S LASTNUM=LASTNUM+1
57 ...I $P(FMT(COL),U,7)="SUBJECT" D
58 ....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($P(FMT(COL),U,7))
59 ...E D
60 ....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$P(FIELD($P(FMT(COL),U,7)),U,2)
61 .S ^TMP("FSCRPC",$J,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
62 E D
63 .S LNUM=1 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
64 ..S ROWNUM=ROWNUM+1
65 ..S LASTNUM=LASTNUM+1
66 ..S LISTNUM=LISTNUM+1
67 ..S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_"^0^"_$P(^FSCD("CALL",CALL,0),U)
68 ..N FIELD K FIELD
69 ..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
70 ...I '$L($P(FMT(COL),U,7)) S $P(FMT(COL),U,7)=" "
71 ...S FIELD($P(FMT(COL),U,7))=""
72 ..D GET^FSCGET("CUSTOM",CALL,.FIELD)
73 ..S COL=0 F S COL=$O(FMT(COL)) Q:COL<1 D
74 ...S LASTNUM=LASTNUM+1
75 ...I $P(FMT(COL),U,7)="SUBJECT" D
76 ....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_FIELD($P(FMT(COL),U,7))
77 ...E D
78 ....S ^TMP("FSCRPC",$J,"OUTPUT",LASTNUM)=LISTNUM_U_COL_U_$P(FIELD($P(FMT(COL),U,7)),U,2)
79 .S ^TMP("FSCRPC",$J,"OUTPUT",1)=ROWNUM_";"_(1+COLNUM)
80 Q
81 ;
82INFO(FMT,FLDS,NODE,TYPE) ;
83 N CNT,FIELD,FORMAT,NUM,PIECE
84 I FMT="BRIEF" S NODE="FSC MULT BRIEF",TYPE="FSC MULT " Q
85 I FMT="CUSTOM"!(FMT="STAT") D
86 .S TYPE="FSC VIEW "
87 .S NODE=TYPE_FMT
88 .S NUM=0
89 .I $E(FLDS)="{" D
90 ..S FORMAT=+$P(FLDS,"{",2)
91 ..S CNT=0 F S CNT=$O(^FSC("FORMAT",FORMAT,2,CNT)) Q:CNT<1 S FIELD=+^(CNT,0) D
92 ...S NUM=NUM+1
93 ...S FMT(NUM)=$G(^FSC("FLD",FIELD,0))
94 .E D
95 ..F PIECE=1:1 S FIELD=$P(FLDS,";",PIECE) Q:FIELD="" D
96 ...S NUM=NUM+1
97 ...S FMT(NUM)=$G(^FSC("FLD",+FIELD,0))
98 E S NODE="FSC MULT DETAIL",FMT="DETAIL",TYPE="FSC MULT "
99 Q
100 ;
101BUILD(LISTNUM,CALL,NODE,FMT,TYPE,LASTNUM) ;
102 N FIRSTNUM,LINE,NUM
103 S FIRSTNUM=LASTNUM+1
104 K ^TMP(NODE,$J)
105 D BUILD^FSCFORM(LISTNUM,CALL,.FMT,.LASTNUM,TYPE)
106 I FMT="BRIEF"!(FMT="DETAIL") D
107 .S NUM=0 F S NUM=$O(^TMP(NODE,$J,LISTNUM,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
108 ..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
109 .S LASTNUM=LASTNUM+1,$P(^TMP("FSCRPC",$J,"OUTPUT",LASTNUM),"=",80)=""
110 I FMT="CUSTOM"!(FMT="STAT") D
111 .S NUM=0 F S NUM=$O(^TMP(NODE,$J,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
112 ..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
113 I FMT'="STAT" S ^TMP("FSCRPC",$J,"OUTPUT",FIRSTNUM)=$$SHORT^FSCGETS(CALL,LISTNUM)
114 K ^TMP(NODE,$J)
115 Q
116 ;
117EDITABLE(IN,OUT) ; from FSCRPX (RPCEditableCall)
118 N CALL,OLDSTAT
119 S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
120 I $L($G(^FSCD("CALL",CALL,0))) D ; *** if no status, force to open
121 .S OLDSTAT=$$STATCALL^FSCESU(CALL)
122 .I 'OLDSTAT D
123 ..D STATUS^FSCES(CALL,"",1)
124 ..D UPDATE^FSCAUDIT(CALL)
125 ..D UPDATE^FSCTASK(CALL)
126 S STAT=+$P($G(^FSCD("CALL",CALL,0)),U,2)
127 D
128 .I STAT=2 S OPEN=0 Q
129 .I STAT=99 S OPEN=0 Q
130 .S OPEN=1
131 S ^TMP("FSCRPC",$J,"OUTPUT",1)=$$OKTOED(CALL)_U_$$PRIMARY(CALL)_U_OPEN
132 Q
133 ;
134PRIMARY(CALL) ; $$(call) -> 0 or primary ien
135 Q +$P($G(^FSCD("CALL",+CALL,120)),U,24)
136 ;
137OKTOED(CALL) ; $$(call) -> 0 no edit, 1 reopen, 2 edit
138 N CDATE,CONTACT,DAYS,RESULT,SPEC,STATUS,WKLD,ZERO
139 S RESULT=0
140 S ZERO=$G(^FSCD("CALL",+CALL,0)) I '$L(ZERO) Q 0
141 S CONTACT=$P(ZERO,U,6),STATUS=$P(ZERO,U,2),CDATE=$P(ZERO,U,4),SPEC=$$ACCESS^FSCU(DUZ,"SPEC")
142 I '(STATUS=2!(STATUS=99)) Q 2
143 I SPEC D Q RESULT
144 .I STATUS=99 S RESULT=1 Q
145 .S DAYS=+$P(^FSC("PARAM",1,0),U,10),WKLD=+$P(^(0),U,9)
146 .I 'WKLD S RESULT=1 Q
147 .I 'DAYS S DAYS=30
148 .I DT>$$FMADD^XLFDT(CDATE,DAYS) S RESULT=1 Q
149 .S RESULT=2
150 I CONTACT=DUZ Q 1
151 Q 0
Note: See TracBrowser for help on using the repository browser.