| 1 | SCMCMU ;ALB/MJK - PCMM Mass Team/Position Unassignment Utility ; 10 Jul 98
|
|---|
| 2 | ;;5.3;Scheduling;**148**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; -- entry point for mass unassignment (mu)
|
|---|
| 5 | ;
|
|---|
| 6 | N SCMUTYPE,SCTEAM,SCPOS,SCABORT,SCDATE,SCDIS,SCTPDIS
|
|---|
| 7 | ;
|
|---|
| 8 | S (SCTEAM,SCPOS,SCDIS)=0
|
|---|
| 9 | S SCABORT=-1
|
|---|
| 10 | ;
|
|---|
| 11 | ; -- get type of md (team or position)
|
|---|
| 12 | S SCMUTYPE=$$TYPE()
|
|---|
| 13 | IF SCMUTYPE=SCABORT G ENQ
|
|---|
| 14 | ;
|
|---|
| 15 | ; -- get effective date
|
|---|
| 16 | S SCDATE=$$DATE()
|
|---|
| 17 | IF SCDATE=SCABORT G ENQ
|
|---|
| 18 | ;
|
|---|
| 19 | ; -- get team
|
|---|
| 20 | S SCTEAM=$$TEAM(SCDATE)
|
|---|
| 21 | IF SCTEAM=SCABORT G ENQ
|
|---|
| 22 | ;
|
|---|
| 23 | ; -- get position if position md
|
|---|
| 24 | IF SCMUTYPE="T" D IF SCDIS=SCABORT G ENQ
|
|---|
| 25 | . S SCDIS=$$TMDIS(SCTEAM,SCDATE,.SCTPDIS)
|
|---|
| 26 | ;
|
|---|
| 27 | ; -- get position if position md
|
|---|
| 28 | IF SCMUTYPE="P" D IF SCPOS=SCABORT!(SCDIS=SCABORT) G ENQ
|
|---|
| 29 | . S SCPOS=$$POS(SCTEAM,SCDATE)
|
|---|
| 30 | . S SCDIS=$$TPDIS(SCPOS,.SCTPDIS)
|
|---|
| 31 | ;
|
|---|
| 32 | ; -- call lm routine
|
|---|
| 33 | D EN^SCMCMU1(SCTEAM,SCPOS,.SCTPDIS,SCMUTYPE,SCDATE)
|
|---|
| 34 | ;
|
|---|
| 35 | ENQ Q
|
|---|
| 36 | ;
|
|---|
| 37 | TYPE() ; -- get type of mu
|
|---|
| 38 | N DIR,DIRUT,Y
|
|---|
| 39 | S DIR(0)="SABM^T:Team;P:Position"
|
|---|
| 40 | S DIR("A")="Select Type of Mass Unassignment: "
|
|---|
| 41 | S DIR("B")="Team"
|
|---|
| 42 | D ^DIR
|
|---|
| 43 | Q $S($D(DIRUT):-1,1:Y)
|
|---|
| 44 | ;
|
|---|
| 45 | DATE() ; -- get effective date
|
|---|
| 46 | N DIR,DIRUT,Y
|
|---|
| 47 | S DIR(0)="DA^::EX"
|
|---|
| 48 | S DIR("A")="Effective Date: "
|
|---|
| 49 | S DIR("B")="T-1"
|
|---|
| 50 | D ^DIR
|
|---|
| 51 | Q $S($D(DIRUT):-1,1:Y)
|
|---|
| 52 | ;
|
|---|
| 53 | TEAM(SCDATE) ; -- get team
|
|---|
| 54 | N DIC,Y,SCDTE
|
|---|
| 55 | D DATE^SCMCMU1(SCDATE,.SCDTE)
|
|---|
| 56 | S DIC("S")="IF +$$ACTHIST^SCAPMCU2(404.58,+Y,SCDTE)=1"
|
|---|
| 57 | S DIC="^SCTM(404.51,",DIC(0)="AEQM"
|
|---|
| 58 | D ^DIC
|
|---|
| 59 | Q +Y
|
|---|
| 60 | ;
|
|---|
| 61 | POS(SCTEAM,SCDATE) ; -- get position for team
|
|---|
| 62 | N DIC,Y,SCDTE,SCPOS,SCPOSI,I
|
|---|
| 63 | D DATE^SCMCMU1(SCDATE,.SCDTE)
|
|---|
| 64 | S SCPOS=$NA(^TMP("SCMU",$J,"POSITION"))
|
|---|
| 65 | K @SCPOS
|
|---|
| 66 | IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS) S Y=-1 G POSQ
|
|---|
| 67 | S I=0 F S I=$O(@SCPOS@(I)) Q:'I S SCPOSI(+@SCPOS@(I))=""
|
|---|
| 68 | S DIC="^SCTM(404.57,"
|
|---|
| 69 | S DIC(0)="AEQM"
|
|---|
| 70 | S DIC("S")="IF $D(SCPOSI(+Y)),$P(^(0),U,2)=+SCTEAM,+$$ACTHIST^SCAPMCU2(404.59,+Y,SCDTE)=1"
|
|---|
| 71 | D ^DIC
|
|---|
| 72 | POSQ K @SCPOS
|
|---|
| 73 | Q +Y
|
|---|
| 74 | ;
|
|---|
| 75 | TMDIS(SCTEAM,SCDATE,SCTPDIS) ; -- discharge patient from clinics
|
|---|
| 76 | N DIR,Y,SCDTE,SCPOS,SCPOSI,I,SCOK,SCCL,SCCLNM,SCPOS0,SCTEAMNM
|
|---|
| 77 | S SCOK=1
|
|---|
| 78 | D DATE^SCMCMU1(SCDATE,.SCDTE)
|
|---|
| 79 | W !!,">>> Checking to see if any team positions are associated with clinics..."
|
|---|
| 80 | S SCPOS=$NA(^TMP("SCMU",$J,"POSITION"))
|
|---|
| 81 | K @SCPOS
|
|---|
| 82 | IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS) S Y=-1 G TMDISQ
|
|---|
| 83 | S I=0 F S I=$O(@SCPOS@(I)) Q:'I S SCPOSI(+@SCPOS@(I))=""
|
|---|
| 84 | K @SCPOS
|
|---|
| 85 | S SCPOS=0
|
|---|
| 86 | F S SCPOS=$O(SCPOSI(SCPOS)) Q:'SCPOS D Q:SCOK=SCABORT
|
|---|
| 87 | . S SCPOS0=$G(^SCTM(404.57,+SCPOS,0))
|
|---|
| 88 | . S SCCL=+$P(SCPOS0,U,9)
|
|---|
| 89 | . IF 'SCCL Q
|
|---|
| 90 | . S SCCLNM=$P($G(^SC(SCCL,0)),U)
|
|---|
| 91 | . S SCTEAMNM=$P($G(^SCTM(404.51,SCTEAM,0),"Unknown"),U)
|
|---|
| 92 | . S DIR(0)="YA"
|
|---|
| 93 | . S DIR("A",1)="----------------------------------------------------------------------------"
|
|---|
| 94 | . S DIR("A",2)=" Team : "_SCTEAMNM
|
|---|
| 95 | . S DIR("A",3)=" Position : "_$P(SCPOS0,U)
|
|---|
| 96 | . S DIR("A",4)=" Associated Clinic: "_SCCLNM
|
|---|
| 97 | . S DIR("A",5)=" "
|
|---|
| 98 | . S DIR("A")=">>> Do you want to discharge patients from this clinic? (Yes/No) "
|
|---|
| 99 | . D ^DIR
|
|---|
| 100 | . IF $D(DIRUT) S SCOK=SCABORT Q
|
|---|
| 101 | . IF Y=1 S SCTPDIS(SCPOS)=1
|
|---|
| 102 | . Q
|
|---|
| 103 | TMDISQ Q SCOK
|
|---|
| 104 | ;
|
|---|
| 105 | TPDIS(SCPOS,SCTPDIS) ; -- discharge patient from clinic
|
|---|
| 106 | N SCPOS0,SCCL,SCCL0,DIR,DIRUT,Y,SCOK
|
|---|
| 107 | S SCOK=1
|
|---|
| 108 | S SCPOS0=$G(^SCTM(404.57,+SCPOS,0))
|
|---|
| 109 | S SCCL=+$P(SCPOS0,U,9)
|
|---|
| 110 | IF 'SCCL S Y=0 G TPDISQ
|
|---|
| 111 | S SCCLNM=$P($G(^SC(SCCL,0)),U)
|
|---|
| 112 | S DIR(0)="YA"
|
|---|
| 113 | S DIR("A",1)=" "
|
|---|
| 114 | S DIR("A")="Also discharge patients from the '"_SCCLNM_"' clinic? (Yes/No) "
|
|---|
| 115 | D ^DIR
|
|---|
| 116 | IF $D(DIRUT) S SCOK=SCABORT
|
|---|
| 117 | IF Y=1 S SCTPDIS(+SCPOS)=1
|
|---|
| 118 | TPDISQ Q SCOK
|
|---|
| 119 | ;
|
|---|
