FSCLMPE1 ;SLC/STAFF-NOIS List Manager Protocol Edit Cont. 1 ;9/6/98 20:59
;;1.1;NOIS;;Sep 06, 1998
;
BASIC ; from FSCLMPE
N ABBREV,CALLNUM,DA,DIE,DR,NEWV,OK,OLDV K NEWV,OLDV
S (CALLNUM,DA)=$$CALL(FSCCNT)
D CHECK(CALLNUM,.OK) I 'OK Q
F ABBREV="MOD","SPEC","PRI" S OLDV(ABBREV)=""
D GET^FSCGET("CUSTOM",CALLNUM,.OLDV)
S DIE="^FSCD(""CALL"",",DR="3Module;6T;5T"
L +^FSCD("CALL",CALLNUM):1 I '$T D SOMEONE Q
D ^DIE
L -^FSCD("CALL",CALLNUM)
D PICKUP^FSCES(CALLNUM)
M NEWV=OLDV D GET^FSCGET("CUSTOM",CALLNUM,.NEWV)
D AUDIT^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
D MRE^FSCMR(DUZ,CALLNUM)
D WKLD^FSCEWKLD(CALLNUM,1)
D UPDATE^FSCEU(CALLNUM)
Q
;
DESC ; from FSCLMPE
N CALLNUM,DA,DIC,DWLW,DWPK,NEWV,OK,OLDV K NEWV,OLDV
S (CALLNUM,DA)=$$CALL(FSCCNT)
D CHECK(CALLNUM,.OK) I 'OK Q
S OLDV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
S DIC="^FSCD(""CALL"","_DA_",30,",DWLW=80,DWPK=1
L +^FSCD("CALL",CALLNUM):1 I '$T D SOMEONE Q
D EN^DIWE
L -^FSCD("CALL",CALLNUM)
S NEWV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
D DESC^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
D MRE^FSCMR(DUZ,CALLNUM)
D WKLD^FSCEWKLD(CALLNUM,1)
D UPDATE^FSCEU(CALLNUM)
Q
;
PFIELDS ; from FSCLMPE
N CALLNUM,DA,DIE,DIK,DR,OK
S CALLNUM=$$CALL(FSCCNT)
D CHECK(CALLNUM,.OK) I 'OK Q
S DA=+$G(^FSCD("CALL USER","AUC",DUZ,CALLNUM))
I 'DA S OK=1 D I 'OK Q
.L +^FSCD("CALL USER",0):5 I '$T S OK=0 Q
.S DA=1+$P(^FSCD("CALL USER",0),U,3)
.F Q:'$D(^FSCD("CALL USER",DA,0)) S DA=DA+1
.S $P(^FSCD("CALL USER",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
.S ^FSCD("CALL USER",DA,0)=CALLNUM_U_DUZ
.L -^FSCD("CALL USER",0)
.S DIK="^FSCD(""CALL USER"","
.D IX1^DIK
S DIE="^FSCD(""CALL USER"",",DR="2:5"
L +^FSCD("CALL USER",DA):1 I '$T D SOMEONE Q
D ^DIE
L -^FSCD("CALL USER",DA)
S OK=1 D
.Q:$L($P(^FSCD("CALL USER",DA,0),U,3)) Q:$L($P(^(0),U,4)) Q:$L($G(^(1))) Q:$O(^(2,0))
.S OK=0
I 'OK D DEL^FSCUCD("^FSCD(""CALL USER"",",DA)
D MRE^FSCMR(DUZ,CALLNUM)
Q
;
WKLD ; from FSCLMPE
N CALLNUM
S CALLNUM=$$CALL(FSCCNT)
I +$$STATCALL^FSCESU(CALLNUM)=99 W !,"This call has been cancelled.",$C(7) H 2 Q
D WKLD^FSCEWKLD(CALLNUM,0)
D BUILD^FSCEU(CALLNUM)
Q
;
RES ; from FSCLMP, FSCLMPES
N CALLNUM,FROM,OK
S CALLNUM=$$CALL(FSCCNT)
D CHECK(CALLNUM,.OK) I 'OK Q
S FROM=+$$STATCALL^FSCESU(CALLNUM)
I 'FROM D STATUS^FSCES(CALLNUM,"",1) D UPDATE^FSCEU(CALLNUM) W !,"This call did not have a complete status. The status is now OPEN.",$C(7) H 2 Q
D CLOSE^FSCEC(CALLNUM,.OK) I 'OK Q
D STATUS^FSCES(CALLNUM,FROM,2)
D WKLD^FSCEWKLD(CALLNUM,1)
D UPDATE^FSCTASK(CALLNUM)
D BUILD^FSCEU(CALLNUM)
Q
;
ALL ; from FSCLMPE
N ABBREV,CALLNUM,DA,DIE,DR,NEWV,OK,OLDV,WNEWV,WOLDV K NEWV,OLDV,WNEWV,WOLDV
S (CALLNUM,DA)=$$CALL(FSCCNT)
D CHECK(CALLNUM,.OK) I 'OK Q
F ABBREV="SUBJECT","IRM","PHONE","MOD","SPEC","SPECD","PRI","PATCH","DEVSUB","KEYWORDS" S OLDV(ABBREV)=""
D GET^FSCGET("CUSTOM",CALLNUM,.OLDV)
S WOLDV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
S DIE="^FSCD(""CALL"",",DR="1R;D CINFO^FSCELS(DA);2.1R;H .1;2.2R//^S X=$$CPHONE^FSCELS(DA);3;S Y=$$SUB^FSCEU(DA);@1;3.2;@2;6R;5;5.1;7;1.5;30;"
L +^FSCD("CALL",CALLNUM):1 I '$T D SOMEONE Q
D ^DIE
L -^FSCD("CALL",CALLNUM)
D PICKUP^FSCES(CALLNUM)
M NEWV=OLDV D GET^FSCGET("CUSTOM",CALLNUM,.NEWV)
S WNEWV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
D AUDIT^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
D DESC^FSCAUDIT(CALLNUM,.WOLDV,.WNEWV)
D MRE^FSCMR(DUZ,CALLNUM)
D WKLD^FSCEWKLD(CALLNUM,1)
D UPDATE^FSCEU(CALLNUM)
Q
;
CHKSUM(ROOT) ; $$ (root array) -> checksum
N SUM,IX,IX2,XU1,Y
Q:$D(@ROOT)=0 0
S (SUM,IX)=0,XU1=ROOT,ROOT=$E(ROOT,1,$L(ROOT)-1)
F S Y=$G(@XU1) D S XU1=$Q(@XU1) Q:XU1'[ROOT
.F IX2=1:1:$L(Y) S IX=IX+1,SUM=($A(Y,IX2)-31*IX)+SUM
Q SUM_"A"
;
CHECK(CALLNUM,OK) ; from FSCEB, FSCEN
N STAT S OK=1
S STAT=$$STATCALL^FSCESU(CALLNUM) I +STAT=2!(+STAT=99) W !,"This call has been ",$P(STAT,U,3),".",$C(7) H 2 S OK=0 Q
Q
;
SOMEONE ; from FSCED, FSCEDC, FSCELS, FSCELSNS, FSCEU
W !,"Someone else is editing this call.",$C(7) H 2
Q
;
CALL(FSCCNT) ; $$(count from list) -> call#
N CALLLINE
S CALLLINE=+$O(^TMP("FSC LIST CALLS",$J,"IDX",FSCCNT,0))
Q +$O(^TMP("FSC LIST CALLS",$J,"ICX",CALLLINE,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPE1 4270 printed Oct 16, 2024@18:18:51 Page 2
FSCLMPE1 ;SLC/STAFF-NOIS List Manager Protocol Edit Cont. 1 ;9/6/98 20:59
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
BASIC ; from FSCLMPE
+1 NEW ABBREV,CALLNUM,DA,DIE,DR,NEWV,OK,OLDV
KILL NEWV,OLDV
+2 SET (CALLNUM,DA)=$$CALL(FSCCNT)
+3 DO CHECK(CALLNUM,.OK)
IF 'OK
QUIT
+4 FOR ABBREV="MOD","SPEC","PRI"
SET OLDV(ABBREV)=""
+5 DO GET^FSCGET("CUSTOM",CALLNUM,.OLDV)
+6 SET DIE="^FSCD(""CALL"","
SET DR="3Module;6T;5T"
+7 LOCK +^FSCD("CALL",CALLNUM):1
IF '$TEST
DO SOMEONE
QUIT
+8 DO ^DIE
+9 LOCK -^FSCD("CALL",CALLNUM)
+10 DO PICKUP^FSCES(CALLNUM)
+11 MERGE NEWV=OLDV
DO GET^FSCGET("CUSTOM",CALLNUM,.NEWV)
+12 DO AUDIT^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
+13 DO MRE^FSCMR(DUZ,CALLNUM)
+14 DO WKLD^FSCEWKLD(CALLNUM,1)
+15 DO UPDATE^FSCEU(CALLNUM)
+16 QUIT
+17 ;
DESC ; from FSCLMPE
+1 NEW CALLNUM,DA,DIC,DWLW,DWPK,NEWV,OK,OLDV
KILL NEWV,OLDV
+2 SET (CALLNUM,DA)=$$CALL(FSCCNT)
+3 DO CHECK(CALLNUM,.OK)
IF 'OK
QUIT
+4 SET OLDV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
+5 SET DIC="^FSCD(""CALL"","_DA_",30,"
SET DWLW=80
SET DWPK=1
+6 LOCK +^FSCD("CALL",CALLNUM):1
IF '$TEST
DO SOMEONE
QUIT
+7 DO EN^DIWE
+8 LOCK -^FSCD("CALL",CALLNUM)
+9 SET NEWV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
+10 DO DESC^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
+11 DO MRE^FSCMR(DUZ,CALLNUM)
+12 DO WKLD^FSCEWKLD(CALLNUM,1)
+13 DO UPDATE^FSCEU(CALLNUM)
+14 QUIT
+15 ;
PFIELDS ; from FSCLMPE
+1 NEW CALLNUM,DA,DIE,DIK,DR,OK
+2 SET CALLNUM=$$CALL(FSCCNT)
+3 DO CHECK(CALLNUM,.OK)
IF 'OK
QUIT
+4 SET DA=+$GET(^FSCD("CALL USER","AUC",DUZ,CALLNUM))
+5 IF 'DA
SET OK=1
Begin DoDot:1
+6 LOCK +^FSCD("CALL USER",0):5
IF '$TEST
SET OK=0
QUIT
+7 SET DA=1+$PIECE(^FSCD("CALL USER",0),U,3)
+8 FOR
if '$DATA(^FSCD("CALL USER",DA,0))
QUIT
SET DA=DA+1
+9 SET $PIECE(^FSCD("CALL USER",0),U,3)=DA
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+10 SET ^FSCD("CALL USER",DA,0)=CALLNUM_U_DUZ
+11 LOCK -^FSCD("CALL USER",0)
+12 SET DIK="^FSCD(""CALL USER"","
+13 DO IX1^DIK
End DoDot:1
IF 'OK
QUIT
+14 SET DIE="^FSCD(""CALL USER"","
SET DR="2:5"
+15 LOCK +^FSCD("CALL USER",DA):1
IF '$TEST
DO SOMEONE
QUIT
+16 DO ^DIE
+17 LOCK -^FSCD("CALL USER",DA)
+18 SET OK=1
Begin DoDot:1
+19 if $LENGTH($PIECE(^FSCD("CALL USER",DA,0),U,3))
QUIT
if $LENGTH($PIECE(^(0),U,4))
QUIT
if $LENGTH($GET(^(1)))
QUIT
if $ORDER(^(2,0))
QUIT
+20 SET OK=0
End DoDot:1
+21 IF 'OK
DO DEL^FSCUCD("^FSCD(""CALL USER"",",DA)
+22 DO MRE^FSCMR(DUZ,CALLNUM)
+23 QUIT
+24 ;
WKLD ; from FSCLMPE
+1 NEW CALLNUM
+2 SET CALLNUM=$$CALL(FSCCNT)
+3 IF +$$STATCALL^FSCESU(CALLNUM)=99
WRITE !,"This call has been cancelled.",$CHAR(7)
HANG 2
QUIT
+4 DO WKLD^FSCEWKLD(CALLNUM,0)
+5 DO BUILD^FSCEU(CALLNUM)
+6 QUIT
+7 ;
RES ; from FSCLMP, FSCLMPES
+1 NEW CALLNUM,FROM,OK
+2 SET CALLNUM=$$CALL(FSCCNT)
+3 DO CHECK(CALLNUM,.OK)
IF 'OK
QUIT
+4 SET FROM=+$$STATCALL^FSCESU(CALLNUM)
+5 IF 'FROM
DO STATUS^FSCES(CALLNUM,"",1)
DO UPDATE^FSCEU(CALLNUM)
WRITE !,"This call did not have a complete status. The status is now OPEN.",$CHAR(7)
HANG 2
QUIT
+6 DO CLOSE^FSCEC(CALLNUM,.OK)
IF 'OK
QUIT
+7 DO STATUS^FSCES(CALLNUM,FROM,2)
+8 DO WKLD^FSCEWKLD(CALLNUM,1)
+9 DO UPDATE^FSCTASK(CALLNUM)
+10 DO BUILD^FSCEU(CALLNUM)
+11 QUIT
+12 ;
ALL ; from FSCLMPE
+1 NEW ABBREV,CALLNUM,DA,DIE,DR,NEWV,OK,OLDV,WNEWV,WOLDV
KILL NEWV,OLDV,WNEWV,WOLDV
+2 SET (CALLNUM,DA)=$$CALL(FSCCNT)
+3 DO CHECK(CALLNUM,.OK)
IF 'OK
QUIT
+4 FOR ABBREV="SUBJECT","IRM","PHONE","MOD","SPEC","SPECD","PRI","PATCH","DEVSUB","KEYWORDS"
SET OLDV(ABBREV)=""
+5 DO GET^FSCGET("CUSTOM",CALLNUM,.OLDV)
+6 SET WOLDV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
+7 SET DIE="^FSCD(""CALL"","
SET DR="1R;D CINFO^FSCELS(DA);2.1R;H .1;2.2R//^S X=$$CPHONE^FSCELS(DA);3;S Y=$$SUB^FSCEU(DA);@1;3.2;@2;6R;5;5.1;7;1.5;30;"
+8 LOCK +^FSCD("CALL",CALLNUM):1
IF '$TEST
DO SOMEONE
QUIT
+9 DO ^DIE
+10 LOCK -^FSCD("CALL",CALLNUM)
+11 DO PICKUP^FSCES(CALLNUM)
+12 MERGE NEWV=OLDV
DO GET^FSCGET("CUSTOM",CALLNUM,.NEWV)
+13 SET WNEWV("DESC")=$$CHKSUM("^FSCD(""CALL"","_DA_",30)")
+14 DO AUDIT^FSCAUDIT(CALLNUM,.OLDV,.NEWV)
+15 DO DESC^FSCAUDIT(CALLNUM,.WOLDV,.WNEWV)
+16 DO MRE^FSCMR(DUZ,CALLNUM)
+17 DO WKLD^FSCEWKLD(CALLNUM,1)
+18 DO UPDATE^FSCEU(CALLNUM)
+19 QUIT
+20 ;
CHKSUM(ROOT) ; $$ (root array) -> checksum
+1 NEW SUM,IX,IX2,XU1,Y
+2 if $DATA(@ROOT)=0
QUIT 0
+3 SET (SUM,IX)=0
SET XU1=ROOT
SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)
+4 FOR
SET Y=$GET(@XU1)
Begin DoDot:1
+5 FOR IX2=1:1:$LENGTH(Y)
SET IX=IX+1
SET SUM=($ASCII(Y,IX2)-31*IX)+SUM
End DoDot:1
SET XU1=$QUERY(@XU1)
if XU1'[ROOT
QUIT
+6 QUIT SUM_"A"
+7 ;
CHECK(CALLNUM,OK) ; from FSCEB, FSCEN
+1 NEW STAT
SET OK=1
+2 SET STAT=$$STATCALL^FSCESU(CALLNUM)
IF +STAT=2!(+STAT=99)
WRITE !,"This call has been ",$PIECE(STAT,U,3),".",$CHAR(7)
HANG 2
SET OK=0
QUIT
+3 QUIT
+4 ;
SOMEONE ; from FSCED, FSCEDC, FSCELS, FSCELSNS, FSCEU
+1 WRITE !,"Someone else is editing this call.",$CHAR(7)
HANG 2
+2 QUIT
+3 ;
CALL(FSCCNT) ; $$(count from list) -> call#
+1 NEW CALLLINE
+2 SET CALLLINE=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",FSCCNT,0))
+3 QUIT +$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",CALLLINE,0))
