SCMCMU11 ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998
;;5.3;Scheduling;**148**;AUG 13, 1993
;
;
PTTPLST(SCTEAM,SCDATE,SCPTTP) ; -- create list of patients assigned to team positions
; -- sort list by dfn and position ien
N SCPOS,SCDTE,SCPR,SCPRX
;
; -- check for patient-position assignments
D DATE^SCMCMU1(SCDATE,.SCDTE)
S SCPOS=$NA(^TMP("SCMU",$J,"POSITION"))
;
; -- get list of positions for team
K @SCPOS
IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS) S Y=-1 G PTTPLSTQ
S SCPR=0
F S SCPR=$O(@SCPOS@(SCPR)) Q:'SCPR D
. S SCPRX=@SCPOS@(SCPR)
. ; -- create sorted list of dfn by position ien
. D PTTP(+SCPRX,SCDATE,SCPTTP)
. Q
PTTPLSTQ K @SCPOS
Q
;
PTTP(SCPOS,SCDATE,SCPTTP) ; -- create list of pats assigned to position sort by dfn, position
N SCPAT,SCPATX,SCPATS,SCDTE
D DATE^SCMCMU1(SCDATE,.SCDTE)
S SCPATS=$NA(^TMP("SCMU",$J,"PATIENT"))
K @SCPATS
IF '$$PTTP^SCAPMC(SCPOS,SCDTE,SCPATS) S SCOK=0 G PTTPQ
S SCPAT=0
F S SCPAT=$O(@SCPATS@(SCPAT)) Q:'SCPAT D
. S SCPATX=@SCPATS@(SCPAT)
. ; -- store by dfn / pos data
. S @SCPTTP@(+SCPATX,SCPOS)=SCPATX
. Q
PTTPQ K @SCPATS
Q
;
UNASSIGN ; -- unassign selected
; protocol: SCMC MU UNASSIGN PATIENTS
N DIR,Y
IF 'SCSELCNT D G UNQ
. W !!,"No patients have been selected.",!
. D PAUSE^SCMCMU1
. D BACK^SCMCMU1("")
. Q
ELSE D
. D FULL^VALM1
. W @IOF
. S DIR(0)="YA"
. D SET("----------------------------------------------------------------------------")
. D SET(" Team"_$S(SCMUTYPE="P":" Position",1:"")_" Unassignment Definition")
. D SET("----------------------------------------------------------------------------")
. D SET(" Team : "_$P($G(^SCTM(404.51,SCTEAM,0),"Unknown"),U))
. IF SCMUTYPE="P" D SET(" Position : "_$P($G(^SCTM(404.57,SCPOS,0),"Unknown"),U))
. D SET(" Effective Date : "_$$FMTE^XLFDT($E(SCDATE,1,7),"5Z"))
. D SET(" # of Patients : "_SCSELCNT)
. D CLINIC
. D SET(" ")
. S DIR("A")="Are you sure you want to continue? "
. S DIR("B")="No"
. D ^DIR
. IF Y=1 D
. . N DIR,SCTSK
. . S SCTSK=$$QUE^SCMCMU2()
. . IF SCTSK="" D
. . . D BACK^SCMCMU1("R")
. . ELSE D
. . . W !!,"Task#: ",SCTSK,!
. . D PAUSE^SCMCMU1
. . Q
. ELSE D
. . D BACK^SCMCMU1("R")
. . Q
. Q
UNQ Q
;
CLINIC ; -- display clinic to be discharged from
N SCPOS,SCX,Y
D SET(" ")
IF '$O(SCTPDIS(0)) D G CLINICQ
. D SET(" Clinic Discharges: None")
;
S Y=""
S Y=$$SETSTR^VALM1("Clinic Discharges:",Y,5,20)
S Y=$$SETSTR^VALM1("Position",Y,25,25)
S Y=$$SETSTR^VALM1("Associated Clinic",Y,55,25)
D SET(Y)
S Y=""
S Y=$$SETSTR^VALM1("--------",Y,25,25)
S Y=$$SETSTR^VALM1("-----------------",Y,55,25)
D SET(Y)
;
S SCPOS=0
F S SCPOS=$O(SCTPDIS(SCPOS)) Q:'SCPOS D
. S SCX=$G(^SCTM(404.57,SCPOS,0),"Unknown")
. S Y=""
. S Y=$$SETSTR^VALM1($E($P(SCX,U),1,25),Y,25,25)
. S Y=$$SETSTR^VALM1($E($P($G(^SC(+$P(SCX,U,9),0),"Unknown"),U),1,25),Y,55,25)
. D SET(Y)
. Q
;
CLINICQ Q
;
SET(X) ; -- set DIR text
S DIR("A",$O(DIR("A",""),-1)+1)=X
Q
;
QUIT ; -- quit logic
; protocol: SCMC MU QUIT
N DIR,Y
S Y=0
IF SCSELCNT D
. W !
. S DIR(0)="YA"
. S DIR("A",1)="You have "_SCSELCNT_" patient"_$S(SCSELCNT=1:"",1:"s")_" selected."
. S DIR("A",2)=" "
. S DIR("A")="Are you sure you want to quit? "
. S DIR("B")="No"
. D ^DIR
. IF Y'=1 D BACK^SCMCMU1("")
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCMU11 3492 printed Apr 09, 2024@21:47:02 Page 2
SCMCMU11 ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998
+1 ;;5.3;Scheduling;**148**;AUG 13, 1993
+2 ;
+3 ;
PTTPLST(SCTEAM,SCDATE,SCPTTP) ; -- create list of patients assigned to team positions
+1 ; -- sort list by dfn and position ien
+2 NEW SCPOS,SCDTE,SCPR,SCPRX
+3 ;
+4 ; -- check for patient-position assignments
+5 DO DATE^SCMCMU1(SCDATE,.SCDTE)
+6 SET SCPOS=$NAME(^TMP("SCMU",$JOB,"POSITION"))
+7 ;
+8 ; -- get list of positions for team
+9 KILL @SCPOS
+10 IF '$$TPTM^SCAPMC24(SCTEAM,SCDTE,"","",SCPOS)
SET Y=-1
GOTO PTTPLSTQ
+11 SET SCPR=0
+12 FOR
SET SCPR=$ORDER(@SCPOS@(SCPR))
if 'SCPR
QUIT
Begin DoDot:1
+13 SET SCPRX=@SCPOS@(SCPR)
+14 ; -- create sorted list of dfn by position ien
+15 DO PTTP(+SCPRX,SCDATE,SCPTTP)
+16 QUIT
End DoDot:1
PTTPLSTQ KILL @SCPOS
+1 QUIT
+2 ;
PTTP(SCPOS,SCDATE,SCPTTP) ; -- create list of pats assigned to position sort by dfn, position
+1 NEW SCPAT,SCPATX,SCPATS,SCDTE
+2 DO DATE^SCMCMU1(SCDATE,.SCDTE)
+3 SET SCPATS=$NAME(^TMP("SCMU",$JOB,"PATIENT"))
+4 KILL @SCPATS
+5 IF '$$PTTP^SCAPMC(SCPOS,SCDTE,SCPATS)
SET SCOK=0
GOTO PTTPQ
+6 SET SCPAT=0
+7 FOR
SET SCPAT=$ORDER(@SCPATS@(SCPAT))
if 'SCPAT
QUIT
Begin DoDot:1
+8 SET SCPATX=@SCPATS@(SCPAT)
+9 ; -- store by dfn / pos data
+10 SET @SCPTTP@(+SCPATX,SCPOS)=SCPATX
+11 QUIT
End DoDot:1
PTTPQ KILL @SCPATS
+1 QUIT
+2 ;
UNASSIGN ; -- unassign selected
+1 ; protocol: SCMC MU UNASSIGN PATIENTS
+2 NEW DIR,Y
+3 IF 'SCSELCNT
Begin DoDot:1
+4 WRITE !!,"No patients have been selected.",!
+5 DO PAUSE^SCMCMU1
+6 DO BACK^SCMCMU1("")
+7 QUIT
End DoDot:1
GOTO UNQ
+8 IF '$TEST
Begin DoDot:1
+9 DO FULL^VALM1
+10 WRITE @IOF
+11 SET DIR(0)="YA"
+12 DO SET("----------------------------------------------------------------------------")
+13 DO SET(" Team"_$SELECT(SCMUTYPE="P":" Position",1:"")_" Unassignment Definition")
+14 DO SET("----------------------------------------------------------------------------")
+15 DO SET(" Team : "_$PIECE($GET(^SCTM(404.51,SCTEAM,0),"Unknown"),U))
+16 IF SCMUTYPE="P"
DO SET(" Position : "_$PIECE($GET(^SCTM(404.57,SCPOS,0),"Unknown"),U))
+17 DO SET(" Effective Date : "_$$FMTE^XLFDT($EXTRACT(SCDATE,1,7),"5Z"))
+18 DO SET(" # of Patients : "_SCSELCNT)
+19 DO CLINIC
+20 DO SET(" ")
+21 SET DIR("A")="Are you sure you want to continue? "
+22 SET DIR("B")="No"
+23 DO ^DIR
+24 IF Y=1
Begin DoDot:2
+25 NEW DIR,SCTSK
+26 SET SCTSK=$$QUE^SCMCMU2()
+27 IF SCTSK=""
Begin DoDot:3
+28 DO BACK^SCMCMU1("R")
End DoDot:3
+29 IF '$TEST
Begin DoDot:3
+30 WRITE !!,"Task#: ",SCTSK,!
End DoDot:3
+31 DO PAUSE^SCMCMU1
+32 QUIT
End DoDot:2
+33 IF '$TEST
Begin DoDot:2
+34 DO BACK^SCMCMU1("R")
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
UNQ QUIT
+1 ;
CLINIC ; -- display clinic to be discharged from
+1 NEW SCPOS,SCX,Y
+2 DO SET(" ")
+3 IF '$ORDER(SCTPDIS(0))
Begin DoDot:1
+4 DO SET(" Clinic Discharges: None")
End DoDot:1
GOTO CLINICQ
+5 ;
+6 SET Y=""
+7 SET Y=$$SETSTR^VALM1("Clinic Discharges:",Y,5,20)
+8 SET Y=$$SETSTR^VALM1("Position",Y,25,25)
+9 SET Y=$$SETSTR^VALM1("Associated Clinic",Y,55,25)
+10 DO SET(Y)
+11 SET Y=""
+12 SET Y=$$SETSTR^VALM1("--------",Y,25,25)
+13 SET Y=$$SETSTR^VALM1("-----------------",Y,55,25)
+14 DO SET(Y)
+15 ;
+16 SET SCPOS=0
+17 FOR
SET SCPOS=$ORDER(SCTPDIS(SCPOS))
if 'SCPOS
QUIT
Begin DoDot:1
+18 SET SCX=$GET(^SCTM(404.57,SCPOS,0),"Unknown")
+19 SET Y=""
+20 SET Y=$$SETSTR^VALM1($EXTRACT($PIECE(SCX,U),1,25),Y,25,25)
+21 SET Y=$$SETSTR^VALM1($EXTRACT($PIECE($GET(^SC(+$PIECE(SCX,U,9),0),"Unknown"),U),1,25),Y,55,25)
+22 DO SET(Y)
+23 QUIT
End DoDot:1
+24 ;
CLINICQ QUIT
+1 ;
SET(X) ; -- set DIR text
+1 SET DIR("A",$ORDER(DIR("A",""),-1)+1)=X
+2 QUIT
+3 ;
QUIT ; -- quit logic
+1 ; protocol: SCMC MU QUIT
+2 NEW DIR,Y
+3 SET Y=0
+4 IF SCSELCNT
Begin DoDot:1
+5 WRITE !
+6 SET DIR(0)="YA"
+7 SET DIR("A",1)="You have "_SCSELCNT_" patient"_$SELECT(SCSELCNT=1:"",1:"s")_" selected."
+8 SET DIR("A",2)=" "
+9 SET DIR("A")="Are you sure you want to quit? "
+10 SET DIR("B")="No"
+11 DO ^DIR
+12 IF Y'=1
DO BACK^SCMCMU1("")
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
