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 ---[H[J[2J[HSCMCRT0 1930 printed Apr 09, 2024@21:44:34 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
