SCMCMU11.m

SCMCMU11 ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998

 ;;5.3;Scheduling;**148,1015**;AUG 13, 1993;Build 21

 ;

 ;

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

 ;

SCMCMU11  ;ALB/MJK - PCMM Mass Team/Position Unassignment ; 10-JUL-1998

 +1       ;;5.3;Scheduling;**148,1015**;AUG 13, 1993;Build 21

 +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      ;