Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCRPCNC

FSCRPCNC.m

Go to the documentation of this file. 
  1. FSCRPCNC ;SLC/STAFF-NOIS RPC New Call ;9/6/98  22:02
  1.  ;;1.1;NOIS;;Sep 06, 1998
  1.  ;
  1. NEW(IN,OUT) ; from FSCRPX (RPCNewCall)
  1.  N CALLID,CALL,DATEO,FIELDS,OK,SITE K FIELDS
  1.  K ^TMP("FSC WP",$J)
  1.  D PROCESS(.FIELDS)
  1.  S SITE=+$G(FIELDS("SITE"))
  1.  S DATEO=+$G(FIELDS("DATEO"))
  1.  Q:'SITE  Q:'DATEO
  1.  D NEWCALL(SITE,DATEO,.CALLID,.CALL,.OK)
  1.  I 'OK Q
  1.  D FIELDS(CALL,.FIELDS)
  1.  S ^TMP("FSCRPC",$J,"OUTPUT",1)=+CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
  1.  K ^TMP("FSC WP",$J)
  1.  Q
  1.  ;
  1. NEWCALL(SITE,RDATE,CALLID,CALL,OK) ;
  1.  N DIC,DLAYGO,DR,EPTYPE,ISC,SITE0,X,Y K DIC
  1.  S OK=0
  1.  S SITE0=^FSC("SITE",SITE,0)
  1.  D CALLNUM^FSCUC(SITE0,RDATE,.CALLID,.OK)
  1.  I 'OK Q
  1.  S OK=0
  1.  S DIC=7100,DIC(0)="XL",DLAYGO=7100,X=CALLID
  1.  D ^DIC K DIC,DLAYGO
  1.  I Y<1 Q
  1.  I $$ACCESS^FSCU(DUZ,"SPEC") S EPTYPE=$O(^FSC("EPTYPE","B","SPECIALIST",0))
  1.  E  S EPTYPE=$O(^FSC("EPTYPE","B","NON-SPECIALIST",0))
  1.  S CALL=+Y,OK=1
  1.  S DR="2///`"_SITE_";10///"_RDATE_";120///NOW;5.2///`"_DUZ_";5.3///"_EPTYPE_";101///`"_CALL
  1.  S ISC=+$P($G(^FSC("SITE",SITE,0)),U,11) I ISC S DR=DR_";2.3///`"_ISC
  1.  D SETUP(CALL,"^FSCD(""CALL"",",.DR)
  1.  D MRE^FSCMR(DUZ,CALL)
  1.  Q
  1.  ;
  1. FIELDS(CALL,FIELDS) ;
  1.  N DR,STATUS
  1.  D DESC(CALL)
  1.  D NOTE(CALL)
  1.  S DR=""
  1.  I $L($G(FIELDS("SUBJECT"))) S DR=DR_";1///"_$$FIX^FSCRPCEC(FIELDS("SUBJECT"))
  1.  I $L($G(FIELDS("PHONE"))) S DR=DR_";2.2///"_$$FIX^FSCRPCEC(FIELDS("PHONE"))
  1.  I $L($G(FIELDS("PATCH"))) S DR=DR_";7///"_$$FIX^FSCRPCEC(FIELDS("PATCH"))
  1.  I $L($G(FIELDS("KEYWORDS"))) S DR=DR_";1.5///"_$$FIX^FSCRPCEC(FIELDS("KEYWORDS"))
  1.  I $L(DR)>100 D SETUP(CALL,"^FSCD(""CALL"",",.DR)
  1.  I $G(FIELDS("MOD")) S DR=DR_";3///`"_+FIELDS("MOD")
  1.  I $G(FIELDS("IRM")) S DR=DR_";2.1///`"_+FIELDS("IRM")
  1.  I $G(FIELDS("PRI")) S DR=DR_";6///`"_+FIELDS("PRI")
  1.  I $G(FIELDS("SPEC")) S DR=DR_";5///`"_+FIELDS("SPEC")
  1.  I $G(FIELDS("SPECD")) S DR=DR_";5.1///`"_+FIELDS("SPECD")
  1.  I $G(FIELDS("DEVSUB")) S DR=DR_";3.2///`"_+FIELDS("DEVSUB")
  1.  D SETUP(CALL,"^FSCD(""CALL"",",.DR)
  1.  S STATUS=+$G(FIELDS("STATUS"))
  1.  I STATUS=2 D
  1.  .S DR="81///`"_DUZ
  1.  .I $G(FIELDS("FUNC")) S DR=DR_";8///`"_+FIELDS("FUNC")
  1.  .I $G(FIELDS("TASK")) S DR=DR_";9///`"_+FIELDS("TASK")
  1.  .I $L($G(FIELDS("DATEC"))) S DR=DR_";82///"_FIELDS("DATEC")
  1.  .D SETUP(CALL,"^FSCD(""CALL"",",.DR)
  1.  .D RES(CALL)
  1.  D STATUS(CALL,STATUS)
  1.  Q
  1.  ;
  1. SETUP(DA,DIE,DR) ;
  1.  N X,Y
  1.  I '$L(DR) Q
  1.  I $E(DR)=";" S DR=$E(DR,2,245)
  1.  L +^FSCD("CALL",DA):30 I '$T Q  ; *** needs ok
  1.  D ^DIE
  1.  L -^FSCD("CALL",DA)
  1.  D PICKUP^FSCES(DA)
  1.  S DR=""
  1.  Q
  1.  ;
  1. STATUS(CALL,STATUS) ;
  1.  I STATUS=1 D
  1.  .D STATUS^FSCES(CALL,"",1)
  1.  .D UPDATE^FSCTASK(CALL)
  1.  E  I STATUS=3 D
  1.  .D STATUS^FSCES(CALL,"",1)
  1.  .D UPDATE^FSCTASK(CALL)
  1.  .D STATUS^FSCES(CALL,1,3)
  1.  .D UPDATE^FSCTASK(CALL)
  1.  E  I STATUS=2 D
  1.  .D STATUS^FSCES(CALL,"",1)
  1.  .D UPDATE^FSCTASK(CALL)
  1.  .D STATUS^FSCES(CALL,1,2)
  1.  .D UPDATE^FSCTASK(CALL)
  1.  Q
  1.  ;
  1. RES(CALL) ; from FSCRPCEC, FSCRPCEF
  1.  N CNT,LINE,LINECNT
  1.  I '$O(^TMP("FSC WP",$J,"RES",0)) Q
  1.  S (LINECNT,CNT)=0 F  S CNT=$O(^TMP("FSC WP",$J,"RES",CNT)) Q:CNT<1  S LINE=^(CNT) D
  1.  .S LINECNT=LINECNT+1
  1.  .S ^FSCD("CALL",CALL,80,LINECNT,0)=LINE
  1.  S ^FSCD("CALL",CALL,80,0)="^^"_LINECNT_U_LINECNT_U_DT_U
  1.  Q
  1.  ;
  1. DESC(CALL) ; from FSCRPCEC, FSCRPCEF
  1.  N CNT,LINE,LINECNT
  1.  I '$O(^TMP("FSC WP",$J,"DESC",0)) Q
  1.  K ^FSCD("CALL",CALL,30)
  1.  S (LINECNT,CNT)=0 F  S CNT=$O(^TMP("FSC WP",$J,"DESC",CNT)) Q:CNT<1  S LINE=^(CNT) D
  1.  .S LINECNT=LINECNT+1
  1.  .S ^FSCD("CALL",CALL,30,LINECNT,0)=LINE
  1.  S ^FSCD("CALL",CALL,30,0)="^^"_LINECNT_U_LINECNT_U_DT_U
  1.  Q
  1.  ;
  1. NOTE(CALL) ; from FSCRPCEC, FSCRPCEF
  1.  N CNT,LINE,NUM
  1.  I '$O(^TMP("FSC WP",$J,"NOTE",0)) Q
  1.  S NUM=$P(^FSCD("CALL",CALL,120),U,7)+1,$P(^(120),U,7)=NUM
  1.  S LINE="("_NUM_") "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S LINE=$$SETSTR^VALM1($$VALUE^FSCGET(DUZ,7107.1,1),LINE,35,$L(LINE))
  1.  L +^FSCD("CALL",CALL,50):30 I '$T Q  ; *** needs ok
  1.  I '$D(^FSCD("CALL",CALL,50,0)) S ^(0)="^^0^0^"_DT_U
  1.  S CNT=1+$O(^FSCD("CALL",CALL,50,"A"),-1)
  1.  S $P(^FSCD("CALL",CALL,120),U,6)=CNT
  1.  S ^FSCD("CALL",CALL,50,CNT,0)=LINE
  1.  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)
  1.  S CNT=CNT+1,^FSCD("CALL",CALL,50,CNT,0)=""
  1.  S $P(^FSCD("CALL",CALL,50,0),U,3,4)=CNT_U_CNT
  1.  L -^FSCD("CALL",CALL,50)
  1.  Q
  1.  ;
  1. PROCESS(FIELDS) ; from FSCRPCEB, FSCRPCEC, FSCRPCEN, FSCRPCWP, FSCRPCWS
  1.  N CNT,LINE
  1.  S CNT=0 F  S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1  S LINE=^(CNT) D  Q:CNT<1
  1.  .I '$L(LINE) Q
  1.  .I $E(LINE)'="{" S FIELDS($P(LINE,U))=$P(LINE,U,2,99) Q
  1.  .I LINE="{DESC}" D WP("DESC",.CNT) Q
  1.  .I LINE="{NOTE}" D WP("NOTE",.CNT) Q
  1.  .I LINE="{RES}" D WP("RES",.CNT) Q
  1.  .I LINE="{PNOTE}" D WP("PNOTE",.CNT) Q
  1.  Q
  1.  ;
  1. WP(NODE,CNT) ;
  1.  N LINE,LINECNT
  1.  S LINECNT=0
  1.  F  S CNT=$O(^TMP("FSCRPC",$J,"INPUT",CNT)) Q:CNT<1  S LINE=^(CNT) Q:LINE="{{{}}}"  D
  1.  .S LINECNT=LINECNT+1
  1.  .S ^TMP("FSC WP",$J,NODE,LINECNT)=LINE
  1.  Q