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

Last change on this file since 1739 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1SCMCBK7 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 6, 1998
2 ;;5.3;Scheduling;**148,177**;AUG 13, 1993
3 Q
4 ;
5MAILLST(SCTM,SCFIELDA,SCDATE,SCNEWTM,SCOLDTM,SCBADTM,SCTOTCNT) ;
6 ; ;like MAILLIST^SCMCTMM(...
7 ; Input:
8 ; SCTM - Pointer to Team File (#404.51)
9 ; SCFIELDA - Field array with internal values
10 ; SCDATE - Effective Date
11 ; SCNEWTM - DFN array of newly assigned to team
12 ; SCOLDTM - DFN array of previously assigned to team
13 ; SCBADTM - DFN array of patients unassignable to team
14 ; SCTOTCNT - Count of DFN array passed to process
15 ;
16 N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,ZTQUEUED
17 N SCTMNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
18 N SCE,SCB,SCDELTEM,SCJ,SCL,SCDETAIL
19 ;
20 D PREP1
21 S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
22 S XMSUB=$$S(4)_SCTMNM
23 S XMTEXT="^TMP($J,""SCTMXM"","
24 ;
25 S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
26 D SETLN($$S(5)_SCTMNM)
27 D SETLN($$S(6)_$$FMTE^XLFDT(SCDATE))
28 D SETLN($$S(7)_SCTOTCNT)
29 D SETLN(" ")
30 ;
31 I $D(SCFIELDA) D
32 .F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
33 ..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
34 ..D SETLN($$TEXT^SCMCTMM(404.42,SCNODE,SCNDX,SCSPACE,1))
35 ;
36 I SCTOTCNT=0 G MAIL
37 ;
38NEW I $S('$D(SCNEWTM):0,1:$O(@SCNEWTM@(0))) D BLDLST(1)
39 ;
40BAD I $S('$D(SCBADTM):0,1:$O(@SCBADTM@(0))) D BLDLST(2)
41 ;
42OLD I $S('$D(SCOLDTM):0,1:$O(@SCOLDTM@(0))) D BLDLST(3)
43 ;
44MAIL D SEND(8)
45 ;
46QTMULT K:$G(SCDELTEM) ^TMP("SCTM MAIL LST",$J,SCTM)
47 K ^TMP($J,"SCTMXM")
48 Q
49 ;
50PREP1 S ZTQUEUED=1
51 S SCDELTEM=1 ;ok to delete tmp global
52 S $P(SCSPACE," ",80)=""
53 S SCLNCNT=0
54 S SCOK=1
55 Q
56 ;
57 ;
58SETLN(TEXT) ;
59 D SETLN^SCMCTMM(TEXT)
60 Q
61 ;
62SEND(SCX) ;input SCX=points to string to use as sender
63 ;
64 S XMY(SCMAIL1)=""
65 S XMDUZ=$$S(SCX)
66 ;S XMDUZ=.5
67 D ^XMD
68 Q
69 ;
70BLDLST(SCL) ;create text by new/bad/old
71 ;input SCL = for header line, ^tmp, $o
72 N SCJ
73 D SETLN(" ")
74 D SETLN($$S(SCL))
75 S SCJ="^TMP(""SCTM MAIL LST"","_$J_","_SCTM_","_SCL_")"
76 S DFN=0
77 F S DFN=$$O(SCL) Q:'DFN D DTLLST
78 D SETLST(0)
79 Q
80 ;
81DTLLST ;detail the list
82 S SCPTNM=$P(^DPT(DFN,0),U,1)
83 D PID^VADPT6
84 S SCDETAIL=" "_SCPTNM_" ("_$G(VA("PID"))_")"
85 I SCL=2 D RJD
86 S @SCJ@(DFN)=SCDETAIL
87 S @SCJ@("B",SCPTNM,DFN)=""
88 Q
89 ;
90SETLST(SCX) ;set the list into message
91 ;input: SCX: 0=team assignment, 1=position assignment
92 S SCPTNM=""
93 F S SCPTNM=$O(@SCJ@("B",SCPTNM)) Q:SCPTNM']"" D
94 .S DFN=0
95 .F S DFN=$O(@SCJ@("B",SCPTNM,DFN)) Q:'DFN D
96 ..S SCDETAIL=$G(@SCJ@(DFN))
97 ..I SCX=0 D SETLN(SCDETAIL) Q
98 ..D SETLN^SCMCTPM(SCDETAIL)
99 ..Q
100 .Q
101 Q
102 ;
103RJD ;ReJect Detail
104 ;
105 N SCX
106 I $D(SCBADTM) S SCX=$P(@SCBADTM@(DFN),U)
107 E S SCX=$P(@SCBADTP@(DFN),U)
108 S SCDETAIL=SCDETAIL_" ["_SCX_"]"
109 Q
110 ;
111O(SCL) ;returns next patient in array
112 Q $S(SCL=1:$O(@SCNEWTM@(DFN)),SCL=2:$O(@SCBADTM@(DFN)),1:$O(@SCOLDTM@(DFN)))
113 ;
114S(SCL) ;returns line of text
115 Q $P($T(T+SCL),";;",2)
116 ;
117T ;;
1181 ;;There has been a new team assignment for the following patients:
1192 ;;There has been NO new team assignment for the following patients:
1203 ;;The following patients were already assigned to the target team:
1214 ;;Multiple PATIENT-TEAM ASSIGNMENT for ;;
1225 ;;Team: ;;
1236 ;;Effective Date: ;;
1247 ;;Processed: ;;
1258 ;;PCMM - Multiple Patient-Team Assignment
1269 ;;PCMM - Multiple Patient-Position Assignment
Note: See TracBrowser for help on using the repository browser.