| [613] | 1 | SCMCMU11 ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998
|
|---|
| 2 | ;;5.3;Scheduling;**148**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | PTTPLST(SCTEAM,SCDATE,SCPTTP) ; -- create list of patients assigned to team positions
|
|---|
| 6 | ; -- sort list by dfn and position ien
|
|---|
| 7 | N SCPOS,SCDTE,SCPR,SCPRX
|
|---|
| 8 | ;
|
|---|
| 9 | ; -- check for patient-position assignments
|
|---|
| 10 | D DATE^SCMCMU1(SCDATE,.SCDTE)
|
|---|
| 11 | S SCPOS=$NA(^TMP("SCMU",$J,"POSITION"))
|
|---|
| 12 | ;
|
|---|
| 13 | ; -- get list of positions for team
|
|---|
| 14 | K @SCPOS
|
|---|
| 15 | IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS) S Y=-1 G PTTPLSTQ
|
|---|
| 16 | S SCPR=0
|
|---|
| 17 | F S SCPR=$O(@SCPOS@(SCPR)) Q:'SCPR D
|
|---|
| 18 | . S SCPRX=@SCPOS@(SCPR)
|
|---|
| 19 | . ; -- create sorted list of dfn by position ien
|
|---|
| 20 | . D PTTP(+SCPRX,SCDATE,SCPTTP)
|
|---|
| 21 | . Q
|
|---|
| 22 | PTTPLSTQ K @SCPOS
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | PTTP(SCPOS,SCDATE,SCPTTP) ; -- create list of pats assigned to position sort by dfn, position
|
|---|
| 26 | N SCPAT,SCPATX,SCPATS,SCDTE
|
|---|
| 27 | D DATE^SCMCMU1(SCDATE,.SCDTE)
|
|---|
| 28 | S SCPATS=$NA(^TMP("SCMU",$J,"PATIENT"))
|
|---|
| 29 | K @SCPATS
|
|---|
| 30 | IF '$$PTTP^SCAPMC(SCPOS,SCDTE,SCPATS) S SCOK=0 G PTTPQ
|
|---|
| 31 | S SCPAT=0
|
|---|
| 32 | F S SCPAT=$O(@SCPATS@(SCPAT)) Q:'SCPAT D
|
|---|
| 33 | . S SCPATX=@SCPATS@(SCPAT)
|
|---|
| 34 | . ; -- store by dfn / pos data
|
|---|
| 35 | . S @SCPTTP@(+SCPATX,SCPOS)=SCPATX
|
|---|
| 36 | . Q
|
|---|
| 37 | PTTPQ K @SCPATS
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | UNASSIGN ; -- unassign selected
|
|---|
| 41 | ; protocol: SCMC MU UNASSIGN PATIENTS
|
|---|
| 42 | N DIR,Y
|
|---|
| 43 | IF 'SCSELCNT D G UNQ
|
|---|
| 44 | . W !!,"No patients have been selected.",!
|
|---|
| 45 | . D PAUSE^SCMCMU1
|
|---|
| 46 | . D BACK^SCMCMU1("")
|
|---|
| 47 | . Q
|
|---|
| 48 | ELSE D
|
|---|
| 49 | . D FULL^VALM1
|
|---|
| 50 | . W @IOF
|
|---|
| 51 | . S DIR(0)="YA"
|
|---|
| 52 | . D SET("----------------------------------------------------------------------------")
|
|---|
| 53 | . D SET(" Team"_$S(SCMUTYPE="P":" Position",1:"")_" Unassignment Definition")
|
|---|
| 54 | . D SET("----------------------------------------------------------------------------")
|
|---|
| 55 | . D SET(" Team : "_$P($G(^SCTM(404.51,SCTEAM,0),"Unknown"),U))
|
|---|
| 56 | . IF SCMUTYPE="P" D SET(" Position : "_$P($G(^SCTM(404.57,SCPOS,0),"Unknown"),U))
|
|---|
| 57 | . D SET(" Effective Date : "_$$FMTE^XLFDT($E(SCDATE,1,7),"5Z"))
|
|---|
| 58 | . D SET(" # of Patients : "_SCSELCNT)
|
|---|
| 59 | . D CLINIC
|
|---|
| 60 | . D SET(" ")
|
|---|
| 61 | . S DIR("A")="Are you sure you want to continue? "
|
|---|
| 62 | . S DIR("B")="No"
|
|---|
| 63 | . D ^DIR
|
|---|
| 64 | . IF Y=1 D
|
|---|
| 65 | . . N DIR,SCTSK
|
|---|
| 66 | . . S SCTSK=$$QUE^SCMCMU2()
|
|---|
| 67 | . . IF SCTSK="" D
|
|---|
| 68 | . . . D BACK^SCMCMU1("R")
|
|---|
| 69 | . . ELSE D
|
|---|
| 70 | . . . W !!,"Task#: ",SCTSK,!
|
|---|
| 71 | . . D PAUSE^SCMCMU1
|
|---|
| 72 | . . Q
|
|---|
| 73 | . ELSE D
|
|---|
| 74 | . . D BACK^SCMCMU1("R")
|
|---|
| 75 | . . Q
|
|---|
| 76 | . Q
|
|---|
| 77 | UNQ Q
|
|---|
| 78 | ;
|
|---|
| 79 | CLINIC ; -- display clinic to be discharged from
|
|---|
| 80 | N SCPOS,SCX,Y
|
|---|
| 81 | D SET(" ")
|
|---|
| 82 | IF '$O(SCTPDIS(0)) D G CLINICQ
|
|---|
| 83 | . D SET(" Clinic Discharges: None")
|
|---|
| 84 | ;
|
|---|
| 85 | S Y=""
|
|---|
| 86 | S Y=$$SETSTR^VALM1("Clinic Discharges:",Y,5,20)
|
|---|
| 87 | S Y=$$SETSTR^VALM1("Position",Y,25,25)
|
|---|
| 88 | S Y=$$SETSTR^VALM1("Associated Clinic",Y,55,25)
|
|---|
| 89 | D SET(Y)
|
|---|
| 90 | S Y=""
|
|---|
| 91 | S Y=$$SETSTR^VALM1("--------",Y,25,25)
|
|---|
| 92 | S Y=$$SETSTR^VALM1("-----------------",Y,55,25)
|
|---|
| 93 | D SET(Y)
|
|---|
| 94 | ;
|
|---|
| 95 | S SCPOS=0
|
|---|
| 96 | F S SCPOS=$O(SCTPDIS(SCPOS)) Q:'SCPOS D
|
|---|
| 97 | . S SCX=$G(^SCTM(404.57,SCPOS,0),"Unknown")
|
|---|
| 98 | . S Y=""
|
|---|
| 99 | . S Y=$$SETSTR^VALM1($E($P(SCX,U),1,25),Y,25,25)
|
|---|
| 100 | . S Y=$$SETSTR^VALM1($E($P($G(^SC(+$P(SCX,U,9),0),"Unknown"),U),1,25),Y,55,25)
|
|---|
| 101 | . D SET(Y)
|
|---|
| 102 | . Q
|
|---|
| 103 | ;
|
|---|
| 104 | CLINICQ Q
|
|---|
| 105 | ;
|
|---|
| 106 | SET(X) ; -- set DIR text
|
|---|
| 107 | S DIR("A",$O(DIR("A",""),-1)+1)=X
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | QUIT ; -- quit logic
|
|---|
| 111 | ; protocol: SCMC MU QUIT
|
|---|
| 112 | N DIR,Y
|
|---|
| 113 | S Y=0
|
|---|
| 114 | IF SCSELCNT D
|
|---|
| 115 | . W !
|
|---|
| 116 | . S DIR(0)="YA"
|
|---|
| 117 | . S DIR("A",1)="You have "_SCSELCNT_" patient"_$S(SCSELCNT=1:"",1:"s")_" selected."
|
|---|
| 118 | . S DIR("A",2)=" "
|
|---|
| 119 | . S DIR("A")="Are you sure you want to quit? "
|
|---|
| 120 | . S DIR("B")="No"
|
|---|
| 121 | . D ^DIR
|
|---|
| 122 | . IF Y'=1 D BACK^SCMCMU1("")
|
|---|
| 123 | . Q
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
