source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC25.m@ 1096

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

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1SCAPMC25 ;ALB/REW - Team API's:MSGDTH ; may 1999
2 ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
3 ;;1.0
4MSGPT(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL,SCLIST,SCERR) ; users getting death message
5 ; Input:
6 ; MSGTYPE:
7 ; 1 = Death Message
8 ; 2 = Inpatient Message
9 ; 3 = Team Message
10 ; 4 = Consult Message
11 ; 5 = Inactivation Message
12 ;
13 ; DFN - Pointer to Patient File #2
14 ; SCTEAMA -array of pointers to team file 404.51
15 ; if none are defined - returns all teams
16 ; if @scteama@('exclude') is defined - exclude listed teams
17 ; SCDATES("BEGIN") = begin date to search (inclusive)
18 ; [default: TODAY]
19 ; ("END") = end date to search (inclusive)
20 ; [default: TODAY]
21 ; ("INCL") = 1: only use pracitioners who were on
22 ; team for entire date range
23 ; 0: anytime in date range
24 ; [default: 1]
25 ; SCYESCL -boolean[1-yes(default)/0-no] Include pts asc. via enrollment?
26 ; SCLIST - Name of output array
27 ; SCERR = array NAME to store error messages.
28 ; [ex. ^TMP("ORXX",$J
29 ; Output:
30 ; SCLIST() = array of practitioners (users) - pointers to file #200
31 ; Format:
32 ; Subscript: Sequential # from 1 to n
33 ; Piece Description
34 ; 1 IEN of NEW PERSON file entry (#200)
35 ; 2 .01 of file #200
36 ; SCERR() = Array of DIALOG file messages(errors) .
37 ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
38 ; Foramt:
39 ; Subscript: Sequential # from 1 to n
40 ; Piece Description
41 ; 1 IEN of DIALOG file
42 ; Returned: 1 if ok, 0 if error
43 ;
44ST N SCOK,SCTM,SCTP,SCX,SCY,NODE,SCZ,SCTPND
45 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
46 S SCOK=1
47 ; -- initialize control variables
48 G:'$$OKDATA MSGQ
49 ;given patient get list of their teams
50 S SCOK=$$TMPT^SCAPMC(DFN,SCDATES,,"^TMP(""SCMSG1"",$J)",.SCERR)
51 G:SCOK<1 MSGQ
52 ;validate teams
53 F SCX=1:1 S NODE=$G(^TMP("SCMSG1",$J,SCX)) Q:'NODE S SCTM=+NODE D:$$OKARRAY^SCAPU1(.SCTEAMA,SCTM) Q:SCOK<1
54 .;given teams get list of their positions
55 .S SCZ=$$TPTM^SCAPMC(SCTM,SCDATES,,,"^TMP(""SCMSG2"",$J)",.SCERR)
56 .Q:'SCZ
57 .IF SCZ<0 S SCOK=-1 Q
58 .;given list of valid positions get list of practitioners
59 ; should position get message?
60 ;;bp/cmf **177** begin
61 F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND D
62 .S SCTP=$P(SCTPND,U,1)
63 .D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
64 ..;given list of valid positions get current practitioners
65 ..S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
66 ..Q
67 .;new code here
68 .;if preceptor notice turned on for message type
69 .I +$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE+4) D
70 ..S SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
71 ..;if preceptor duz returned, add to array
72 ..I SCX S @SCLIST@("SCPR",SCX)=""
73 ..Q
74 .Q
75 ;
76 ;;bp/cmf **177** orig begin
77 ;;o;;F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND S SCTP=$P(SCTPND,U,1) D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
78 ;;o;;.;given list of valid positions get current practitioners
79 ;;o;;.S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
80 ;;bp/cmf **177** orig end
81 ;;bp/cmf **177** end
82MSGQ F SCZ="SCMSG1","SCMSG2","SCMSG3" K ^TMP(SCZ)
83PRACQ Q $G(@SCERR@(0))<1
84 ;
85OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,SCERR) ;check if message should go out to position for given pt
86 ;needs pre-validated input
87 ;return 1=ok,0=not ok
88 N GETMESS,SCOK,SCX,SCTM
89 K ^TMP("SCMSG3",$J)
90 S SCTM=$P($G(^SCTM(404.57,SCTP,0)),U,2)
91 S GETMESS=$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE)
92 S:"T"[GETMESS SCOK=1 ;if null give messages
93 S:GETMESS="N" SCOK=0
94 IF GETMESS="P" D
95 .;check if pt is assigned to position
96 .S SCX=$$TPPT^SCAPMC(DFN,SCDATES,,,,,SCYESCL,"^TMP(""SCMSG3"",$J)",.SCERR)
97 .S SCOK=$D(^TMP("SCMSG3",$J,"SCTP",SCTM,SCTP))
98 .S:SCX<0 SCOK="-1^Error in position-patient call"
99 K ^TMP("SCMSG3",$J)
100 Q SCOK
101 ;
102OKDATA() ;setup/check variables
103 N SCOK
104 S SCOK=1
105 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
106 S:'$L($G(SCYESCL)) SCYESCL=1
107 IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
108 . S SCPARM("PATIENT")=$G(PATIENT,"Undefined")
109 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
110 ;
111 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
112 IF '$D(^DPT(+DFN,0)) D S SCOK=0
113 . S SCPARM("PATIENT")=DFN
114 . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
115 Q SCOK
116 ;
117PCMMXMY(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL) ;create xmy array for the appropriate type of pcmm mess
118 ; return 1 if success,0 if error or no users receiving message
119 N SCOK,SCGROUP,SC200,SCGROUP
120 IF '$G(MSGTYPE) S SCOK=0 G QTXMY
121 S SCOK=1
122 S SCOK=$$MSGPT(MSGTYPE,.DFN,.SCTEAMA,.SCDATES,.SCYESCL,"^TMP(""SC PCMM MAIL"",$J)")
123 S SC200=0
124 F S SC200=$O(^TMP("SC PCMM MAIL",$J,"SCPR",SC200)) Q:'SC200 S XMY(SC200)=""
125 IF $D(XMY) D
126 .S XMY(.5)=""
127 ELSE D
128 .S SCOK=0
129 .S XMY(.5)=""
130 K ^TMP("SC PCMM MAIL",$J)
131QTXMY Q SCOK
132 ;
133MSGTEXT(MSGTYPE) ;
134 Q $S(MSGTYPE=1:"DEATH",(MSGTYPE=2):"INPATIENT",(MSGTYPE=3):"TEAM",(MSGTYPE=4):"CONSULT",(MSGTYPE=5):"INACTIVATION",1:"ERROR")
Note: See TracBrowser for help on using the repository browser.