| 1 | SCAPMR21 ;ALB/REW/PDR - Position Reasignment ; AUG 1998
|
|---|
| 2 | ;;5.3;Scheduling;**148,157**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ACPTATP(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 | ;
|
|---|
