| 1 | SCAPMR6 ;ALB/REW/PDR - Team Reassignment APIs:APPTTM ; 5 Jul 1995
|
|---|
| 2 | ;;5.3;Scheduling;**148,157**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; --------------------------- MAIN -------------------------------------
|
|---|
| 5 | ACPTRATM(DFNA,SCTMTO,SCTMFRM,SCOTH,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ; list of patients RE-assigned to a team (404.42)
|
|---|
| 6 | ; input: as per ACPTTM (above with the following change:)
|
|---|
| 7 | ; DFNA = is the name of a patient array (e.g. $N(^TMP(SCJOB,"SC PATIENT LIST")))
|
|---|
| 8 | ; there is at least one scpt(dfn)="" defined
|
|---|
| 9 | ; SCTMTO = pointer to "TO" team file
|
|---|
| 10 | ; SCTMFRM = pointer to "FROM" team file - PDR 7/98
|
|---|
| 11 | ; SCOTH = array of other parameters e.g. SCOTH("SIZELIM")
|
|---|
| 12 | ; SCFIELDA = List of array of fields and values in 404.42
|
|---|
| 13 | ; SCACT = Date filed (NOW)
|
|---|
| 14 | ; SCERR = Name of error message var
|
|---|
| 15 | ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
|
|---|
| 16 | ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
|
|---|
| 17 | ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
|
|---|
| 18 | ; Note: The above three arrays return data in a user determined array
|
|---|
| 19 | ; output: Count of Patients:
|
|---|
| 20 | ; 1 2 3 4
|
|---|
| 21 | ; total assigned^newly assigned^assigned prior^not assigned
|
|---|
| 22 | N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX,SCNOMAIL,SCERR,FASIEN
|
|---|
| 23 | S SCNOMAIL=1
|
|---|
| 24 | S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
|
|---|
| 25 | S DFN=0
|
|---|
| 26 | F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
|
|---|
| 27 | . S FASIEN=@DFNA@(DFN) ; get the "FROM" team assignment
|
|---|
| 28 | . S SCX=$$ACPTTM^SCRPMTA(DFN,SCTMTO,.SCFIELDA,.SCACT,FASIEN,.SCERR)
|
|---|
| 29 | . ; SCX = ien of 404.42^new?
|
|---|
| 30 | . IF $P(SCX,U,2) D ;newly assigned to TO Team
|
|---|
| 31 | .. ;S ^TMP("PDR",$J,"NEW",DFN)=""
|
|---|
| 32 | .. S SCNEWCNT=SCNEWCNT+1
|
|---|
| 33 | .. S @SCNEWTM@(DFN)=+SCX ;scnewtm
|
|---|
| 34 | . IF $P(SCX,U,1)&('$P(SCX,U,2)) D ;already assigned to TO team
|
|---|
| 35 | .. ;S ^TMP("PDR",$J,"OLD",DFN)=""
|
|---|
| 36 | .. S SCOLDCNT=SCOLDCNT+1
|
|---|
| 37 | .. S @SCOLDTM@(DFN)=+SCX
|
|---|
| 38 | . IF 'SCX D ; Unable to reassign to new team, so don't discharge from old team
|
|---|
| 39 | .. ;S ^TMP("PDR",$J,"BAD",DFN)=""
|
|---|
| 40 | .. S @SCBADTM@(DFN)=$P(SCX,U,3)
|
|---|
| 41 | .. S SCBADCNT=SCBADCNT+1
|
|---|
| 42 | K SCNOMAIL
|
|---|
| 43 | ; Send out mail notices only if there are failures to reassign
|
|---|
| 44 | I SCBADCNT D MAILLST^SCMRTMM(SCTMTO,.SCADDFLD,DT,.SCBADTM) ; report only on unable to assign
|
|---|
| 45 | Q (SCNEWCNT+SCOLDCNT)_U_SCBADCNT
|
|---|
| 46 | ;
|
|---|
