- 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 Jan 18, 2025@03:41:11 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