SCMCRT0.m

SCMCRT0 ;ALB/SCK - PCM REPORT OUTPUTS ; 10/30/95

 ;;5.3;Scheduling;**41**;AUG 13, 1993

 ;;1T1; Primary Care Management

 ;

 Q

 ;

TMPRFL ;   Team Profile Report Entry point

 ;

 N SCTMS,SCPOS,SCBRK,SCTEAMS

 I '$$SELTM G EXIT

 I '$$SELPOS(SCTMS) G EXIT

 S SCBRK=$$PAGEBRK("Team") G:SCBRK="" EXIT

 IF '$$GETDEV G EXIT

 IF $D(IO("Q")) D QUE  G EXIT

 W ! D WAIT^DICD

 D START^SCMCRT1(SCTMS,SCPOS,.SCTEAMS,SCBRK)

EXIT ;

 D:'$D(ZTQUEUED) ^%ZISC

 K ^TMP("PCMTP",$J)

 Q

 ;

SELTM() ;

 N SCOK

 S SCOK=1

 W !!,$$LINE("Team Selection")

 I '$$TMS S SCOK=0 G SELTMQ

 IF SCTMS="S" S SCTMS=10 D  G:'SCOK SELTMQ

 . S DIC="^SCTM(404.51,",VAUTSTR="Team",VAUTVB="SCTEAMS",VAUTNI=2

 . D FIRST^VAUTOMA

 . I Y<0 K SCTMS S SCOK=0

 S:SCTMS="A" SCTMS=1

 S:SCTMS="I" SCTMS=0

 ;

SELTMQ Q SCOK

 ;

SELPOS(SCTMS) ;

 N SCOK

 S SCOK=1

 IF SCTMS=0 S SCPOS=-1  G SELPSQ

 ;

 W !!,$$LINE("Position Selection")

 S DIR(0)="S^A:Active Positions;I:Inactive Positions;P:All Positions"

 S DIR("A")="Positons: ",DIR("B")="A"

 D ^DIR

 I $D(DIRUT) S SCOK=0 G SELPSQ

 S:Y="A" SCPOS=1

 S:Y="I" SCPOS=0

 S:Y="P" SCPOS=-1

SELPSQ Q SCOK

 ;

GETDEV() ;

 N SCOK

 S SCOK=0

 W !!,"This report is formatted for standard letter size output",!

 S %ZIS="PMQ" D ^%ZIS  G DEVQ:POP

 S SCOK=1

DEVQ Q (SCOK)

 ;

TMS() ;

 N SCOK

 S SCOK=1

 S DIR(0)="S^A:Active Teams;I:Inactive Teams;S:Select Teams"

 S DIR("A")="Teams: ",DIR("B")="A"

 D ^DIR

 S SCTMS=Y

 I $D(DIRUT) S SCOK=0

TMSQ Q SCOK

 ;

LINE(STR) ;

 N X

 S:STR]"" STR=" "_STR_" "

 S $P(X,"_",(IOM/2)-($L(STR)/2))=""

 Q X_STR_X

 ;

PAGEBRK(STR) ;

 N X

 S DIR(0)="Y",DIR("B")="NO"

 S DIR("A")="Do you want a page break as the "_STR_" changes?"

 D ^DIR

 I $D(DIRUT) S Y=""

 Q Y

 ;

QUE ;

 S ZTRTN="QSTART^SCMCRT1",ZTDESC="TEAM PROFILE REPORT"

 F X="SCTMS","SCPOS","SCTEAMS(","SCBRK" S ZTSAVE(X)=""

 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK

 D HOME^%ZIS K IO("Q")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCMCRT0   1930     printed  Feb 19, 2025@00:07:46                                                                                                                                                                                                     Page 2

SCMCRT0   ;ALB/SCK - PCM REPORT OUTPUTS ; 10/30/95

 +1       ;;5.3;Scheduling;**41**;AUG 13, 1993

 +2       ;;1T1; Primary Care Management

 +3       ;

 +4        QUIT 

 +5       ;

