| 1 | SCMCLK ;bp/cmf - Preceptor History Functions ; Sep 1999
|
|---|
| 2 | ;;5.3;Scheduling;**177,204**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; - $$OKPREC functions
|
|---|
| 5 | ; - input variables (required)
|
|---|
| 6 | ; scien := pointer to 404.57 (precepted ien)
|
|---|
| 7 | ; scpien := pointer to 404.57 (preceptor ien)
|
|---|
| 8 | ; sclnkdt := date to test
|
|---|
| 9 | ; - output
|
|---|
| 10 | ; $p1 := 1=assignment ok
|
|---|
| 11 | ; 0=not
|
|---|
| 12 | ; $p2 := if not, reason code
|
|---|
| 13 | ; $p3 := if not, reason
|
|---|
| 14 | ;
|
|---|
| 15 | OKPREC(SCIEN,SCPIEN,SCLNKDT) ;
|
|---|
| 16 | ;
|
|---|
| 17 | S SCIEN=+$G(SCIEN,0)
|
|---|
| 18 | S SCPIEN=+$G(SCPIEN,0)
|
|---|
| 19 | S SCLNKDT=+$G(SCLNKDT,0)
|
|---|
| 20 | I (SCIEN<1)!(SCPIEN<1)!(SCLNKDT<1) Q $$S(8)
|
|---|
| 21 | ;
|
|---|
| 22 | I SCIEN=SCPIEN Q $$S(1)
|
|---|
| 23 | ;
|
|---|
| 24 | N SCX,SCY,SCPAH,SCPAHA
|
|---|
| 25 | I '$D(^SCTM(404.57,SCIEN,0)) Q $$S(8)
|
|---|
| 26 | S SCX=$G(^SCTM(404.57,SCIEN,0))
|
|---|
| 27 | I '$D(^SCTM(404.57,SCPIEN,0)) Q $$S(8)
|
|---|
| 28 | S SCY=^SCTM(404.57,SCPIEN,0)
|
|---|
| 29 | I $P(SCX,U,2)'=$P(SCY,U,2) Q $$S(2)
|
|---|
| 30 | ;
|
|---|
| 31 | D DTARY(0)
|
|---|
| 32 | S SCPAH=$$VALHIST^SCAPMCU5(404.53,SCPIEN,"SCPAHA")
|
|---|
| 33 | I $$ACTHIST^SCAPMCU5("SCPAHA","SCLNKDT") Q $$S(3)
|
|---|
| 34 | ;I $$ACTHIST^SCAPMCU2(404.53,SCPIEN,"SCLNKDT") Q $$S(3)
|
|---|
| 35 | ;
|
|---|
| 36 | I '+$P(SCY,U,12) Q $$S(4)
|
|---|
| 37 | ;
|
|---|
| 38 | I +$P(SCX,U,4),'+$P(SCY,U,4) Q $$S(5)
|
|---|
| 39 | ;
|
|---|
| 40 | I $$ACTHIST^SCAPMCU2(404.59,SCPIEN,"SCLNKDT")<1 Q $$S(6)
|
|---|
| 41 | ;
|
|---|
| 42 | I $$CHKPRTP() Q $$S(9)
|
|---|
| 43 | ;
|
|---|
| 44 | Q 1
|
|---|
| 45 | ;
|
|---|
| 46 | OKPREC1(SCPIEN,SCLNKDT) ;
|
|---|
| 47 | ; ; prevent preceptor assignment danglers
|
|---|
| 48 | ; ; should also return array of danglers, if any,
|
|---|
| 49 | ; ; for a cleanup function, but not asked for yet
|
|---|
| 50 | ;
|
|---|
| 51 | ;
|
|---|
| 52 | S SCPIEN=+$G(SCPIEN,0)
|
|---|
| 53 | S SCLNKDT=+$G(SCLNKDT,0)
|
|---|
| 54 | I (SCPIEN<1)!(SCLNKDT<1) Q $$S(8)
|
|---|
| 55 | I '$D(^SCTM(404.53,"AD",SCPIEN)) Q 1
|
|---|
| 56 | ;
|
|---|
| 57 | N SCX,SCN
|
|---|
| 58 | D DTARY(1)
|
|---|
| 59 | K ^TMP("SCPHIS",$J)
|
|---|
| 60 | S SCX=$$PRECHIS(SCPIEN,"SCLNKDT","^TMP(""SCPHIS"",$J)")
|
|---|
| 61 | K ^TMP("SCPHIS",$J)
|
|---|
| 62 | ;
|
|---|
| 63 | Q $S(SCX>0:$$S(7),1:1)
|
|---|
| 64 | ;
|
|---|
| 65 | OKPREC2(SCIEN,SCLNKDT) ; return preceptor ien^name, if any
|
|---|
| 66 | ; ; used for computed field 306 of file 404.57
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | S SCIEN=+$G(SCIEN,0)
|
|---|
| 70 | S SCLNKDT=+$G(SCLNKDT,0)
|
|---|
| 71 | I (SCIEN<1)!(SCLNKDT<1) Q $$S(8)
|
|---|
| 72 | N SCX,SCP2,SCP3,SCPIEN,SCLNKLI,SCLNKER,SCPAH,SCPAHA
|
|---|
| 73 | D DTARY(0)
|
|---|
| 74 | S SCPAH=$$VALHIST^SCAPMCU5(404.53,SCIEN,"SCPAHA")
|
|---|
| 75 | S SCX=$$ACTHIST^SCAPMCU5("SCPAHA","SCLNKDT")
|
|---|
| 76 | ;S SCX=$$ACTHIST^SCAPMCU2(404.53,SCIEN,"SCLNKDT")
|
|---|
| 77 | I +SCX<1 Q ""
|
|---|
| 78 | S SCP2=$P(SCX,U,2)
|
|---|
| 79 | I +SCP2<1 Q ""
|
|---|
| 80 | S SCP3=$P(SCX,U,3)
|
|---|
| 81 | I '$D(^SCTM(404.53,SCP3,0)) Q $$S(8)
|
|---|
| 82 | S SCPIEN=$P(^SCTM(404.53,SCP3,0),U,6)
|
|---|
| 83 | Q $$GETPRTP^SCAPMCU2(SCPIEN,SCLNKDT)
|
|---|
| 84 | ;
|
|---|
| 85 | OKPREC3(SCIEN,SCLNKDT) ; return preceptor position ien^name, if any
|
|---|
| 86 | ; ; used for computed field 305 of file 404.57
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | S SCIEN=+$G(SCIEN,0)
|
|---|
| 90 | S SCLNKDT=+$G(SCLNKDT,0)
|
|---|
| 91 | I (SCIEN<1)!(SCLNKDT<1) Q $$S(8)
|
|---|
| 92 | N SCX,SCP2,SCP3,SCPIEN,SCLNKER,SCPAH,SCPAHA
|
|---|
| 93 | D DTARY(0)
|
|---|
| 94 | S SCPAH=$$VALHIST^SCAPMCU5(404.53,SCIEN,"SCPAHA")
|
|---|
| 95 | S SCX=$$ACTHIST^SCAPMCU5("SCPAHA","SCLNKDT")
|
|---|
| 96 | ;S SCX=$$ACTHIST^SCAPMCU2(404.53,SCIEN,"SCLNKDT")
|
|---|
| 97 | I +SCX<1 Q ""
|
|---|
| 98 | S SCP2=$P(SCX,U,2)
|
|---|
| 99 | I +SCP2<1 Q ""
|
|---|
| 100 | S SCP3=$P(SCX,U,3)
|
|---|
| 101 | I '$D(^SCTM(404.53,SCP3,0)) Q $$S(8)
|
|---|
| 102 | S SCPIEN=$P(^SCTM(404.53,SCP3,0),U,6)
|
|---|
| 103 | Q SCPIEN_U_$$EXT^SCAPMCU2(404.53,SCPIEN)
|
|---|
| 104 | ;
|
|---|
| 105 | OKPREC4(SCIEN) ; return if precepted position can be un-precepted
|
|---|
| 106 | ; ; if patient assign after 1st preceptment date, NO
|
|---|
| 107 | ; ; used by computed field #400 of file 404.57
|
|---|
| 108 | S SCIEN=$G(SCIEN,0)
|
|---|
| 109 | I (SCIEN<1)!('$D(^SCTM(404.57,SCIEN))) Q $$S(8)
|
|---|
| 110 | I '$D(^SCTM(404.53,"B",SCIEN)) Q 1
|
|---|
| 111 | ;
|
|---|
| 112 | N SCVALHIS,SCDT,SCX
|
|---|
| 113 | S SCDT=$P($$VALHIST^SCAPMCU5(404.53,SCIEN,"SCVALHIS"),U,2)
|
|---|
| 114 | I SCDT=0 Q 1
|
|---|
| 115 | S SCX=$$PCPOSCNT^SCAPMCU1(SCIEN,SCDT,0,1)
|
|---|
| 116 | Q $S(SCX>0:$$S(10),1:1)
|
|---|
| 117 | ;
|
|---|
| 118 | OKPREC5(SCIEN,SCLNKDT) ; if position has a preceptor,
|
|---|
| 119 | ; ; is preceptor link valid?
|
|---|
| 120 | ;
|
|---|
| 121 | S SCIEN=$G(SCIEN,0)
|
|---|
| 122 | S SCLNKDT=$G(SCLNKDT,DT)
|
|---|
| 123 | I (SCIEN<1)!(SCLNKDT<1) Q $$S(8)
|
|---|
| 124 | N SCPIEN
|
|---|
| 125 | S SCPIEN=+$$OKPREC3(SCIEN,SCLNKDT)
|
|---|
| 126 | I SCPIEN<1 Q 1
|
|---|
| 127 | Q $$OKPREC(SCIEN,SCPIEN,SCLNKDT)
|
|---|
| 128 | ;
|
|---|
| 129 | PRECHIS(SCPIEN,SCDATES,SCLIST) ;return precepted positions for preceptor
|
|---|
| 130 | ; input
|
|---|
| 131 | ; SCPIEN := preceptor pos ien (404.57) (required)
|
|---|
| 132 | ; SCDATES := standard PCMM date array (required)
|
|---|
| 133 | ; SCDATES(begin) := start date [default = DT]
|
|---|
| 134 | ; SCDATES(end) := end date [default = DT]
|
|---|
| 135 | ; SCDATES(incl) := always set to 0
|
|---|
| 136 | ; SCLIST := output array (required)
|
|---|
| 137 | ;
|
|---|
| 138 | ; output
|
|---|
| 139 | ; @SCLIST@(scn)
|
|---|
| 140 | ; format :=
|
|---|
| 141 | ; pieces 1-13: same as SCLIST(scn,) node of $$prtp^scapmc8
|
|---|
| 142 | ; pieces 14-16: same as SCLIST(scn,'PR',) node of $$prtp^scapmc8
|
|---|
| 143 | ; @SCLIST@('SCPR',precepted team posn ien (404.57) +
|
|---|
| 144 | ; ,preceptor start date +
|
|---|
| 145 | ; ,preceptor asgn ien, +
|
|---|
| 146 | ; ,precepted posn asgn ien,scn)
|
|---|
| 147 | ;
|
|---|
| 148 | S SCPIEN=+$G(SCPIEN,0)
|
|---|
| 149 | S SCDATES=$G(SCDATES)
|
|---|
| 150 | S SCLIST=$G(SCLIST)
|
|---|
| 151 | I (SCPIEN<1)!(SCDATES']"")!(SCLIST']"") Q $$S(8)
|
|---|
| 152 | ;
|
|---|
| 153 | N SCN,SCPVAL,SCPN,SCIEN,SCX,SCXP,SCXPR,SCXARY,SCXDT
|
|---|
| 154 | N SCPTP,SCPTPN,SCBEGIN,SCEND,SCESEQ,SCLSEQ
|
|---|
| 155 | N SCP1P11,SCP12,SCP13,SCP14,SCP15,SCP16,SCR
|
|---|
| 156 | ;
|
|---|
| 157 | S (@SCDATES@("BEGIN"),SCBEGIN)=$G(@SCDATES@("BEGIN"),DT)
|
|---|
| 158 | S (@SCDATES@("END"),SCEND)=$G(@SCDATES@("END"),DT)
|
|---|
| 159 | S @SCDATES@("INCL")=0
|
|---|
| 160 | ;
|
|---|
| 161 | I '$D(^SCTM(404.53,"D",SCPIEN)) Q 0
|
|---|
| 162 | I '$D(^SCTM(404.53,"AD",SCPIEN)) Q 0
|
|---|
| 163 | S SCPN=0 ; incrementor
|
|---|
| 164 | S @SCLIST@(0)=0
|
|---|
| 165 | S SCIEN=0
|
|---|
| 166 | F S SCIEN=$O(^SCTM(404.53,"AD",SCPIEN,SCIEN)) Q:'SCIEN D
|
|---|
| 167 | . ;K SCXPR
|
|---|
| 168 | . ;S SCX=$$ACTHIST^SCAPMCU2(404.53,SCIEN,.SCDATES,"SCXER","SCXPR")
|
|---|
| 169 | . ;Q:+SCX<1
|
|---|
| 170 | . K SCPVAL(SCIEN)
|
|---|
| 171 | . S SCX=$$VALHIST^SCAPMCU5(404.53,SCIEN,"SCPVAL("_SCIEN_")")
|
|---|
| 172 | . Q:'$D(SCPVAL(SCIEN))
|
|---|
| 173 | . S SCX=$$ACTHIST^SCAPMCU5("SCPVAL("_SCIEN_")",.SCDATES)
|
|---|
| 174 | . Q:+SCX<1
|
|---|
| 175 | . ;
|
|---|
| 176 | . S SCX=0
|
|---|
| 177 | . F S SCX=$O(^SCTM(404.53,"AD",SCPIEN,SCIEN,1,SCX)) Q:'SCX D
|
|---|
| 178 | . . Q:'$D(SCPVAL(SCIEN,"I",SCX))
|
|---|
| 179 | . . S SCXARY=$O(SCPVAL(SCIEN,"I",SCX,0))
|
|---|
| 180 | . . S SCP14=$O(SCPVAL(SCIEN,SCXARY,0)) ;precept start dt
|
|---|
| 181 | . . S SCP16=$O(SCPVAL(SCIEN,SCXARY,SCP14,0)) ;precept start ien
|
|---|
| 182 | . . S SCP15=$P(SCPVAL(SCIEN,SCXARY,SCP14,SCP16),U)
|
|---|
| 183 | . . S SCP15=$S(+SCP15>1:SCP15,1:9999999) ;precept end dt
|
|---|
| 184 | . . Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,0,SCP14,SCP15)
|
|---|
| 185 | . . K SCPTP
|
|---|
| 186 | . . K SCXDT
|
|---|
| 187 | . . S SCXDT("BEGIN")=SCP14
|
|---|
| 188 | . . S SCXDT("END")=SCP15
|
|---|
| 189 | . . S SCXDT("INCL")=0
|
|---|
| 190 | . . S SCXP=$$PRTP^SCAPMC8(SCIEN,"SCXDT","SCPTP","SCPTPE")
|
|---|
| 191 | . . Q:+$G(SCPTP(0))<1
|
|---|
| 192 | . . F SCXP=1:1:SCPTP(0) D
|
|---|
| 193 | . . . S SCPN=SCPN+1
|
|---|
| 194 | . . . S SCP1P11=$P(SCPTP(SCXP),U,1,11)
|
|---|
| 195 | . . . S SCP12=$P(SCPTP(SCXP),U,12)
|
|---|
| 196 | . . . S SCP13=$P(SCPTP(SCXP),U,13)
|
|---|
| 197 | . . . S SCR=SCP1P11_U_SCP12_U_SCP13_U_SCP14_U_SCP15_U_SCP16
|
|---|
| 198 | . . . S @SCLIST@(0)=SCPN
|
|---|
| 199 | . . . S @SCLIST@(SCPN)=SCR
|
|---|
| 200 | . . . S @SCLIST@("SCPR",SCIEN,SCP14,SCP16,$P(SCR,U,11),SCPN)=""
|
|---|
| 201 | . . . Q
|
|---|
| 202 | . . Q
|
|---|
| 203 | . K SCPVAL(SCIEN)
|
|---|
| 204 | . Q
|
|---|
| 205 | ;
|
|---|
| 206 | PRECQ Q @SCLIST@(0)>0
|
|---|
| 207 | ;
|
|---|
| 208 | DTARY(SCX) ;
|
|---|
| 209 | S SCLNKDT("BEGIN")=SCLNKDT
|
|---|
| 210 | S SCLNKDT("END")=$S(SCX=1:9999999,1:SCLNKDT)
|
|---|
| 211 | S SCLNKDT("INCL")=0
|
|---|
| 212 | ;I $G(SCLIST)]"" S SCLNKDT("END")=$G(SCLNKDT0,9999999)
|
|---|
| 213 | Q
|
|---|
| 214 | ;
|
|---|
| 215 | CHKPRTP() ;
|
|---|
| 216 | Q $$GETPRTP^SCAPMCU2(SCIEN,SCLNKDT)=$$GETPRTP^SCAPMCU2(SCPIEN,SCLNKDT)
|
|---|
| 217 | ;
|
|---|
| 218 | S(SCX) Q 0_U_SCX_U_$P($T(T+SCX),";;",2)_"."
|
|---|
| 219 | ;
|
|---|
| 220 | T ;;
|
|---|
| 221 | 1 ;;Position can't precept itself;;
|
|---|
| 222 | 2 ;;Preceptor and precepted must be on same team;;
|
|---|
| 223 | 3 ;;Preceptor can't have a preceptor on assignment date;;
|
|---|
| 224 | 4 ;;Preceptor must be able to act as a preceptor;;
|
|---|
| 225 | 5 ;;Preceptor must be PC if precepted is PC;;
|
|---|
| 226 | 6 ;;Preceptor must be active on assignment date;;
|
|---|
| 227 | 7 ;;Active or future precepted position(s);;
|
|---|
| 228 | 8 ;;Invalid Parameter
|
|---|
| 229 | 9 ;;Preceptor/Precepted Staff can't be the same;;
|
|---|
| 230 | 10 ;;Position has patient assignments after precepted date;;
|
|---|
| 231 | ;
|
|---|
