- 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 Feb 19, 2025@00:07:47 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