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

FSCLMPEA.m

Go to the documentation of this file.
  1. FSCLMPEA ;SLC/STAFF-NOIS List Manager Protocol Edit Association ;5/17/98 21:49
  1. ;;1.1;NOIS;;Sep 06, 1998
  1. ;
  1. PRIMARY ; from FSCLMPE
  1. N CALLNUM,DIC,NUM,PRIMARY,PRIMNAME,TARGET,X,Y K DIC,Y
  1. S CALLNUM=$$CALL^FSCLMPE1(FSCCNT)
  1. S PRIMARY=+$P($G(^FSCD("CALL",CALLNUM,120)),U,24)
  1. S PRIMNAME=$P($G(^FSCD("CALL",PRIMARY,0)),U)
  1. W !,"The primary call for this call is currently "_PRIMNAME_"."
  1. I PRIMARY=CALLNUM,$O(^FSCD("CALL","APRIMARY",CALLNUM,0)) D
  1. .W !,"This call has the following secondary calls that will also be associated:"
  1. .S NUM=0 F S NUM=$O(^FSCD("CALL","APRIMARY",CALLNUM,NUM)) Q:NUM<1 D
  1. ..S NAME=$P($G(^FSCD("CALL",NUM,0)),U) I $L(NAME) W !,NAME," ",$G(^(1))
  1. S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select call to associate with: "
  1. D ^DIC K DIC Q:Y<1
  1. D ASSOC(CALLNUM,+Y)
  1. D UPDATE^FSCEU(CALLNUM)
  1. Q
  1. ;
  1. ASSOC(CALL1,CALL2) ; from FSCRPCD, FSCUCD
  1. N CALL,PRIM1,PRIM2,SEC1,SEC2,TYPE1,TYPE2
  1. S PRIM1=+$P($G(^FSCD("CALL",CALL1,120)),U,24),SEC1=+$P($G(^(120)),U,25)
  1. S PRIM2=+$P($G(^FSCD("CALL",CALL2,120)),U,24),SEC2=+$P($G(^(120)),U,25)
  1. I CALL1=CALL2,SEC1 D SETUP(CALL1,CALL2) Q
  1. I CALL1=CALL2 Q
  1. I PRIM1=PRIM2 Q
  1. I PRIM1=CALL2 Q
  1. S TYPE1=$S(SEC1:"C",$O(^FSCD("CALL","APRIMARY",CALL1,0)):"PC",1:"PN")
  1. S TYPE2=$S(SEC2:"C",$O(^FSCD("CALL","APRIMARY",CALL2,0)):"PC",1:"PN")
  1. I TYPE1="PN" D Q
  1. .I TYPE2="C" D SETUP(CALL1,PRIM2) Q
  1. .I TYPE2="PN" D SETUP(CALL1,CALL2) Q
  1. .I TYPE2="PC" D SETUP(CALL1,CALL2) Q
  1. I TYPE1="PC" D Q
  1. .I TYPE2="C" D Q
  1. ..D SETUP(CALL1,PRIM2)
  1. ..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
  1. ...D SETUP(CALL,PRIM1)
  1. .I TYPE2="PN" D
  1. ..D SETUP(CALL1,CALL2)
  1. ..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
  1. ...D SETUP(CALL,CALL2)
  1. .I TYPE2="PC" D
  1. ..D SETUP(CALL1,CALL2)
  1. ..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
  1. ...D SETUP(CALL,CALL2)
  1. I TYPE1="C" D Q
  1. .I TYPE2="C" D SETUP(CALL1,PRIM2) Q
  1. .I TYPE2="PN" D SETUP(CALL1,CALL2) Q
  1. .I TYPE2="PC" D SETUP(CALL1,CALL2) Q
  1. Q
  1. ;
  1. SETUP(CALL,PRIMARY) ; from FSCRPCD
  1. N DA,DIE,DR,LASTLINE,USERNAME,X,Y
  1. S USERNAME=$P($G(^VA(200,+$G(DUZ),0)),U)
  1. I '$L(USERNAME) S USERNAME="Purge Routine"
  1. S DA=CALL,DIE="^FSCD(""CALL"",",DR="101///`"_PRIMARY
  1. I CALL'=PRIMARY S DR=DR_";102///`"_PRIMARY
  1. E S DR=DR_";102///@"
  1. D ^DIE
  1. S LASTLINE=1+$O(^FSCD("CALL",CALL,103,"A"),-1)
  1. S ^FSCD("CALL",CALL,103,LASTLINE,0)="Changed to "_$P($G(^FSCD("CALL",PRIMARY,0)),U)_" by "_USERNAME_" on "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. S ^FSCD("CALL",CALL,103,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
  1. Q
  1. ;
  1. CONVERT ;
  1. N DA,DIE,DR
  1. S DA=0 F S DA=$O(^FSCD("CALL",DA)) Q:DA<1 D
  1. .S DIE="^FSCD(""CALL"",",DR="101///`"_DA_";102///@" D ^DIE W "."
  1. Q
  1. ;
  1. COLLAPS ;
  1. N NUM
  1. K ^TMP("FSC COLLAPSE",$J)
  1. S NUM=0 F S NUM=$O(^TMP("FSC CURRENT LIST",$J,NUM)) Q:NUM<1 D
  1. Q
  1. ;
  1. EXPAND ;
  1. Q
  1. ;
  1. EXPCALL(CALL) ;
  1. Q