FSCELID ;SLC/STAFF-NOIS Edit Log ID ;5/2/98 20:41
;;1.1;NOIS;;Sep 06, 1998
;
ID(SITE,RDATE,CALLID,CALLNUM,OK) ; from FSCED, FSCEL
N DIC,DIR,GOOD,SITE0,X,Y K DIC,DIR,Y S OK=0
S DIC="^FSC(""SITE"",",DIC(0)="AEMQZ",DIC("A")="Select Reporting Location: ",DIC("S")="I '$P(^(0),U,2)"
D ^DIC K DIC
Q:$D(DTOUT) Q:Y<1
S SITE=+Y,SITE0=Y(0)
S GOOD=1,RDATE=DT I $$ASKDATE D I 'GOOD Q
.S DIR(0)="DAO^0:"_DT_":EX",DIR("A")="Date of Problem: ",DIR("B")="TODAY"
.S DIR("?",1)="This is the date the problem is reported."
.S DIR("?",2)="This date is used to create the call ID."
.S DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
.S DIR("??")="FSC U1 NOIS"
.D ^DIR K DIR
.I $D(DIRUT) S GOOD=0 Q
.S RDATE=+Y
D CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
I 'OK Q
S OK=0
N DA,DIC,DIE,DLAYGO,DR,EPTYPE,ISC,X,Y K DIC
S DIC=7100,DIC(0)="XL",DLAYGO=7100,X=CALLID
D ^DIC K DIC,DLAYGO
I Y<1 Q
I $$ACCESS^FSCU(DUZ,"SPEC") S EPTYPE=$O(^FSC("EPTYPE","B","SPECIALIST",0))
E S EPTYPE=$O(^FSC("EPTYPE","B","NON-SPECIALIST",0))
S CALLNUM=+Y,OK=1
S DA=CALLNUM,DIE="^FSCD(""CALL"",",DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALLNUM
S ISC=+$P($G(^FSC("SITE",SITE,0)),U,11) I ISC S DR=DR_";2.3///`"_ISC
L +^FSCD("CALL",CALLNUM)
D ^DIE
L -^FSCD("CALL",CALLNUM)
D MRE^FSCMR(DUZ,CALLNUM)
D STATUS^FSCES(CALLNUM,"",1)
Q
;
ASKDATE() ;
I $$ACCESS^FSCU(DUZ,"SPEC") Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCELID 1439 printed Dec 13, 2024@02:17:34 Page 2
FSCELID ;SLC/STAFF-NOIS Edit Log ID ;5/2/98 20:41
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ID(SITE,RDATE,CALLID,CALLNUM,OK) ; from FSCED, FSCEL
+1 NEW DIC,DIR,GOOD,SITE0,X,Y
KILL DIC,DIR,Y
SET OK=0
+2 SET DIC="^FSC(""SITE"","
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Reporting Location: "
SET DIC("S")="I '$P(^(0),U,2)"
+3 DO ^DIC
KILL DIC
+4 if $DATA(DTOUT)
QUIT
if Y<1
QUIT
+5 SET SITE=+Y
SET SITE0=Y(0)
+6 SET GOOD=1
SET RDATE=DT
IF $$ASKDATE
Begin DoDot:1
+7 SET DIR(0)="DAO^0:"_DT_":EX"
SET DIR("A")="Date of Problem: "
SET DIR("B")="TODAY"
+8 SET DIR("?",1)="This is the date the problem is reported."
+9 SET DIR("?",2)="This date is used to create the call ID."
+10 SET DIR("?")="^D HELP^%DTC,HELP^FSCU(.DIR)"
+11 SET DIR("??")="FSC U1 NOIS"
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET GOOD=0
QUIT
+14 SET RDATE=+Y
End DoDot:1
IF 'GOOD
QUIT
+15 DO CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
+16 IF 'OK
QUIT
+17 SET OK=0
+18 NEW DA,DIC,DIE,DLAYGO,DR,EPTYPE,ISC,X,Y
KILL DIC
+19 SET DIC=7100
SET DIC(0)="XL"
SET DLAYGO=7100
SET X=CALLID
+20 DO ^DIC
KILL DIC,DLAYGO
+21 IF Y<1
QUIT
+22 IF $$ACCESS^FSCU(DUZ,"SPEC")
SET EPTYPE=$ORDER(^FSC("EPTYPE","B","SPECIALIST",0))
+23 IF '$TEST
SET EPTYPE=$ORDER(^FSC("EPTYPE","B","NON-SPECIALIST",0))
+24 SET CALLNUM=+Y
SET OK=1
+25 SET DA=CALLNUM
SET DIE="^FSCD(""CALL"","
SET DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALLNUM
+26 SET ISC=+$PIECE($GET(^FSC("SITE",SITE,0)),U,11)
IF ISC
SET DR=DR_";2.3///`"_ISC
+27 LOCK +^FSCD("CALL",CALLNUM)
+28 DO ^DIE
+29 LOCK -^FSCD("CALL",CALLNUM)
+30 DO MRE^FSCMR(DUZ,CALLNUM)
+31 DO STATUS^FSCES(CALLNUM,"",1)
+32 QUIT
+33 ;
ASKDATE() ;
+1 IF $$ACCESS^FSCU(DUZ,"SPEC")
QUIT 1
+2 QUIT 0
