| 1 | FSCLMPEA ;SLC/STAFF-NOIS List Manager Protocol Edit Association ;5/17/98  21:49 | 
|---|
| 2 | ;;1.1;NOIS;;Sep 06, 1998 | 
|---|
| 3 | ; | 
|---|
| 4 | PRIMARY ; from FSCLMPE | 
|---|
| 5 | N CALLNUM,DIC,NUM,PRIMARY,PRIMNAME,TARGET,X,Y K DIC,Y | 
|---|
| 6 | S CALLNUM=$$CALL^FSCLMPE1(FSCCNT) | 
|---|
| 7 | S PRIMARY=+$P($G(^FSCD("CALL",CALLNUM,120)),U,24) | 
|---|
| 8 | S PRIMNAME=$P($G(^FSCD("CALL",PRIMARY,0)),U) | 
|---|
| 9 | W !,"The primary call for this call is currently "_PRIMNAME_"." | 
|---|
| 10 | I PRIMARY=CALLNUM,$O(^FSCD("CALL","APRIMARY",CALLNUM,0)) D | 
|---|
| 11 | .W !,"This call has the following secondary calls that will also be associated:" | 
|---|
| 12 | .S NUM=0 F  S NUM=$O(^FSCD("CALL","APRIMARY",CALLNUM,NUM)) Q:NUM<1  D | 
|---|
| 13 | ..S NAME=$P($G(^FSCD("CALL",NUM,0)),U) I $L(NAME) W !,NAME," ",$G(^(1)) | 
|---|
| 14 | S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select call to associate with: " | 
|---|
| 15 | D ^DIC K DIC Q:Y<1 | 
|---|
| 16 | D ASSOC(CALLNUM,+Y) | 
|---|
| 17 | D UPDATE^FSCEU(CALLNUM) | 
|---|
| 18 | Q | 
|---|
| 19 | ; | 
|---|
| 20 | ASSOC(CALL1,CALL2) ; from FSCRPCD, FSCUCD | 
|---|
| 21 | N CALL,PRIM1,PRIM2,SEC1,SEC2,TYPE1,TYPE2 | 
|---|
| 22 | S PRIM1=+$P($G(^FSCD("CALL",CALL1,120)),U,24),SEC1=+$P($G(^(120)),U,25) | 
|---|
| 23 | S PRIM2=+$P($G(^FSCD("CALL",CALL2,120)),U,24),SEC2=+$P($G(^(120)),U,25) | 
|---|
| 24 | I CALL1=CALL2,SEC1 D SETUP(CALL1,CALL2) Q | 
|---|
| 25 | I CALL1=CALL2 Q | 
|---|
| 26 | I PRIM1=PRIM2 Q | 
|---|
| 27 | I PRIM1=CALL2 Q | 
|---|
| 28 | S TYPE1=$S(SEC1:"C",$O(^FSCD("CALL","APRIMARY",CALL1,0)):"PC",1:"PN") | 
|---|
| 29 | S TYPE2=$S(SEC2:"C",$O(^FSCD("CALL","APRIMARY",CALL2,0)):"PC",1:"PN") | 
|---|
| 30 | I TYPE1="PN" D  Q | 
|---|
| 31 | .I TYPE2="C" D SETUP(CALL1,PRIM2) Q | 
|---|
| 32 | .I TYPE2="PN" D SETUP(CALL1,CALL2) Q | 
|---|
| 33 | .I TYPE2="PC" D SETUP(CALL1,CALL2) Q | 
|---|
| 34 | I TYPE1="PC" D  Q | 
|---|
| 35 | .I TYPE2="C" D  Q | 
|---|
| 36 | ..D SETUP(CALL1,PRIM2) | 
|---|
| 37 | ..S CALL=0 F  S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1  D | 
|---|
| 38 | ...D SETUP(CALL,PRIM1) | 
|---|
| 39 | .I TYPE2="PN" D | 
|---|
| 40 | ..D SETUP(CALL1,CALL2) | 
|---|
| 41 | ..S CALL=0 F  S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1  D | 
|---|
| 42 | ...D SETUP(CALL,CALL2) | 
|---|
| 43 | .I TYPE2="PC" D | 
|---|
| 44 | ..D SETUP(CALL1,CALL2) | 
|---|
| 45 | ..S CALL=0 F  S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1  D | 
|---|
| 46 | ...D SETUP(CALL,CALL2) | 
|---|
| 47 | I TYPE1="C" D  Q | 
|---|
| 48 | .I TYPE2="C" D SETUP(CALL1,PRIM2) Q | 
|---|
| 49 | .I TYPE2="PN" D SETUP(CALL1,CALL2) Q | 
|---|
| 50 | .I TYPE2="PC" D SETUP(CALL1,CALL2) Q | 
|---|
| 51 | Q | 
|---|
| 52 | ; | 
|---|
| 53 | SETUP(CALL,PRIMARY) ; from FSCRPCD | 
|---|
| 54 | N DA,DIE,DR,LASTLINE,USERNAME,X,Y | 
|---|
| 55 | S USERNAME=$P($G(^VA(200,+$G(DUZ),0)),U) | 
|---|
| 56 | I '$L(USERNAME) S USERNAME="Purge Routine" | 
|---|
| 57 | S DA=CALL,DIE="^FSCD(""CALL"",",DR="101///`"_PRIMARY | 
|---|
| 58 | I CALL'=PRIMARY S DR=DR_";102///`"_PRIMARY | 
|---|
| 59 | E  S DR=DR_";102///@" | 
|---|
| 60 | D ^DIE | 
|---|
| 61 | S LASTLINE=1+$O(^FSCD("CALL",CALL,103,"A"),-1) | 
|---|
| 62 | S ^FSCD("CALL",CALL,103,LASTLINE,0)="Changed to "_$P($G(^FSCD("CALL",PRIMARY,0)),U)_" by "_USERNAME_" on "_$$FMTE^XLFDT($$NOW^XLFDT) | 
|---|
| 63 | S ^FSCD("CALL",CALL,103,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U | 
|---|
| 64 | Q | 
|---|
| 65 | ; | 
|---|
| 66 | CONVERT ; | 
|---|
| 67 | N DA,DIE,DR | 
|---|
| 68 | S DA=0 F  S DA=$O(^FSCD("CALL",DA)) Q:DA<1  D | 
|---|
| 69 | .S DIE="^FSCD(""CALL"",",DR="101///`"_DA_";102///@" D ^DIE W "." | 
|---|
| 70 | Q | 
|---|
| 71 | ; | 
|---|
| 72 | COLLAPS ; | 
|---|
| 73 | N NUM | 
|---|
| 74 | K ^TMP("FSC COLLAPSE",$J) | 
|---|
| 75 | S NUM=0 F  S NUM=$O(^TMP("FSC CURRENT LIST",$J,NUM)) Q:NUM<1  D | 
|---|
| 76 | Q | 
|---|
| 77 | ; | 
|---|
| 78 | EXPAND ; | 
|---|
| 79 | Q | 
|---|
| 80 | ; | 
|---|
| 81 | EXPCALL(CALL) ; | 
|---|
| 82 | Q | 
|---|