127 lines
3.2 KiB
Mathematica
127 lines
3.2 KiB
Mathematica
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
|