SCMCBK ;ALB/SCK - Broker Utilities for multiple patient assignments; 4/8/96 [1/8/99 7:53am]
;;5.3;Scheduling;**41,51,148,157,177,205,1015**;AUG 13, 1993;Build 21
;
Q
;
PTCLBLD(SCOK,SC) ; Build patient list for a selected clinic
; 'SC BLD PAT CLN LIST'
;
D NEWVAR^SCMCBK1
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
;
I SCPOS'="" S SCOK=$$PTCLBRTP^SCAPMC26(.SCCLN,.SCPOS,"SCDTRNG")
E S SCOK=$$PTCLBR^SCAPMC26(.SCCLN,.SCTEAM,"SCDTRNG")
K ^TMP("SCMC",$J,"EXCLUDE PT")
G:SCOK=0 PTCLNQ
;
M ^TMP($J,"SC PCMM IN")=^TMP(SCOK,"SCCLPT")
K ^TMP(SCOK,"SCCLPT")
;
D ALPHA^SCAPMCU2("^TMP($J,""SC PCMM IN"")","^TMP($J,""SCCLPT"")")
;
S SCOK=$J_U_^TMP($J,"SC PCMM IN",0)
;
PTCLNQ D CLRVAR^SCMCBK1
Q
;
PTSCBLD(SCOK,SC) ; Build patient list for selected stop code
; 'SC BLD PAT SCDE LIST'
;
D NEWVAR^SCMCBK1
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
;
K ^TMP($J,"SCSCDE")
;
; Build exclude list
S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
D @BLOCK
;
IF 'SCOK1 S SCOK="0^0^0^0" G PTSCQ
;
S SCOK=0
S SCOK=$$PTST^SCAPMC27(SCSCDE,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
K ^TMP("SCMC",$J,"EXCLUDE PT")
;
M ^TMP($J,"SC PCMM IN")=@SCLOC
S I1=$G(^TMP($J,"SC PCMM IN",0))
F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
;
D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCSCDE"")")
S SCOK=$J_U_+I1_U_SCOK
;
PTSCQ D CLRVAR^SCMCBK1
Q
;
PTTMBLD(SCOK,SC) ; Build a list of patients for a selected team and return the $J of the TMP globall
; where the list is stored.
; ' SC BLD PAT TM LIST '
;
D NEWVAR^SCMCBK1
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
K ^TMP($J,"SCTEAM")
;
; Build exclude list
S SCOK=0
S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
D @BLOCK
;
S SCOK=$$PTTM^SCAPMC2(SCFRMTM,"SCDTRNG",.SCLOC,"SCERMSG")
K ^TMP("SCMC",$J,"EXCLUDE PT")
M ^TMP($J,"SC PCMM IN")=@SCLOC
;
S I="" F S I=$O(^TMP($J,"SC PCMM IN",I)) Q:'I D
. S ^TMP($J,"PCMM TMP",I)=^TMP($J,"SC PCMM IN",I)
;
D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCTEAM"")")
S I1="" F S I1=$O(^TMP($J,"SCTEAM",I1)) Q:'I1 S I=I1
;
S SCOK=$J_U_+I_U_SCOK
;
D CLRVAR^SCMCBK1
Q
;
PTPSBLD(SCOK,SC) ;
; ' SC BLD PAT POS LIST '
;
D NEWVAR^SCMCBK1
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
;
K ^TMP($J,"SCPOS")
;
; Build exclude list
S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
D @BLOCK
;
S SCOK=0
;
S SCOK=$$PTTP^SCAPMC11(SCFRMPOS,"SCDTRNG",.SCLOC,.SCERMSG)
K ^TMP("SCMC",$J,"EXCLUDE PT")
M ^TMP($J,"SC PCMM IN")=@SCLOC
;
S I1=$G(^TMP($J,"SC PCMM IN",0))
F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPOS"")")
S SCOK=$J_U_+I1_U_SCOK
;
;IF '+$G(^TMP($J,"SCPOS",0)) D S SCOK=$J_U_SCOK
;. S I="" F S I=$O(^TMP($J,"SCPOS",I)) Q:'I S SCOK=I
;
D CLRVAR^SCMCBK1
Q
;
PTAPBLD(SCOK,SC) ; Build patient list for selected appointment range.
; ' SC BLD PAT APT LIST '
;
;N SCCLN,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,SCBLOCK
;
D NEWVAR^SCMCBK1
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
;
K ^TMP($J,"SCCLN")
;
; Build exclude list
S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
D @BLOCK
;
IF 'SCOK1 S SCOK="0^0^0^0" G PTAPQ
S SCOK=0
S SCOK=$$PTAP^SCAPMC28(SCCLN,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
K ^TMP("SCMC",$J,"EXCLUDE PT")
;
M ^TMP($J,"SC PCMM IN")=@SCLOC
;
S I1=$G(^TMP($J,"SC PCMM IN",0))
F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
;
D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCAPP"")")
S SCOK=$J_U_I1_U_SCOK
;
D CLRVAR^SCMCBK1
PTAPQ Q
;
PTGET(SCDATA,SC) ; Return a block of patients to the client
; 'SC GET PAT BLOCK'
;
; SCJOB = $J for the ^TMP global
; SCJOBID = The second subscript id for the ^TMP global
; SCSTART = Beginning entry number for the block retrieval in the ^TMP global
; SCEND = The ending entry number for the block retrieval
; SCLAST = The last entry number in the ^TMP global
;
N SCJOB,SCSTART,SCEND,I,SCLAST,SCJOBID
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
;
F I=SCSTART:1:SCEND Q:'$G(^TMP(SCJOB,SCJOBID,I),0) D
. S SCDATA(I)=^TMP(SCJOB,SCJOBID,I)
I SCEND>SCLAST K ^TMP(SCJOB,SCJOBID)
;
D CLRVAR^SCMCBK1
Q
;
PTLSTBLD(SCOK,SCVAL) ; Build the list of patients to be assigned in the ^TMP($J,"SC PATIENT LIST",DFN) global
; 'SC BLD PAT LIST'
;
N SCJOB,SCDFN
;
D CHK^SCUTBK
D TMP^SCUTBK
;
S SCOK=0
I SCVAL["Start" D G PTBLDQ
.S SCOK=$J
.K ^TMP(SCOK,"SC PATIENT LIST")
;
S SCJOB=$P(SCVAL,U,1)
S SCDFN=$P(SCVAL,U,2)
S ^TMP(SCJOB,"SC PATIENT LIST",SCDFN)=""
S SCOK=1
PTBLDQ Q
;
PTFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC TEAM ASSIGN",SCDFN) global
; 'SC FILE PAT TM ASGN'
;
;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(1) Q
;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
; pre 177 code follows....
I XWBAPVER=1 D QUEUED^SCMCBK4(1) Q
;
N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
G:+$G(SCJOB)=0 FILEQ
;
;
S SCADDFLD(.08)=$G(SC("TYPE"),99)
S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
S SCADDFLD(.11)=DUZ
S SCADDFLD(.12)=DT
;
S SCX=$$ACPTATM^SCAPMC6("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
D BAD^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
S SCOK(.1)=SCX
;
K ^TMP(SCJOB,"SC PATIENT LIST")
;
D CLRVAR^SCMCBK1
FILEQ Q
;
POSFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC PATIENT LIST") global
; ' SC FILE PAT POS ASGN '
;
;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(2) Q
;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
; pre 177 code follows...
I XWBAPVER=1 D QUEUED^SCMCBK4(2) Q
;
N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE^SCMCBK1(.SC)
G:+$G(SCJOB)=0 FILEQ
S SCADTM=1
;
S SCADDFLD(.05)=$G(SC("TYPE"),0)
S SCADDFLD(.06)=DUZ
S SCADDFLD(.07)=DT
;
S SCX=$$ACPTATP^SCAPMC21("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
;
D BAD2^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
S SCOK(.1)=SCX
K ^TMP(SCJOB,"SC PATIENT LIST")
;
D CLRVAR^SCMCBK1
Q
;
BLKPOS ;
N SCX
S SCX=$G(SCDTRNG("END"))
S SCDTRNG("END")=3990101 ;check forever
S SCOK1=$$PTTP^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
S SCDTRNG("END")=SCX
Q
;
BLKTM ;
N SCX
S SCX=$G(SCDTRNG("END"))
S SCDTRNG("END")=3990101 ;check forever
S SCOK1=$$PTTM^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
S SCDTRNG("END")=SCX
Q
;
SCMCBK ;ALB/SCK - Broker Utilities for multiple patient assignments; 4/8/96 [1/8/99 7:53am]
+1 ;;5.3;Scheduling;**41,51,148,157,177,205,1015**;AUG 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
PTCLBLD(SCOK,SC) ; Build patient list for a selected clinic
+1 ; 'SC BLD PAT CLN LIST'
+2 ;
+3 DO NEWVAR^SCMCBK1
+4 DO CHK^SCUTBK
+5 DO TMP^SCUTBK
+6 ;
+7 DO PARSE^SCMCBK1(.SC)
+8 ;
+9 IF SCPOS'=""
SET SCOK=$$PTCLBRTP^SCAPMC26(.SCCLN,.SCPOS,"SCDTRNG")
+10 IF '$TEST
SET SCOK=$$PTCLBR^SCAPMC26(.SCCLN,.SCTEAM,"SCDTRNG")
+11 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+12 IF SCOK=0
GOTO PTCLNQ
+13 ;
+14 MERGE ^TMP($JOB,"SC PCMM IN")=^TMP(SCOK,"SCCLPT")
+15 KILL ^TMP(SCOK,"SCCLPT")
+16 ;
+17 DO ALPHA^SCAPMCU2("^TMP($J,""SC PCMM IN"")","^TMP($J,""SCCLPT"")")
+18 ;
+19 SET SCOK=$JOB_U_^TMP($JOB,"SC PCMM IN",0)
+20 ;
PTCLNQ DO CLRVAR^SCMCBK1
+1 QUIT
+2 ;
PTSCBLD(SCOK,SC) ; Build patient list for selected stop code
+1 ; 'SC BLD PAT SCDE LIST'
+2 ;
+3 DO NEWVAR^SCMCBK1
+4 ;
+5 DO CHK^SCUTBK
+6 DO TMP^SCUTBK
+7 ;
+8 DO PARSE^SCMCBK1(.SC)
+9 ;
+10 KILL ^TMP($JOB,"SCSCDE")
+11 ;
+12 ; Build exclude list
+13 SET BLOCK=$SELECT(SCPOS'="":"BLKPOS",1:"BLKTM")
+14 SET SCBLOCK=$SELECT(SCPOS'="":SCPOS,1:SCTEAM)
+15 DO @BLOCK
+16 ;
+17 IF 'SCOK1
SET SCOK="0^0^0^0"
GOTO PTSCQ
+18 ;
+19 SET SCOK=0
+20 SET SCOK=$$PTST^SCAPMC27(SCSCDE,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
+21 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+22 ;
+23 MERGE ^TMP($JOB,"SC PCMM IN")=@SCLOC
+24 SET I1=$GET(^TMP($JOB,"SC PCMM IN",0))
+25 FOR I=1:1:I1
SET ^TMP($JOB,"PCMM TMP",I)=$GET(^TMP($JOB,"SC PCMM IN",I))
+26 ;
+27 DO ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCSCDE"")")
+28 SET SCOK=$JOB_U_+I1_U_SCOK
+29 ;
PTSCQ DO CLRVAR^SCMCBK1
+1 QUIT
+2 ;
PTTMBLD(SCOK,SC) ; Build a list of patients for a selected team and return the $J of the TMP globall
+1 ; where the list is stored.
+2 ; ' SC BLD PAT TM LIST '
+3 ;
+4 DO NEWVAR^SCMCBK1
+5 DO CHK^SCUTBK
+6 DO TMP^SCUTBK
+7 ;
+8 DO PARSE^SCMCBK1(.SC)
+9 KILL ^TMP($JOB,"SCTEAM")
+10 ;
+11 ; Build exclude list
+12 SET SCOK=0
+13 SET BLOCK=$SELECT(SCPOS'="":"BLKPOS",1:"BLKTM")
+14 SET SCBLOCK=$SELECT(SCPOS'="":SCPOS,1:SCTEAM)
+15 DO @BLOCK
+16 ;
+17 SET SCOK=$$PTTM^SCAPMC2(SCFRMTM,"SCDTRNG",.SCLOC,"SCERMSG")
+18 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+19 MERGE ^TMP($JOB,"SC PCMM IN")=@SCLOC
+20 ;
+21 SET I=""
FOR
SET I=$ORDER(^TMP($JOB,"SC PCMM IN",I))
IF 'I
QUIT
Begin DoDot:1
+22 SET ^TMP($JOB,"PCMM TMP",I)=^TMP($JOB,"SC PCMM IN",I)
End DoDot:1
+23 ;
+24 DO ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCTEAM"")")
+25 SET I1=""
FOR
SET I1=$ORDER(^TMP($JOB,"SCTEAM",I1))
IF 'I1
QUIT
SET I=I1
+26 ;
+27 SET SCOK=$JOB_U_+I_U_SCOK
+28 ;
+29 DO CLRVAR^SCMCBK1
+30 QUIT
+31 ;
PTPSBLD(SCOK,SC) ;
+1 ; ' SC BLD PAT POS LIST '
+2 ;
+3 DO NEWVAR^SCMCBK1
+4 DO CHK^SCUTBK
+5 DO TMP^SCUTBK
+6 ;
+7 DO PARSE^SCMCBK1(.SC)
+8 ;
+9 KILL ^TMP($JOB,"SCPOS")
+10 ;
+11 ; Build exclude list
+12 SET BLOCK=$SELECT(SCPOS'="":"BLKPOS",1:"BLKTM")
+13 SET SCBLOCK=$SELECT(SCPOS'="":SCPOS,1:SCTEAM)
+14 DO @BLOCK
+15 ;
+16 SET SCOK=0
+17 ;
+18 SET SCOK=$$PTTP^SCAPMC11(SCFRMPOS,"SCDTRNG",.SCLOC,.SCERMSG)
+19 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+20 MERGE ^TMP($JOB,"SC PCMM IN")=@SCLOC
+21 ;
+22 SET I1=$GET(^TMP($JOB,"SC PCMM IN",0))
+23 FOR I=1:1:I1
SET ^TMP($JOB,"PCMM TMP",I)=$GET(^TMP($JOB,"SC PCMM IN",I))
+24 DO ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPOS"")")
+25 SET SCOK=$JOB_U_+I1_U_SCOK
+26 ;
+27 ;IF '+$G(^TMP($J,"SCPOS",0)) D S SCOK=$J_U_SCOK
+28 ;. S I="" F S I=$O(^TMP($J,"SCPOS",I)) Q:'I S SCOK=I
+29 ;
+30 DO CLRVAR^SCMCBK1
+31 QUIT
+32 ;
PTAPBLD(SCOK,SC) ; Build patient list for selected appointment range.
+1 ; ' SC BLD PAT APT LIST '
+2 ;
+3 ;N SCCLN,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,SCBLOCK
+4 ;
+5 DO NEWVAR^SCMCBK1
+6 DO CHK^SCUTBK
+7 DO TMP^SCUTBK
+8 ;
+9 DO PARSE^SCMCBK1(.SC)
+10 ;
+11 KILL ^TMP($JOB,"SCCLN")
+12 ;
+13 ; Build exclude list
+14 SET BLOCK=$SELECT(SCPOS'="":"BLKPOS",1:"BLKTM")
+15 SET SCBLOCK=$SELECT(SCPOS'="":SCPOS,1:SCTEAM)
+16 DO @BLOCK
+17 ;
+18 IF 'SCOK1
SET SCOK="0^0^0^0"
GOTO PTAPQ
+19 SET SCOK=0
+20 SET SCOK=$$PTAP^SCAPMC28(SCCLN,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
+21 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+22 ;
+23 MERGE ^TMP($JOB,"SC PCMM IN")=@SCLOC
+24 ;
+25 SET I1=$GET(^TMP($JOB,"SC PCMM IN",0))
+26 FOR I=1:1:I1
SET ^TMP($JOB,"PCMM TMP",I)=$GET(^TMP($JOB,"SC PCMM IN",I))
+27 ;
+28 DO ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCAPP"")")
+29 SET SCOK=$JOB_U_I1_U_SCOK
+30 ;
+31 DO CLRVAR^SCMCBK1
PTAPQ QUIT
+1 ;
PTGET(SCDATA,SC) ; Return a block of patients to the client
+1 ; 'SC GET PAT BLOCK'
+2 ;
+3 ; SCJOB = $J for the ^TMP global
+4 ; SCJOBID = The second subscript id for the ^TMP global
+5 ; SCSTART = Beginning entry number for the block retrieval in the ^TMP global
+6 ; SCEND = The ending entry number for the block retrieval
+7 ; SCLAST = The last entry number in the ^TMP global
+8 ;
+9 NEW SCJOB,SCSTART,SCEND,I,SCLAST,SCJOBID
+10 ;
+11 DO CHK^SCUTBK
+12 DO TMP^SCUTBK
+13 ;
+14 DO PARSE^SCMCBK1(.SC)
+15 ;
+16 FOR I=SCSTART:1:SCEND
IF '$GET(^TMP(SCJOB,SCJOBID,I),0)
QUIT
Begin DoDot:1
+17 SET SCDATA(I)=^TMP(SCJOB,SCJOBID,I)
End DoDot:1
+18 IF SCEND>SCLAST
KILL ^TMP(SCJOB,SCJOBID)
+19 ;
+20 DO CLRVAR^SCMCBK1
+21 QUIT
+22 ;
PTLSTBLD(SCOK,SCVAL) ; Build the list of patients to be assigned in the ^TMP($J,"SC PATIENT LIST",DFN) global
+1 ; 'SC BLD PAT LIST'
+2 ;
+3 NEW SCJOB,SCDFN
+4 ;
+5 DO CHK^SCUTBK
+6 DO TMP^SCUTBK
+7 ;
+8 SET SCOK=0
+9 IF SCVAL["Start"
Begin DoDot:1
+10 SET SCOK=$JOB
+11 KILL ^TMP(SCOK,"SC PATIENT LIST")
End DoDot:1
GOTO PTBLDQ
+12 ;
+13 SET SCJOB=$PIECE(SCVAL,U,1)
+14 SET SCDFN=$PIECE(SCVAL,U,2)
+15 SET ^TMP(SCJOB,"SC PATIENT LIST",SCDFN)=""
+16 SET SCOK=1
PTBLDQ QUIT
+1 ;
PTFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC TEAM ASSIGN",SCDFN) global
+1 ; 'SC FILE PAT TM ASGN'
+2 ;
+3 ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(1) Q
+4 ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
+5 ; pre 177 code follows....
+6 IF XWBAPVER=1
DO QUEUED^SCMCBK4(1)
QUIT
+7 ;
+8 NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
+9 ;
+10 DO CHK^SCUTBK
+11 DO TMP^SCUTBK
+12 ;
+13 DO PARSE^SCMCBK1(.SC)
+14 IF +$GET(SCJOB)=0
GOTO FILEQ
+15 ;
+16 ;
+17 SET SCADDFLD(.08)=$GET(SC("TYPE"),99)
+18 SET SCADDFLD(.1)=$GET(SC("RESTRICT"),0)
+19 SET SCADDFLD(.11)=DUZ
+20 SET SCADDFLD(.12)=DT
+21 ;
+22 SET SCX=$$ACPTATM^SCAPMC6("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
+23 DO BAD^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
+24 SET SCOK(.1)=SCX
+25 ;
+26 KILL ^TMP(SCJOB,"SC PATIENT LIST")
+27 ;
+28 DO CLRVAR^SCMCBK1
FILEQ QUIT
+1 ;
POSFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC PATIENT LIST") global
+1 ; ' SC FILE PAT POS ASGN '
+2 ;
+3 ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(2) Q
+4 ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
+5 ; pre 177 code follows...
+6 IF XWBAPVER=1
DO QUEUED^SCMCBK4(2)
QUIT
+7 ;
+8 NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
+9 ;
+10 DO CHK^SCUTBK
+11 DO TMP^SCUTBK
+12 ;
+13 DO PARSE^SCMCBK1(.SC)
+14 IF +$GET(SCJOB)=0
GOTO FILEQ
+15 SET SCADTM=1
+16 ;
+17 SET SCADDFLD(.05)=$GET(SC("TYPE"),0)
+18 SET SCADDFLD(.06)=DUZ
+19 SET SCADDFLD(.07)=DT
+20 ;
+21 SET SCX=$$ACPTATP^SCAPMC21("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
+22 ;
+23 DO BAD2^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
+24 SET SCOK(.1)=SCX
+25 KILL ^TMP(SCJOB,"SC PATIENT LIST")
+26 ;
+27 DO CLRVAR^SCMCBK1
+28 QUIT
+29 ;
BLKPOS ;
+1 NEW SCX
+2 SET SCX=$GET(SCDTRNG("END"))
+3 ;check forever
SET SCDTRNG("END")=3990101
+4 SET SCOK1=$$PTTP^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
+5 SET SCDTRNG("END")=SCX
+6 QUIT
+7 ;
BLKTM ;
+1 NEW SCX
+2 SET SCX=$GET(SCDTRNG("END"))
+3 ;check forever
SET SCDTRNG("END")=3990101
+4 SET SCOK1=$$PTTM^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
+5 SET SCDTRNG("END")=SCX
+6 QUIT
+7 ;
