SCMCCV4 ; bp-ciofo/vad - PCMM PC Attending Assignments Report ; 05 May 99 9:05 AM
;;5.3;Scheduling;**195**;AUG 13, 1993
;
; List those assignments that are for PC Attending. This is to easily
; inform the user of these assignments since they are no longer valid
; as a result of the enhancements from the PCMM Phase II (177) release.
;
; This report is sent to the user as a Mailman Message.
;
; This routine is part of a Pre-Release Patch to 177. The Pre-Release
; Patch number is 195.
; -------------------------------------------------------------------
;
Q
;
;
; -------------------------------------------------------------------
MAIN ; Main module to drive this routine
; -------------------------------------------------------------------
K SCY
S SCY(1)=""
S SCY(2)="PCMM PC Attending Assignments Report"
S SCY(3)=$$DTU^SCMCCV3()
S SCY(4)="------------------------------------"
S SCY(5)=$$QIT
K ZTSK
S SCY(6)=""
D EN^DDIOL(.SCY)
Q
;
; -------------------------------------------------------------------
QIT() ; Module to QUEUE and Run this job in the Background.
; -------------------------------------------------------------------
N SCX,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="MAINQ^SCMCCV4"
S ZTDESC="PCMM PC Attending Assignments Report"
S ZTDTH=$H
S ZTIO=""
S SCMCSTOP=$$ASKTEAM()
F SCX="SCMCSTOP","SCMCTM","SCMCTM(","SCTMNAM","SCTMNAM(" S ZTSAVE(SCX)=""
D ^%ZTLOAD
Q "==> "_$S(+ZTSK:" Queued - Task # "_ZTSK,1:" Not Queued!")
;
; -------------------------------------------------------------------
MAINQ ; Main module to drive this routine
; -------------------------------------------------------------------
S STORE="^TMP(""SCMCCV4"",$J)"
S REPORT="^TMP(""SCMC-RPT"",$J)"
K @STORE,@REPORT
I SCMCSTOP D EXIT Q
;
D RUNIT
;
Q
;
; -------------------------------------------------------------------
RUNIT ; Module to gather the data and print the report.
; -------------------------------------------------------------------
D SCPTLP ; Process thru the ^SCPT(404.43) global.
D PRINT ; Store the Report in a Temp array.
I 'SCGOTONE D ; No data to print.
. F I=1:1:3 S STRING=" " X SCLNUP
. S STRING=$E(SCBLK,1,5)_"Zero Team Position Assignments were found based upon selection criteria."
. X SCLNUP
;
D MAILIT ; Queue the report as a Mailman Message.
D EXIT
Q
;
; -------------------------------------------------------------------
ASKTEAM() ; Prompt for "A"ll or "S"elected Teams.
; -------------------------------------------------------------------
; Sets up the SCMCTM and SCTMNAM arrays.
; Returns a "1" to STOP, or a "0" to CONTINUE.
;
N STOP
K SCMCTM,SCTMNAM
S (STOP,SCMCTM,SCTMNAM)=0
S SCMCTYPE=$$TYPE() ; Gets the type of selections (all or selected)
I SCMCTYPE=0 S STOP=1 Q STOP
;
I SCMCTYPE="A" Q STOP
;
I SCMCTYPE="S" D TMLP S:'+SCMCTM STOP=1
Q STOP
;
; -------------------------------------------------------------------
TYPE() ; Ask the user to enter "A"ll or "S"elected teams.
; -------------------------------------------------------------------
; "A" means All Teams.
; "S" means Select Teams.
; Returns a "0" to quit or a "1" to continue.
;
N DIR
S DIR(0)="SM^A:All Teams;S:Specific Teams"
S DIR("?",1)="Select A for a report of All Teams"
S DIR("?",2)="Select S for a report of Specific Teams"
S DIR("?",3)=" "
;
D ^DIR
Q $S($D(DIRUT):0,1:Y)
;
; -------------------------------------------------------------------
TMLP ; Allow the user to select multiple teams.
; -------------------------------------------------------------------
; Sets up the SCMCTM and SCTMNAM arrays with the teams.
; Sets SCSTOP=1 to stop selection.
;
N SCSTOP,SCCTR,SCTMREC
S (SCSTOP,SCCTR)=0
F D I SCSTOP Q
. N TM
. S TM=$$TEAM^SCMCMU(DT)
. I (TM>0),'$D(SCMCTM(TM)) D
. . S SCMCTM(TM)="",SCCTR=SCCTR+1
. . S SCTMREC=$G(^SCTM(404.51,TM,0))
. . S SCTMNAM($P(SCTMREC,U,1))=TM
. E S SCSTOP=1
. Q
S (SCMCTM,SCTMNAM)=SCCTR
Q
;
; -------------------------------------------------------------------
SCPTLP ; Process the ^SCPT(404.43) global to gather reportable data.
; -------------------------------------------------------------------
N SCTNAME,SCMCVAR,SCZZPROV,SCMCERR,SCG,SCG2
S (DFN,SCACTDT,SCTMPOS,SCTNAME,SCSEQ1,SCSTATUS)=""
F S SCTNAME=$O(SCTMNAM(SCTNAME)) Q:SCTNAME="" D
. S @STORE@("B",SCTNAME)=0
;
S SCG="^SCPT(404.43,""APCPOS"")"
F S DFN=$O(@SCG@(DFN)) Q:DFN="" D
. I '$D(@SCG@(DFN,2)) Q ; Attending only
. N VA,VADM,VAERR
. D DEM^VADPT
. S SCPTNM=$G(VADM(1),"Invalid Name:"_DFN) ;patient name
. S SCPTSSN=$G(VA("PID"),"Invalid PID:"_DFN) ;patient SSN
. ;
. S SCG2="^SCPT(404.43,""APCPOS"","_DFN_",2)"
. F S SCACTDT=$O(@SCG2@(SCACTDT)) Q:SCACTDT="" D
. . F S SCTMPOS=$O(@SCG2@(SCACTDT,SCTMPOS)) Q:SCTMPOS="" D
. . . F S SCSEQ1=$O(@SCG2@(SCACTDT,SCTMPOS,SCSEQ1)) Q:SCSEQ1="" D
. . . . S SCREC1=$G(^SCPT(404.43,SCSEQ1,0))
. . . . I +$P(SCREC1,U,4),$P(SCREC1,U,4)<DT Q ;no old discharges
. . . . S Y=$P(SCREC1,U,3)
. . . . S SCASNDT=$$FMTE^DILIBF(Y,"6U") ;mm-dd-yyyy
. . . . ;
. . . . S SCREC2=$G(^SCTM(404.57,SCTMPOS,0))
. . . . S SCPOSNM=$P(SCREC2,U,1)
. . . . S SCTMNO=$P(SCREC2,U,2)
. . . . Q:(+SCTMNO<1)!('$D(^SCTM(404.51,SCTMNO,0)))
. . . . ;
. . . . I +SCMCTM,'$D(SCMCTM(SCTMNO)) Q ;not a selected Team
. . . . ;
. . . . S SCREC3=$G(^SCTM(404.51,SCTMNO,0))
. . . . S SCTMNM=$P(SCREC3,U,1)
. . . . ;
. . . . N SCMCVAR,SCDATES,SCZZPROV,SCMCERR
. . . . S SCMCVAR=$$PRTP^SCAPMC8(SCTMPOS,"SCDATES","SCZZPROV","SCMCERR")
. . . . I 'SCMCVAR Q
. . . . I '$D(SCZZPROV(1)) Q
. . . . ; There should be only one provider for this day
. . . . S SCPHYPOS=$P(SCZZPROV(1),U,4)_" ("_$P(SCZZPROV(1),U,2)_")"
. . . . ; Store a data record.
. . . . N SCCNT
. . . . S SCCNT=+$G(@STORE@(SCTMNO,0))+1
. . . . S @STORE@("B",SCTMNM)=SCTMNO
. . . . S @STORE@(SCTMNO,0)=SCCNT
. . . . S @STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN,SCACTDT,SCCNT)=""
. . . . S @STORE@(SCTMNO,SCCNT)=SCTMNM_U_SCPHYPOS_U_SCPTNM_U_SCPTSSN_U_SCASNDT
. . . . Q
. . . Q
. . Q
. Q
Q
;
; -------------------------------------------------------------------
PRINT ; Store the report in temp array prior to a Mailman Message.
; -------------------------------------------------------------------
S (SCTMNM,SCPHYPOS,SCPTNM,SCPTSSN,SCASNDT)=""
S (SCGOTONE,SCSTOP,SCLNSEQ)=0
S SCLNUP="S SCLNSEQ=SCLNSEQ+1,@REPORT@(SCLNSEQ)=STRING"
S SCRPDT=$$FMTE^XLFDT($$NOW^XLFDT())
S SCBLK=" ",$P(SCBLK," ",80)=" "
S SCDSH="-",$P(SCDSH,"-",80)="-"
S SCDBL="=",$P(SCDBL,"=",80)="="
;
S STRING=$E(SCBLK,1,15)_"PCMM PC Attending Assignments Report - "_SCRPDT
X SCLNUP
S STRING=$E(SCBLK,1,$S(+SCMCTM:26,1:23))_"Selection Criteria: "_$S(+SCMCTM:"SELECTED",1:"ALL")_" TEAMS"
X SCLNUP
;
F S SCTMNM=$O(@STORE@("B",SCTMNM)) Q:SCTMNM="" D
. D PRTTMHDR
. S SCTMNO=@STORE@("B",SCTMNM)
. I SCTMNO=0 D Q
. . S STRING=$E(SCBLK,1,5)_"Zero Team Position Assignments were found within this team."
. . X SCLNUP
. ;
. S SCPHYPOS=""
. F S SCPHYPOS=$O(@STORE@(SCTMNO,1,SCPHYPOS)) Q:SCPHYPOS="" D
. . D PRTPHHDR
. . S SCPTNM=""
. . F S SCPTNM=$O(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM)) Q:SCPTNM="" D
. . . S DFN=0
. . . F S DFN=$O(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN)) Q:'DFN D
. . . . S SCACTDT=0
. . . . F S SCACTDT=$O(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN,SCACTDT)) Q:'SCACTDT D
. . . . . S SCCNT=$O(^(SCACTDT,0))
. . . . . S SCX=@STORE@(SCTMNO,SCCNT)
. . . . . ; Print a Detail Line.
. . . . . S STRING=$$LJ("",10)_$$LJ(SCPTNM,29)_$$LJ($P(SCX,U,4),18)_$P(SCX,U,5)
. . . . . X SCLNUP
. . . . . ;
. . . . . S SCGOTONE=1
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
Q
;
LJ(STRING,LENGTH) Q $$LJ^XLFSTR(STRING,LENGTH)
;
; -------------------------------------------------------------------
PRTTMHDR ; Print the Team Sub-heading.
; -------------------------------------------------------------------
N STRING
;
S STRING=" " F I=1:1:2 X SCLNUP
S STRING=$E(SCDBL,1,11+$L(SCTMNM)) X SCLNUP
S STRING="TEAM NAME: "_SCTMNM X SCLNUP
S STRING=$E(SCDBL,1,11+$L(SCTMNM)) X SCLNUP
S STRING=" " X SCLNUP
S STRING=$E(SCBLK,1,5)_"Positions" X SCLNUP
S STRING=$E(SCBLK,1,5)_$E(SCDSH,1,9) X SCLNUP
Q
;
; -------------------------------------------------------------------
PRTPHHDR ; Print the Physician Sub-heading.
; -------------------------------------------------------------------
N STRING
;
S STRING=" " X SCLNUP
S STRING=$E(SCBLK,1,5)_SCPHYPOS X SCLNUP
S STRING=$E(SCBLK,1,5)_$E(SCDSH,1,$L(SCPHYPOS)) X SCLNUP
;
;
S STRING=" " X SCLNUP
S STRING=$E(SCBLK,1,10)_"Patient Name"_$E(SCBLK,1,17)_"SSN"_$E(SCBLK,1,12)_"Date Assigned"
X SCLNUP
S STRING=$E(SCBLK,1,10)_$E(SCDSH,1,12)_$E(SCBLK,1,17)_"---"_$E(SCBLK,1,12)_$E(SCDSH,1,13)
X SCLNUP
Q
;
; -------------------------------------------------------------------
MAILIT ; Queue the report as a MailMan Message.
; -------------------------------------------------------------------
N XMY,XMDUZ,XMSUB,XMTEXT
S XMDUZ=.5
S (XMY(DUZ),XMY(XMDUZ))=""
S XMSUB="PCMM PC Attending Assignments Report"
S XMTEXT="^TMP(""SCMC-RPT"",$J,"
D ^XMD
Q
;
; -------------------------------------------------------------------
EXIT ; Clean up and Exit
; -------------------------------------------------------------------
K @STORE,@REPORT
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCCV4 9565 printed Sep 23, 2025@20:16:23 Page 2
SCMCCV4 ; bp-ciofo/vad - PCMM PC Attending Assignments Report ; 05 May 99 9:05 AM
+1 ;;5.3;Scheduling;**195**;AUG 13, 1993
+2 ;
+3 ; List those assignments that are for PC Attending. This is to easily
+4 ; inform the user of these assignments since they are no longer valid
+5 ; as a result of the enhancements from the PCMM Phase II (177) release.
+6 ;
+7 ; This report is sent to the user as a Mailman Message.
+8 ;
+9 ; This routine is part of a Pre-Release Patch to 177. The Pre-Release
+10 ; Patch number is 195.
+11 ; -------------------------------------------------------------------
+12 ;
+13 QUIT
+14 ;
+15 ;
+16 ; -------------------------------------------------------------------
MAIN ; Main module to drive this routine
+1 ; -------------------------------------------------------------------
+2 KILL SCY
+3 SET SCY(1)=""
+4 SET SCY(2)="PCMM PC Attending Assignments Report"
+5 SET SCY(3)=$$DTU^SCMCCV3()
+6 SET SCY(4)="------------------------------------"
+7 SET SCY(5)=$$QIT
+8 KILL ZTSK
+9 SET SCY(6)=""
+10 DO EN^DDIOL(.SCY)
+11 QUIT
+12 ;
+13 ; -------------------------------------------------------------------
QIT() ; Module to QUEUE and Run this job in the Background.
+1 ; -------------------------------------------------------------------
+2 NEW SCX,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+3 SET ZTRTN="MAINQ^SCMCCV4"
+4 SET ZTDESC="PCMM PC Attending Assignments Report"
+5 SET ZTDTH=$HOROLOG
+6 SET ZTIO=""
+7 SET SCMCSTOP=$$ASKTEAM()
+8 FOR SCX="SCMCSTOP","SCMCTM","SCMCTM(","SCTMNAM","SCTMNAM("
SET ZTSAVE(SCX)=""
+9 DO ^%ZTLOAD
+10 QUIT "==> "_$SELECT(+ZTSK:" Queued - Task # "_ZTSK,1:" Not Queued!")
+11 ;
+12 ; -------------------------------------------------------------------
MAINQ ; Main module to drive this routine
+1 ; -------------------------------------------------------------------
+2 SET STORE="^TMP(""SCMCCV4"",$J)"
+3 SET REPORT="^TMP(""SCMC-RPT"",$J)"
+4 KILL @STORE,@REPORT
+5 IF SCMCSTOP
DO EXIT
QUIT
+6 ;
+7 DO RUNIT
+8 ;
+9 QUIT
+10 ;
+11 ; -------------------------------------------------------------------
RUNIT ; Module to gather the data and print the report.
+1 ; -------------------------------------------------------------------
+2 ; Process thru the ^SCPT(404.43) global.
DO SCPTLP
+3 ; Store the Report in a Temp array.
DO PRINT
+4 ; No data to print.
IF 'SCGOTONE
Begin DoDot:1
+5 FOR I=1:1:3
SET STRING=" "
XECUTE SCLNUP
+6 SET STRING=$EXTRACT(SCBLK,1,5)_"Zero Team Position Assignments were found based upon selection criteria."
+7 XECUTE SCLNUP
End DoDot:1
+8 ;
+9 ; Queue the report as a Mailman Message.
DO MAILIT
+10 DO EXIT
+11 QUIT
+12 ;
+13 ; -------------------------------------------------------------------
ASKTEAM() ; Prompt for "A"ll or "S"elected Teams.
+1 ; -------------------------------------------------------------------
+2 ; Sets up the SCMCTM and SCTMNAM arrays.
+3 ; Returns a "1" to STOP, or a "0" to CONTINUE.
+4 ;
+5 NEW STOP
+6 KILL SCMCTM,SCTMNAM
+7 SET (STOP,SCMCTM,SCTMNAM)=0
+8 ; Gets the type of selections (all or selected)
SET SCMCTYPE=$$TYPE()
+9 IF SCMCTYPE=0
SET STOP=1
QUIT STOP
+10 ;
+11 IF SCMCTYPE="A"
QUIT STOP
+12 ;
+13 IF SCMCTYPE="S"
DO TMLP
if '+SCMCTM
SET STOP=1
+14 QUIT STOP
+15 ;
+16 ; -------------------------------------------------------------------
TYPE() ; Ask the user to enter "A"ll or "S"elected teams.
+1 ; -------------------------------------------------------------------
+2 ; "A" means All Teams.
+3 ; "S" means Select Teams.
+4 ; Returns a "0" to quit or a "1" to continue.
+5 ;
+6 NEW DIR
+7 SET DIR(0)="SM^A:All Teams;S:Specific Teams"
+8 SET DIR("?",1)="Select A for a report of All Teams"
+9 SET DIR("?",2)="Select S for a report of Specific Teams"
+10 SET DIR("?",3)=" "
+11 ;
+12 DO ^DIR
+13 QUIT $SELECT($DATA(DIRUT):0,1:Y)
+14 ;
+15 ; -------------------------------------------------------------------
TMLP ; Allow the user to select multiple teams.
+1 ; -------------------------------------------------------------------
+2 ; Sets up the SCMCTM and SCTMNAM arrays with the teams.
+3 ; Sets SCSTOP=1 to stop selection.
+4 ;
+5 NEW SCSTOP,SCCTR,SCTMREC
+6 SET (SCSTOP,SCCTR)=0
+7 FOR
Begin DoDot:1
+8 NEW TM
+9 SET TM=$$TEAM^SCMCMU(DT)
+10 IF (TM>0)
IF '$DATA(SCMCTM(TM))
Begin DoDot:2
+11 SET SCMCTM(TM)=""
SET SCCTR=SCCTR+1
+12 SET SCTMREC=$GET(^SCTM(404.51,TM,0))
+13 SET SCTMNAM($PIECE(SCTMREC,U,1))=TM
End DoDot:2
+14 IF '$TEST
SET SCSTOP=1
+15 QUIT
End DoDot:1
IF SCSTOP
QUIT
+16 SET (SCMCTM,SCTMNAM)=SCCTR
+17 QUIT
+18 ;
+19 ; -------------------------------------------------------------------
SCPTLP ; Process the ^SCPT(404.43) global to gather reportable data.
+1 ; -------------------------------------------------------------------
+2 NEW SCTNAME,SCMCVAR,SCZZPROV,SCMCERR,SCG,SCG2
+3 SET (DFN,SCACTDT,SCTMPOS,SCTNAME,SCSEQ1,SCSTATUS)=""
+4 FOR
SET SCTNAME=$ORDER(SCTMNAM(SCTNAME))
if SCTNAME=""
QUIT
Begin DoDot:1
+5 SET @STORE@("B",SCTNAME)=0
End DoDot:1
+6 ;
+7 SET SCG="^SCPT(404.43,""APCPOS"")"
+8 FOR
SET DFN=$ORDER(@SCG@(DFN))
if DFN=""
QUIT
Begin DoDot:1
+9 ; Attending only
IF '$DATA(@SCG@(DFN,2))
QUIT
+10 NEW VA,VADM,VAERR
+11 DO DEM^VADPT
+12 ;patient name
SET SCPTNM=$GET(VADM(1),"Invalid Name:"_DFN)
+13 ;patient SSN
SET SCPTSSN=$GET(VA("PID"),"Invalid PID:"_DFN)
+14 ;
+15 SET SCG2="^SCPT(404.43,""APCPOS"","_DFN_",2)"
+16 FOR
SET SCACTDT=$ORDER(@SCG2@(SCACTDT))
if SCACTDT=""
QUIT
Begin DoDot:2
+17 FOR
SET SCTMPOS=$ORDER(@SCG2@(SCACTDT,SCTMPOS))
if SCTMPOS=""
QUIT
Begin DoDot:3
+18 FOR
SET SCSEQ1=$ORDER(@SCG2@(SCACTDT,SCTMPOS,SCSEQ1))
if SCSEQ1=""
QUIT
Begin DoDot:4
+19 SET SCREC1=$GET(^SCPT(404.43,SCSEQ1,0))
+20 ;no old discharges
IF +$PIECE(SCREC1,U,4)
IF $PIECE(SCREC1,U,4)<DT
QUIT
+21 SET Y=$PIECE(SCREC1,U,3)
+22 ;mm-dd-yyyy
SET SCASNDT=$$FMTE^DILIBF(Y,"6U")
+23 ;
+24 SET SCREC2=$GET(^SCTM(404.57,SCTMPOS,0))
+25 SET SCPOSNM=$PIECE(SCREC2,U,1)
+26 SET SCTMNO=$PIECE(SCREC2,U,2)
+27 if (+SCTMNO<1)!('$DATA(^SCTM(404.51,SCTMNO,0)))
QUIT
+28 ;
+29 ;not a selected Team
IF +SCMCTM
IF '$DATA(SCMCTM(SCTMNO))
QUIT
+30 ;
+31 SET SCREC3=$GET(^SCTM(404.51,SCTMNO,0))
+32 SET SCTMNM=$PIECE(SCREC3,U,1)
+33 ;
+34 NEW SCMCVAR,SCDATES,SCZZPROV,SCMCERR
+35 SET SCMCVAR=$$PRTP^SCAPMC8(SCTMPOS,"SCDATES","SCZZPROV","SCMCERR")
+36 IF 'SCMCVAR
QUIT
+37 IF '$DATA(SCZZPROV(1))
QUIT
+38 ; There should be only one provider for this day
+39 SET SCPHYPOS=$PIECE(SCZZPROV(1),U,4)_" ("_$PIECE(SCZZPROV(1),U,2)_")"
+40 ; Store a data record.
+41 NEW SCCNT
+42 SET SCCNT=+$GET(@STORE@(SCTMNO,0))+1
+43 SET @STORE@("B",SCTMNM)=SCTMNO
+44 SET @STORE@(SCTMNO,0)=SCCNT
+45 SET @STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN,SCACTDT,SCCNT)=""
+46 SET @STORE@(SCTMNO,SCCNT)=SCTMNM_U_SCPHYPOS_U_SCPTNM_U_SCPTSSN_U_SCASNDT
+47 QUIT
End DoDot:4
+48 QUIT
End DoDot:3
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 QUIT
+52 ;
+53 ; -------------------------------------------------------------------
PRINT ; Store the report in temp array prior to a Mailman Message.
+1 ; -------------------------------------------------------------------
+2 SET (SCTMNM,SCPHYPOS,SCPTNM,SCPTSSN,SCASNDT)=""
+3 SET (SCGOTONE,SCSTOP,SCLNSEQ)=0
+4 SET SCLNUP="S SCLNSEQ=SCLNSEQ+1,@REPORT@(SCLNSEQ)=STRING"
+5 SET SCRPDT=$$FMTE^XLFDT($$NOW^XLFDT())
+6 SET SCBLK=" "
SET $PIECE(SCBLK," ",80)=" "
+7 SET SCDSH="-"
SET $PIECE(SCDSH,"-",80)="-"
+8 SET SCDBL="="
SET $PIECE(SCDBL,"=",80)="="
+9 ;
+10 SET STRING=$EXTRACT(SCBLK,1,15)_"PCMM PC Attending Assignments Report - "_SCRPDT
+11 XECUTE SCLNUP
+12 SET STRING=$EXTRACT(SCBLK,1,$SELECT(+SCMCTM:26,1:23))_"Selection Criteria: "_$SELECT(+SCMCTM:"SELECTED",1:"ALL")_" TEAMS"
+13 XECUTE SCLNUP
+14 ;
+15 FOR
SET SCTMNM=$ORDER(@STORE@("B",SCTMNM))
if SCTMNM=""
QUIT
Begin DoDot:1
+16 DO PRTTMHDR
+17 SET SCTMNO=@STORE@("B",SCTMNM)
+18 IF SCTMNO=0
Begin DoDot:2
+19 SET STRING=$EXTRACT(SCBLK,1,5)_"Zero Team Position Assignments were found within this team."
+20 XECUTE SCLNUP
End DoDot:2
QUIT
+21 ;
+22 SET SCPHYPOS=""
+23 FOR
SET SCPHYPOS=$ORDER(@STORE@(SCTMNO,1,SCPHYPOS))
if SCPHYPOS=""
QUIT
Begin DoDot:2
+24 DO PRTPHHDR
+25 SET SCPTNM=""
+26 FOR
SET SCPTNM=$ORDER(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM))
if SCPTNM=""
QUIT
Begin DoDot:3
+27 SET DFN=0
+28 FOR
SET DFN=$ORDER(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN))
if 'DFN
QUIT
Begin DoDot:4
+29 SET SCACTDT=0
+30 FOR
SET SCACTDT=$ORDER(@STORE@(SCTMNO,1,SCPHYPOS,2,SCPTNM,DFN,SCACTDT))
if 'SCACTDT
QUIT
Begin DoDot:5
+31 SET SCCNT=$ORDER(^(SCACTDT,0))
+32 SET SCX=@STORE@(SCTMNO,SCCNT)
+33 ; Print a Detail Line.
+34 SET STRING=$$LJ("",10)_$$LJ(SCPTNM,29)_$$LJ($PIECE(SCX,U,4),18)_$PIECE(SCX,U,5)
+35 XECUTE SCLNUP
+36 ;
+37 SET SCGOTONE=1
+38 QUIT
End DoDot:5
+39 QUIT
End DoDot:4
+40 QUIT
End DoDot:3
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 QUIT
+44 ;
LJ(STRING,LENGTH) QUIT $$LJ^XLFSTR(STRING,LENGTH)
+1 ;
+2 ; -------------------------------------------------------------------
PRTTMHDR ; Print the Team Sub-heading.
+1 ; -------------------------------------------------------------------
+2 NEW STRING
+3 ;
+4 SET STRING=" "
FOR I=1:1:2
XECUTE SCLNUP
+5 SET STRING=$EXTRACT(SCDBL,1,11+$LENGTH(SCTMNM))
XECUTE SCLNUP
+6 SET STRING="TEAM NAME: "_SCTMNM
XECUTE SCLNUP
+7 SET STRING=$EXTRACT(SCDBL,1,11+$LENGTH(SCTMNM))
XECUTE SCLNUP
+8 SET STRING=" "
XECUTE SCLNUP
+9 SET STRING=$EXTRACT(SCBLK,1,5)_"Positions"
XECUTE SCLNUP
+10 SET STRING=$EXTRACT(SCBLK,1,5)_$EXTRACT(SCDSH,1,9)
XECUTE SCLNUP
+11 QUIT
+12 ;
+13 ; -------------------------------------------------------------------
PRTPHHDR ; Print the Physician Sub-heading.
+1 ; -------------------------------------------------------------------
+2 NEW STRING
+3 ;
+4 SET STRING=" "
XECUTE SCLNUP
+5 SET STRING=$EXTRACT(SCBLK,1,5)_SCPHYPOS
XECUTE SCLNUP
+6 SET STRING=$EXTRACT(SCBLK,1,5)_$EXTRACT(SCDSH,1,$LENGTH(SCPHYPOS))
XECUTE SCLNUP
+7 ;
+8 ;
+9 SET STRING=" "
XECUTE SCLNUP
+10 SET STRING=$EXTRACT(SCBLK,1,10)_"Patient Name"_$EXTRACT(SCBLK,1,17)_"SSN"_$EXTRACT(SCBLK,1,12)_"Date Assigned"
+11 XECUTE SCLNUP
+12 SET STRING=$EXTRACT(SCBLK,1,10)_$EXTRACT(SCDSH,1,12)_$EXTRACT(SCBLK,1,17)_"---"_$EXTRACT(SCBLK,1,12)_$EXTRACT(SCDSH,1,13)
+13 XECUTE SCLNUP
+14 QUIT
+15 ;
+16 ; -------------------------------------------------------------------
MAILIT ; Queue the report as a MailMan Message.
+1 ; -------------------------------------------------------------------
+2 NEW XMY,XMDUZ,XMSUB,XMTEXT
+3 SET XMDUZ=.5
+4 SET (XMY(DUZ),XMY(XMDUZ))=""
+5 SET XMSUB="PCMM PC Attending Assignments Report"
+6 SET XMTEXT="^TMP(""SCMC-RPT"",$J,"
+7 DO ^XMD
+8 QUIT
+9 ;
+10 ; -------------------------------------------------------------------
EXIT ; Clean up and Exit
+1 ; -------------------------------------------------------------------
+2 KILL @STORE,@REPORT
+3 DO KILL^XUSCLEAN
+4 QUIT
