source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMR6.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1SCAPMR6 ;ALB/REW/PDR - Team Reassignment APIs:APPTTM ; 5 Jul 1995
2 ;;5.3;Scheduling;**148,157**;AUG 13, 1993
3 ;
4 ; --------------------------- MAIN -------------------------------------
5ACPTRATM(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 ;
Note: See TracBrowser for help on using the repository browser.