| [1115] | 1 | BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/16/11 7:08am
|
|---|
| [1142] | 2 | ;;1.5T1;BSDX;;Apr 06, 2011
|
|---|
| [614] | 3 | ;
|
|---|
| 4 | SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
|---|
| 5 | ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
|
|---|
| 6 | ;
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | SUINFO(BSDXY,BSDXDUZ) ;EP
|
|---|
| 10 | ;Called by BSDX SCHEDULING USER INFO
|
|---|
| 11 | ;Returns ADO Recordset having column MANAGER
|
|---|
| 12 | ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
|
|---|
| 13 | ;
|
|---|
| 14 | N BSDXMGR,BSDXERR
|
|---|
| 15 | K ^BSDXTMP($J)
|
|---|
| 16 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 17 | S BSDXI=0
|
|---|
| 18 | S BSDXERR=""
|
|---|
| 19 | S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
|
|---|
| 20 | ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
|
|---|
| 21 | I '+BSDXDUZ S BSDXDUZ=DUZ
|
|---|
| 22 | S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
|
|---|
| 23 | S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
|
|---|
| 24 | S BSDXI=BSDXI+1
|
|---|
| 25 | S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
|
|---|
| 26 | S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
|---|
| 27 | Q
|
|---|
| 28 | DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
|---|
| 29 | ;
|
|---|
| 30 | ;
|
|---|
| 31 | ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
|
|---|
| 32 | ;
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | DEPUSR(BSDXY,BSDXDUZ) ;EP
|
|---|
| 36 | ;Called by BSDX RESOURCE GROUPS BY USER
|
|---|
| 37 | ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
|
|---|
| [963] | 38 | ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
|
|---|
| [614] | 39 | ;If BSDXDUZ=0 then returns all department names for current DUZ
|
|---|
| [968] | 40 | ;if not linked, always returned.
|
|---|
| [614] | 41 | ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
|
|---|
| 42 | ;then ALL resource group names are returned regardless of whether any active resources
|
|---|
| 43 | ;are associated with the group or not.
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
|
|---|
| 47 | N BSDXMGR,BSDXNOD
|
|---|
| 48 | K ^BSDXTEMP($J)
|
|---|
| 49 | K ^BSDXTMP($J)
|
|---|
| 50 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 51 | S BSDXI=0
|
|---|
| 52 | S BSDXERR=""
|
|---|
| 53 | S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
|
|---|
| 54 | I '+BSDXDUZ S BSDXDUZ=DUZ
|
|---|
| 55 | ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
|
|---|
| 56 | S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
|
|---|
| 57 | ;
|
|---|
| 58 | ;User does not have BSDXZMGR or XUPROGMODE keys, so
|
|---|
| 59 | ;$O THRU AC XREF OF BSDX RESOURCE USER
|
|---|
| 60 | I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 61 | . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
|
|---|
| [963] | 62 | . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file)
|
|---|
| [968] | 63 | . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit
|
|---|
| [614] | 64 | . S BSDXRNOD=^BSDXRES(BSDXRES,0)
|
|---|
| 65 | . ;QUIT if the resource is inactive
|
|---|
| 66 | . Q:$P(BSDXRNOD,U,2)=1
|
|---|
| 67 | . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
|
|---|
| 68 | . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
|
|---|
| 69 | . . Q:$D(^BSDXTEMP($J,BSDXDEP))
|
|---|
| 70 | . . S ^BSDXTEMP($J,BSDXDEP)=""
|
|---|
| 71 | . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
|
|---|
| 72 | . . S BSDXI=BSDXI+1
|
|---|
| 73 | . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
|
|---|
| 74 | . . Q
|
|---|
| 75 | . Q
|
|---|
| 76 | ;
|
|---|
| 77 | ;User does have BSDXZMGR or XUPROGMODE keys, so
|
|---|
| 78 | ;$O THRU BSDX RESOURCE GROUP file directly
|
|---|
| 79 | I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 80 | . Q:'$D(^BSDXDEPT(BSDXIEN,0))
|
|---|
| 81 | . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
|
|---|
| 82 | . S BSDXDEPN=$P(BSDXNOD,U)
|
|---|
| 83 | . S BSDXI=BSDXI+1
|
|---|
| 84 | . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
|
|---|
| 85 | . Q
|
|---|
| 86 | ;
|
|---|
| 87 | S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | ;
|
|---|
| 91 | RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
|---|
| 92 | ;
|
|---|
| 93 | ;
|
|---|
| 94 | ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
|
|---|
| 95 | ;
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | RESUSR(BSDXY,BSDXDUZ) ;EP
|
|---|
| 99 | ;Returns ADO Recordset with ALL RESOURCE names
|
|---|
| 100 | ;Inactive RESOURCES are NOT filtered out
|
|---|
| 101 | ;Called by BSDX RESOURCES BY USER
|
|---|
| 102 | ;
|
|---|
| 103 | N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
|
|---|
| 104 | N BSDXNOS,BSDXCAN
|
|---|
| 105 | K ^BSDXTMP($J)
|
|---|
| 106 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 107 | S BSDXI=0
|
|---|
| 108 | S BSDXERR=""
|
|---|
| 109 | S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
|
|---|
| 110 | S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
|
|---|
| 111 | I '+BSDXDUZ S BSDXDUZ=DUZ
|
|---|
| 112 | ;$O THRU AC XREF OF BSDX RESOURCE USER
|
|---|
| 113 | ;Rmoved these lines in order to just return all resource names
|
|---|
| 114 | ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 115 | ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
|
|---|
| 116 | ;
|
|---|
| 117 | ;$O THRU BSDX RESOURCE File
|
|---|
| 118 | S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D
|
|---|
| 119 | . Q:'$D(^BSDXRES(BSDXRES,0))
|
|---|
| 120 | . S BSDXRNOD=^BSDXRES(BSDXRES,0)
|
|---|
| [951] | 121 | . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location
|
|---|
| [968] | 122 | . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
|
|---|
| [614] | 123 | . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
|
|---|
| [965] | 124 | . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit
|
|---|
| [968] | 125 | . K BSDXRDAT
|
|---|
| [614] | 126 | . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
|
|---|
| 127 | . S BSDXRDAT=BSDXRES_U_BSDXRDAT
|
|---|
| 128 | . ;Get letter text from wp field
|
|---|
| 129 | . S BSDXLTR=""
|
|---|
| 130 | . I $D(^BSDXRES(BSDXRES,1)) D
|
|---|
| 131 | . . S BSDXIEN=0
|
|---|
| 132 | . . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 133 | . . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
|
|---|
| 134 | . . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
|
|---|
| 135 | . S BSDXNOS=""
|
|---|
| 136 | . I $D(^BSDXRES(BSDXRES,12)) D
|
|---|
| 137 | . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 138 | . . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
|
|---|
| 139 | . . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
|
|---|
| 140 | . S BSDXCAN=""
|
|---|
| 141 | . I $D(^BSDXRES(BSDXRES,13)) D
|
|---|
| 142 | . . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 143 | . . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
|
|---|
| 144 | . . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
|
|---|
| 145 | . N BSDXACC,BSDXMGR
|
|---|
| 146 | . S BSDXACC="0^0^0^0"
|
|---|
| 147 | . S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
|
|---|
| 148 | . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
|
|---|
| 149 | . S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
|
|---|
| 150 | . I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
|
|---|
| 151 | . I BSDXACC="0^0^0^0" D
|
|---|
| 152 | . . N BSDXNOD,BSDXRUID
|
|---|
| 153 | . . S BSDXRUID=0
|
|---|
| 154 | . . ;Get entry for this user and resource
|
|---|
| 155 | . . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
|
|---|
| 156 | . . Q:'+BSDXRUID
|
|---|
| 157 | . . S $P(BSDXACC,U)=1
|
|---|
| 158 | . . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
|
|---|
| 159 | . . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
|
|---|
| 160 | . . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
|
|---|
| 161 | . . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
|
|---|
| 162 | . S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
|
|---|
| 163 | . S BSDXI=BSDXI+1
|
|---|
| 164 | . S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
|
|---|
| 165 | S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
|---|
| 166 | Q
|
|---|
| 167 | ;
|
|---|
| 168 | DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
|
|---|
| 169 | ;
|
|---|
| 170 | ;
|
|---|
| 171 | ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
|
|---|
| 172 | ;
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | DEPRES(BSDXY,BSDXDUZ) ;EP
|
|---|
| 176 | ;Called by BSDX GROUP RESOURCE
|
|---|
| 177 | ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
|
|---|
| 178 | ;to which user has access based on entries in BSDX RESOURCE USER file
|
|---|
| 179 | ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
|
|---|
| 180 | ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
|
|---|
| 181 | ;then ALL ACTIVE resource group names are returned
|
|---|
| 182 | ;
|
|---|
| 183 | N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
|
|---|
| 184 | N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
|
|---|
| 185 | K ^BSDXTEMP($J)
|
|---|
| 186 | K ^BSDXTMP($J)
|
|---|
| 187 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 188 | S BSDXI=0
|
|---|
| 189 | S BSDXERR=""
|
|---|
| 190 | S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
|
|---|
| 191 | I '+BSDXDUZ S BSDXDUZ=DUZ
|
|---|
| 192 | ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
|
|---|
| 193 | S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
|
|---|
| 194 | ;
|
|---|
| 195 | ;User does not have BSDXZMGR or XUPROGMODE keys, so
|
|---|
| 196 | ;$O THRU AC XREF OF BSDX RESOURCE USER
|
|---|
| 197 | I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 198 | . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
|
|---|
| [963] | 199 | . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group
|
|---|
| [968] | 200 | . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.
|
|---|
| [614] | 201 | . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
|
|---|
| 202 | . Q:BSDXRNOD=""
|
|---|
| 203 | . ;QUIT if the resource is inactive
|
|---|
| 204 | . Q:$P(BSDXRNOD,U,2)=1
|
|---|
| 205 | . S BSDXRESN=$P(BSDXRNOD,U)
|
|---|
| 206 | . S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
|
|---|
| 207 | . . Q:'$D(^BSDXDEPT(BSDXDEP,0))
|
|---|
| 208 | . . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
|
|---|
| 209 | . . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
|
|---|
| 210 | . . S BSDXI=BSDXI+1
|
|---|
| 211 | . . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
|
|---|
| 212 | . Q
|
|---|
| 213 | ;
|
|---|
| 214 | ;User does have BSDXZMGR or XUPROGMODE keys, so
|
|---|
| 215 | ;$O THRU BSDX RESOURCE GROUP file directly
|
|---|
| 216 | I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
|
|---|
| 217 | . Q:'$D(^BSDXDEPT(BSDXIEN,0))
|
|---|
| 218 | . S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
|
|---|
| 219 | . S BSDXDEPN=$P(BSDXNOD,U)
|
|---|
| 220 | . S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
|
|---|
| 221 | . . N BSDXRESD
|
|---|
| [963] | 222 | . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple
|
|---|
| [614] | 223 | . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
|
|---|
| [963] | 224 | . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid
|
|---|
| [968] | 225 | . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division
|
|---|
| [614] | 226 | . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
|
|---|
| 227 | . . Q:BSDXRNOD=""
|
|---|
| 228 | . . ;QUIT if the resource is inactive
|
|---|
| 229 | . . Q:$P(BSDXRNOD,U,2)=1
|
|---|
| 230 | . . S BSDXRESN=$P(BSDXRNOD,U)
|
|---|
| 231 | . . S BSDXI=BSDXI+1
|
|---|
| 232 | . . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
|
|---|
| 233 | . . Q
|
|---|
| 234 | . Q
|
|---|
| 235 | ;
|
|---|
| 236 | S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
|
|---|
| 237 | Q
|
|---|
| 238 | ;
|
|---|
| 239 | APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
|
|---|
| 240 | ;
|
|---|
| 241 | N BSDXIEN,BSDXPROG,BSDXPKEY
|
|---|
| 242 | I '$G(BSDXDUZ) Q 0
|
|---|
| 243 | ;
|
|---|
| 244 | ;Test for programmer mode key
|
|---|
| 245 | S BSDXPROG=0
|
|---|
| 246 | I $D(^DIC(19.1,"B","XUPROGMODE")) D
|
|---|
| 247 | . S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
|
|---|
| 248 | . I '+BSDXPKEY Q
|
|---|
| 249 | . I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
|
|---|
| 250 | . S BSDXPROG=1
|
|---|
| 251 | I BSDXPROG Q 1
|
|---|
| 252 | ;
|
|---|
| 253 | I BSDXKEY="" Q 0
|
|---|
| 254 | I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
|
|---|
| 255 | S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
|
|---|
| 256 | I '+BSDXIEN Q 0
|
|---|
| 257 | I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
|
|---|
| 258 | Q 1
|
|---|
| [1116] | 259 | SP(BSDXY,PARAM,YESNO) ; Save Param at User Level - EP
|
|---|
| [1115] | 260 | ; Called by RPC: BSDX SET PARAM
|
|---|
| 261 | ; Input:
|
|---|
| 262 | ; - Param: Name of Parameter (prog name of course)
|
|---|
| 263 | ; - Yes/No: 1 or 0
|
|---|
| 264 | ; Output: Error Code as string; 0 is good
|
|---|
| 265 | ;
|
|---|
| 266 | ; Security Protection
|
|---|
| 267 | IF $EXTRACT(PARAM,1,4)'="BSDX" S BSDXY="-1^BSDX Params only allowed" QUIT
|
|---|
| 268 | ;
|
|---|
| 269 | N ERROR
|
|---|
| 270 | D PUT^XPAR("USR",PARAM,1,YESNO,.ERROR)
|
|---|
| 271 | S BSDXY=$G(ERROR)
|
|---|
| 272 | QUIT
|
|---|
| 273 | ;
|
|---|
| [1116] | 274 | GP(BSDXY,PARAM) ; Get Param - EP
|
|---|
| [1115] | 275 | ; Called by RPC: BSDX GET PARAM
|
|---|
| 276 | ; Input: Name of Parameter
|
|---|
| 277 | ; Output: Value of parameter: 0 or 1, for now.
|
|---|
| 278 | ;
|
|---|
| 279 | S BSDXY=$$GET^XPAR("USR^LOC^SYS^PKG",PARAM,1,"I")
|
|---|
| 280 | QUIT
|
|---|
| 281 | ;
|
|---|
| [968] | 282 | INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
|
|---|
| 283 | ; Input: BSDXSC - Hospital Location IEN
|
|---|
| 284 | ; Output: True or False
|
|---|
| 285 | I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
|
|---|
| 286 | I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
|
|---|
| 287 | ; Jump to Division:Medical Center Division:Inst File Pointer for
|
|---|
| 288 | ; Institution IEN (and get its internal value)
|
|---|
| 289 | N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
|
|---|
| 290 | I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
|
|---|
| 291 | I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
|
|---|
| 292 | E Q 0 ; Otherwise, no
|
|---|
| 293 | QUIT
|
|---|
| 294 | INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
|
|---|
| 295 | ; Input BSDXRES - BSDX RESOURCE IEN
|
|---|
| 296 | ; Output: True of False
|
|---|
| 297 | Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
|
|---|
| 298 | UnitTestINDIV
|
|---|
| 299 | W "Testing if they are the same",!
|
|---|
| 300 | S DUZ(2)=67
|
|---|
| 301 | I '$$INDIV(1) W "ERROR",!
|
|---|
| 302 | I '$$INDIV(2) W "ERROR",!
|
|---|
| 303 | W "Testing if Div not defined in 44, should be true",!
|
|---|
| 304 | I '$$INDIV(3) W "ERROR",!
|
|---|
| 305 | W "Testing empty string. Should be true",!
|
|---|
| 306 | I '$$INDIV("") W "ERROR",!
|
|---|
| 307 | W "Testing if they are different",!
|
|---|
| 308 | S DUZ(2)=899
|
|---|
| 309 | I $$INDIV(1) W "ERROR",!
|
|---|
| 310 | I $$INDIV(2) W "ERROR",!
|
|---|
| 311 | QUIT
|
|---|
| 312 | UnitTestINDIV2
|
|---|
| 313 | W "Testing if they are the same",!
|
|---|
| 314 | S DUZ(2)=69
|
|---|
| 315 | I $$INDIV2(22)'=0 W "ERROR",!
|
|---|
| 316 | I $$INDIV2(25)'=1 W "ERROR",!
|
|---|
| 317 | I $$INDIV2(26)'=1 W "ERROR",!
|
|---|
| 318 | I $$INDIV2(27)'=1 W "ERROR",!
|
|---|
| 319 | QUIT
|
|---|
