FSCRPCNC ;SLC/STAFF-NOIS RPC New Call ;9/6/98 22:02
;;1.1;NOIS;;Sep 06, 1998
;
NEW(IN,OUT) ; from FSCRPX (RPCNewCall)
N CALLID,CALL,DATEO,FIELDS,OK,SITE K FIELDS
K ^TMP("FSC WP",$J)
D PROCESS(.FIELDS)
S SITE=+$G(FIELDS("SITE"))
S DATEO=+$G(FIELDS("DATEO"))
Q:'SITE Q:'DATEO
D NEWCALL(SITE,DATEO,.CALLID,.CALL,.OK)
I 'OK Q
D FIELDS(CALL,.FIELDS)
S ^TMP("FSCRPC",$J,"OUTPUT",1)=+CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
K ^TMP("FSC WP",$J)
Q
;
NEWCALL(SITE,RDATE,CALLID,CALL,OK) ;
N DIC,DLAYGO,DR,EPTYPE,ISC,SITE0,X,Y K DIC
S OK=0
S SITE0=^FSC("SITE",SITE,0)
D CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
I 'OK Q
S OK=0
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 CALL=+Y,OK=1
S DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALL
S ISC=+$P($G(^FSC("SITE",SITE,0)),U,11) I ISC S DR=DR_";2.3///`"_ISC
D SETUP(CALL,"^FSCD(""CALL"",",.DR)
D MRE^FSCMR(DUZ,CALL)
Q
;
FIELDS(CALL,FIELDS) ;
N DR,STATUS
D DESC(CALL)
D NOTE(CALL)
S DR=""
I $L($G(FIELDS("SUBJECT"))) S DR=DR_";1///"_$$FIX^FSCRPCEC(FIELDS("SUBJECT"))
I $L($G(FIELDS("PHONE"))) S DR=DR_";2.2///"_$$FIX^FSCRPCEC(FIELDS("PHONE"))
I $L($G(FIELDS("PATCH"))) S DR=DR_";7///"_$$FIX^FSCRPCEC(FIELDS("PATCH"))
I $L($G(FIELDS("KEYWORDS"))) S DR=DR_";1.5///"_$$FIX^FSCRPCEC(FIELDS("KEYWORDS"))
I $L(DR)>100 D SETUP(CALL,"^FSCD(""CALL"",",.DR)
I $G(FIELDS("MOD")) S DR=DR_";3///`"_+FIELDS("MOD")
I $G(FIELDS("IRM")) S DR=DR_";2.1///`"_+FIELDS("IRM")
I $G(FIELDS("PRI")) S DR=DR_";6///`"_+FIELDS("PRI")
I $G(FIELDS("SPEC")) S DR=DR_";5///`"_+FIELDS("SPEC")
I $G(FIELDS("SPECD")) S DR=DR_";5.1///`"_+FIELDS("SPECD")
I $G(FIELDS("DEVSUB")) S DR=DR_";3.2///`"_+FIELDS("DEVSUB")
D SETUP(CALL,"^FSCD(""CALL"",",.DR)
S STATUS=+$G(FIELDS("STATUS"))
I STATUS=2 D
.S DR="81///`"_DUZ
.I $G(FIELDS("FUNC")) S DR=DR_";8///`"_+FIELDS("FUNC")
.I $G(FIELDS("TASK")) S DR=DR_";9///`"_+FIELDS("TASK")
.I $L($G(FIELDS("DATEC"))) S DR=DR_";82///"_FIELDS("DATEC")
.D SETUP(CALL,"^FSCD(""CALL"",",.DR)
.D RES(CALL)
D STATUS(CALL,STATUS)
Q
;
SETUP(DA,DIE,DR) ;
N X,Y
I '$L(DR) Q
I $E(DR)=";" S DR=$E(DR,2,245)
L +^FSCD("CALL",DA):30 I '$T Q ; *** needs ok
D ^DIE
L -^FSCD("CALL",DA)
D PICKUP^FSCES(DA)
S DR=""
Q
;
STATUS(CALL,STATUS) ;
I STATUS=1 D
.D STATUS^FSCES(CALL,"",1)
.D UPDATE^FSCTASK(CALL)
E I STATUS=3 D
.D STATUS^FSCES(CALL,"",1)
.D UPDATE^FSCTASK(CALL)
.D STATUS^FSCES(CALL,1,3)
.D UPDATE^FSCTASK(CALL)
E I STATUS=2 D
.D STATUS^FSCES(CALL,"",1)
.D UPDATE^FSCTASK(CALL)
.D STATUS^FSCES(CALL,1,2)
.D UPDATE^FSCTASK(CALL)
Q
;
RES(CALL) ; from FSCRPCEC, FSCRPCEF
N CNT,LINE,LINECNT
I '$O(^TMP("FSC WP",$J,"RES",0)) Q
S (LINECNT,CNT)=0 F S CNT=$O(^TMP("FSC WP",$J,"RES",CNT)) Q:CNT<1 S LINE=^(CNT) D
.S LINECNT=LINECNT+1
.S ^FSCD("CALL",CALL,80,LINECNT,0)=LINE
S ^FSCD("CALL",CALL,80,0)="^^"_LINECNT_U_LINECNT_U_DT_U
Q
;
DESC(CALL) ; from FSCRPCEC, FSCRPCEF
N CNT,LINE,LINECNT
I '$O(^TMP("FSC WP",$J,"DESC",0)) Q
K ^FSCD("CALL",CALL,30)
S (LINECNT,CNT)=0 F S CNT=$O(^TMP("FSC WP",$J,"DESC",CNT)) Q:CNT<1 S LINE=^(CNT) D
.S LINECNT=LINECNT+1
.S ^FSCD("CALL",CALL,30,LINECNT,0)=LINE
S ^FSCD("CALL",CALL,30,0)="^^"_LINECNT_U_LINECNT_U_DT_U
Q
;
NOTE(CALL) ; from FSCRPCEC, FSCRPCEF
N CNT,LINE,NUM
I '$O(^TMP("FSC WP",$J,"NOTE",0)) Q
S NUM=$P(^FSCD("CALL",CALL,120),U,7)+1,$P(^(120),U,7)=NUM
S LINE="("_NUM_") "_$$FMTE^XLFDT($$NOW^XLFDT)
S LINE=$$SETSTR^VALM1($$VALUE^FSCGET(DUZ,7107.1,1),LINE,35,$L(LINE))
L +^FSCD("CALL",CALL,50):30 I '$T Q ; *** needs ok
I '$D(^FSCD("CALL",CALL,50,0)) S ^(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(^TMP("FSC WP",$J,"NOTE",LINE)) Q:LINE<1 S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=^(LINE)
S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=""
S $P(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
L -^FSCD("CALL",CALL,50)
Q
;
PROCESS(FIELDS) ; from FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCWP, FSCRPCWS
N CNT,LINE
S CNT=0 F S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1 S LINE=^(CNT) D Q:CNT<1
.I '$L(LINE) Q
.I $E(LINE)'="{" S FIELDS($P(LINE,U))=$P(LINE,U,2,99) Q
.I LINE="{DESC}" D WP("DESC",.CNT) Q
.I LINE="{NOTE}" D WP("NOTE",.CNT) Q
.I LINE="{RES}" D WP("RES",.CNT) Q
.I LINE="{PNOTE}" D WP("PNOTE",.CNT) Q
Q
;
WP(NODE,CNT) ;
N LINE,LINECNT
S LINECNT=0
F S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1 S LINE=^(CNT) Q:LINE="{{{}}}" D
.S LINECNT=LINECNT+1
.S ^TMP("FSC WP",$J,NODE,LINECNT)=LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCNC 4828 printed Oct 16, 2024@18:20:13 Page 2
FSCRPCNC ;SLC/STAFF-NOIS RPC New Call ;9/6/98 22:02
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
NEW(IN,OUT) ; from FSCRPX (RPCNewCall)
+1 NEW CALLID,CALL,DATEO,FIELDS,OK,SITE
KILL FIELDS
+2 KILL ^TMP("FSC WP",$JOB)
+3 DO PROCESS(.FIELDS)
+4 SET SITE=+$GET(FIELDS("SITE"))
+5 SET DATEO=+$GET(FIELDS("DATEO"))
+6 if 'SITE
QUIT
if 'DATEO
QUIT
+7 DO NEWCALL(SITE,DATEO,.CALLID,.CALL,.OK)
+8 IF 'OK
QUIT
+9 DO FIELDS(CALL,.FIELDS)
+10 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=+CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+11 KILL ^TMP("FSC WP",$JOB)
+12 QUIT
+13 ;
NEWCALL(SITE,RDATE,CALLID,CALL,OK) ;
+1 NEW DIC,DLAYGO,DR,EPTYPE,ISC,SITE0,X,Y
KILL DIC
+2 SET OK=0
+3 SET SITE0=^FSC("SITE",SITE,0)
+4 DO CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
+5 IF 'OK
QUIT
+6 SET OK=0
+7 SET DIC=7100
SET DIC(0)="XL"
SET DLAYGO=7100
SET X=CALLID
+8 DO ^DIC
KILL DIC,DLAYGO
+9 IF Y<1
QUIT
+10 IF $$ACCESS^FSCU(DUZ,"SPEC")
SET EPTYPE=$ORDER(^FSC("EPTYPE","B","SPECIALIST",0))
+11 IF '$TEST
SET EPTYPE=$ORDER(^FSC("EPTYPE","B","NON-SPECIALIST",0))
+12 SET CALL=+Y
SET OK=1
+13 SET DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALL
+14 SET ISC=+$PIECE($GET(^FSC("SITE",SITE,0)),U,11)
IF ISC
SET DR=DR_";2.3///`"_ISC
+15 DO SETUP(CALL,"^FSCD(""CALL"",",.DR)
+16 DO MRE^FSCMR(DUZ,CALL)
+17 QUIT
+18 ;
FIELDS(CALL,FIELDS) ;
+1 NEW DR,STATUS
+2 DO DESC(CALL)
+3 DO NOTE(CALL)
+4 SET DR=""
+5 IF $LENGTH($GET(FIELDS("SUBJECT")))
SET DR=DR_";1///"_$$FIX^FSCRPCEC(FIELDS("SUBJECT"))
+6 IF $LENGTH($GET(FIELDS("PHONE")))
SET DR=DR_";2.2///"_$$FIX^FSCRPCEC(FIELDS("PHONE"))
+7 IF $LENGTH($GET(FIELDS("PATCH")))
SET DR=DR_";7///"_$$FIX^FSCRPCEC(FIELDS("PATCH"))
+8 IF $LENGTH($GET(FIELDS("KEYWORDS")))
SET DR=DR_";1.5///"_$$FIX^FSCRPCEC(FIELDS("KEYWORDS"))
+9 IF $LENGTH(DR)>100
DO SETUP(CALL,"^FSCD(""CALL"",",.DR)
+10 IF $GET(FIELDS("MOD"))
SET DR=DR_";3///`"_+FIELDS("MOD")
+11 IF $GET(FIELDS("IRM"))
SET DR=DR_";2.1///`"_+FIELDS("IRM")
+12 IF $GET(FIELDS("PRI"))
SET DR=DR_";6///`"_+FIELDS("PRI")
+13 IF $GET(FIELDS("SPEC"))
SET DR=DR_";5///`"_+FIELDS("SPEC")
+14 IF $GET(FIELDS("SPECD"))
SET DR=DR_";5.1///`"_+FIELDS("SPECD")
+15 IF $GET(FIELDS("DEVSUB"))
SET DR=DR_";3.2///`"_+FIELDS("DEVSUB")
+16 DO SETUP(CALL,"^FSCD(""CALL"",",.DR)
+17 SET STATUS=+$GET(FIELDS("STATUS"))
+18 IF STATUS=2
Begin DoDot:1
+19 SET DR="81///`"_DUZ
+20 IF $GET(FIELDS("FUNC"))
SET DR=DR_";8///`"_+FIELDS("FUNC")
+21 IF $GET(FIELDS("TASK"))
SET DR=DR_";9///`"_+FIELDS("TASK")
+22 IF $LENGTH($GET(FIELDS("DATEC")))
SET DR=DR_";82///"_FIELDS("DATEC")
+23 DO SETUP(CALL,"^FSCD(""CALL"",",.DR)
+24 DO RES(CALL)
End DoDot:1
+25 DO STATUS(CALL,STATUS)
+26 QUIT
+27 ;
SETUP(DA,DIE,DR) ;
+1 NEW X,Y
+2 IF '$LENGTH(DR)
QUIT
+3 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,245)
+4 ; *** needs ok
LOCK +^FSCD("CALL",DA):30
IF '$TEST
QUIT
+5 DO ^DIE
+6 LOCK -^FSCD("CALL",DA)
+7 DO PICKUP^FSCES(DA)
+8 SET DR=""
+9 QUIT
+10 ;
STATUS(CALL,STATUS) ;
+1 IF STATUS=1
Begin DoDot:1
+2 DO STATUS^FSCES(CALL,"",1)
+3 DO UPDATE^FSCTASK(CALL)
End DoDot:1
+4 IF '$TEST
IF STATUS=3
Begin DoDot:1
+5 DO STATUS^FSCES(CALL,"",1)
+6 DO UPDATE^FSCTASK(CALL)
+7 DO STATUS^FSCES(CALL,1,3)
+8 DO UPDATE^FSCTASK(CALL)
End DoDot:1
+9 IF '$TEST
IF STATUS=2
Begin DoDot:1
+10 DO STATUS^FSCES(CALL,"",1)
+11 DO UPDATE^FSCTASK(CALL)
+12 DO STATUS^FSCES(CALL,1,2)
+13 DO UPDATE^FSCTASK(CALL)
End DoDot:1
+14 QUIT
+15 ;
RES(CALL) ; from FSCRPCEC, FSCRPCEF
+1 NEW CNT,LINE,LINECNT
+2 IF '$ORDER(^TMP("FSC WP",$JOB,"RES",0))
QUIT
+3 SET (LINECNT,CNT)=0
FOR
SET CNT=$ORDER(^TMP("FSC WP",$JOB,"RES",CNT))
if CNT<1
QUIT
SET LINE=^(CNT)
Begin DoDot:1
+4 SET LINECNT=LINECNT+1
+5 SET ^FSCD("CALL",CALL,80,LINECNT,0)=LINE
End DoDot:1
+6 SET ^FSCD("CALL",CALL,80,0)="^^"_LINECNT_U_LINECNT_U_DT_U
+7 QUIT
+8 ;
DESC(CALL) ; from FSCRPCEC, FSCRPCEF
+1 NEW CNT,LINE,LINECNT
+2 IF '$ORDER(^TMP("FSC WP",$JOB,"DESC",0))
QUIT
+3 KILL ^FSCD("CALL",CALL,30)
+4 SET (LINECNT,CNT)=0
FOR
SET CNT=$ORDER(^TMP("FSC WP",$JOB,"DESC",CNT))
if CNT<1
QUIT
SET LINE=^(CNT)
Begin DoDot:1
+5 SET LINECNT=LINECNT+1
+6 SET ^FSCD("CALL",CALL,30,LINECNT,0)=LINE
End DoDot:1
+7 SET ^FSCD("CALL",CALL,30,0)="^^"_LINECNT_U_LINECNT_U_DT_U
+8 QUIT
+9 ;
NOTE(CALL) ; from FSCRPCEC, FSCRPCEF
+1 NEW CNT,LINE,NUM
+2 IF '$ORDER(^TMP("FSC WP",$JOB,"NOTE",0))
QUIT
+3 SET NUM=$PIECE(^FSCD("CALL",CALL,120),U,7)+1
SET $PIECE(^(120),U,7)=NUM
+4 SET LINE="("_NUM_") "_$$FMTE^XLFDT($$NOW^XLFDT)
+5 SET LINE=$$SETSTR^VALM1($$VALUE^FSCGET(DUZ,7107.1,1),LINE,35,$LENGTH(LINE))
+6 ; *** needs ok
LOCK +^FSCD("CALL",CALL,50):30
IF '$TEST
QUIT
+7 IF '$DATA(^FSCD("CALL",CALL,50,0))
SET ^(0)="^^0^0^"_DT_U
+8 SET CNT=1+$ORDER(^FSCD("CALL",CALL,50,"A"),-1)
+9 SET $PIECE(^FSCD("CALL",CALL,120),U,6)=CNT
+10 SET ^FSCD("CALL",CALL,50,CNT,0)=LINE
+11 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("FSC WP",$JOB,"NOTE",LINE))
if LINE<1
QUIT
SET CNT=CNT+1
SET ^FSCD("CALL",CALL,50,CNT,0)=^(LINE)
+12 SET CNT=CNT+1
SET ^FSCD("CALL",CALL,50,CNT,0)=""
+13 SET $PIECE(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
+14 LOCK -^FSCD("CALL",CALL,50)
+15 QUIT
+16 ;
PROCESS(FIELDS) ; from FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCWP, FSCRPCWS
+1 NEW CNT,LINE
+2 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",CNT))
if CNT<1
QUIT
SET LINE=^(CNT)
Begin DoDot:1
+3 IF '$LENGTH(LINE)
QUIT
+4 IF $EXTRACT(LINE)'="{"
SET FIELDS($PIECE(LINE,U))=$PIECE(LINE,U,2,99)
QUIT
+5 IF LINE="{DESC}"
DO WP("DESC",.CNT)
QUIT
+6 IF LINE="{NOTE}"
DO WP("NOTE",.CNT)
QUIT
+7 IF LINE="{RES}"
DO WP("RES",.CNT)
QUIT
+8 IF LINE="{PNOTE}"
DO WP("PNOTE",.CNT)
QUIT
End DoDot:1
if CNT<1
QUIT
+9 QUIT
+10 ;
WP(NODE,CNT) ;
+1 NEW LINE,LINECNT
+2 SET LINECNT=0
+3 FOR
SET CNT=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",CNT))
if CNT<1
QUIT
SET LINE=^(CNT)
if LINE="{{{}}}"
QUIT
Begin DoDot:1
+4 SET LINECNT=LINECNT+1
+5 SET ^TMP("FSC WP",$JOB,NODE,LINECNT)=LINE
End DoDot:1
+6 QUIT
