SCMCRT1A ;ALB/SCK - PCM TEAM PROFILE REPORT OUTPUT ; 10/30/95
;;5.3;Scheduling;**41**;AUG 13, 1993
;;1T1; Primary Care Management
;
Q
;
TMRPT(SCBRK) ;
N PAGE,SCTEAM,SCPOST,SCWPND,SCWP,LINECNT
I '$D(^TMP("PCMTP",$J)) D NOREP G EXIT
U IO
S (PAGE,LINECNT,END)=0
;D HDR Q:END
;
S SCTEAM=""
F S SCTEAM=$O(^TMP("PCMTP",$J,SCTEAM)) Q:SCTEAM="" D:+SCBRK NEWPAGE D G:END EXIT
. N SCWPND
. D PRINT1(^TMP("PCMTP",$J,SCTEAM,0))
. S SCWP="",SCWPND=""
. F S SCWP=$O(^TMP("PCMTP",$J,SCTEAM,"D",SCWP)) Q:SCWP="" D Q:END
.. S SCWPND(SCWP)=^TMP("PCMTP",$J,SCTEAM,"D",SCWP)
. IF $D(SCWPND) D PRINTW(.SCWPND)
. D PRINT2(SCTEAM,^TMP("PCMTP",$J,SCTEAM,0))
. S SCPOST=""
. D PRINTCP Q:END
. F S SCPOST=$O(^TMP("PCMTP",$J,SCTEAM,"P",SCPOST)) Q:SCPOST="" D Q:END
.. D PRINTP(SCPOST,^TMP("PCMTP",$J,SCTEAM,"P",SCPOST))
. W !!
;
EXIT ;
D ^%ZISC
Q
;
PRINT1(SCNODE) ;
N X,X1
I $Y+5>IOSL D HDR Q:END
N SCSERV
S SCSERV=$P($G(SCNODE),U,6)
S X=$$SPACE(5)_"Team Name: "_$P($G(SCNODE),U)
S X=X_$$SPACE(45-$L(X))_"Service/Section: "_$E($P($G(^DIC(49,SCSERV,0)),U),1,20)
W !,X
;
S X=$$SPACE(5)_"Team Telephone: "_$P($G(SCNODE),U,2)
W !,X
Q
;
PRINTCP ;
I $Y+8>IOSL D HDR Q:END
S X=$$SPACE(56)_"Provides Patients"
W !,X
S X=$$SPACE(5)_"Position"_$$SPACE(19)_"Standard Role"_$$SPACE(13)_"Care"_$$SPACE(10)_"Allowed"
W !,X
S X=$$SPACE(5)_"--------"_$$SPACE(19)_"-------------"_$$SPACE(13)_"--------"_$$SPACE(6)_"-------"
W !,X
Q
;
PRINT2(SCIEN,SCNODE) ;
N X
I $Y+8>IOSL D HDR Q:END
N SCPRP,SCMAX,SCINST
S SCPRP=$P($G(SCNODE),U,3)
S SCMAX=$P($G(SCNODE),U,8)
S SCINST=$P($G(SCNODE),U,7)
S X=$$SPACE(5)_"Team Settings:"
W !!,X
;
S X=$$SPACE(6)_"Status: "_$S(+$$ACTHISTB^SCAPMCU2(404.58,SCIEN)=1:"ACTIVE",1:"INACTIVE")
S X=X_$$SPACE(45-$L(X))_"Purpose: "_$E($P($G(^SD(403.47,SCPRP,0)),U),1,20)
W !,X
;
S X=$$SPACE(6)_"Maximum Patients: "_$S(SCMAX]"":SCMAX,1:0)
S X=X_$$SPACE(45-$L(X))_"Institution: "_$E($P($G(^DIC(4,SCINST,0)),U),1,20)
W !,X
;
S X=$$SPACE(5)_$S($P($G(SCNODE),U,5)=1:"This team can provide primary care.",1:"This is not a primary care team")
W !!,X
;
S X=$$SPACE(5)_$S($P($G(SCNODE),U,10)=1:"This team is closed to further patients.",1:"This team is still accepting patients.")
W !,X
Q
;
PRINTW(SCDES) ;
N NC,DIWL,DIWR,DIWF,WP
I $Y+5>IOSL D HDR Q:END
K ^UTILITY($J,"W")
S WP=$$SPACE(5)_"Team Description:"
W !!,WP
S DIWL=10,DIWR=80,DIWF="C60"
S NC=""
F S NC=$O(SCDES(NC)) Q:NC="" D D ^DIWW
. S X=SCDES(NC)
. D ^DIWP
;
S X=""
F S X=$O(^UTILITY($J,"W",DIWL,X)) Q:X="" D
. S WP=$$SPACE(5)_^UTILTIY($J,"W",DIWL,1,0)
. W !,WP
W !
K ^UTILITY($J,"W")
Q
;
PRINTP(SCPOS,SCPNODE) ;
N X
I $Y+5>IOSL D HDR Q:END
S X=$$SPACE(4)_$S($P(SCPNODE,U,5)=1:">",1:" ")_$E(SCPOS,1,28)
S X=X_$$SPACE(31-$L(X))_$E($P(SCPNODE,U,2),1,25)
S X=X_$$SPACE(56-$L(X))_$P(SCPNODE,U,3)
S X=X_$$SPACE(70-$L(X))_$P(SCPNODE,U,4)
W !,X
Q
;
NOREP ;
W !!,"No Information for the Team Profile report"
Q
;
RPTHDR ;
S X=$$SPACE(5)_"Primary Care Management Team Profile Report"
W !,X
S X=$$SPACE(5)_"Report Date: "_$P($$NOW^VALM1,"@")
S X=X_$$SPACE(70-$L(X))_"Page: "_PAGE
W !,X,!!
Q
;
HDR ;
IF $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
;
HDR1 W:'($E(IOST,1,2)'="C-"&'PAGE) @IOF
HDR2 S PAGE=PAGE+1
D RPTHDR
Q
;
LINE() ;
N X
S $P(X,"=",80)=""
Q X
;
SPACE(SCNUM) ;
N X
S $P(X," ",SCNUM)=""
Q X
;
WRITE(DEV,STR) ;
W @STR
Q
;
NEWPAGE ;
W @IOF
D HDR2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCRT1A 3632 printed Oct 16, 2024@18:41:57 Page 2
SCMCRT1A ;ALB/SCK - PCM TEAM PROFILE REPORT OUTPUT ; 10/30/95
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;;1T1; Primary Care Management
+3 ;
+4 QUIT
+5 ;
TMRPT(SCBRK) ;
+1 NEW PAGE,SCTEAM,SCPOST,SCWPND,SCWP,LINECNT
+2 IF '$DATA(^TMP("PCMTP",$JOB))
DO NOREP
GOTO EXIT
+3 USE IO
+4 SET (PAGE,LINECNT,END)=0
+5 ;D HDR Q:END
+6 ;
+7 SET SCTEAM=""
+8 FOR
SET SCTEAM=$ORDER(^TMP("PCMTP",$JOB,SCTEAM))
if SCTEAM=""
QUIT
if +SCBRK
DO NEWPAGE
Begin DoDot:1
+9 NEW SCWPND
+10 DO PRINT1(^TMP("PCMTP",$JOB,SCTEAM,0))
+11 SET SCWP=""
SET SCWPND=""
+12 FOR
SET SCWP=$ORDER(^TMP("PCMTP",$JOB,SCTEAM,"D",SCWP))
if SCWP=""
QUIT
Begin DoDot:2
+13 SET SCWPND(SCWP)=^TMP("PCMTP",$JOB,SCTEAM,"D",SCWP)
End DoDot:2
if END
QUIT
+14 IF $DATA(SCWPND)
DO PRINTW(.SCWPND)
+15 DO PRINT2(SCTEAM,^TMP("PCMTP",$JOB,SCTEAM,0))
+16 SET SCPOST=""
+17 DO PRINTCP
if END
QUIT
+18 FOR
SET SCPOST=$ORDER(^TMP("PCMTP",$JOB,SCTEAM,"P",SCPOST))
if SCPOST=""
QUIT
Begin DoDot:2
+19 DO PRINTP(SCPOST,^TMP("PCMTP",$JOB,SCTEAM,"P",SCPOST))
End DoDot:2
if END
QUIT
+20 WRITE !!
End DoDot:1
if END
GOTO EXIT
+21 ;
EXIT ;
+1 DO ^%ZISC
+2 QUIT
+3 ;
PRINT1(SCNODE) ;
+1 NEW X,X1
+2 IF $Y+5>IOSL
DO HDR
if END
QUIT
+3 NEW SCSERV
+4 SET SCSERV=$PIECE($GET(SCNODE),U,6)
+5 SET X=$$SPACE(5)_"Team Name: "_$PIECE($GET(SCNODE),U)
+6 SET X=X_$$SPACE(45-$LENGTH(X))_"Service/Section: "_$EXTRACT($PIECE($GET(^DIC(49,SCSERV,0)),U),1,20)
+7 WRITE !,X
+8 ;
+9 SET X=$$SPACE(5)_"Team Telephone: "_$PIECE($GET(SCNODE),U,2)
+10 WRITE !,X
+11 QUIT
+12 ;
PRINTCP ;
+1 IF $Y+8>IOSL
DO HDR
if END
QUIT
+2 SET X=$$SPACE(56)_"Provides Patients"
+3 WRITE !,X
+4 SET X=$$SPACE(5)_"Position"_$$SPACE(19)_"Standard Role"_$$SPACE(13)_"Care"_$$SPACE(10)_"Allowed"
+5 WRITE !,X
+6 SET X=$$SPACE(5)_"--------"_$$SPACE(19)_"-------------"_$$SPACE(13)_"--------"_$$SPACE(6)_"-------"
+7 WRITE !,X
+8 QUIT
+9 ;
PRINT2(SCIEN,SCNODE) ;
+1 NEW X
+2 IF $Y+8>IOSL
DO HDR
if END
QUIT
+3 NEW SCPRP,SCMAX,SCINST
+4 SET SCPRP=$PIECE($GET(SCNODE),U,3)
+5 SET SCMAX=$PIECE($GET(SCNODE),U,8)
+6 SET SCINST=$PIECE($GET(SCNODE),U,7)
+7 SET X=$$SPACE(5)_"Team Settings:"
+8 WRITE !!,X
+9 ;
+10 SET X=$$SPACE(6)_"Status: "_$SELECT(+$$ACTHISTB^SCAPMCU2(404.58,SCIEN)=1:"ACTIVE",1:"INACTIVE")
+11 SET X=X_$$SPACE(45-$LENGTH(X))_"Purpose: "_$EXTRACT($PIECE($GET(^SD(403.47,SCPRP,0)),U),1,20)
+12 WRITE !,X
+13 ;
+14 SET X=$$SPACE(6)_"Maximum Patients: "_$SELECT(SCMAX]"":SCMAX,1:0)
+15 SET X=X_$$SPACE(45-$LENGTH(X))_"Institution: "_$EXTRACT($PIECE($GET(^DIC(4,SCINST,0)),U),1,20)
+16 WRITE !,X
+17 ;
+18 SET X=$$SPACE(5)_$SELECT($PIECE($GET(SCNODE),U,5)=1:"This team can provide primary care.",1:"This is not a primary care team")
+19 WRITE !!,X
+20 ;
+21 SET X=$$SPACE(5)_$SELECT($PIECE($GET(SCNODE),U,10)=1:"This team is closed to further patients.",1:"This team is still accepting patients.")
+22 WRITE !,X
+23 QUIT
+24 ;
PRINTW(SCDES) ;
+1 NEW NC,DIWL,DIWR,DIWF,WP
+2 IF $Y+5>IOSL
DO HDR
if END
QUIT
+3 KILL ^UTILITY($JOB,"W")
+4 SET WP=$$SPACE(5)_"Team Description:"
+5 WRITE !!,WP
+6 SET DIWL=10
SET DIWR=80
SET DIWF="C60"
+7 SET NC=""
+8 FOR
SET NC=$ORDER(SCDES(NC))
if NC=""
QUIT
Begin DoDot:1
+9 SET X=SCDES(NC)
+10 DO ^DIWP
End DoDot:1
DO ^DIWW
+11 ;
+12 SET X=""
+13 FOR
SET X=$ORDER(^UTILITY($JOB,"W",DIWL,X))
if X=""
QUIT
Begin DoDot:1
+14 SET WP=$$SPACE(5)_^UTILTIY($JOB,"W",DIWL,1,0)
+15 WRITE !,WP
End DoDot:1
+16 WRITE !
+17 KILL ^UTILITY($JOB,"W")
+18 QUIT
+19 ;
PRINTP(SCPOS,SCPNODE) ;
+1 NEW X
+2 IF $Y+5>IOSL
DO HDR
if END
QUIT
+3 SET X=$$SPACE(4)_$SELECT($PIECE(SCPNODE,U,5)=1:">",1:" ")_$EXTRACT(SCPOS,1,28)
+4 SET X=X_$$SPACE(31-$LENGTH(X))_$EXTRACT($PIECE(SCPNODE,U,2),1,25)
+5 SET X=X_$$SPACE(56-$LENGTH(X))_$PIECE(SCPNODE,U,3)
+6 SET X=X_$$SPACE(70-$LENGTH(X))_$PIECE(SCPNODE,U,4)
+7 WRITE !,X
+8 QUIT
+9 ;
NOREP ;
+1 WRITE !!,"No Information for the Team Profile report"
+2 QUIT
+3 ;
RPTHDR ;
+1 SET X=$$SPACE(5)_"Primary Care Management Team Profile Report"
+2 WRITE !,X
+3 SET X=$$SPACE(5)_"Report Date: "_$PIECE($$NOW^VALM1,"@")
+4 SET X=X_$$SPACE(70-$LENGTH(X))_"Page: "_PAGE
+5 WRITE !,X,!!
+6 QUIT
+7 ;
HDR ;
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue or '^' to exit: "
READ X:DTIME
SET END='$TEST!(X="^")
if END
QUIT
+2 ;
HDR1 if '($EXTRACT(IOST,1,2)'="C-"&'PAGE)
WRITE @IOF
HDR2 SET PAGE=PAGE+1
+1 DO RPTHDR
+2 QUIT
+3 ;
LINE() ;
+1 NEW X
+2 SET $PIECE(X,"=",80)=""
+3 QUIT X
+4 ;
SPACE(SCNUM) ;
+1 NEW X
+2 SET $PIECE(X," ",SCNUM)=""
+3 QUIT X
+4 ;
WRITE(DEV,STR) ;
+1 WRITE @STR
+2 QUIT
+3 ;
NEWPAGE ;
+1 WRITE @IOF
+2 DO HDR2
+3 QUIT
