- 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 Jan 18, 2025@03:19:25 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))