Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCBK

SCMCBK.m

Go to the documentation of this file.
  1. SCMCBK ;ALB/SCK - Broker Utilities for multiple patient assignments; 4/8/96 ; 11/30/11 4:23pm
  1. ;;5.3;Scheduling;**41,51,148,157,177,205,564**;AUG 13, 1993;Build 8
  1. ;
  1. Q
  1. ;
  1. PTCLBLD(SCOK,SC) ; Build patient list for a selected clinic
  1. ; 'SC BLD PAT CLN LIST'
  1. ;
  1. D NEWVAR^SCMCBK1
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. ;
  1. I SCPOS'="" S SCOK=$$PTCLBRTP^SCAPMC26(.SCCLN,.SCPOS,"SCDTRNG")
  1. E S SCOK=$$PTCLBR^SCAPMC26(.SCCLN,.SCTEAM,"SCDTRNG")
  1. K ^TMP("SCMC",$J,"EXCLUDE PT")
  1. G:SCOK=0 PTCLNQ
  1. ;
  1. M ^TMP($J,"SC PCMM IN")=^TMP(SCOK,"SCCLPT")
  1. K ^TMP(SCOK,"SCCLPT")
  1. ;
  1. D ALPHA^SCAPMCU2("^TMP($J,""SC PCMM IN"")","^TMP($J,""SCCLPT"")")
  1. ;
  1. S SCOK=$J_U_^TMP($J,"SC PCMM IN",0)
  1. ;
  1. PTCLNQ D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. PTSCBLD(SCOK,SC) ; Build patient list for selected stop code
  1. ; 'SC BLD PAT SCDE LIST'
  1. ;
  1. D NEWVAR^SCMCBK1
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. ;
  1. K ^TMP($J,"SCSCDE")
  1. ;
  1. ; Build exclude list
  1. S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
  1. S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
  1. D @BLOCK
  1. ;
  1. IF 'SCOK1 S SCOK="0^0^0^0" G PTSCQ
  1. ;
  1. S SCOK=0
  1. S SCOK=$$PTST^SCAPMC27(SCSCDE,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
  1. K ^TMP("SCMC",$J,"EXCLUDE PT")
  1. ;
  1. M ^TMP($J,"SC PCMM IN")=@SCLOC
  1. S I1=$G(^TMP($J,"SC PCMM IN",0))
  1. F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
  1. ;
  1. D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCSCDE"")")
  1. S SCOK=$J_U_+I1_U_SCOK
  1. ;
  1. PTSCQ D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. 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.
  1. ; ' SC BLD PAT TM LIST '
  1. ;
  1. D NEWVAR^SCMCBK1
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. K ^TMP($J,"SCTEAM")
  1. ;
  1. ; Build exclude list
  1. S SCOK=0
  1. S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
  1. S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
  1. D @BLOCK
  1. ;
  1. S SCOK=$$PTTM^SCAPMC2(SCFRMTM,"SCDTRNG",.SCLOC,"SCERMSG")
  1. K ^TMP("SCMC",$J,"EXCLUDE PT")
  1. M ^TMP($J,"SC PCMM IN")=@SCLOC
  1. ;
  1. S I="" F S I=$O(^TMP($J,"SC PCMM IN",I)) Q:'I D
  1. . S ^TMP($J,"PCMM TMP",I)=^TMP($J,"SC PCMM IN",I)
  1. ;
  1. D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCTEAM"")")
  1. S I1="" F S I1=$O(^TMP($J,"SCTEAM",I1)) Q:'I1 S I=I1
  1. ;
  1. S SCOK=$J_U_+I_U_SCOK
  1. ;
  1. D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. PTPSBLD(SCOK,SC) ;
  1. ; ' SC BLD PAT POS LIST '
  1. ;
  1. D NEWVAR^SCMCBK1
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. ;
  1. K ^TMP($J,"SCPOS")
  1. ;
  1. ; Build exclude list
  1. S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
  1. S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
  1. D @BLOCK
  1. ;
  1. S SCOK=0
  1. ;
  1. S SCOK=$$PTTP^SCAPMC11(SCFRMPOS,"SCDTRNG",.SCLOC,.SCERMSG)
  1. K ^TMP("SCMC",$J,"EXCLUDE PT")
  1. M ^TMP($J,"SC PCMM IN")=@SCLOC
  1. ;
  1. S I1=$G(^TMP($J,"SC PCMM IN",0))
  1. F I=1:1:I1 S ^TMP($J,"PCMM TMP",I)=$G(^TMP($J,"SC PCMM IN",I))
  1. D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCPOS"")")
  1. S SCOK=$J_U_+I1_U_SCOK
  1. ;
  1. ;IF '+$G(^TMP($J,"SCPOS",0)) D S SCOK=$J_U_SCOK
  1. ;. S I="" F S I=$O(^TMP($J,"SCPOS",I)) Q:'I S SCOK=I
  1. ;
  1. D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. PTAPBLD(SCOK,SC) ; Build patient list for selected appointment range.
  1. ; ' SC BLD PAT APT LIST '
  1. ;
  1. ;SD/564-this build includes modification as follows:
  1. ;- patients already assigned to another PC team then evaluated team SCTEAM are excluded
  1. ;- patients previously assigned and unassigned to evaluated position are included
  1. ;
  1. ;N SCCLN,SCTEAM,SCDTRNG,SCLOC,SCERMSG,SCNUM,SCCOUNT,SCMORE,SCOK1,SCER2,SCOUT,SCBLOCK
  1. ;
  1. D NEWVAR^SCMCBK1
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. ;
  1. K ^TMP($J,"SCCLN")
  1. ;
  1. ; Build exclude list
  1. S BLOCK=$S(SCPOS'="":"BLKPOS",1:"BLKTM")
  1. S SCBLOCK=$S(SCPOS'="":SCPOS,1:SCTEAM)
  1. D @BLOCK
  1. ;
  1. IF 'SCOK1 S SCOK="0^0^0^0" G PTAPQ
  1. S SCOK=0
  1. S SCOK=$$PTAP^SCAPMC28(SCCLN,"SCDTRNG",SCNUM,.SCLOC,"SCERMSG",SCMORE)
  1. ;
  1. ;identify excluded to be included if unassigned from evaluated position-sd/564
  1. N SCTMP S SCTMP=$G(^TMP("SC TMP LIST",$J,0))
  1. N SS S SS=$G(^TMP("SCMC",$J,"EXCLUDE PT",0))
  1. N SDFN,XX F XX=1:1:SS S SDFN=+$G(^TMP("SCMC",$J,"EXCLUDE PT",XX)) D
  1. .N SCI S SCI=^TMP("SCMC",$J,"EXCLUDE PT",XX) D
  1. ..N SCII S SCII=$P(SCI,U,5) I SCII>0&(SCII<(DT+1)) D
  1. ...;PROCEED ONLY WITH THE CURRENT MONTH ASSIGNMENT
  1. ...N SCAS S SCAS=$P(SCI,U,4) I SCAS>0 I $E(DT,1,5)'=$E(SCAS,1,5) Q
  1. ...N SCPOS S SCPOS=$P(SCI,U,3) I SCPOS>0 I $P(^SCPT(404.43,SCPOS,0),U,2)'=$G(SC("POSITION")) Q
  1. ...N SCN,SCS S SCN=$P(SCI,U,2),SCS=$P(SCI,U,6)
  1. ...S SCTMP=SCTMP+1
  1. ...S ^TMP("SC TMP LIST",$J,SCTMP)=SDFN_U_SCN_U_SC("CLINIC")_U_U_SCS
  1. ...S ^TMP("SC TMP LIST",$J,"SCPTAP",SDFN,SCTMP)=""
  1. S ^TMP("SC TMP LIST",$J,0)=SCTMP
  1. ;
  1. K ^TMP("SCMC",$J,"EXCLUDE PT")
  1. ;
  1. ;eliminate patients if assigned to another PC team-SD/564
  1. N DFN S DFN="" F S DFN=$O(^TMP("SC TMP LIST",$J,"SCPTAP",DFN)) Q:DFN="" D
  1. .N SCEX S SCEX=$$GETPC^SCAPMCU2(DFN) ;call to get patient's PC assignment
  1. .N NSAS S NSAS=$P(SCEX,U,2) I +SCEX>0!(NSAS>0&(NSAS'=SCTEAM)) D
  1. ..N SCN S SCN=$O(^TMP("SC TMP LIST",$J,"SCPTAP",DFN,""))
  1. ..K ^TMP("SC TMP LIST",$J,"SCPTAP",DFN)
  1. ..K ^TMP("SC TMP LIST",$J,SCN)
  1. ..S ^TMP("SC TMP LIST",$J,0)=^TMP("SC TMP LIST",$J,0)-1
  1. ;
  1. M ^TMP($J,"SC PCMM IN")=@SCLOC
  1. S I1=$G(^TMP($J,"SC PCMM IN",0))
  1. ;reindex entries in ^TMP global list - SD/564
  1. N SCC S SCC=0 F I=1:1:I1 S SCC=$O(^TMP($J,"SC PCMM IN",SCC)) D
  1. .S ^TMP($J,"PCMM TMP",I)=^TMP($J,"SC PCMM IN",SCC)
  1. ;
  1. D ALPHA^SCAPMCU2("^TMP($J,""PCMM TMP"")","^TMP($J,""SCAPP"")")
  1. S SCOK=$J_U_I1_U_SCOK
  1. ;
  1. D CLRVAR^SCMCBK1
  1. PTAPQ Q
  1. ;
  1. PTGET(SCDATA,SC) ; Return a block of patients to the client
  1. ; 'SC GET PAT BLOCK'
  1. ;
  1. ; SCJOB = $J for the ^TMP global
  1. ; SCJOBID = The second subscript id for the ^TMP global
  1. ; SCSTART = Beginning entry number for the block retrieval in the ^TMP global
  1. ; SCEND = The ending entry number for the block retrieval
  1. ; SCLAST = The last entry number in the ^TMP global
  1. ;
  1. N SCJOB,SCSTART,SCEND,I,SCLAST,SCJOBID
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. ;
  1. F I=SCSTART:1:SCEND Q:'$G(^TMP(SCJOB,SCJOBID,I),0) D
  1. . S SCDATA(I)=^TMP(SCJOB,SCJOBID,I)
  1. I SCEND>SCLAST K ^TMP(SCJOB,SCJOBID)
  1. ;
  1. D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. 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'
  1. ;
  1. N SCJOB,SCDFN
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. S SCOK=0
  1. I SCVAL["Start" D G PTBLDQ
  1. .S SCOK=$J
  1. .K ^TMP(SCOK,"SC PATIENT LIST")
  1. ;
  1. S SCJOB=$P(SCVAL,U,1)
  1. S SCDFN=$P(SCVAL,U,2)
  1. S ^TMP(SCJOB,"SC PATIENT LIST",SCDFN)=""
  1. S SCOK=1
  1. PTBLDQ Q
  1. ;
  1. PTFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC TEAM ASSIGN",SCDFN) global
  1. ; 'SC FILE PAT TM ASGN'
  1. ;
  1. ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(1) Q
  1. ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
  1. ; pre 177 code follows....
  1. I XWBAPVER=1 D QUEUED^SCMCBK4(1) Q
  1. ;
  1. N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. G:+$G(SCJOB)=0 FILEQ
  1. ;
  1. ;
  1. S SCADDFLD(.08)=$G(SC("TYPE"),99)
  1. S SCADDFLD(.1)=$G(SC("RESTRICT"),0)
  1. S SCADDFLD(.11)=DUZ
  1. S SCADDFLD(.12)=DT
  1. ;
  1. S SCX=$$ACPTATM^SCAPMC6("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")
  1. D BAD^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
  1. S SCOK(.1)=SCX
  1. ;
  1. K ^TMP(SCJOB,"SC PATIENT LIST")
  1. ;
  1. D CLRVAR^SCMCBK1
  1. FILEQ Q
  1. ;
  1. POSFILE(SCOK,SC) ; File the patient assignments in the ^TMP($J,"SC PATIENT LIST") global
  1. ; ' SC FILE PAT POS ASGN '
  1. ;
  1. ;205 remove;I XWBAPVER=177 D QUEUED^SCMCBK4(2) Q
  1. ;205 remove;I $$VPROGMR^SCUTBK3()'=1 Q
  1. ; pre 177 code follows...
  1. I XWBAPVER=1 D QUEUED^SCMCBK4(2) Q
  1. ;
  1. N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1
  1. ;
  1. D CHK^SCUTBK
  1. D TMP^SCUTBK
  1. ;
  1. D PARSE^SCMCBK1(.SC)
  1. G:+$G(SCJOB)=0 FILEQ
  1. S SCADTM=1
  1. ;
  1. S SCADDFLD(.05)=$G(SC("TYPE"),0)
  1. S SCADDFLD(.06)=DUZ
  1. S SCADDFLD(.07)=DT
  1. ;
  1. S SCX=$$ACPTATP^SCAPMC21("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")
  1. ;
  1. D BAD2^SCMCBK1(.SCBAD,.SCOLD,.SCOK)
  1. S SCOK(.1)=SCX
  1. K ^TMP(SCJOB,"SC PATIENT LIST")
  1. ;
  1. D CLRVAR^SCMCBK1
  1. Q
  1. ;
  1. BLKPOS ;
  1. N SCX
  1. S SCX=$G(SCDTRNG("END"))
  1. S SCDTRNG("END")=3990101 ;check forever
  1. S SCOK1=$$PTTP^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
  1. S SCDTRNG("END")=SCX
  1. Q
  1. ;
  1. BLKTM ;
  1. N SCX
  1. S SCX=$G(SCDTRNG("END"))
  1. S SCDTRNG("END")=3990101 ;check forever
  1. S SCOK1=$$PTTM^SCAPMC(SCBLOCK,"SCDTRNG","^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCER2")
  1. S SCDTRNG("END")=SCX
  1. Q
  1. ;