source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCMCTPU3.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SCMCTPU3 ;ALB/MJK - Team Position Utility ; 1 SEP 98
2 ;;5.3;Scheduling;**148**;AUG 13,1993
3 ;
4EN ; -- main entry point to find pat position assignments w/o team assignment
5 N SCMODE,SCTMLST,SCTSK
6 ;
7 ; -- ask user which mode (diagnosis vs. fix)
8 S SCMODE=$$MODE()
9 IF 'SCMODE G ENQ
10 ;
11 ; -- ask user for teams
12 IF '$$TEAM() G ENQ
13 ;
14 ; -- queue job to run
15 S SCTSK=$$QUE()
16 IF SCTSK'="" D
17 . W !!,">>> Task#: ",SCTSK
18 . W !!," This task will send a MailMan message to you containing"
19 . W !," the results of the position assignment review.",!
20 D PAUSE
21ENQ Q
22 ;
23MODE() ; -- get mode from user (1 - diagnostic 2 - fix 0 - abort)
24 Q 1 ; -- fix mode (2) is a future
25 ;
26TEAM() ; -- get teams from user
27 N Y,DIC,VAUTVB,VAUTSTR,VAUTINI
28 S VAUTVB="SCTMLST"
29 S VAUTSTR="Team"
30 S VAUTNI=2
31 S DIC="^SCTM(404.51,"
32 D FIRST^VAUTOMA
33 Q $S(Y=-1:0,1:1)
34 ;
35QUE() ; -- setup task and queue job to run
36 ;D START Q 99999 ; -- for interactive testing
37 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
38 S ZTRTN="START^SCMCTPU3"
39 S ZTDESC="Patient Team Position Assignment Review"
40 S ZTDTH=$H
41 S ZTIO=""
42 F X="SCTMLST(","SCTMLST","SCMODE" S ZTSAVE(X)=""
43 D ^%ZTLOAD
44 Q $G(ZTSK)
45 ;
46START ; -- entry point for queued job
47 ;
48 N SCSTOP,SCER,SCERTMP,SCNT
49 N SCTP,SCTP0,SCTPNM
50 N SCTM,SCTM0,SCTMNM
51 N SCPT,SCPT0,SCPTNM,SCPTID
52 N SCTPA,SCTPA0,SCTPASDT,SCTPUNDT
53 N SCTMA,SCTMA0,SCTMASDT,SCTMUNDT
54 ;
55 S SCERTMP=$NA(^TMP("SCTP DANGLERS",$J))
56 K @SCERTMP
57 ;
58 ; -- is 'all' teams selected build array
59 IF SCTMLST=1 D
60 . S SCTM=0
61 . F S SCTM=$O(^SCTM(404.51,SCTM)) Q:'SCTM S X=$G(^SCTM(404.51,SCTM,0)) S SCTMLST(SCTM)=$P(X,U)
62 ;
63 ; -- loop through entire team position assignment file
64 S (SCSTOP,SCTPA)=0
65 F S SCTPA=$O(^SCPT(404.43,SCTPA)) Q:'SCTPA D Q:SCSTOP
66 . IF $$S^%ZTLOAD() S (SCSTOP,ZTSTOP)=1 Q
67 . N SCERAR
68 . ;
69 . ; -- get data
70 . D DATA(SCTPA)
71 . ;
72 . ; -- quit if team not selected by user
73 . IF '$D(SCTMLST(SCTM)) Q
74 . ;
75 . D CNT("TOTAL")
76 . ;
77 . ; -- if postion assigned date >= team assigned date
78 . ; and
79 . ; position unassigned date <= team unassigned date
80 . ; then entry is good
81 . ;
82 . ; else
83 . ; process error
84 . ;
85 . IF SCTPASDT>SCTMASDT!(SCTPASDT=SCTMASDT) D
86 . . IF SCTPUNDT<SCTMUNDT!(SCTPUNDT=SCTMUNDT) D
87 . . . D CNT("OK")
88 . . . Q
89 . . ; -- position unassign date > team unassign date
90 . . ELSE D
91 . . . D ERR(2)
92 . . . Q
93 . . Q
94 . ; -- position assign date < team assign date
95 . ELSE D
96 . . D ERR(1)
97 . . Q
98 . ;
99 . IF $O(SCERAR(0)) D CNT("BAD"),SET
100 . ; -- check if user asked job to stop
101 . Q
102 ;
103 IF 'SCSTOP D BULL^SCMCTPU4
104 ;
105 K @SCERTMP
106 Q
107 ;
108CNT(TYPE) ; -- set counter
109 S SCNT(TYPE)=$G(SCNT(TYPE))+1
110 Q
111 ;
112ERR(NUMBER) ; -- set error array
113 S SCERAR(NUMBER)=""
114 Q
115 ;
116SET ; -- set tmp for report
117 N SCER
118 S SCER=0
119 F S SCER=$O(SCERAR(SCER)) Q:'SCER D
120 . S @SCERTMP@(SCTMNM_SCTM,SCTPNM_SCTP,SCPTNM_SCPT,SCTPASDT,SCTPA,SCER)=""
121 Q
122 ;
123DATA(SCTPA) ; -- get team, position, tm pos assign, tm assignment & patient data
124 ; input: SCPTA := ien to patient team position assignment (404.43)
125 ;
126 ; -- Team Position Assignment (TPA) data
127 S SCTPA0=$G(^SCPT(404.43,SCTPA,0))
128 S SCTPASDT=+$P(SCTPA0,U,3)
129 S SCTPUNDT=$S($P(SCTPA0,U,4):$P(SCTPA0,U,4),1:9999999)
130 ;
131 ; -- Team Position (TP) data
132 S SCTP=+$P(SCTPA0,U,2)
133 S SCTP0=$G(^SCTM(404.57,SCTP,0))
134 S SCTPNM=$P(SCTP0,U)
135 ;
136 ; -- TeaM Assignment (TMA) data
137 S SCTMA=+SCTPA0
138 S SCTMA0=$G(^SCPT(404.42,SCTMA,0))
139 S SCTMASDT=+$P(SCTMA0,U,2)
140 S SCTMUNDT=$S($P(SCTMA0,U,9):$P(SCTMA0,U,9),1:9999999)
141 ;
142 ; -- TeaM (TM) data
143 S SCTM=+$P(SCTMA0,U,3)
144 S SCTM0=$G(^SCTM(404.51,SCTM,0))
145 S SCTMNM=$P(SCTM0,U)
146 ;
147 ; -- PaTient (PT) data
148 S SCPT=+SCTMA0
149 S SCPT0=$G(^DPT(SCPT,0))
150 S SCPTNM=$P(SCPT0,U)
151 N DFN,VA
152 S DFN=SCPT D PID^VADPT6
153 S SCPTID=VA("BID")
154 Q
155 ;
156PAUSE ; -- pause
157 N DIR,Y
158 S DIR(0)="EA"
159 S DIR("A")=">>> Press RETURN to continue: "
160 D ^DIR
161 Q
Note: See TracBrowser for help on using the repository browser.