FSCLMPEA ;SLC/STAFF-NOIS List Manager Protocol Edit Association ;5/17/98 21:49
;;1.1;NOIS;;Sep 06, 1998
;
PRIMARY ; from FSCLMPE
N CALLNUM,DIC,NUM,PRIMARY,PRIMNAME,TARGET,X,Y K DIC,Y
S CALLNUM=$$CALL^FSCLMPE1(FSCCNT)
S PRIMARY=+$P($G(^FSCD("CALL",CALLNUM,120)),U,24)
S PRIMNAME=$P($G(^FSCD("CALL",PRIMARY,0)),U)
W !,"The primary call for this call is currently "_PRIMNAME_"."
I PRIMARY=CALLNUM,$O(^FSCD("CALL","APRIMARY",CALLNUM,0)) D
.W !,"This call has the following secondary calls that will also be associated:"
.S NUM=0 F S NUM=$O(^FSCD("CALL","APRIMARY",CALLNUM,NUM)) Q:NUM<1 D
..S NAME=$P($G(^FSCD("CALL",NUM,0)),U) I $L(NAME) W !,NAME," ",$G(^(1))
S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select call to associate with: "
D ^DIC K DIC Q:Y<1
D ASSOC(CALLNUM,+Y)
D UPDATE^FSCEU(CALLNUM)
Q
;
ASSOC(CALL1,CALL2) ; from FSCRPCD, FSCUCD
N CALL,PRIM1,PRIM2,SEC1,SEC2,TYPE1,TYPE2
S PRIM1=+$P($G(^FSCD("CALL",CALL1,120)),U,24),SEC1=+$P($G(^(120)),U,25)
S PRIM2=+$P($G(^FSCD("CALL",CALL2,120)),U,24),SEC2=+$P($G(^(120)),U,25)
I CALL1=CALL2,SEC1 D SETUP(CALL1,CALL2) Q
I CALL1=CALL2 Q
I PRIM1=PRIM2 Q
I PRIM1=CALL2 Q
S TYPE1=$S(SEC1:"C",$O(^FSCD("CALL","APRIMARY",CALL1,0)):"PC",1:"PN")
S TYPE2=$S(SEC2:"C",$O(^FSCD("CALL","APRIMARY",CALL2,0)):"PC",1:"PN")
I TYPE1="PN" D Q
.I TYPE2="C" D SETUP(CALL1,PRIM2) Q
.I TYPE2="PN" D SETUP(CALL1,CALL2) Q
.I TYPE2="PC" D SETUP(CALL1,CALL2) Q
I TYPE1="PC" D Q
.I TYPE2="C" D Q
..D SETUP(CALL1,PRIM2)
..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
...D SETUP(CALL,PRIM1)
.I TYPE2="PN" D
..D SETUP(CALL1,CALL2)
..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
...D SETUP(CALL,CALL2)
.I TYPE2="PC" D
..D SETUP(CALL1,CALL2)
..S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",CALL1,CALL)) Q:CALL<1 D
...D SETUP(CALL,CALL2)
I TYPE1="C" D Q
.I TYPE2="C" D SETUP(CALL1,PRIM2) Q
.I TYPE2="PN" D SETUP(CALL1,CALL2) Q
.I TYPE2="PC" D SETUP(CALL1,CALL2) Q
Q
;
SETUP(CALL,PRIMARY) ; from FSCRPCD
N DA,DIE,DR,LASTLINE,USERNAME,X,Y
S USERNAME=$P($G(^VA(200,+$G(DUZ),0)),U)
I '$L(USERNAME) S USERNAME="Purge Routine"
S DA=CALL,DIE="^FSCD(""CALL"",",DR="101///`"_PRIMARY
I CALL'=PRIMARY S DR=DR_";102///`"_PRIMARY
E S DR=DR_";102///@"
D ^DIE
S LASTLINE=1+$O(^FSCD("CALL",CALL,103,"A"),-1)
S ^FSCD("CALL",CALL,103,LASTLINE,0)="Changed to "_$P($G(^FSCD("CALL",PRIMARY,0)),U)_" by "_USERNAME_" on "_$$FMTE^XLFDT($$NOW^XLFDT)
S ^FSCD("CALL",CALL,103,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
Q
;
CONVERT ;
N DA,DIE,DR
S DA=0 F S DA=$O(^FSCD("CALL",DA)) Q:DA<1 D
.S DIE="^FSCD(""CALL"",",DR="101///`"_DA_";102///@" D ^DIE W "."
Q
;
COLLAPS ;
N NUM
K ^TMP("FSC COLLAPSE",$J)
S NUM=0 F S NUM=$O(^TMP("FSC CURRENT LIST",$J,NUM)) Q:NUM<1 D
Q
;
EXPAND ;
Q
;
EXPCALL(CALL) ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPEA 2891 printed Apr 09, 2024@21:22:11 Page 2
FSCLMPEA ;SLC/STAFF-NOIS List Manager Protocol Edit Association ;5/17/98 21:49
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
PRIMARY ; from FSCLMPE
+1 NEW CALLNUM,DIC,NUM,PRIMARY,PRIMNAME,TARGET,X,Y
KILL DIC,Y
+2 SET CALLNUM=$$CALL^FSCLMPE1(FSCCNT)
+3 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALLNUM,120)),U,24)
+4 SET PRIMNAME=$PIECE($GET(^FSCD("CALL",PRIMARY,0)),U)
+5 WRITE !,"The primary call for this call is currently "_PRIMNAME_"."
+6 IF PRIMARY=CALLNUM
IF $ORDER(^FSCD("CALL","APRIMARY",CALLNUM,0))
Begin DoDot:1
+7 WRITE !,"This call has the following secondary calls that will also be associated:"
+8 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("CALL","APRIMARY",CALLNUM,NUM))
if NUM<1
QUIT
Begin DoDot:2
+9 SET NAME=$PIECE($GET(^FSCD("CALL",NUM,0)),U)
IF $LENGTH(NAME)
WRITE !,NAME," ",$GET(^(1))
End DoDot:2
End DoDot:1
+10 SET DIC=7100
SET DIC(0)="AEMOQ"
SET DIC("A")="Select call to associate with: "
+11 DO ^DIC
KILL DIC
if Y<1
QUIT
+12 DO ASSOC(CALLNUM,+Y)
+13 DO UPDATE^FSCEU(CALLNUM)
+14 QUIT
+15 ;
ASSOC(CALL1,CALL2) ; from FSCRPCD, FSCUCD
+1 NEW CALL,PRIM1,PRIM2,SEC1,SEC2,TYPE1,TYPE2
+2 SET PRIM1=+$PIECE($GET(^FSCD("CALL",CALL1,120)),U,24)
SET SEC1=+$PIECE($GET(^(120)),U,25)
+3 SET PRIM2=+$PIECE($GET(^FSCD("CALL",CALL2,120)),U,24)
SET SEC2=+$PIECE($GET(^(120)),U,25)
+4 IF CALL1=CALL2
IF SEC1
DO SETUP(CALL1,CALL2)
QUIT
+5 IF CALL1=CALL2
QUIT
+6 IF PRIM1=PRIM2
QUIT
+7 IF PRIM1=CALL2
QUIT
+8 SET TYPE1=$SELECT(SEC1:"C",$ORDER(^FSCD("CALL","APRIMARY",CALL1,0)):"PC",1:"PN")
+9 SET TYPE2=$SELECT(SEC2:"C",$ORDER(^FSCD("CALL","APRIMARY",CALL2,0)):"PC",1:"PN")
+10 IF TYPE1="PN"
Begin DoDot:1
+11 IF TYPE2="C"
DO SETUP(CALL1,PRIM2)
QUIT
+12 IF TYPE2="PN"
DO SETUP(CALL1,CALL2)
QUIT
+13 IF TYPE2="PC"
DO SETUP(CALL1,CALL2)
QUIT
End DoDot:1
QUIT
+14 IF TYPE1="PC"
Begin DoDot:1
+15 IF TYPE2="C"
Begin DoDot:2
+16 DO SETUP(CALL1,PRIM2)
+17 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","APRIMARY",CALL1,CALL))
if CALL<1
QUIT
Begin DoDot:3
+18 DO SETUP(CALL,PRIM1)
End DoDot:3
End DoDot:2
QUIT
+19 IF TYPE2="PN"
Begin DoDot:2
+20 DO SETUP(CALL1,CALL2)
+21 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","APRIMARY",CALL1,CALL))
if CALL<1
QUIT
Begin DoDot:3
+22 DO SETUP(CALL,CALL2)
End DoDot:3
End DoDot:2
+23 IF TYPE2="PC"
Begin DoDot:2
+24 DO SETUP(CALL1,CALL2)
+25 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","APRIMARY",CALL1,CALL))
if CALL<1
QUIT
Begin DoDot:3
+26 DO SETUP(CALL,CALL2)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+27 IF TYPE1="C"
Begin DoDot:1
+28 IF TYPE2="C"
DO SETUP(CALL1,PRIM2)
QUIT
+29 IF TYPE2="PN"
DO SETUP(CALL1,CALL2)
QUIT
+30 IF TYPE2="PC"
DO SETUP(CALL1,CALL2)
QUIT
End DoDot:1
QUIT
+31 QUIT
+32 ;
SETUP(CALL,PRIMARY) ; from FSCRPCD
+1 NEW DA,DIE,DR,LASTLINE,USERNAME,X,Y
+2 SET USERNAME=$PIECE($GET(^VA(200,+$GET(DUZ),0)),U)
+3 IF '$LENGTH(USERNAME)
SET USERNAME="Purge Routine"
+4 SET DA=CALL
SET DIE="^FSCD(""CALL"","
SET DR="101///`"_PRIMARY
+5 IF CALL'=PRIMARY
SET DR=DR_";102///`"_PRIMARY
+6 IF '$TEST
SET DR=DR_";102///@"
+7 DO ^DIE
+8 SET LASTLINE=1+$ORDER(^FSCD("CALL",CALL,103,"A"),-1)
+9 SET ^FSCD("CALL",CALL,103,LASTLINE,0)="Changed to "_$PIECE($GET(^FSCD("CALL",PRIMARY,0)),U)_" by "_USERNAME_" on "_$$FMTE^XLFDT($$NOW^XLFDT)
+10 SET ^FSCD("CALL",CALL,103,0)="^^"_LASTLINE_U_LASTLINE_U_DT_U
+11 QUIT
+12 ;
CONVERT ;
+1 NEW DA,DIE,DR
+2 SET DA=0
FOR
SET DA=$ORDER(^FSCD("CALL",DA))
if DA<1
QUIT
Begin DoDot:1
+3 SET DIE="^FSCD(""CALL"","
SET DR="101///`"_DA_";102///@"
DO ^DIE
WRITE "."
End DoDot:1
+4 QUIT
+5 ;
COLLAPS ;
+1 NEW NUM
+2 KILL ^TMP("FSC COLLAPSE",$JOB)
+3 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,NUM))
if NUM<1
QUIT
Begin DoDot:1
End DoDot:1
+4 QUIT
+5 ;
EXPAND ;
+1 QUIT
+2 ;
EXPCALL(CALL) ;
+1 QUIT