TMPRFL    ;   Team Profile Report Entry point

 +1       ;

 +2        NEW SCTMS,SCPOS,SCBRK,SCTEAMS

 +3        IF '$$SELTM

               GOTO EXIT

 +4        IF '$$SELPOS(SCTMS)

               GOTO EXIT

 +5        SET SCBRK=$$PAGEBRK("Team")

           if SCBRK=""

               GOTO EXIT

 +6        IF '$$GETDEV

               GOTO EXIT

 +7        IF $DATA(IO("Q"))

               DO QUE

               GOTO EXIT

 +8        WRITE !

           DO WAIT^DICD

 +9        DO START^SCMCRT1(SCTMS,SCPOS,.SCTEAMS,SCBRK)

EXIT      ;

 +1        if '$DATA(ZTQUEUED)

               DO ^%ZISC

 +2        KILL ^TMP("PCMTP",$JOB)

 +3        QUIT 

 +4       ;

SELTM()   ;

 +1        NEW SCOK

 +2        SET SCOK=1

 +3        WRITE !!,$$LINE("Team Selection")

 +4        IF '$$TMS

               SET SCOK=0

               GOTO SELTMQ

 +5        IF SCTMS="S"

               SET SCTMS=10

               Begin DoDot:1

 +6                SET DIC="^SCTM(404.51,"

                   SET VAUTSTR="Team"

                   SET VAUTVB="SCTEAMS"

                   SET VAUTNI=2

 +7                DO FIRST^VAUTOMA

 +8                IF Y<0

                       KILL SCTMS

                       SET SCOK=0

               End DoDot:1

               if 'SCOK

                   GOTO SELTMQ

 +9        if SCTMS="A"

               SET SCTMS=1

 +10       if SCTMS="I"

               SET SCTMS=0

 +11      ;

SELTMQ     QUIT SCOK

 +1       ;

SELPOS(SCTMS) ;

 +1        NEW SCOK

 +2        SET SCOK=1

 +3        IF SCTMS=0

               SET SCPOS=-1

               GOTO SELPSQ

 +4       ;

 +5        WRITE !!,$$LINE("Position Selection")

 +6        SET DIR(0)="S^A:Active Positions;I:Inactive Positions;P:All Positions"

 +7        SET DIR("A")="Positons: "

           SET DIR("B")="A"

 +8        DO ^DIR

 +9        IF $DATA(DIRUT)

               SET SCOK=0

               GOTO SELPSQ

 +10       if Y="A"

               SET SCPOS=1

 +11       if Y="I"

               SET SCPOS=0

 +12       if Y="P"

               SET SCPOS=-1

SELPSQ     QUIT SCOK

 +1       ;

GETDEV()  ;

 +1        NEW SCOK

 +2        SET SCOK=0

 +3        WRITE !!,"This report is formatted for standard letter size output",!

 +4        SET %ZIS="PMQ"

           DO ^%ZIS

           if POP

               GOTO DEVQ

 +5        SET SCOK=1

DEVQ       QUIT (SCOK)

 +1       ;

TMS()     ;

 +1        NEW SCOK

 +2        SET SCOK=1

 +3        SET DIR(0)="S^A:Active Teams;I:Inactive Teams;S:Select Teams"

 +4        SET DIR("A")="Teams: "

           SET DIR("B")="A"

 +5        DO ^DIR

 +6        SET SCTMS=Y

 +7        IF $DATA(DIRUT)

               SET SCOK=0

TMSQ       QUIT SCOK

 +1       ;

LINE(STR) ;

 +1        NEW X

 +2        if STR]""

               SET STR=" "_STR_" "

 +3        SET $PIECE(X,"_",(IOM/2)-($LENGTH(STR)/2))=""

 +4        QUIT X_STR_X

 +5       ;

PAGEBRK(STR) ;

 +1        NEW X

 +2        SET DIR(0)="Y"

           SET DIR("B")="NO"

 +3        SET DIR("A")="Do you want a page break as the "_STR_" changes?"

 +4        DO ^DIR

 +5        IF $DATA(DIRUT)

               SET Y=""

 +6        QUIT Y

 +7       ;

QUE       ;

 +1        SET ZTRTN="QSTART^SCMCRT1"

           SET ZTDESC="TEAM PROFILE REPORT"

 +2        FOR X="SCTMS","SCPOS","SCTEAMS(","SCBRK"

               SET ZTSAVE(X)=""

 +3        DO ^%ZTLOAD

           if $DATA(ZTSK)

               WRITE !,"TASK #",ZTSK

 +4        DO HOME^%ZIS

           KILL IO("Q")

 +5        QUIT