source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTPU4.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1SCMCTPU4 ;ALB/MJK - Team Position Dangler Bulletin ; 10-JUL-1998
2 ;;5.3;Scheduling;**148,177**;AUG 13, 1993
3 ;
4BULL ; -- send bulletin (called from SCMCTPU3)
5 N XMY,XMTEXT,XMSUB,XMDUZ,SCLCNT
6 D INIT
7 D TEXT
8 IF 'SCSTOP D ^XMD
9 D FINAL
10 Q
11 ;
12INIT ; -- set vars for bulletin
13 N SCPCT
14 S XMDUZ=.5
15 S XMY($S($G(DUZ):DUZ,1:XMDUZ))=""
16 S XMSUB="Patient Team Position Assignment Review"
17 K ^TMP("SCTPTEXT",$J)
18 S XMTEXT="^TMP(""SCTPTEXT"",$J,"
19 S SCLCNT=0
20 S SCPCT="0.00"
21 IF $G(SCNT("TOTAL")) S SCPCT=(+$G(SCNT("BAD"))/+$G(SCNT("TOTAL")))*100
22 ;
23 ; -- summary info
24 ;
25 D SET(" In order to correct the following active positions with discharged team")
26 D SET("assignments, please refer to the documentation for the Patient Team")
27 D SET("Position Assignment Review option found in the Stand-alone Options")
28 D SET("Section of the PCMM User Guide.")
29 D SET(" ")
30 ;
31 ;D SET(" ")
32 ;D SET(" Mode: "_$S(SCMODE=1:"Diagnostic Only",1:"Fix"))
33 ;
34 ; -- show teams
35 D SET(" Teams Reviewed: "_$S(SCTMLST=1:"All",1:""))
36 IF SCTMLST=0 D
37 . ; -- sort and set
38 . N SCTMI,X
39 . S SCTMI=0
40 . F S SCTMI=$O(SCTMLST(SCTMI)) Q:'SCTMI S X(SCTMLST(SCTMI)_SCTMI)=SCTMLST(SCTMI)
41 . S SCTMI=""
42 . F S SCTMI=$O(X(SCTMI)) Q:SCTMI="" D SET(" "_X(SCTMI))
43 . D SET(" ")
44 . Q
45 ;
46 D SET(" ")
47 D SET(" Patient Team Position Assignments Reviewed: "_$J(+$G(SCNT("TOTAL")),6))
48 D SET(" Number of Assignments with Problems : "_$J(+$G(SCNT("BAD")),6)_" ("_$J(SCPCT,6,2)_"%)")
49 D SET(" ")
50 D DASH("=")
51 Q
52 ;
53FINAL ; -- clean up
54 K ^TMP("SCTPTEXT",$J)
55 Q
56 ;
57TEXT ; -- set of mm array
58 N SCTMI,SCTPI,SCPTI,SCASDTI,SCPTAI
59 ;
60 ; -- sort is by team, position, patient, assign date, position assignment ien
61 ;
62 S SCSTOP=0
63 S SCTMI=""
64 F S SCTMI=$O(@SCERTMP@(SCTMI)) Q:SCTMI="" D Q:SCSTOP
65 . S SCTPI="" F S SCTPI=$O(@SCERTMP@(SCTMI,SCTPI)) Q:SCTPI="" D
66 . . S SCPTI="" F S SCPTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI)) Q:SCPTI="" D
67 . . . S SCASDTI=0 F S SCASDTI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI)) Q:'SCASDTI D
68 . . . . S SCTPAI=0 F S SCTPAI=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI)) Q:'SCTPAI D PTA
69 . ;
70 . ; -- check if user asked job to stop
71 . IF $$S^%ZTLOAD() S (SCSTOP,ZTSTOP)=1
72 Q
73 ;
74PTA ; -- process errors for team position assignment
75 N SCTP,SCTP0,SCTPNM
76 N SCTM,SCTM0,SCTMNM
77 N SCPT,SCPT0,SCPTNM,SCPTID
78 N SCTPA,SCTPA0,SCTPASDT,SCTPUNDT
79 N SCTMA,SCTMA0,SCTMASDT,SCTMUNDT
80 N SCER
81 ; -- get data
82 D DATA^SCMCTPU3(SCTPAI)
83 ;
84 ; -- set mm text
85 D SET(" Team: "_SCTMNM_" Position: "_SCTPNM)
86 D SET(" Patient: "_SCPTNM_" ("_SCPTID_")")
87 S SCER=0
88 F S SCER=$O(@SCERTMP@(SCTMI,SCTPI,SCPTI,SCASDTI,SCTPAI,SCER)) Q:'SCER D
89 . IF SCER=1 D
90 . . D SET(" Error: Position Assigned Date is BEFORE Team Assigned Date")
91 . . D SET(" Position Assigned Date: "_$$FMTE^XLFDT($E(SCTPASDT,1,7),"5Z"))
92 . . D SET(" Team Assigned Date: "_$$FMTE^XLFDT($E(SCTMASDT,1,7),"5Z"))
93 . ;
94 . IF SCER=2 D
95 . . D SET(" Error: Position Unassigned Date is AFTER Team Unassigned Date")
96 . . D SET(" Team Unassigned Date: "_$S(SCTMUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTMUNDT,1,7),"5Z")))
97 . . D SET(" Position Unassigned Date: "_$S(SCTPUNDT=9999999:"<none>",1:$$FMTE^XLFDT($E(SCTPUNDT,1,7),"5Z")))
98 . ; -- do fix if selected
99 . IF SCMODE=2 D FIX
100 D DASH()
101 Q
102 ;
103FIX ; -- fix team position assignment entry (future)
104 Q
105 ;
106SET(X) ;
107 S SCLCNT=SCLCNT+1,^TMP("SCTPTEXT",$J,SCLCNT,0)=X
108 Q
109 ;
110DASH(CHAR) ; -- send line of CHAR
111 N X
112 S $P(X,$E($G(CHAR,"-")),78)=""
113 D SET(" "_X)
114 Q
115 ;
Note: See TracBrowser for help on using the repository browser.