source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCBK7.m@ 794

SCMCBK7 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 6, 1998
 ;;5.3;Scheduling;**148,177**;AUG 13, 1993
 Q
 ;
MAILLST(SCTM,SCFIELDA,SCDATE,SCNEWTM,SCOLDTM,SCBADTM,SCTOTCNT) ;
 ;       ;like MAILLIST^SCMCTMM(...
 ; Input:
 ;    SCTM     - Pointer to Team File (#404.51)
 ;    SCFIELDA - Field array with internal values
 ;    SCDATE   - Effective Date
 ;    SCNEWTM  - DFN array of newly assigned to team
 ;    SCOLDTM  - DFN array of previously assigned to team
 ;    SCBADTM  - DFN array of patients unassignable to team
 ;    SCTOTCNT - Count of DFN array passed to process
 ;
 N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,ZTQUEUED
 N SCTMNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
 N SCE,SCB,SCDELTEM,SCJ,SCL,SCDETAIL
 ;
 D PREP1
 S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
 S XMSUB=$$S(4)_SCTMNM
 S XMTEXT="^TMP($J,""SCTMXM"","
 ;
 S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
 D SETLN($$S(5)_SCTMNM)
 D SETLN($$S(6)_$$FMTE^XLFDT(SCDATE))
 D SETLN($$S(7)_SCTOTCNT)
 D SETLN(" ")
 ;
 I $D(SCFIELDA) D
 .F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
 ..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
 ..D SETLN($$TEXT^SCMCTMM(404.42,SCNODE,SCNDX,SCSPACE,1))
 ;
 I SCTOTCNT=0 G MAIL
 ;
NEW I $S('$D(SCNEWTM):0,1:$O(@SCNEWTM@(0))) D BLDLST(1)
 ;
BAD I $S('$D(SCBADTM):0,1:$O(@SCBADTM@(0))) D BLDLST(2)
 ;
OLD I $S('$D(SCOLDTM):0,1:$O(@SCOLDTM@(0))) D BLDLST(3)
 ;
MAIL D SEND(8)
 ;
QTMULT K:$G(SCDELTEM) ^TMP("SCTM MAIL LST",$J,SCTM)
 K ^TMP($J,"SCTMXM")
 Q
 ;
PREP1 S ZTQUEUED=1
 S SCDELTEM=1 ;ok to delete tmp global
 S $P(SCSPACE," ",80)=""
 S SCLNCNT=0
 S SCOK=1
 Q
 ;
 ;
SETLN(TEXT) ;
 D SETLN^SCMCTMM(TEXT)
 Q
 ;
SEND(SCX) ;input SCX=points to string to use as sender
 ;
 S XMY(SCMAIL1)=""
 S XMDUZ=$$S(SCX)
 ;S XMDUZ=.5
 D ^XMD
 Q
 ;
BLDLST(SCL) ;create text by new/bad/old
 ;input SCL = for header line, ^tmp, $o
 N SCJ
 D SETLN(" ")
 D SETLN($$S(SCL))
 S SCJ="^TMP(""SCTM MAIL LST"","_$J_","_SCTM_","_SCL_")"
 S DFN=0
 F  S DFN=$$O(SCL) Q:'DFN  D DTLLST
 D SETLST(0)
 Q
 ;
DTLLST ;detail the list
 S SCPTNM=$P(^DPT(DFN,0),U,1)
 D PID^VADPT6
 S SCDETAIL="    "_SCPTNM_" ("_$G(VA("PID"))_")"
 I SCL=2 D RJD
 S @SCJ@(DFN)=SCDETAIL
 S @SCJ@("B",SCPTNM,DFN)=""
 Q
 ;
SETLST(SCX) ;set the list into message
 ;input: SCX: 0=team assignment, 1=position assignment
 S SCPTNM=""
 F  S SCPTNM=$O(@SCJ@("B",SCPTNM)) Q:SCPTNM']""  D
 .S DFN=0
 .F  S DFN=$O(@SCJ@("B",SCPTNM,DFN)) Q:'DFN  D
 ..S SCDETAIL=$G(@SCJ@(DFN))
 ..I SCX=0 D SETLN(SCDETAIL) Q
 ..D SETLN^SCMCTPM(SCDETAIL)
 ..Q
 .Q
 Q
 ;
RJD ;ReJect Detail
 ;
 N SCX
 I $D(SCBADTM) S SCX=$P(@SCBADTM@(DFN),U)
 E  S SCX=$P(@SCBADTP@(DFN),U)
 S SCDETAIL=SCDETAIL_" ["_SCX_"]"
 Q
 ;
O(SCL) ;returns next patient in array
 Q $S(SCL=1:$O(@SCNEWTM@(DFN)),SCL=2:$O(@SCBADTM@(DFN)),1:$O(@SCOLDTM@(DFN)))
 ;
S(SCL) ;returns line of text 
 Q $P($T(T+SCL),";;",2)
 ;
T ;;
1 ;;There has been a new team assignment for the following patients:
2 ;;There has been NO new team assignment for the following patients:
3 ;;The following patients were already assigned to the target team:
4 ;;Multiple PATIENT-TEAM ASSIGNMENT for ;;
5 ;;Team:                  ;;
6 ;;Effective Date:        ;;
7 ;;Processed:             ;;
8 ;;PCMM - Multiple Patient-Team Assignment
9 ;;PCMM - Multiple Patient-Position Assignment