FSCLMPES ;SLC/STAFF-NOIS List Manager Protocol Edit Status ;5/14/97 10:16
;;1.1;NOIS;;Sep 06, 1998
;
STATUS ; from FSCLMP
N CALLNUM,OK,OLDSTAT,REOPEN,STATUS
S CALLNUM=$$CALL^FSCLMPE1(FSCCNT)
S OLDSTAT=$$STATCALL^FSCESU(CALLNUM)
I '$$ACCESS(DUZ,CALLNUM,+OLDSTAT) D Q
.W !,"You do not have access to change the status of this call." H 2
I 'OLDSTAT D STATUS^FSCES(CALLNUM,"",1) D UPDATE^FSCEU(CALLNUM) W !,"This call did not have a complete status. The status is now OPEN.",$C(7) H 2 Q
W !,"Current Status is ",$P(OLDSTAT,U,3)
S STATUS=+OLDSTAT
D ASK(.STATUS,.REOPEN,.OK)
I 'OK Q
I STATUS=2 D RES^FSCLMPE1 Q
I REOPEN D REOPEN(.OK) I 'OK Q
I REOPEN D GOODWKLD^FSCEWKLD(CALLNUM)
D STATUS^FSCES(CALLNUM,+OLDSTAT,STATUS,REOPEN)
I STATUS=6 D PATCH(CALLNUM,.OK) I 'OK D UPDATE^FSCEU(CALLNUM) Q
D NOTE(.OK) I OK D
.N OPER
.D DATA^FSCEN("ACTION",.OPER)
.I OPER="TIMEOUT" Q
.I OPER="QUIT" Q
.I OPER="ACCEPT" D NOTE^FSCEF(CALLNUM,"ACTION")
I STATUS=99 D BADWKLD^FSCEWKLD(CALLNUM)
E D WKLD^FSCEWKLD(CALLNUM,1)
D UPDATE^FSCEU(CALLNUM)
Q
;
ACCESS(USER,CALL,STATUS) ; $$(user,call,status) -> 1 to allow editing else 0
I $$ACCESS^FSCU(USER,"SPEC") Q 1
I '(STATUS=2!(STATUS=99)) Q 0
I USER=$P($G(^FSCD("CALL",CALL,0)),U,6) Q 1
I USER=$P($G(^FSCD("CALL",CALL,120)),U,20) Q 1
Q 0
;
PATCH(DA,OK) ;
N DIE,DR,X,Y S OK=1
S DIE="^FSCD(""CALL"",",DR=7
D ^DIE
I $D(DTOUT) S OK=0
Q
;
NOTE(OK) ;
N DIR,X,Y K DIR S OK=0
S DIR(0)="YAO",DIR("A")="Include a note with this status change? ",DIR("B")="NO"
S DIR("?",1)="Enter YES to make a note on this call."
S DIR("?",2)="Enter NO change the status without making a note."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) Q
I Y=1 S OK=1
Q
;
ASK(STATUS,REOPEN,OK) ;
N DIC,X,Y K DIC
S (OK,REOPEN)=0
I '$G(STATUS) Q
I STATUS=2!(STATUS=99) S (OK,REOPEN,STATUS)=1 Q ; closed or cancelled can only be reopened
S DIC=7106.1,DIC(0)="AEMOQ",DIC("A")="Select Status: "
S DIC("S")="I $D(^FSC(""STATUS"",STATUS,1,""B"",+Y))"
D ^DIC K DIC
I Y<1 Q
S OK=1,STATUS=+Y
Q
;
REOPEN(OK) ;
N DIR,X,Y K DIR S OK=0
S DIR(0)="YAO",DIR("A")="Are you sure you want to REOPEN this call? ",DIR("B")="NO"
S DIR("?",1)="Enter YES to reopen this call. The status will return to open"
S DIR("?",2)="allowing editing, referrals, etc."
S DIR("?",3)="Enter NO or '^' to exit without reopening the call, '??' for more help."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) Q
I Y=1 S OK=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPES 2597 printed Apr 09, 2024@21:22:31 Page 2
FSCLMPES ;SLC/STAFF-NOIS List Manager Protocol Edit Status ;5/14/97 10:16
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
STATUS ; from FSCLMP
+1 NEW CALLNUM,OK,OLDSTAT,REOPEN,STATUS
+2 SET CALLNUM=$$CALL^FSCLMPE1(FSCCNT)
+3 SET OLDSTAT=$$STATCALL^FSCESU(CALLNUM)
+4 IF '$$ACCESS(DUZ,CALLNUM,+OLDSTAT)
Begin DoDot:1
+5 WRITE !,"You do not have access to change the status of this call."
HANG 2
End DoDot:1
QUIT
+6 IF 'OLDSTAT
DO STATUS^FSCES(CALLNUM,"",1)
DO UPDATE^FSCEU(CALLNUM)
WRITE !,"This call did not have a complete status. The status is now OPEN.",$CHAR(7)
HANG 2
QUIT
+7 WRITE !,"Current Status is ",$PIECE(OLDSTAT,U,3)
+8 SET STATUS=+OLDSTAT
+9 DO ASK(.STATUS,.REOPEN,.OK)
+10 IF 'OK
QUIT
+11 IF STATUS=2
DO RES^FSCLMPE1
QUIT
+12 IF REOPEN
DO REOPEN(.OK)
IF 'OK
QUIT
+13 IF REOPEN
DO GOODWKLD^FSCEWKLD(CALLNUM)
+14 DO STATUS^FSCES(CALLNUM,+OLDSTAT,STATUS,REOPEN)
+15 IF STATUS=6
DO PATCH(CALLNUM,.OK)
IF 'OK
DO UPDATE^FSCEU(CALLNUM)
QUIT
+16 DO NOTE(.OK)
IF OK
Begin DoDot:1
+17 NEW OPER
+18 DO DATA^FSCEN("ACTION",.OPER)
+19 IF OPER="TIMEOUT"
QUIT
+20 IF OPER="QUIT"
QUIT
+21 IF OPER="ACCEPT"
DO NOTE^FSCEF(CALLNUM,"ACTION")
End DoDot:1
+22 IF STATUS=99
DO BADWKLD^FSCEWKLD(CALLNUM)
+23 IF '$TEST
DO WKLD^FSCEWKLD(CALLNUM,1)
+24 DO UPDATE^FSCEU(CALLNUM)
+25 QUIT
+26 ;
ACCESS(USER,CALL,STATUS) ; $$(user,call,status) -> 1 to allow editing else 0
+1 IF $$ACCESS^FSCU(USER,"SPEC")
QUIT 1
+2 IF '(STATUS=2!(STATUS=99))
QUIT 0
+3 IF USER=$PIECE($GET(^FSCD("CALL",CALL,0)),U,6)
QUIT 1
+4 IF USER=$PIECE($GET(^FSCD("CALL",CALL,120)),U,20)
QUIT 1
+5 QUIT 0
+6 ;
PATCH(DA,OK) ;
+1 NEW DIE,DR,X,Y
SET OK=1
+2 SET DIE="^FSCD(""CALL"","
SET DR=7
+3 DO ^DIE
+4 IF $DATA(DTOUT)
SET OK=0
+5 QUIT
+6 ;
NOTE(OK) ;
+1 NEW DIR,X,Y
KILL DIR
SET OK=0
+2 SET DIR(0)="YAO"
SET DIR("A")="Include a note with this status change? "
SET DIR("B")="NO"
+3 SET DIR("?",1)="Enter YES to make a note on this call."
+4 SET DIR("?",2)="Enter NO change the status without making a note."
+5 SET DIR("?")="^D HELP^FSCU(.DIR)"
+6 SET DIR("??")="FSC U1 NOIS"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
QUIT
+9 IF Y=1
SET OK=1
+10 QUIT
+11 ;
ASK(STATUS,REOPEN,OK) ;
+1 NEW DIC,X,Y
KILL DIC
+2 SET (OK,REOPEN)=0
+3 IF '$GET(STATUS)
QUIT
+4 ; closed or cancelled can only be reopened
IF STATUS=2!(STATUS=99)
SET (OK,REOPEN,STATUS)=1
QUIT
+5 SET DIC=7106.1
SET DIC(0)="AEMOQ"
SET DIC("A")="Select Status: "
+6 SET DIC("S")="I $D(^FSC(""STATUS"",STATUS,1,""B"",+Y))"
+7 DO ^DIC
KILL DIC
+8 IF Y<1
QUIT
+9 SET OK=1
SET STATUS=+Y
+10 QUIT
+11 ;
REOPEN(OK) ;
+1 NEW DIR,X,Y
KILL DIR
SET OK=0
+2 SET DIR(0)="YAO"
SET DIR("A")="Are you sure you want to REOPEN this call? "
SET DIR("B")="NO"
+3 SET DIR("?",1)="Enter YES to reopen this call. The status will return to open"
+4 SET DIR("?",2)="allowing editing, referrals, etc."
+5 SET DIR("?",3)="Enter NO or '^' to exit without reopening the call, '??' for more help."
+6 SET DIR("?")="^D HELP^FSCU(.DIR)"
+7 SET DIR("??")="FSC U1 NOIS"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 IF Y=1
SET OK=1
+11 QUIT
