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

SCMCBK1.m

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