source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMR21.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1SCAPMR21 ;ALB/REW/PDR - Position Reasignment ; AUG 1998
2 ;;5.3;Scheduling;**148,157**;AUG 13, 1993
3 ;
4ACPTATP(DFNA,SCTPTO,SCTPFRM,SCFIELDA,SCACT,SCERR,SCYESTM,SCMAINA,SCNEWTP,SCNEWTM,SCOLDTP,SCBADTP) ;list of patients to a position (pt TP assgn - #404.43 and possibly #404.42
5 ; input:
6 ; DFNA = is the literal value of a patient array (e.g. "scpt"
7 ; there is at least one scpt(dfn)="" defined
8 ; SCTPTO = IEN of Position reasigned "to" ptr to 404.57
9 ; SCTPFRM = IEN of position reasigned "from" ptr to 404.57
10 ; SCNEWTP = Subset of DFNA that was NEWLY assigned to a Position
11 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to a Team
12 ; SCOLDTP = Subset of DFNA that was already assigned to Position
13 ; SCBADTP = Subset of DFNA that was NOT assigned to Position
14 ; output: Count of Patients (New or Old) assigned to Position
15 N DFN,SCCNT,SCX,SCNOMAIL,FASIEN
16 S SCNOMAIL=1
17 S SCCNT=0
18 S DFN=0
19 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
20 . S FASIEN=@DFNA@(DFN) ; get the "FROM" position Assignment
21 . S SCX=$$ACPTTP^SCRPMPSP(.DFN,.SCTPTO,.SCFIELDA,.SCACT,FASIEN,SCERR,.SCYESTM,"SCMAIN")
22 . ; SCX = ien of 404.43^new?^404.42 ien (new entries only)^new?
23 . IF $P(SCX,U,2) D ;newly assigned
24 .. S SCCNT=SCCNT+1
25 .. S @SCNEWTP@(DFN)=+SCX ;scnewtp
26 .. S:$P(SCX,U,4) @SCNEWTM@(DFN)=$P(SCX,U,3) ;scnewtm
27 . IF $P(SCX,U,1)&('$P(SCX,U,2)) D ;old
28 .. S SCCNT=SCCNT+1
29 .. S @SCOLDTP@(DFN)=+SCX
30 . IF 'SCX D
31 .. S @SCBADTP@(DFN)=$P(SCX,U,5)
32 K SCNOMAIL
33 ;D MAILLST^SCMCTPM(SCTPTO,.SCADDFLD,DT,.SCNEWTP,.SCOLDTP,.SCBADTP)
34 D MAILLST^SCMRTPM(SCTPTO,.SCADDFLD,DT,.SCBADTP,SCTPFRM) ; report errors only
35 Q SCCNT
36 ;
Note: See TracBrowser for help on using the repository browser.