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**;AUG 13, 1993 ; 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 ;