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)