source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCES.m@ 1259

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1FSCES ;SLC/STAFF-NOIS Edit Status ;9/6/98 20:38
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4STATUS(CALL,OLD,NEW,REOPEN) ; from FSCEB, FSCED, FSCEL, FSCELID, FSCELSNS, FSCLMPE1, FSCLMPES, FSCRPCEC, FSCRPCEF, FSCRPCF, FSCRPCNC
5 Q:'$G(CALL) Q:'$L($G(NEW))
6 S OLD=$G(OLD),REOPEN=+$G(REOPEN)
7 N DEV,SUP
8 D STATNEW(NEW,.SUP,.DEV)
9 D CALL(CALL,OLD,NEW,REOPEN)
10 Q
11 ;
12CALL(CALL,OLD,NEW,REOPEN) ;
13 N DA,DEV,DIE,DR,HISTORY,SUP,TIME
14 S TIME=$$NOW^XLFDT
15 D STATNEW(NEW,.SUP,.DEV)
16 S DA=CALL,DIE="^FSCD(""CALL"","
17 S DR="4///`"_SUP
18 D RTDCHECK(CALL,.DR,SUP)
19 S:DEV DEV="`"_DEV S:DEV="" DEV="@"
20 S DR=DR_";4.1///"_DEV_";4.5///"_NEW_";121///"_TIME_";123///"_TIME_";124///`"_DUZ
21 I OLD S DR=DR_";4.6///`"_OLD
22 S HISTORY=$$HISTORY(OLD,NEW,TIME,DUZ)
23 L +^FSCD("CALL",CALL):30 I '$T Q ; *** needs ok
24 I REOPEN D
25 .S DR=DR_";2.6///"_TIME_";81///@;82///@;8///@;9///@;122///@"
26 .D TRANSFER(CALL) ;
27 D ^DIE
28 D STUFF(CALL,HISTORY)
29 L -^FSCD("CALL",CALL)
30 D PICKUP(CALL)
31 D STATHIST(CALL,DUZ,TIME,NEW,OLD)
32 D MRE^FSCMR(DUZ,CALL)
33 Q
34 ;
35PICKUP(CALL) ; from FSCED, FSCELS, FSCLMPE1, FSCRPCEC, FSCRPCEF, FSCRPCNC
36 I $P(^FSCD("CALL",CALL,120),U,22) Q
37 I $P(^FSCD("CALL",CALL,120),U)<2970901 Q ;** pickup times only collected after 9/1/97
38 I $P(^FSCD("CALL",CALL,0),U,9) D PICKSET(CALL) Q
39 I $P(^FSCD("CALL",CALL,0),U,2)=2 D PICKSET(CALL) Q
40 Q
41 ;
42PICKSET(CALL) ;
43 N DA,DIE,DR,NOW,PTIME,RTIME
44 S DA=CALL,DIE="^FSCD(""CALL"","
45 S RTIME=$P(^FSCD("CALL",CALL,120),U)
46 S NOW=$$NOW^XLFDT
47 S PTIME=$$FMDIFF^XLFDT(NOW,RTIME,2)/60\1
48 S DR="125///NOW;126///"_PTIME
49 L +^FSCD("CALL",CALL):30 I '$T Q ; *** needs ok
50 D ^DIE
51 L -^FSCD("CALL",CALL)
52 Q
53 ;
54RTDCHECK(CALL,DR,SUP) ;
55 I $P(^FSCD("CALL",CALL,0),U,17) D
56 .I SUP'=3 S DR=DR_";4.8///"_DT
57 E D
58 .I SUP=3 D
59 ..I $$DEVEXIST(CALL) S DR=DR_";4.9///"_DT
60 ..S DR=DR_";4.7///"_DT_";4.8///@"
61 Q
62 ;
63DEVEXIST(CALL) ; $$(call) -> 1 if ever referred else 0
64 N RESULT,SUB
65 S RESULT=0
66 S SUB=0 F S SUB=$O(^FSCD("STATUS HIST","B",CALL,SUB)) Q:SUB<1 D Q:RESULT
67 .I $P(^FSCD("STATUS HIST",SUB,0),U,4)=3 S RESULT=1
68 Q RESULT
69 ;
70HISTORY(OLD,NEW,TIME,USER) ; $$(old status,new status,time,person) -> formatted text
71 I OLD Q " Changed from "_$$VALUE^FSCGET(OLD,7100,4.5)_" to "_$$VALUE^FSCGET(NEW,7100,4.5)_" on "_$$FMTE^XLFDT(TIME)_" by "_$$VALUE^FSCGET(USER,7100,124)_"."
72 Q " "_$$VALUE^FSCGET(NEW,7100,4.5)_" on "_$$FMTE^XLFDT(TIME)_" by "_$$VALUE^FSCGET(USER,7100,124)_"."
73 ;
74STUFF(CALL,HISTORY) ;
75 N LINE
76 S LINE=1+$O(^FSCD("CALL",CALL,110,"A"),-1)
77 S ^FSCD("CALL",CALL,110,LINE,0)=HISTORY
78 S ^FSCD("CALL",CALL,110,0)="^^"_LINE_U_LINE_U_DT_"^^"
79 Q
80 ;
81STATHIST(CALL,USER,DATE,STATUS,PREV) ;
82 S PREV=$G(PREV)
83 N DA,DATA,DIK,NUM
84 S DATA=CALL_U_USER_U_DATE_U_STATUS_U_PREV
85 S NUM=1+$P(^FSCD("STATUS HIST",0),U,3)
86 L +^FSCD("STATUS HIST",0):30 I '$T Q ; *** needs ok
87 F Q:'$D(^FSCD("STATUS HIST",NUM,0)) S NUM=NUM+1
88 S ^FSCD("STATUS HIST",NUM,0)=DATA
89 S $P(^FSCD("STATUS HIST",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
90 L -^FSCD("STATUS HIST",0)
91 S DIK="^FSCD(""STATUS HIST"",",DA=NUM D IX1^DIK
92 Q
93 ;
94TRANSFER(CALL) ;
95 N CNT,DATE,LINE,NUM,PERSON
96 S DATE=$P(^FSCD("CALL",CALL,0),U,4),PERSON=$P(^(0),U,11)
97 I 'DATE,'PERSON Q
98 S NUM=$P(^FSCD("CALL",CALL,120),U,7)+1,$P(^(120),U,7)=NUM
99 S LINE="("_NUM_") Call closed by "_$$VALUE^FSCGET(PERSON,7100,81)_" on "_$$VALUE^FSCGET(DATE,7100,82)_"."
100 I '$D(^FSCD("CALL",CALL,50,0)) S ^FSCD("CALL",CALL,50,0)="^^0^0^"_DT_U
101 S CNT=1+$O(^FSCD("CALL",CALL,50,"A"),-1)
102 S $P(^FSCD("CALL",CALL,120),U,6)=CNT
103 S ^FSCD("CALL",CALL,50,CNT,0)=LINE
104 S LINE=0 F S LINE=$O(^FSCD("CALL",CALL,80,LINE)) Q:LINE<1 S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=^(LINE,0)
105 S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=" "
106 S $P(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
107 K ^FSCD("CALL",CALL,80)
108 Q
109 ;
110STATNEW(NEW,SUP,DEV) ; returns sup and dev status from new status
111 S SUP=$G(SUP),DEV=$G(DEV)
112 I 'NEW Q
113 I NEW=1 S SUP=1,DEV="" Q
114 I NEW=2 S SUP=2 I DEV S DEV=2 Q
115 I NEW=3 S SUP=3,DEV=1 Q
116 I NEW=4 S SUP=4,DEV="" Q
117 I NEW=5 S SUP=3,DEV=5 Q
118 I NEW=6 S SUP=3,DEV=6 Q
119 I NEW=7 S SUP=3,DEV=7 Q
120 I NEW=8 S SUP=3,DEV=8 Q
121 I NEW=9 S SUP=3,DEV=9 Q
122 I NEW=10 S SUP=10,DEV="" Q
123 I NEW=99 S SUP=99 I DEV S DEV=99 Q
124 Q
Note: See TracBrowser for help on using the repository browser.