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

SCMCBK5.m

Go to the documentation of this file. 
  1. SCMCBK5 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998
  1.  ;;5.3;Scheduling;**148,177,1015**;AUG 13, 1993;Build 21
  1.  Q
  1.  ;
  1. ACPTTM(DFN,SCTM,SCFIELDA,SCACT,SCERR) ;add a patient to a team (pt tm assgn - #404.42
  1.  ; input:
  1.  ;  DFN     = pointer to PATIENT file (#2)
  1.  ;  SCTM    = pointer to TEAM file (#404.51)
  1.  ;  SCFIELDA= array of additional fields to be added
  1.  ;  SCACT   = date to activate [default=DT]
  1.  ;  SCERR = array NAME to store error messages.
  1.  ;          [ex. ^TMP("ORXX",$J)]
  1.  ;
  1.  ; Output:
  1.  ;  Returned = ien of 404.42 - 0 if none after^new?^Message
  1.  ;
  1.  N SCPTTM,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWTM,SCMESS,SCX
  1.  ;
  1.  ;check/setup variables
  1.  I '$$OKDATA^SCAPMC6() S SCMESS=$$S(9) G APTTMQ
  1.  ; 
  1.  ;is patient deceased?
  1.  I $$DP^SCMCBK6(DFN) S SCMESS=$$S(1) G APTTMQ
  1.  ;
  1.  ;can PC assignment be made?
  1.  I $$T1() D  I 'SCX S SCMESS=$P(SCX,U,2) G APTTMQ
  1.  .S SCX=$$OKPTTMPC^SCMCBK6(DFN,SCTM,SCACT)
  1.  .;      ;like $$OKPTTMPC^SCMCTMU2(...
  1.  .Q
  1.  ;
  1.  ;is pt already assignmed to team?
  1.  S SCPTTM=$$PTTMACT^SCAPMC6(DFN,SCTM,SCACT,.SCERR)
  1.  I SCPTTM S SCMESS=$$S(10) G APTTMQ
  1.  ;
  1.  I $D(SCFIELDA) D
  1.  .S SCFLD=0
  1.  .F  S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD  D
  1.  ..S SC($J,404.42,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
  1.  ..Q
  1.  .Q
  1.  ;
  1.  S SC($J,404.42,"+1,",.01)=DFN
  1.  S SC($J,404.42,"+1,",.02)=SCACT
  1.  S SC($J,404.42,"+1,",.03)=SCTM
  1.  N SCTMERR
  1.  D UPDATE^DIE("","SC($J)","SCIEN","SCTMERR")
  1.  ;
  1.  I $D(SCTMERR) S SCMESS=$$S(11) K SCIEN
  1.  E  D
  1.  .S SCPTTM=$G(SCIEN(1))
  1.  .S SCNEWTM=1
  1.  .D AFTERTM^SCMCDD1(SCPTTM)
  1.  .Q
  1.  ;
  1. APTTMQ Q +$G(SCPTTM)_U_+$G(SCNEWTM)_U_$G(SCMESS)
  1.  ;
  1. T1() Q $S('$D(SCFIELDA):0,('($D(@SCFIELDA@(.08))#2)):0,($G(@SCFIELDA@(.08))=1):1,1:0)
  1.  ;
  1. S(SCX) Q $$S^SCMCBK6(SCX)
  1.  ;
  1. ACPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
  1.  ; input: as per ACPTTM (above with the following change:)
  1.  ;    DFNA    = is the literal value of a patient array (e.g. "scpt"
  1.  ;              there is at least one scpt(dfn)="" defined
  1.  ;    SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
  1.  ;    SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
  1.  ;    SCBADTP = Subset of DFNA that was NOT assigned to Team  [returned]
  1.  ;    Note: The above three arrays return data in a user determined array
  1.  ;
  1.  ; output: Count of Patients: 
  1.  ;           1             2            3               4
  1.  ;    total assigned^newly assigned^assigned prior^not assigned
  1.  ;
  1.  N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCTOTCNT,SCX,SCNOMAIL
  1.  S SCNOMAIL=1
  1.  S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
  1.  S SCTOTCNT=$$PASSCNT(DFNA)
  1.  I SCTOTCNT=0 G MAIL
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(@DFNA@(DFN)) Q:'DFN  D
  1.  .S SCX=$$ACPTTM(.DFN,.SCTM,.SCFIELDA,.SCACT,.SCERR)
  1.  .;
  1.  .;newly assigned
  1.  .I $P(SCX,U,2)=1 D  Q
  1.  ..S SCNEWCNT=SCNEWCNT+1
  1.  ..S @SCNEWTM@(DFN)=+SCX
  1.  ..Q
  1.  .;
  1.  .;already assigned
  1.  .I +SCX D  Q
  1.  ..;;;I $P(SCX,U,1)&('$P(SCX,U,2)) D  Q
  1.  ..S SCOLDCNT=SCOLDCNT+1
  1.  ..S @SCOLDTM@(DFN)=+SCX
  1.  ..Q
  1.  .;
  1.  .;not assigned ;;;I 'SCX D
  1.  .S @SCBADTM@(DFN)=$P(SCX,U,3)
  1.  .S SCBADCNT=SCBADCNT+1
  1.  .Q
  1.  ;
  1. MAIL K SCNOMAIL
  1.  D MAILLST^SCMCBK7(SCTM,.SCADDFLD,DT,.SCNEWTM,.SCOLDTM,.SCBADTM,SCTOTCNT)
  1.  Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
  1.  ;
  1. PASSCNT(DFNA) ;count total patients passed to queue
  1.  ;input:  DFNA=tmp array location
  1.  ;output: count
  1.  ;
  1.  N SCX,DFN
  1.  S (SCX,DFN)=0
  1.  F  S DFN=$O(@DFNA@(DFN)) Q:'DFN  S SCX=SCX+1
  1.  Q SCX
  1.  ;