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

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