FSCES ;SLC/STAFF-NOIS Edit Status ;9/6/98 20:38
;;1.1;NOIS;;Sep 06, 1998
;
STATUS(CALL,OLD,NEW,REOPEN) ; from FSCEB, FSCED, FSCEL, FSCELID, FSCELSNS, FSCLMPE1, FSCLMPES, FSCRPCEC, FSCRPCEF, FSCRPCF, FSCRPCNC
Q:'$G(CALL) Q:'$L($G(NEW))
S OLD=$G(OLD),REOPEN=+$G(REOPEN)
N DEV,SUP
D STATNEW(NEW,.SUP,.DEV)
D CALL(CALL,OLD,NEW,REOPEN)
Q
;
CALL(CALL,OLD,NEW,REOPEN) ;
N DA,DEV,DIE,DR,HISTORY,SUP,TIME
S TIME=$$NOW^XLFDT
D STATNEW(NEW,.SUP,.DEV)
S DA=CALL,DIE="^FSCD(""CALL"","
S DR="4///`"_SUP
D RTDCHECK(CALL,.DR,SUP)
S:DEV DEV="`"_DEV S:DEV="" DEV="@"
S DR=DR_";4.1///"_DEV_";4.5///"_NEW_";121///"_TIME_";123///"_TIME_";124///`"_DUZ
I OLD S DR=DR_";4.6///`"_OLD
S HISTORY=$$HISTORY(OLD,NEW,TIME,DUZ)
L +^FSCD("CALL",CALL):30 I '$T Q ; *** needs ok
I REOPEN D
.S DR=DR_";2.6///"_TIME_";81///@;82///@;8///@;9///@;122///@"
.D TRANSFER(CALL) ;
D ^DIE
D STUFF(CALL,HISTORY)
L -^FSCD("CALL",CALL)
D PICKUP(CALL)
D STATHIST(CALL,DUZ,TIME,NEW,OLD)
D MRE^FSCMR(DUZ,CALL)
Q
;
PICKUP(CALL) ; from FSCED, FSCELS, FSCLMPE1, FSCRPCEC, FSCRPCEF, FSCRPCNC
I $P(^FSCD("CALL",CALL,120),U,22) Q
I $P(^FSCD("CALL",CALL,120),U)<2970901 Q ;** pickup times only collected after 9/1/97
I $P(^FSCD("CALL",CALL,0),U,9) D PICKSET(CALL) Q
I $P(^FSCD("CALL",CALL,0),U,2)=2 D PICKSET(CALL) Q
Q
;
PICKSET(CALL) ;
N DA,DIE,DR,NOW,PTIME,RTIME
S DA=CALL,DIE="^FSCD(""CALL"","
S RTIME=$P(^FSCD("CALL",CALL,120),U)
S NOW=$$NOW^XLFDT
S PTIME=$$FMDIFF^XLFDT(NOW,RTIME,2)/60\1
S DR="125///NOW;126///"_PTIME
L +^FSCD("CALL",CALL):30 I '$T Q ; *** needs ok
D ^DIE
L -^FSCD("CALL",CALL)
Q
;
RTDCHECK(CALL,DR,SUP) ;
I $P(^FSCD("CALL",CALL,0),U,17) D
.I SUP'=3 S DR=DR_";4.8///"_DT
E D
.I SUP=3 D
..I $$DEVEXIST(CALL) S DR=DR_";4.9///"_DT
..S DR=DR_";4.7///"_DT_";4.8///@"
Q
;
DEVEXIST(CALL) ; $$(call) -> 1 if ever referred else 0
N RESULT,SUB
S RESULT=0
S SUB=0 F S SUB=$O(^FSCD("STATUS HIST","B",CALL,SUB)) Q:SUB<1 D Q:RESULT
.I $P(^FSCD("STATUS HIST",SUB,0),U,4)=3 S RESULT=1
Q RESULT
;
HISTORY(OLD,NEW,TIME,USER) ; $$(old status,new status,time,person) -> formatted text
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)_"."
Q " "_$$VALUE^FSCGET(NEW,7100,4.5)_" on "_$$FMTE^XLFDT(TIME)_" by "_$$VALUE^FSCGET(USER,7100,124)_"."
;
STUFF(CALL,HISTORY) ;
N LINE
S LINE=1+$O(^FSCD("CALL",CALL,110,"A"),-1)
S ^FSCD("CALL",CALL,110,LINE,0)=HISTORY
S ^FSCD("CALL",CALL,110,0)="^^"_LINE_U_LINE_U_DT_"^^"
Q
;
STATHIST(CALL,USER,DATE,STATUS,PREV) ;
S PREV=$G(PREV)
N DA,DATA,DIK,NUM
S DATA=CALL_U_USER_U_DATE_U_STATUS_U_PREV
S NUM=1+$P(^FSCD("STATUS HIST",0),U,3)
L +^FSCD("STATUS HIST",0):30 I '$T Q ; *** needs ok
F Q:'$D(^FSCD("STATUS HIST",NUM,0)) S NUM=NUM+1
S ^FSCD("STATUS HIST",NUM,0)=DATA
S $P(^FSCD("STATUS HIST",0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
L -^FSCD("STATUS HIST",0)
S DIK="^FSCD(""STATUS HIST"",",DA=NUM D IX1^DIK
Q
;
TRANSFER(CALL) ;
N CNT,DATE,LINE,NUM,PERSON
S DATE=$P(^FSCD("CALL",CALL,0),U,4),PERSON=$P(^(0),U,11)
I 'DATE,'PERSON Q
S NUM=$P(^FSCD("CALL",CALL,120),U,7)+1,$P(^(120),U,7)=NUM
S LINE="("_NUM_") Call closed by "_$$VALUE^FSCGET(PERSON,7100,81)_" on "_$$VALUE^FSCGET(DATE,7100,82)_"."
I '$D(^FSCD("CALL",CALL,50,0)) S ^FSCD("CALL",CALL,50,0)="^^0^0^"_DT_U
S CNT=1+$O(^FSCD("CALL",CALL,50,"A"),-1)
S $P(^FSCD("CALL",CALL,120),U,6)=CNT
S ^FSCD("CALL",CALL,50,CNT,0)=LINE
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)
S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=" "
S $P(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
K ^FSCD("CALL",CALL,80)
Q
;
STATNEW(NEW,SUP,DEV) ; returns sup and dev status from new status
S SUP=$G(SUP),DEV=$G(DEV)
I 'NEW Q
I NEW=1 S SUP=1,DEV="" Q
I NEW=2 S SUP=2 I DEV S DEV=2 Q
I NEW=3 S SUP=3,DEV=1 Q
I NEW=4 S SUP=4,DEV="" Q
I NEW=5 S SUP=3,DEV=5 Q
I NEW=6 S SUP=3,DEV=6 Q
I NEW=7 S SUP=3,DEV=7 Q
I NEW=8 S SUP=3,DEV=8 Q
I NEW=9 S SUP=3,DEV=9 Q
I NEW=10 S SUP=10,DEV="" Q
I NEW=99 S SUP=99 I DEV S DEV=99 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCES 4227 printed Oct 16, 2024@18:18:15 Page 2
FSCES ;SLC/STAFF-NOIS Edit Status ;9/6/98 20:38
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
STATUS(CALL,OLD,NEW,REOPEN) ; from FSCEB, FSCED, FSCEL, FSCELID, FSCELSNS, FSCLMPE1, FSCLMPES, FSCRPCEC, FSCRPCEF, FSCRPCF, FSCRPCNC
+1 if '$GET(CALL)
QUIT
if '$LENGTH($GET(NEW))
QUIT
+2 SET OLD=$GET(OLD)
SET REOPEN=+$GET(REOPEN)
+3 NEW DEV,SUP
+4 DO STATNEW(NEW,.SUP,.DEV)
+5 DO CALL(CALL,OLD,NEW,REOPEN)
+6 QUIT
+7 ;
CALL(CALL,OLD,NEW,REOPEN) ;
+1 NEW DA,DEV,DIE,DR,HISTORY,SUP,TIME
+2 SET TIME=$$NOW^XLFDT
+3 DO STATNEW(NEW,.SUP,.DEV)
+4 SET DA=CALL
SET DIE="^FSCD(""CALL"","
+5 SET DR="4///`"_SUP
+6 DO RTDCHECK(CALL,.DR,SUP)
+7 if DEV
SET DEV="`"_DEV
if DEV=""
SET DEV="@"
+8 SET DR=DR_";4.1///"_DEV_";4.5///"_NEW_";121///"_TIME_";123///"_TIME_";124///`"_DUZ
+9 IF OLD
SET DR=DR_";4.6///`"_OLD
+10 SET HISTORY=$$HISTORY(OLD,NEW,TIME,DUZ)
+11 ; *** needs ok
LOCK +^FSCD("CALL",CALL):30
IF '$TEST
QUIT
+12 IF REOPEN
Begin DoDot:1
+13 SET DR=DR_";2.6///"_TIME_";81///@;82///@;8///@;9///@;122///@"
+14 ;
DO TRANSFER(CALL)
End DoDot:1
+15 DO ^DIE
+16 DO STUFF(CALL,HISTORY)
+17 LOCK -^FSCD("CALL",CALL)
+18 DO PICKUP(CALL)
+19 DO STATHIST(CALL,DUZ,TIME,NEW,OLD)
+20 DO MRE^FSCMR(DUZ,CALL)
+21 QUIT
+22 ;
PICKUP(CALL) ; from FSCED, FSCELS, FSCLMPE1, FSCRPCEC, FSCRPCEF, FSCRPCNC
+1 IF $PIECE(^FSCD("CALL",CALL,120),U,22)
QUIT
+2 ;** pickup times only collected after 9/1/97
IF $PIECE(^FSCD("CALL",CALL,120),U)<2970901
QUIT
+3 IF $PIECE(^FSCD("CALL",CALL,0),U,9)
DO PICKSET(CALL)
QUIT
+4 IF $PIECE(^FSCD("CALL",CALL,0),U,2)=2
DO PICKSET(CALL)
QUIT
+5 QUIT
+6 ;
PICKSET(CALL) ;
+1 NEW DA,DIE,DR,NOW,PTIME,RTIME
+2 SET DA=CALL
SET DIE="^FSCD(""CALL"","
+3 SET RTIME=$PIECE(^FSCD("CALL",CALL,120),U)
+4 SET NOW=$$NOW^XLFDT
+5 SET PTIME=$$FMDIFF^XLFDT(NOW,RTIME,2)/60\1
+6 SET DR="125///NOW;126///"_PTIME
+7 ; *** needs ok
LOCK +^FSCD("CALL",CALL):30
IF '$TEST
QUIT
+8 DO ^DIE
+9 LOCK -^FSCD("CALL",CALL)
+10 QUIT
+11 ;
RTDCHECK(CALL,DR,SUP) ;
+1 IF $PIECE(^FSCD("CALL",CALL,0),U,17)
Begin DoDot:1
+2 IF SUP'=3
SET DR=DR_";4.8///"_DT
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 IF SUP=3
Begin DoDot:2
+5 IF $$DEVEXIST(CALL)
SET DR=DR_";4.9///"_DT
+6 SET DR=DR_";4.7///"_DT_";4.8///@"
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DEVEXIST(CALL) ; $$(call) -> 1 if ever referred else 0
+1 NEW RESULT,SUB
+2 SET RESULT=0
+3 SET SUB=0
FOR
SET SUB=$ORDER(^FSCD("STATUS HIST","B",CALL,SUB))
if SUB<1
QUIT
Begin DoDot:1
+4 IF $PIECE(^FSCD("STATUS HIST",SUB,0),U,4)=3
SET RESULT=1
End DoDot:1
if RESULT
QUIT
+5 QUIT RESULT
+6 ;
HISTORY(OLD,NEW,TIME,USER) ; $$(old status,new status,time,person) -> formatted text
+1 IF OLD
QUIT " 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)_"."
+2 QUIT " "_$$VALUE^FSCGET(NEW,7100,4.5)_" on "_$$FMTE^XLFDT(TIME)_" by "_$$VALUE^FSCGET(USER,7100,124)_"."
+3 ;
STUFF(CALL,HISTORY) ;
+1 NEW LINE
+2 SET LINE=1+$ORDER(^FSCD("CALL",CALL,110,"A"),-1)
+3 SET ^FSCD("CALL",CALL,110,LINE,0)=HISTORY
+4 SET ^FSCD("CALL",CALL,110,0)="^^"_LINE_U_LINE_U_DT_"^^"
+5 QUIT
+6 ;
STATHIST(CALL,USER,DATE,STATUS,PREV) ;
+1 SET PREV=$GET(PREV)
+2 NEW DA,DATA,DIK,NUM
+3 SET DATA=CALL_U_USER_U_DATE_U_STATUS_U_PREV
+4 SET NUM=1+$PIECE(^FSCD("STATUS HIST",0),U,3)
+5 ; *** needs ok
LOCK +^FSCD("STATUS HIST",0):30
IF '$TEST
QUIT
+6 FOR
if '$DATA(^FSCD("STATUS HIST",NUM,0))
QUIT
SET NUM=NUM+1
+7 SET ^FSCD("STATUS HIST",NUM,0)=DATA
+8 SET $PIECE(^FSCD("STATUS HIST",0),U,3)=NUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+9 LOCK -^FSCD("STATUS HIST",0)
+10 SET DIK="^FSCD(""STATUS HIST"","
SET DA=NUM
DO IX1^DIK
+11 QUIT
+12 ;
TRANSFER(CALL) ;
+1 NEW CNT,DATE,LINE,NUM,PERSON
+2 SET DATE=$PIECE(^FSCD("CALL",CALL,0),U,4)
SET PERSON=$PIECE(^(0),U,11)
+3 IF 'DATE
IF 'PERSON
QUIT
+4 SET NUM=$PIECE(^FSCD("CALL",CALL,120),U,7)+1
SET $PIECE(^(120),U,7)=NUM
+5 SET LINE="("_NUM_") Call closed by "_$$VALUE^FSCGET(PERSON,7100,81)_" on "_$$VALUE^FSCGET(DATE,7100,82)_"."
+6 IF '$DATA(^FSCD("CALL",CALL,50,0))
SET ^FSCD("CALL",CALL,50,0)="^^0^0^"_DT_U
+7 SET CNT=1+$ORDER(^FSCD("CALL",CALL,50,"A"),-1)
+8 SET $PIECE(^FSCD("CALL",CALL,120),U,6)=CNT
+9 SET ^FSCD("CALL",CALL,50,CNT,0)=LINE
+10 SET LINE=0
FOR
SET LINE=$ORDER(^FSCD("CALL",CALL,80,LINE))
if LINE<1
QUIT
SET CNT=CNT+1
SET ^FSCD("CALL",CALL,50,CNT,0)=^(LINE,0)
+11 SET CNT=CNT+1
SET ^FSCD("CALL",CALL,50,CNT,0)=" "
+12 SET $PIECE(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
+13 KILL ^FSCD("CALL",CALL,80)
+14 QUIT
+15 ;
STATNEW(NEW,SUP,DEV) ; returns sup and dev status from new status
+1 SET SUP=$GET(SUP)
SET DEV=$GET(DEV)
+2 IF 'NEW
QUIT
+3 IF NEW=1
SET SUP=1
SET DEV=""
QUIT
+4 IF NEW=2
SET SUP=2
IF DEV
SET DEV=2
QUIT
+5 IF NEW=3
SET SUP=3
SET DEV=1
QUIT
+6 IF NEW=4
SET SUP=4
SET DEV=""
QUIT
+7 IF NEW=5
SET SUP=3
SET DEV=5
QUIT
+8 IF NEW=6
SET SUP=3
SET DEV=6
QUIT
+9 IF NEW=7
SET SUP=3
SET DEV=7
QUIT
+10 IF NEW=8
SET SUP=3
SET DEV=8
QUIT
+11 IF NEW=9
SET SUP=3
SET DEV=9
QUIT
+12 IF NEW=10
SET SUP=10
SET DEV=""
QUIT
+13 IF NEW=99
SET SUP=99
IF DEV
SET DEV=99
QUIT
+14 QUIT
