SCMCBK1 ;LB/SCK - Broker Utilities for multiple patient assignments;
;;5.3;Scheduling;**41,51,210,297**;AUG 13, 1993
;;1T1;;
Q
;
PARSE(SC) ;
S SCTEAM=$G(SC("TEAM"),"")
S SCPOS=$G(SC("POSITION"),"")
S SCDTVAR=$G(SC("DATE"),DT)
S SCDTRNG("BEGIN")=$G(SC("BEGIN"),DT)
S SCDTRNG("END")=$G(SC("END"),DT)
S SCDTRNG("INCL")=$G(SC("INCL"),0)
S SCJOB=$G(SC("JOB"),"")
S SCSTART=$G(SC("BSTART"),0)
S SCEND=$G(SC("BEND"),0)
S SCLAST=$G(SC("BLAST"),0)
S SCFILE=$G(SC("FILE"),"")
S SCJOBID=$G(SC("JOBID"),"")
S SCNUM=$G(SC("MAX"),300)
S SCCLN=$G(SC("CLINIC"),"")
S SCSCDE=$G(SC("STOPCODE"),"")
S SCFRMTM=$G(SC("FROMTEAM"),"")
S SCFRMPOS=$G(SC("FROMPOS"),"")
S SCDFN=$G(SC("DFN"),"")
S SCMORE=$G(SC("MORE"),"")
Q
;
NEWVAR ;
;bp/cmf 210t0 begin
D CLRVAR Q
;bp/cmf 210t0 end
N SCCLN,SCSCDE,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,BLOCK,SCBLOCK,SCFRMTM,SCFRMPOS,SCSRCE,SCSRCTYP
N SCADDFLD,SCNEW,SCOLD,SCBAD,SUBRTN,SCX,SCTMP
;
K ^TMP($J,"SC PCMM IN")
K ^TMP($J,"PCMM TMP")
K ^TMP("SC TMP LIST",$J)
K ^TMP($J,"SC PATIENT LIST")
;
Q
;
CLRVAR ; Clear all parsing variables
;
K SCNUM,SCSCDE,SCCLN,SCJOBID,SCFILE,SCLAST,SCEND,SCSTART,SCJOB,SCDTRNG
K SCDTVAR,SCPOS,SCTEAM,SCFRMTM,SCFRMPOS,SCDFN,BLOCK,SCBLOCK,SCX,SUBRTN
K SCTMP,SCBAD,SCOLD,SCNEW,SCLOC,SCERMSG,SCCOUNT,SCMORE,SCOK1
K SCER2,SCOUT,SCSRCE,SCSRCTYP,SCADDFLD
;
K ^TMP($J,"SC PCMM IN")
K ^TMP($J,"PCMM TMP")
K ^TMP("SC TMP LIST",$J)
K ^TMP($J,"SC PATIENT LIST")
Q
;
PTCLEN(SCOK,SC) ; Enroll patient in associated clinic for a position
; ' SC PAT ENROLL CLN '
;
N SCCLN,SCDFN,SCDTVAR,SCERMSG,SCADDFLD
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SC)
S SCADDFLD(1)=$G(SC("ADD1"),"O")
S SCOK=0
;
;Enroll Patient in all associated clincs not entrolled in
F SCCLN=0:0 S SCCLN=$O(^SCTM(404.57,SCPOS,5,SCCLN)) Q:'SCCLN D
.I $D(^DPT(SCDFN,"DE","B",SCCLN)) Q
.S SCOK=$$ACPTCL^SCAPMC18(SCDFN,SCCLN,"SCADDFLD",SCDTVAR,"SCERMSG")
;
D CLRVAR
Q
;
CHKPOS(SCOK,SC) ; Check for primary care pratitioner and attending positions for patient
; ' SC CHECK FOR PC POS '
; Piece 1 of SCOK = 1 if ok for practitioner role
; 0 if not ok
; Piece 2 of SCOK = 1 if ok for ateending role
; 0 if not ok
;
N SCPOS,SCDTVAR,SCDFN
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SC)
;
S SCOK=$$PCRLPTTP^SCMCTPU2(SCDFN,SCPOS,SCDTVAR)
;
D CLRVAR
Q
;
NOPCTM(SCOK,SC) ; Build list of patients with a primary care assignment, but no primary care team;
; ' SC BLD NOPC TM LIST '
;
N I1
D NEWVAR
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SC)
;
K ^TMP($J,"SCPCNO")
; Build exclude list
S BLOCK=$S(SCPOS'="":"BLKPOS^SCMCBK",1:"BLKTM^SCMCBK")
S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
D @BLOCK
;
S SCOK=0
;
S SCLOC="^TMP($J,""SC PCMM IN"")"
D PTPCNOTM^SCAPMC20(.SCLOC,SCDTVAR)
K ^TMP("SCMC",$J,"EXCLUDE PT")
;
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,""SCPCNO"")")
S I1="" F S I1=$O(^TMP($J,"SCPCNO",I1)) Q:'I1 S I=I1
;
S SCOK=$J_U_+I_U_1
;
D CLRVAR
Q
;
ASGNALL(SCOK,SC) ; Assign all entries for the selection source to the appropriate team.
; ' SC FILE ALL PAT TM ASGN '
;
D NEWVAR
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SC)
S SCSRCE=$G(SC("SOURCE"),"")
S SCADDFLD(.08)=$G(SC("TYPE"),99)
S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
S SCADDFLD(.11)=DUZ
S SCADDFLD(.12)=DT
;
S DTMP=$G(SCDTRNG("END"))
S SCDTTRNG("END")=3990101
S SCOK2=$$PTTM^SCAPMC(SCTEAM,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
S SCDTRNG("END")=DTMP
;
S SCSRCTYP=$P(SCSRCE,U,1)
D @SCSRCTYP
;
K SCBAD,SCOLD,SCNEW
S SCX=$$ACPTATM^SCAPMC6("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
;
K ^TMP("SCMC",$J,"EXCLUDE PT")
D BAD(.SCBAD,.SCOLD,.SCOK)
S SCOK(.1)=SCX
;
D CLRVAR
Q
;
CLN ; File all patients in selected clinic.
;
S SCOK1=$$PTCLBR^SCAPMC26($P($G(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
S I=0 F S I=$O(^TMP($J,"SCCLPT",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"SCCLPT",I)),U))=""
K ^TMP($J,"SCCLPT")
Q
;
STOPC ; File all patients in the selected stop code
;
S SCOK1=$$PTST^SCAPMC27($P($G(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"ERRMSG",0)
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
APPT ; File all patients for the selected clinic appointment range
S SCOK1=$$PTAP^SCAPMC28($P($G(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"SCERMSG",0)
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
TEAM ; File all patients for the selected team
S SCOK1=$$PTTM^SCAPMC2($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
ASGALLP(SCOK,SC) ; Assign all entries in the selected source to the selected team and position
;
N DTMP
D NEWVAR
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SC)
S SCSRCE=$G(SC("SOURCE"),"")
S SCADDFLD(.05)=$G(SC("TYPE"),0)
S SCADDFLD(.06)=DUZ
S SCADDFLD(.07)=DT
;
S DTMP=$G(SCDTRNG("END"))
S SCDTRNG("END")=3990101
S SCOK2=$$PTTP^SCAPMC(SCPOS,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
S SCDTRNG("END")=DTMP
;
S SCSRCTYP=$P(SCSRCE,U,1)
D @SCSRCTYP
;
K SCBAD,SCOLD,SCNEW
S SCX=$$ACPTATP^SCAPMC21("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERRMSG",1,"","SCNEW","SCNEW1","SCOLD","SCBAD")
;
K ^TMP("SCMC",$J,"EXCLUDE PT")
D BAD2(.SCBAD,.SCOLD,.SCOK)
S SCOK(.1)=SCX
;
D CLRVAR
Q
;
PCLN ; File all patients in selected clinic to the new position and team
;
S SCOK1=$$PTCLBR^SCAPMC26($P($G(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
S I=0 F S I=$O(^TMP($J,"SCCLPT",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"SCCLPT",I)),U))=""
;
Q
;
PSTOPC ; File all patients in with the selected stop code to the new position and team
;
S SCOK1=$$PTST^SCAPMC27($P($G(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
PAPPT ;
S SCOK1=$$PTAP^SCAPMC28($P($G(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
PTEAM ;
S SCOK1=$$PTTM^SCAPMC2($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
PPOS ;
S SCOK1=$$PTTP^SCAPMC11($P($G(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
M ^TMP($J,"PCMM TMP")=@SCTMP
S I=0 F S I=$O(^TMP($J,"PCMM TMP",I)) Q:'I D
. S ^TMP($J,"SC PATIENT LIST",$P($G(^TMP($J,"PCMM TMP",I)),U))=""
Q
;
BAD(SCBAD,SCOLD,SCOK) ;
N SCDFN,SCPARM,DIERR
S SCDFN=0
F S SCDFN=$O(SCBAD(SCDFN)) Q:'SCDFN D
. S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
. D BLD^DIALOG(40442001.001,.SCPARM,"","SCOK","S")
;
F S SCDFN=$O(SCOLD(SCDFN)) Q:'SCDFN D
. S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
. D BLD^DIALOG(40442001.002,.SCPARM,"","SCOK","S")
D HDREC^SCUTBK3(.SCOK,$G(DIERR),"Patient Assignment to Teams")
Q
;
BAD2(SCBAD,SCOLD,SCOK) ;
N SCDFN,SCPARM,DIERR
S SCDFN=0
F S SCDFN=$O(SCBAD(SCDFN)) Q:'SCDFN D
. S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
. D BLD^DIALOG(40443001.001,.SCPARM,"","SCOK","S")
;
F S SCDFN=$O(SCOLD(SCDFN)) Q:'SCDFN D
. S SCPARM("PATIENT")=$P($G(^DPT(SCDFN,0)),U)_" "_$P($G(^DPT(SCDFN,.36)),U,4)
. D BLD^DIALOG(40443001.002,.SCPARM,"","SCOK","S")
D HDREC^SCUTBK3(.SCOK,$G(DIERR),"Patient Assignment to Positions")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCBK1 8285 printed Oct 16, 2024@18:40:27 Page 2
SCMCBK1 ;LB/SCK - Broker Utilities for multiple patient assignments;
+1 ;;5.3;Scheduling;**41,51,210,297**;AUG 13, 1993
+2 ;;1T1;;
+3 QUIT
+4 ;
PARSE(SC) ;
+1 SET SCTEAM=$GET(SC("TEAM"),"")
+2 SET SCPOS=$GET(SC("POSITION"),"")
+3 SET SCDTVAR=$GET(SC("DATE"),DT)
+4 SET SCDTRNG("BEGIN")=$GET(SC("BEGIN"),DT)
+5 SET SCDTRNG("END")=$GET(SC("END"),DT)
+6 SET SCDTRNG("INCL")=$GET(SC("INCL"),0)
+7 SET SCJOB=$GET(SC("JOB"),"")
+8 SET SCSTART=$GET(SC("BSTART"),0)
+9 SET SCEND=$GET(SC("BEND"),0)
+10 SET SCLAST=$GET(SC("BLAST"),0)
+11 SET SCFILE=$GET(SC("FILE"),"")
+12 SET SCJOBID=$GET(SC("JOBID"),"")
+13 SET SCNUM=$GET(SC("MAX"),300)
+14 SET SCCLN=$GET(SC("CLINIC"),"")
+15 SET SCSCDE=$GET(SC("STOPCODE"),"")
+16 SET SCFRMTM=$GET(SC("FROMTEAM"),"")
+17 SET SCFRMPOS=$GET(SC("FROMPOS"),"")
+18 SET SCDFN=$GET(SC("DFN"),"")
+19 SET SCMORE=$GET(SC("MORE"),"")
+20 QUIT
+21 ;
NEWVAR ;
+1 ;bp/cmf 210t0 begin
+2 DO CLRVAR
QUIT
+3 ;bp/cmf 210t0 end
+4 NEW SCCLN,SCSCDE,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,BLOCK,SCBLOCK,SCFRMTM,SCFRMPOS,SCSRCE,SCSRCTYP
+5 NEW SCADDFLD,SCNEW,SCOLD,SCBAD,SUBRTN,SCX,SCTMP
+6 ;
+7 KILL ^TMP($JOB,"SC PCMM IN")
+8 KILL ^TMP($JOB,"PCMM TMP")
+9 KILL ^TMP("SC TMP LIST",$JOB)
+10 KILL ^TMP($JOB,"SC PATIENT LIST")
+11 ;
+12 QUIT
+13 ;
CLRVAR ; Clear all parsing variables
+1 ;
+2 KILL SCNUM,SCSCDE,SCCLN,SCJOBID,SCFILE,SCLAST,SCEND,SCSTART,SCJOB,SCDTRNG
+3 KILL SCDTVAR,SCPOS,SCTEAM,SCFRMTM,SCFRMPOS,SCDFN,BLOCK,SCBLOCK,SCX,SUBRTN
+4 KILL SCTMP,SCBAD,SCOLD,SCNEW,SCLOC,SCERMSG,SCCOUNT,SCMORE,SCOK1
+5 KILL SCER2,SCOUT,SCSRCE,SCSRCTYP,SCADDFLD
+6 ;
+7 KILL ^TMP($JOB,"SC PCMM IN")
+8 KILL ^TMP($JOB,"PCMM TMP")
+9 KILL ^TMP("SC TMP LIST",$JOB)
+10 KILL ^TMP($JOB,"SC PATIENT LIST")
+11 QUIT
+12 ;
PTCLEN(SCOK,SC) ; Enroll patient in associated clinic for a position
+1 ; ' SC PAT ENROLL CLN '
+2 ;
+3 NEW SCCLN,SCDFN,SCDTVAR,SCERMSG,SCADDFLD
+4 ;
+5 DO CHK^SCUTBK
+6 DO TMP^SCUTBK
+7 ;
+8 DO PARSE(.SC)
+9 SET SCADDFLD(1)=$GET(SC("ADD1"),"O")
+10 SET SCOK=0
+11 ;
+12 ;Enroll Patient in all associated clincs not entrolled in
+13 FOR SCCLN=0:0
SET SCCLN=$ORDER(^SCTM(404.57,SCPOS,5,SCCLN))
if 'SCCLN
QUIT
Begin DoDot:1
+14 IF $DATA(^DPT(SCDFN,"DE","B",SCCLN))
QUIT
+15 SET SCOK=$$ACPTCL^SCAPMC18(SCDFN,SCCLN,"SCADDFLD",SCDTVAR,"SCERMSG")
End DoDot:1
+16 ;
+17 DO CLRVAR
+18 QUIT
+19 ;
CHKPOS(SCOK,SC) ; Check for primary care pratitioner and attending positions for patient
+1 ; ' SC CHECK FOR PC POS '
+2 ; Piece 1 of SCOK = 1 if ok for practitioner role
+3 ; 0 if not ok
+4 ; Piece 2 of SCOK = 1 if ok for ateending role
+5 ; 0 if not ok
+6 ;
+7 NEW SCPOS,SCDTVAR,SCDFN
+8 ;
+9 DO CHK^SCUTBK
+10 DO TMP^SCUTBK
+11 ;
+12 DO PARSE(.SC)
+13 ;
+14 SET SCOK=$$PCRLPTTP^SCMCTPU2(SCDFN,SCPOS,SCDTVAR)
+15 ;
+16 DO CLRVAR
+17 QUIT
+18 ;
NOPCTM(SCOK,SC) ; Build list of patients with a primary care assignment, but no primary care team;
+1 ; ' SC BLD NOPC TM LIST '
+2 ;
+3 NEW I1
+4 DO NEWVAR
+5 ;
+6 DO CHK^SCUTBK
+7 DO TMP^SCUTBK
+8 ;
+9 DO PARSE(.SC)
+10 ;
+11 KILL ^TMP($JOB,"SCPCNO")
+12 ; Build exclude list
+13 SET BLOCK=$SELECT(SCPOS'="":"BLKPOS^SCMCBK",1:"BLKTM^SCMCBK")
+14 SET SCBLOCK=$SELECT(SCPOS'="":SCPOS,1:SCTEAM)
+15 DO @BLOCK
+16 ;
+17 SET SCOK=0
+18 ;
+19 SET SCLOC="^TMP($J,""SC PCMM IN"")"
+20 DO PTPCNOTM^SCAPMC20(.SCLOC,SCDTVAR)
+21 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+22 ;
+23 SET I=""
+24 FOR
SET I=$ORDER(^TMP($JOB,"SC PCMM IN",I))
if 'I
QUIT
Begin DoDot:1
+25 SET ^TMP($JOB,"PCMM TMP",I)=^TMP($JOB,"SC PCMM IN",I)
End DoDot:1
+26 ;
+27 DO ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPCNO"")")
+28 SET I1=""
FOR
SET I1=$ORDER(^TMP($JOB,"SCPCNO",I1))
if 'I1
QUIT
SET I=I1
+29 ;
+30 SET SCOK=$JOB_U_+I_U_1
+31 ;
+32 DO CLRVAR
+33 QUIT
+34 ;
ASGNALL(SCOK,SC) ; Assign all entries for the selection source to the appropriate team.
+1 ; ' SC FILE ALL PAT TM ASGN '
+2 ;
+3 DO NEWVAR
+4 ;
+5 DO CHK^SCUTBK
+6 DO TMP^SCUTBK
+7 ;
+8 DO PARSE(.SC)
+9 SET SCSRCE=$GET(SC("SOURCE"),"")
+10 SET SCADDFLD(.08)=$GET(SC("TYPE"),99)
+11 SET SCADDFLD(.1)=$GET(SC("RESTRICT"),0)
+12 SET SCADDFLD(.11)=DUZ
+13 SET SCADDFLD(.12)=DT
+14 ;
+15 SET DTMP=$GET(SCDTRNG("END"))
+16 SET SCDTTRNG("END")=3990101
+17 SET SCOK2=$$PTTM^SCAPMC(SCTEAM,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
+18 SET SCDTRNG("END")=DTMP
+19 ;
+20 SET SCSRCTYP=$PIECE(SCSRCE,U,1)
+21 DO @SCSRCTYP
+22 ;
+23 KILL SCBAD,SCOLD,SCNEW
+24 SET SCX=$$ACPTATM^SCAPMC6("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
+25 ;
+26 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+27 DO BAD(.SCBAD,.SCOLD,.SCOK)
+28 SET SCOK(.1)=SCX
+29 ;
+30 DO CLRVAR
+31 QUIT
+32 ;
CLN ; File all patients in selected clinic.
+1 ;
+2 SET SCOK1=$$PTCLBR^SCAPMC26($PIECE($GET(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"SCCLPT",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"SCCLPT",I)),U))=""
End DoDot:1
+5 KILL ^TMP($JOB,"SCCLPT")
+6 QUIT
+7 ;
STOPC ; File all patients in the selected stop code
+1 ;
+2 SET SCOK1=$$PTST^SCAPMC27($PIECE($GET(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"ERRMSG",0)
+3 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+4 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+5 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+6 QUIT
+7 ;
APPT ; File all patients for the selected clinic appointment range
+1 SET SCOK1=$$PTAP^SCAPMC28($PIECE($GET(SCSRCE),U,2),"SCDTRNG",SCNUM,.SCTMP,"SCERMSG",0)
+2 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+5 QUIT
+6 ;
TEAM ; File all patients for the selected team
+1 SET SCOK1=$$PTTM^SCAPMC2($PIECE($GET(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
+2 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+5 QUIT
+6 ;
ASGALLP(SCOK,SC) ; Assign all entries in the selected source to the selected team and position
+1 ;
+2 NEW DTMP
+3 DO NEWVAR
+4 DO CHK^SCUTBK
+5 DO TMP^SCUTBK
+6 ;
+7 DO PARSE(.SC)
+8 SET SCSRCE=$GET(SC("SOURCE"),"")
+9 SET SCADDFLD(.05)=$GET(SC("TYPE"),0)
+10 SET SCADDFLD(.06)=DUZ
+11 SET SCADDFLD(.07)=DT
+12 ;
+13 SET DTMP=$GET(SCDTRNG("END"))
+14 SET SCDTRNG("END")=3990101
+15 SET SCOK2=$$PTTP^SCAPMC(SCPOS,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
+16 SET SCDTRNG("END")=DTMP
+17 ;
+18 SET SCSRCTYP=$PIECE(SCSRCE,U,1)
+19 DO @SCSRCTYP
+20 ;
+21 KILL SCBAD,SCOLD,SCNEW
+22 SET SCX=$$ACPTATP^SCAPMC21("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERRMSG",1,"","SCNEW","SCNEW1","SCOLD","SCBAD")
+23 ;
+24 KILL ^TMP("SCMC",$JOB,"EXCLUDE PT")
+25 DO BAD2(.SCBAD,.SCOLD,.SCOK)
+26 SET SCOK(.1)=SCX
+27 ;
+28 DO CLRVAR
+29 QUIT
+30 ;
PCLN ; File all patients in selected clinic to the new position and team
+1 ;
+2 SET SCOK1=$$PTCLBR^SCAPMC26($PIECE($GET(SCSRCE),U,2),.SCTEAM,"SCDTRNG")
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"SCCLPT",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"SCCLPT",I)),U))=""
End DoDot:1
+5 ;
+6 QUIT
+7 ;
PSTOPC ; File all patients in with the selected stop code to the new position and team
+1 ;
+2 SET SCOK1=$$PTST^SCAPMC27($PIECE($GET(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
+3 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+4 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+5 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+6 QUIT
+7 ;
PAPPT ;
+1 SET SCOK1=$$PTAP^SCAPMC28($PIECE($GET(SCSRCE),U,2),"SCDTRNG",500,.SCTMP,"SCERMSG",0)
+2 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+5 QUIT
+6 ;
PTEAM ;
+1 SET SCOK1=$$PTTM^SCAPMC2($PIECE($GET(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
+2 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+5 QUIT
+6 ;
PPOS ;
+1 SET SCOK1=$$PTTP^SCAPMC11($PIECE($GET(SCSRCE),U,2),"SCDTRNG",.SCTMP,"SCERMSG")
+2 MERGE ^TMP($JOB,"PCMM TMP")=@SCTMP
+3 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"PCMM TMP",I))
if 'I
QUIT
Begin DoDot:1
+4 SET ^TMP($JOB,"SC PATIENT LIST",$PIECE($GET(^TMP($JOB,"PCMM TMP",I)),U))=""
End DoDot:1
+5 QUIT
+6 ;
BAD(SCBAD,SCOLD,SCOK) ;
+1 NEW SCDFN,SCPARM,DIERR
+2 SET SCDFN=0
+3 FOR
SET SCDFN=$ORDER(SCBAD(SCDFN))
if 'SCDFN
QUIT
Begin DoDot:1
+4 SET SCPARM("PATIENT")=$PIECE($GET(^DPT(SCDFN,0)),U)_" "_$PIECE($GET(^DPT(SCDFN,.36)),U,4)
+5 DO BLD^DIALOG(40442001.001,.SCPARM,"","SCOK","S")
End DoDot:1
+6 ;
+7 FOR
SET SCDFN=$ORDER(SCOLD(SCDFN))
if 'SCDFN
QUIT
Begin DoDot:1
+8 SET SCPARM("PATIENT")=$PIECE($GET(^DPT(SCDFN,0)),U)_" "_$PIECE($GET(^DPT(SCDFN,.36)),U,4)
+9 DO BLD^DIALOG(40442001.002,.SCPARM,"","SCOK","S")
End DoDot:1
+10 DO HDREC^SCUTBK3(.SCOK,$GET(DIERR),"Patient Assignment to Teams")
+11 QUIT
+12 ;
BAD2(SCBAD,SCOLD,SCOK) ;
+1 NEW SCDFN,SCPARM,DIERR
+2 SET SCDFN=0
+3 FOR
SET SCDFN=$ORDER(SCBAD(SCDFN))
if 'SCDFN
QUIT
Begin DoDot:1
+4 SET SCPARM("PATIENT")=$PIECE($GET(^DPT(SCDFN,0)),U)_" "_$PIECE($GET(^DPT(SCDFN,.36)),U,4)
+5 DO BLD^DIALOG(40443001.001,.SCPARM,"","SCOK","S")
End DoDot:1
+6 ;
+7 FOR
SET SCDFN=$ORDER(SCOLD(SCDFN))
if 'SCDFN
QUIT
Begin DoDot:1
+8 SET SCPARM("PATIENT")=$PIECE($GET(^DPT(SCDFN,0)),U)_" "_$PIECE($GET(^DPT(SCDFN,.36)),U,4)
+9 DO BLD^DIALOG(40443001.002,.SCPARM,"","SCOK","S")
End DoDot:1
+10 DO HDREC^SCUTBK3(.SCOK,$GET(DIERR),"Patient Assignment to Positions")
+11 QUIT
