source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCBK5.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SCMCBK5 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1 ;;Aug 7, 1998
2 ;;5.3;Scheduling;**148,177**;AUG 13, 1993
3 Q
4 ;
5ACPTTM(DFN,SCTM,SCFIELDA,SCACT,SCERR) ;add a patient to a team (pt tm assgn - #404.42
6 ; input:
7 ; DFN = pointer to PATIENT file (#2)
8 ; SCTM = pointer to TEAM file (#404.51)
9 ; SCFIELDA= array of additional fields to be added
10 ; SCACT = date to activate [default=DT]
11 ; SCERR = array NAME to store error messages.
12 ; [ex. ^TMP("ORXX",$J)]
13 ;
14 ; Output:
15 ; Returned = ien of 404.42 - 0 if none after^new?^Message
16 ;
17 N SCPTTM,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWTM,SCMESS,SCX
18 ;
19 ;check/setup variables
20 I '$$OKDATA^SCAPMC6() S SCMESS=$$S(9) G APTTMQ
21 ;
22 ;is patient deceased?
23 I $$DP^SCMCBK6(DFN) S SCMESS=$$S(1) G APTTMQ
24 ;
25 ;can PC assignment be made?
26 I $$T1() D I 'SCX S SCMESS=$P(SCX,U,2) G APTTMQ
27 .S SCX=$$OKPTTMPC^SCMCBK6(DFN,SCTM,SCACT)
28 .; ;like $$OKPTTMPC^SCMCTMU2(...
29 .Q
30 ;
31 ;is pt already assignmed to team?
32 S SCPTTM=$$PTTMACT^SCAPMC6(DFN,SCTM,SCACT,.SCERR)
33 I SCPTTM S SCMESS=$$S(10) G APTTMQ
34 ;
35 I $D(SCFIELDA) D
36 .S SCFLD=0
37 .F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
38 ..S SC($J,404.42,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
39 ..Q
40 .Q
41 ;
42 S SC($J,404.42,"+1,",.01)=DFN
43 S SC($J,404.42,"+1,",.02)=SCACT
44 S SC($J,404.42,"+1,",.03)=SCTM
45 N SCTMERR
46 D UPDATE^DIE("","SC($J)","SCIEN","SCTMERR")
47 ;
48 I $D(SCTMERR) S SCMESS=$$S(11) K SCIEN
49 E D
50 .S SCPTTM=$G(SCIEN(1))
51 .S SCNEWTM=1
52 .D AFTERTM^SCMCDD1(SCPTTM)
53 .Q
54 ;
55APTTMQ Q +$G(SCPTTM)_U_+$G(SCNEWTM)_U_$G(SCMESS)
56 ;
57T1() Q $S('$D(SCFIELDA):0,('($D(@SCFIELDA@(.08))#2)):0,($G(@SCFIELDA@(.08))=1):1,1:0)
58 ;
59S(SCX) Q $$S^SCMCBK6(SCX)
60 ;
61ACPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
62 ; input: as per ACPTTM (above with the following change:)
63 ; DFNA = is the literal value of a patient array (e.g. "scpt"
64 ; there is at least one scpt(dfn)="" defined
65 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
66 ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
67 ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
68 ; Note: The above three arrays return data in a user determined array
69 ;
70 ; output: Count of Patients:
71 ; 1 2 3 4
72 ; total assigned^newly assigned^assigned prior^not assigned
73 ;
74 N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCTOTCNT,SCX,SCNOMAIL
75 S SCNOMAIL=1
76 S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
77 S SCTOTCNT=$$PASSCNT(DFNA)
78 I SCTOTCNT=0 G MAIL
79 ;
80 S DFN=0
81 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
82 .S SCX=$$ACPTTM(.DFN,.SCTM,.SCFIELDA,.SCACT,.SCERR)
83 .;
84 .;newly assigned
85 .I $P(SCX,U,2)=1 D Q
86 ..S SCNEWCNT=SCNEWCNT+1
87 ..S @SCNEWTM@(DFN)=+SCX
88 ..Q
89 .;
90 .;already assigned
91 .I +SCX D Q
92 ..;;;I $P(SCX,U,1)&('$P(SCX,U,2)) D Q
93 ..S SCOLDCNT=SCOLDCNT+1
94 ..S @SCOLDTM@(DFN)=+SCX
95 ..Q
96 .;
97 .;not assigned ;;;I 'SCX D
98 .S @SCBADTM@(DFN)=$P(SCX,U,3)
99 .S SCBADCNT=SCBADCNT+1
100 .Q
101 ;
102MAIL K SCNOMAIL
103 D MAILLST^SCMCBK7(SCTM,.SCADDFLD,DT,.SCNEWTM,.SCOLDTM,.SCBADTM,SCTOTCNT)
104 Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
105 ;
106PASSCNT(DFNA) ;count total patients passed to queue
107 ;input: DFNA=tmp array location
108 ;output: count
109 ;
110 N SCX,DFN
111 S (SCX,DFN)=0
112 F S DFN=$O(@DFNA@(DFN)) Q:'DFN S SCX=SCX+1
113 Q SCX
114 ;
Note: See TracBrowser for help on using the repository browser.