Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCCV4

SCMCCV4.m

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