source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCBK9.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SCMCBK9 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1;;Aug 7, 1998
2 ;;5.3;Scheduling;**148**;AUG 13, 1993
3 Q
4 ;
5MAILLST(SCTP,SCFIELDA,SCDATE,SCNEWTP,SCOLDTP,SCBADTP,SCTOTCNT) ;
6 ; ;like MAILLIST^SCMCTPM(...
7 ; Input:
8 ; SCTP - Pointer to Team Position File (#404.57)
9 ; SCFIELDA - Field array with internal values
10 ; SCDATE - Effective Date
11 ; SCNEWTP - DFN array of newly assigned to position
12 ; SCOLDTP - DFN array of previously assigned to position
13 ; SCBADTP - DFN array of patients unassignable to position
14 ; SCTOTCNT - Count of DFN array passed to process
15 ;
16 N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCTPDT,ZTQUEUED
17 N SCTPNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE
18 N SCE,SCB,SCTMNM,SCDELTEM,SCDETAIL,SCJ,SCL
19 ;
20 D PREP1^SCMCBK7
21 ;
22 S SCTPNM=$P($G(^SCTM(404.57,+SCTP,0)),U,1)
23 S XMSUB=$$S(4)_SCTPNM
24 S XMTEXT="^TMP($J,""SCTPXM"","
25 S SCTMNM=$P($G(^SCTM(404.51,+$P($G(^SCTM(404.57,+SCTP,0)),U,2),0)),U,1)
26 ;
27 D SETLN($$S(5)_SCTMNM)
28 D SETLN($$S(6)_SCTPNM)
29 D SETLN($$S(7)_$$FMTE^XLFDT(SCDATE))
30 D SETLN($$S(8)_SCTOTCNT)
31 D SETLN(" ")
32 ;
33 IF $D(SCFIELDA) D
34 .F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
35 ..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
36 ..D SETLN($$TEXT^SCMCTPM(404.43,SCNODE,SCNDX,SCSPACE,1))
37 ;
38 I SCTOTCNT=0 G MAIL
39 ;
40NEW I $S('$D(SCNEWTP):0,1:$O(@SCNEWTP@(0))) D BLDLST(1)
41 ;
42BAD I $S('$D(SCBADTP):0,1:$O(@SCBADTP@(0))) D BLDLST(2)
43 ;
44OLD I $S('$D(SCOLDTP):0,1:$O(@SCOLDTP@(0))) D BLDLST(3)
45 ;
46MAIL D SEND^SCMCBK7(9)
47 ;
48QTMULT K:$G(SCDELTEM) ^TMP("SCTP MAIL LST",$J,SCTP)
49 K ^TMP($J,"SCTPXM")
50 Q
51 ;
52SETLN(TEXT) ;
53 D SETLN^SCMCTPM(TEXT)
54 Q
55 ;
56BLDLST(SCL) ;create text by new/bad/old
57 ;input SCL = for header line, ^tmp, $o
58 N SCJ
59 D SETLN(" ")
60 D SETLN($$S(SCL))
61 S SCJ="^TMP(""SCTP MAIL LST"","_$J_","_SCTP_","_SCL_")"
62 S DFN=0
63 F S DFN=$$O(SCL) Q:'DFN D DTLLST^SCMCBK7
64 D SETLST^SCMCBK7(1)
65 Q
66 ;
67O(SCL) ;returns next patient in array
68 Q $S(SCL=1:$O(@SCNEWTP@(DFN)),SCL=2:$O(@SCBADTP@(DFN)),1:$O(@SCOLDTP@(DFN)))
69 ;
70S(SCL) ;return text string
71 Q $P($T(T+SCL),";;",2)
72 ;
73T ;;
74 ;;There has been a new position assignment for the following patients:
75 ;;There has been NO new position assignment for the following patients:
76 ;;The following patients were already assigned to the target position:
77 ;;Multiple PATIENT-POSITION ASSIGNMENT for ;;
78 ;;Team: ;;
79 ;;Position: ;;
80 ;;Effective Date: ;;
81 ;;Processed: ;;
82 ;
Note: See TracBrowser for help on using the repository browser.