source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC8.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1SCAPMC8 ;;bp/cmf - List of Practitioners for a Position ; 7/12/99 10:03am
2 ;;5.3;Scheduling;**41,177**;AUG 13, 1993
3 ;;1.0
4 ;
5PRTP(SCTP,SCDATES,SCLIST,SCERR,SCPRCPTR,SCALLHIS) ;-- list of practitioners for position (bp/cmf 177-->SCPRCPTR,SCALLHIS param added)
6 ; input:
7 ; SCTP = ien of TEAM POSITION[required]
8 ; SCDATES("BEGIN") = begin date to search (inclusive)
9 ; [default: TODAY]
10 ; ("END") = end date to search (inclusive)
11 ; [default: DT]
12 ; ("INCL") = 1: only use pracitioners who were on
13 ; team for entire date range
14 ; 0: anytime in date range
15 ; [default: 1]
16 ; SCLIST= array NAME for output
17 ; SCERR = array NAME to store error messages.
18 ; [ex. ^TMP("ORXX",$J)]
19 ; SCPRCPTR = 1: return preceptor sub-array in SCLIST
20 ; [default: 0]
21 ; SCALLHIS = 1: return unfiltered sub-array in SCLIST
22 ; [default: 0]
23 ;
24 ; Output:
25 ; SCLIST(scn) = array of practitioners
26 ; Format:
27 ; scn: Sequential # from 1 to n
28 ; Piece Description
29 ; 1 IEN of NEW PERSON file entry (#200)
30 ; 2 Name of person
31 ; 3 IEN of TEAM POSITION file (#404.57)
32 ; 4 Name of Position
33 ; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
34 ; 6 USR Class Name
35 ; 7 IEN of STANDARD POSITION (#403.46)
36 ; 8 Standard Role (Position) Name
37 ; 9 Activation Date for 404.52 (not 404.59!)
38 ; 10 Inactivation Date for 404.52
39 ; 11 IEN of Position Asgn History (404.52)
40 ; 12 IEN of Current(=DT) Preceptor Position
41 ; 13 Name of Current(=DT) Preceptor Position
42 ;
43 ; SCLIST(scn,'PR',scn1) = sub-array of preceptors
44 ; Format: same as SCLIST(scn) PLUS
45 ; scn1: Sequential number from 1 to n
46 ; Piece Description
47 ; 14 precept start date
48 ; 15 precept end date
49 ; 16 IEN of Preceptor Asgn History (404.53)
50 ;
51 ; SCLIST("ALL",file,scn2) = sub array of all asgns within date range
52 ; Format:
53 ; file: 404.52 or 404.53
54 ; scn2: Sequential number form 1 to n
55 ; Piece Description
56 ; 1 status int [1:active,0:inactive]
57 ; 2 status ext ["ACTIVE","INACTIVE"]
58 ; 3 status FM date
59 ; 4 status ext date
60 ; 5 file = 404.52: practitioner ien (200)
61 ; = 404.53: prec tm pos ien (404.57)
62 ; 6 file = 404.52: practitioner name
63 ; = 404.53: prec tm pos name
64 ; 7 ien of [file] history
65 ;
66 ; SCLIST('SCPR',sc200,sctp,scact,scn)=""
67 ;
68 ; SCLIST('CH')= position asgn history status
69 ; Format:
70 ; Piece Description
71 ; 1 [1:corrupt hist file,0:ok]
72 ; 2 global first act hist date
73 ; 3 global first act hist ien
74 ;
75 ; SCLIST('PR','CH')= preceptor asgn history status
76 ; Format:
77 ; Piece Description
78 ; 1 [1:corrupt hist file,0:ok]
79 ; 2 global first act hist date
80 ; 3 global first act hist ien
81 ;
82 ; SCERR() = Array of DIALOG file messages(errors)
83 ; Format:
84 ; @SCERR@(0) = Number of errors, undefined if none
85 ; Subscript: Sequential # from 1 to n
86 ; Piece Description
87 ; 1 IEN of DIALOG file
88 ; Returned: 1 if ok, 0 if error
89 ;
90 ; -- initialize control variables
91 ;
92ST N SCPOSNM,SCPOS0,SCEFF,SCPRTP,SCTPNODE,SCVALHIS,SCI,SCN,SCSTOP
93 N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7,SCP8,SCP9,SCP10,SCP11,SCP12
94 N SCLSEQ,SCRN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
95 ;
96 G:'$$OKDATA PRACQ ; no team pos/date array
97 G:'$D(^SCTM(404.52,"AIDT",SCTP)) PRACQ ; no history
98 ;
99 S SCPRCPTR=$S(+$G(SCPRCPTR):1,1:0)
100 S SCALLHIS=$S(+$G(SCALLHIS):1,1:0)
101 ;
102 S @SCLIST@("CH")=$$VALHIST^SCAPMCU5(404.52,SCTP,"SCVALHIS")
103 G:'$$ACTHIST^SCAPMCU5("SCVALHIS","SCDATES") PRACQ
104 ;G:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP") PRACQ
105 G:'$D(SCVALHIS) TPALL ; no coherent history
106 ;
107 ; get static return pieces
108 S SCP3=SCTP ;tm pos ien
109 S SCTPNODE=$G(^SCTM(404.57,SCTP,0)) ;tm pos node
110 S SCP4=$P(SCTPNODE,U) ;tm pos name
111 S SCP5=$P(SCTPNODE,U,13) ;user class pointer
112 S SCP6=$P($G(^USR(8930,+SCP5,0)),U) ;user class name
113 S SCP7=$P(SCTPNODE,U,3) ;std pos pointer
114 S SCP8=$P($G(^SD(403.46,+SCP7,0)),U) ;std pos name
115 S SCP12=$$OKPREC3^SCMCLK(SCTP,DT) ;prec tm pos ien^name
116 ;
117 ; -- get list from position assignments
118 S SCRN=0
119 S SCEFF=-(SCEND+.000001)
120 F S SCEFF=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF)) Q:'SCEFF D
121 . ;Q:'$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCPRTP")
122 . S SCP11="" ; posn act hist ien
123 . F S SCP11=$O(^SCTM(404.52,"AIDT",SCTP,1,SCEFF,SCP11),-1) Q:'SCP11 D
124 . . Q:'$D(SCVALHIS("I",SCP11))
125 . . S SCP1=+$P($G(^SCTM(404.52,SCP11,0)),U,3) ;practitioner ien
126 . . S SCP2=$P($G(^VA(200,+SCP1,0)),U) ;practitioner name
127 . . S SCI=$O(SCVALHIS("I",SCP11,0))
128 . . S SCP9=$O(SCVALHIS(SCI,0)) ;hist start date
129 . . Q:$D(@SCLIST@("SCPR",SCP1,SCTP,SCP9))
130 . . S SCP10=$P(SCVALHIS(SCI,SCP9,SCP11),U) ;hist end date
131 . . Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCP9,SCP10)
132 . . S SCRN=SCRN+1
133 . . S @SCLIST@(0)=SCRN
134 . . S @SCLIST@("SCPR",SCP1,SCTP,SCP9,SCRN)=""
135 . . S @SCLIST@(SCRN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7_U_SCP8_U_SCP9_U_SCP10_U_SCP11_U_SCP12
136 . . Q
137 . Q
138 ;
139 I $G(@SCLIST@(0))>0,+SCPRCPTR D PRCTP^SCAPMC8P
140TPALL I +SCALLHIS D TPALL^SCAPMC8A(404.52)
141 ;
142PRACQ Q $G(SCERR(0))<1 ;bp/djb 7/12/99
143 ;
144OKDATA() ;check/setup variables - return 1 if ok/0 if error
145 N SCOK
146 S SCOK=1
147 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
148 IF '$D(^SCTM(404.57,+$G(SCTP),0)) D S SCOK=0
149 . S SCPARM("POSITION")=$G(SCTP,"Undefined")
150 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
151 ; -- is it a valid TEAM ien passed (Error # 4045101 in DIALOG file)
152 IF '$D(^SCTM(404.57,+$G(SCTP),0))!('$D(SCDATES)) D S SCOK=0
153 . S SCPARM("POSITION")=$S('$D(SCTP):"Undefined",1:SCTP)
154 . S SCPARM("DATES")=$S('$D(SCDATES):"Undefined",1:SCDATES)
155 . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
156 Q SCOK
157 ;
Note: See TracBrowser for help on using the repository browser.