| [613] | 1 | SCMCPM1 ;ALB/REW - Pt PC Team Assignment on Inpt Discharge ; 1 Apr 1996
|
|---|
| 2 | ;;5.3;Scheduling;**41,130**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | PCMMDIS ; - called by 'SC ASSIGN PC TEAM ON DISCHARGE' which is
|
|---|
| 5 | ; called by the patient movement event driver
|
|---|
| 6 | Q:$D(ZTQUEUED) ;interactive - quit if queued
|
|---|
| 7 | ;check if patient has a current PC team if no prompt to enroll
|
|---|
| 8 | Q:$P($G(DGPMA),U,2)'=3 ;must be a discharge
|
|---|
| 9 | Q:'$G(DFN) ;should exist
|
|---|
| 10 | Q:'$P($G(^SD(404.91,1,"PCMM")),U,2) ; check turn off flag
|
|---|
| 11 | N DIR,DIRUT,DIROUT,SCTMERR,DIC,X,Y,SCOK,SCX,SCOUTFLD,SCBADOUT
|
|---|
| 12 | D:'$G(DGQUIET) EN^DDIOL("Checking Primary Care Status...")
|
|---|
| 13 | ;display PC info, check if patient has a current PC team
|
|---|
| 14 | D PCMM^SCRPU4(DFN,DT)
|
|---|
| 15 | G:$$NMPCTM^SCAPMCU2(DFN,DT,1) END
|
|---|
| 16 | ;if not, check if patient has a PC team in the future
|
|---|
| 17 | S SCOK=$$YSPTTMPC^SCMCTMU2(DFN,DT)
|
|---|
| 18 | IF 'SCOK D G END
|
|---|
| 19 | .D:'$G(DGQUIET) EN^DDIOL($P(SCOK,U,2))
|
|---|
| 20 | ;if not either, ask if they want to assign a patient to a PC team
|
|---|
| 21 | S DIR(0)="Y"
|
|---|
| 22 | S DIR("A")="Do you wish to assign patient to Primary Care"
|
|---|
| 23 | S DIR("B")="NO"
|
|---|
| 24 | D ^DIR
|
|---|
| 25 | G:'Y END
|
|---|
| 26 | S DIR(0)="Y"
|
|---|
| 27 | S DIR("A")="Do you wish to assign patient to a Primary Care Team"
|
|---|
| 28 | S DIR("B")="NO"
|
|---|
| 29 | D ^DIR
|
|---|
| 30 | IF 'Y D G END
|
|---|
| 31 | .S SCOUTFLD(.04)=1
|
|---|
| 32 | .S SCX=$$ACOUTPT^SCAPMC20(DFN,"SCOUTFLD","SCBADOUT")
|
|---|
| 33 | .D:SCX&'($G(DGQUIET)) EN^DDIOL("Patient Assigned to Primary Care, but no Team Assigned...")
|
|---|
| 34 | S DIC="^SCTM(404.51,"
|
|---|
| 35 | S DIC(0)="AEMQZ"
|
|---|
| 36 | S DIC("S")="IF $$ACTTM^SCMCTMU(Y,DT)&($P($G(^SCTM(404.51,Y,0)),U,5))"
|
|---|
| 37 | ; - select from active teams that can be PC Teams
|
|---|
| 38 | D ^DIC
|
|---|
| 39 | G:Y<1 END
|
|---|
| 40 | S SCTM=+Y
|
|---|
| 41 | ;setup fields
|
|---|
| 42 | S SCTMFLDS(.02)=DT
|
|---|
| 43 | S SCTMFLDS(.08)=1 ;primary care assignment
|
|---|
| 44 | S SCTMFLDS(.11)=$G(DUZ,.5)
|
|---|
| 45 | D NOW^%DTC S SCTMFLDS(.12)=%
|
|---|
| 46 | IF $$ACPTTM^SCAPMC(DFN,SCTM,"SCTMFLDS",DT,"SCTPTME") D
|
|---|
| 47 | .D:'$G(DGQUIET) EN^DDIOL("...PC Team Assignment Made")
|
|---|
| 48 | END ;
|
|---|
| 49 | Q
|
|---|
