- 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 Feb 18, 2025@23:44:42 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