source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCNC.m@ 846

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1FSCRPCNC ;SLC/STAFF-NOIS RPC New Call ;9/6/98 22:02
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4NEW(IN,OUT) ; from FSCRPX (RPCNewCall)
5 N CALLID,CALL,DATEO,FIELDS,OK,SITE K FIELDS
6 K ^TMP("FSC WP",$J)
7 D PROCESS(.FIELDS)
8 S SITE=+$G(FIELDS("SITE"))
9 S DATEO=+$G(FIELDS("DATEO"))
10 Q:'SITE Q:'DATEO
11 D NEWCALL(SITE,DATEO,.CALLID,.CALL,.OK)
12 I 'OK Q
13 D FIELDS(CALL,.FIELDS)
14 S ^TMP("FSCRPC",$J,"OUTPUT",1)=+CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
15 K ^TMP("FSC WP",$J)
16 Q
17 ;
18NEWCALL(SITE,RDATE,CALLID,CALL,OK) ;
19 N DIC,DLAYGO,DR,EPTYPE,ISC,SITE0,X,Y K DIC
20 S OK=0
21 S SITE0=^FSC("SITE",SITE,0)
22 D CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
23 I 'OK Q
24 S OK=0
25 S DIC=7100,DIC(0)="XL",DLAYGO=7100,X=CALLID
26 D ^DIC K DIC,DLAYGO
27 I Y<1 Q
28 I $$ACCESS^FSCU(DUZ,"SPEC") S EPTYPE=$O(^FSC("EPTYPE","B","SPECIALIST",0))
29 E S EPTYPE=$O(^FSC("EPTYPE","B","NON-SPECIALIST",0))
30 S CALL=+Y,OK=1
31 S DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALL
32 S ISC=+$P($G(^FSC("SITE",SITE,0)),U,11) I ISC S DR=DR_";2.3///`"_ISC
33 D SETUP(CALL,"^FSCD(""CALL"",",.DR)
34 D MRE^FSCMR(DUZ,CALL)
35 Q
36 ;
37FIELDS(CALL,FIELDS) ;
38 N DR,STATUS
39 D DESC(CALL)
40 D NOTE(CALL)
41 S DR=""
42 I $L($G(FIELDS("SUBJECT"))) S DR=DR_";1///"_$$FIX^FSCRPCEC(FIELDS("SUBJECT"))
43 I $L($G(FIELDS("PHONE"))) S DR=DR_";2.2///"_$$FIX^FSCRPCEC(FIELDS("PHONE"))
44 I $L($G(FIELDS("PATCH"))) S DR=DR_";7///"_$$FIX^FSCRPCEC(FIELDS("PATCH"))
45 I $L($G(FIELDS("KEYWORDS"))) S DR=DR_";1.5///"_$$FIX^FSCRPCEC(FIELDS("KEYWORDS"))
46 I $L(DR)>100 D SETUP(CALL,"^FSCD(""CALL"",",.DR)
47 I $G(FIELDS("MOD")) S DR=DR_";3///`"_+FIELDS("MOD")
48 I $G(FIELDS("IRM")) S DR=DR_";2.1///`"_+FIELDS("IRM")
49 I $G(FIELDS("PRI")) S DR=DR_";6///`"_+FIELDS("PRI")
50 I $G(FIELDS("SPEC")) S DR=DR_";5///`"_+FIELDS("SPEC")
51 I $G(FIELDS("SPECD")) S DR=DR_";5.1///`"_+FIELDS("SPECD")
52 I $G(FIELDS("DEVSUB")) S DR=DR_";3.2///`"_+FIELDS("DEVSUB")
53 D SETUP(CALL,"^FSCD(""CALL"",",.DR)
54 S STATUS=+$G(FIELDS("STATUS"))
55 I STATUS=2 D
56 .S DR="81///`"_DUZ
57 .I $G(FIELDS("FUNC")) S DR=DR_";8///`"_+FIELDS("FUNC")
58 .I $G(FIELDS("TASK")) S DR=DR_";9///`"_+FIELDS("TASK")
59 .I $L($G(FIELDS("DATEC"))) S DR=DR_";82///"_FIELDS("DATEC")
60 .D SETUP(CALL,"^FSCD(""CALL"",",.DR)
61 .D RES(CALL)
62 D STATUS(CALL,STATUS)
63 Q
64 ;
65SETUP(DA,DIE,DR) ;
66 N X,Y
67 I '$L(DR) Q
68 I $E(DR)=";" S DR=$E(DR,2,245)
69 L +^FSCD("CALL",DA):30 I '$T Q ; *** needs ok
70 D ^DIE
71 L -^FSCD("CALL",DA)
72 D PICKUP^FSCES(DA)
73 S DR=""
74 Q
75 ;
76STATUS(CALL,STATUS) ;
77 I STATUS=1 D
78 .D STATUS^FSCES(CALL,"",1)
79 .D UPDATE^FSCTASK(CALL)
80 E I STATUS=3 D
81 .D STATUS^FSCES(CALL,"",1)
82 .D UPDATE^FSCTASK(CALL)
83 .D STATUS^FSCES(CALL,1,3)
84 .D UPDATE^FSCTASK(CALL)
85 E I STATUS=2 D
86 .D STATUS^FSCES(CALL,"",1)
87 .D UPDATE^FSCTASK(CALL)
88 .D STATUS^FSCES(CALL,1,2)
89 .D UPDATE^FSCTASK(CALL)
90 Q
91 ;
92RES(CALL) ; from FSCRPCEC, FSCRPCEF
93 N CNT,LINE,LINECNT
94 I '$O(^TMP("FSC WP",$J,"RES",0)) Q
95 S (LINECNT,CNT)=0 F S CNT=$O(^TMP("FSC WP",$J,"RES",CNT)) Q:CNT<1 S LINE=^(CNT) D
96 .S LINECNT=LINECNT+1
97 .S ^FSCD("CALL",CALL,80,LINECNT,0)=LINE
98 S ^FSCD("CALL",CALL,80,0)="^^"_LINECNT_U_LINECNT_U_DT_U
99 Q
100 ;
101DESC(CALL) ; from FSCRPCEC, FSCRPCEF
102 N CNT,LINE,LINECNT
103 I '$O(^TMP("FSC WP",$J,"DESC",0)) Q
104 K ^FSCD("CALL",CALL,30)
105 S (LINECNT,CNT)=0 F S CNT=$O(^TMP("FSC WP",$J,"DESC",CNT)) Q:CNT<1 S LINE=^(CNT) D
106 .S LINECNT=LINECNT+1
107 .S ^FSCD("CALL",CALL,30,LINECNT,0)=LINE
108 S ^FSCD("CALL",CALL,30,0)="^^"_LINECNT_U_LINECNT_U_DT_U
109 Q
110 ;
111NOTE(CALL) ; from FSCRPCEC, FSCRPCEF
112 N CNT,LINE,NUM
113 I '$O(^TMP("FSC WP",$J,"NOTE",0)) Q
114 S NUM=$P(^FSCD("CALL",CALL,120),U,7)+1,$P(^(120),U,7)=NUM
115 S LINE="("_NUM_") "_$$FMTE^XLFDT($$NOW^XLFDT)
116 S LINE=$$SETSTR^VALM1($$VALUE^FSCGET(DUZ,7107.1,1),LINE,35,$L(LINE))
117 L +^FSCD("CALL",CALL,50):30 I '$T Q ; *** needs ok
118 I '$D(^FSCD("CALL",CALL,50,0)) S ^(0)="^^0^0^"_DT_U
119 S CNT=1+$O(^FSCD("CALL",CALL,50,"A"),-1)
120 S $P(^FSCD("CALL",CALL,120),U,6)=CNT
121 S ^FSCD("CALL",CALL,50,CNT,0)=LINE
122 S LINE=0 F S LINE=$O(^TMP("FSC WP",$J,"NOTE",LINE)) Q:LINE<1 S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=^(LINE)
123 S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=""
124 S $P(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
125 L -^FSCD("CALL",CALL,50)
126 Q
127 ;
128PROCESS(FIELDS) ; from FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCWP, FSCRPCWS
129 N CNT,LINE
130 S CNT=0 F S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1 S LINE=^(CNT) D Q:CNT<1
131 .I '$L(LINE) Q
132 .I $E(LINE)'="{" S FIELDS($P(LINE,U))=$P(LINE,U,2,99) Q
133 .I LINE="{DESC}" D WP("DESC",.CNT) Q
134 .I LINE="{NOTE}" D WP("NOTE",.CNT) Q
135 .I LINE="{RES}" D WP("RES",.CNT) Q
136 .I LINE="{PNOTE}" D WP("PNOTE",.CNT) Q
137 Q
138 ;
139WP(NODE,CNT) ;
140 N LINE,LINECNT
141 S LINECNT=0
142 F S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1 S LINE=^(CNT) Q:LINE="{{{}}}" D
143 .S LINECNT=LINECNT+1
144 .S ^TMP("FSC WP",$J,NODE,LINECNT)=LINE
145 Q
Note: See TracBrowser for help on using the repository browser.