| [613] | 1 | SCDXUAPI ;ALB/MLI - Utility API to add OOS clinic locations ; 10/8/96
|
|---|
| 2 | ;;5.3;Scheduling;**63**;AUG 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; This utility should be called only by the lab or radiology packages
|
|---|
| 5 | ; or other applications designated as needing clinics which are
|
|---|
| 6 | ; exempted from classification and check-out information. It will
|
|---|
| 7 | ; create clinic locations which are editable only using this API.
|
|---|
| 8 | ; These locations will be set up to not allow clinic patterns to be
|
|---|
| 9 | ; built (no appointments may be made to the clinics).
|
|---|
| 10 | ;
|
|---|
| 11 | RAD(IEN,PKG) ; radiology call
|
|---|
| 12 | ;
|
|---|
| 13 | ; Description:
|
|---|
| 14 | ; This call will accept the IEN of a location currently defined.
|
|---|
| 15 | ; It will check to look for clinic patterns. If none exist, it
|
|---|
| 16 | ; will update the location fields for an occasion of service
|
|---|
| 17 | ; location. If there are clinic patterns set up, it will convert
|
|---|
| 18 | ; the existing entry to non-count and create a new entry with the
|
|---|
| 19 | ; appropriate fields defined. It will return the IEN of the entry
|
|---|
| 20 | ; used (either the same as the incoming IEN or the IEN of the new
|
|---|
| 21 | ; entry which had to be created).
|
|---|
| 22 | ;
|
|---|
| 23 | ; Input: IEN of existing entry in the Hospital Location file
|
|---|
| 24 | ; PKG as either name, namespace, or IEN of package file
|
|---|
| 25 | ; Output: same IEN or different one if new one had to be created
|
|---|
| 26 | ; - OR- -1^code^description of error encountered
|
|---|
| 27 | ;
|
|---|
| 28 | N ERR,I,OK,SDERR,X,Y
|
|---|
| 29 | S PKG=$$PKGIEN(PKG)
|
|---|
| 30 | F I="IEN","PKG" S SDERR(I)=@I
|
|---|
| 31 | S ERR=$$ERRCHK(.SDERR,1)
|
|---|
| 32 | I ERR]"" G RADQ ; error encountered
|
|---|
| 33 | S OK=$$CHK(IEN) ; patterns?
|
|---|
| 34 | I OK D UPD(IEN,PKG)
|
|---|
| 35 | I 'OK D
|
|---|
| 36 | . D NONCOUNT(IEN)
|
|---|
| 37 | . S IEN=$$NEW(IEN,PKG)
|
|---|
| 38 | RADQ Q $S(ERR]"":ERR,1:IEN)
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | LOC(NAME,INST,STOP,PKG,IEN,INACT) ; add/edit location for ancillary app
|
|---|
| 42 | ;
|
|---|
| 43 | ; Description:
|
|---|
| 44 | ; This call will accept the name, division, and stop code (DSS ID)
|
|---|
| 45 | ; of the clinic location to be add/edited. If the IEN is passed in,
|
|---|
| 46 | ; the entry with that IEN will be updated. Otherwise, a new entry will
|
|---|
| 47 | ; be added. If the INACT variable is set to a date, it will INACTIVATE
|
|---|
| 48 | ; the location (if it exists).
|
|---|
| 49 | ;
|
|---|
| 50 | ; Input: NAME of clinic to be created (optional)
|
|---|
| 51 | ; INST as pointer to the institution file (optional)
|
|---|
| 52 | ; STOP as number of stop code (not IEN) for
|
|---|
| 53 | ; occasion of service range of codes (optional)
|
|---|
| 54 | ; PKG as package file IEN, name, or namespace - required!
|
|---|
| 55 | ; IEN as IEN of location if you want to update an already
|
|---|
| 56 | ; existing location (optional. If not defined, NAME,
|
|---|
| 57 | ; INST, STOP become required)
|
|---|
| 58 | ; INACT as a date if you want to inactivate the location that
|
|---|
| 59 | ; has the IEN you defined (optional)
|
|---|
| 60 | ;
|
|---|
| 61 | ; Output: IEN of location created/inactivated - OR -
|
|---|
| 62 | ; -1^error message if problem encountered
|
|---|
| 63 | N ERR,I,SCERR,X
|
|---|
| 64 | S PKG=$$PKGIEN(PKG)
|
|---|
| 65 | F I="NAME","INST","STOP","INACT","IEN","PKG" I $G(@I) S SCERR(I)=@I
|
|---|
| 66 | S ERR=$$ERRCHK(.SCERR)
|
|---|
| 67 | I ERR]"" G LOCQ
|
|---|
| 68 | I $D(STOP) S STOP=$O(^DIC(40.7,"C",+STOP,0)) I 'STOP S Y=$$ERR(6) G LOCQ
|
|---|
| 69 | I $G(IEN)]"" D
|
|---|
| 70 | . N X
|
|---|
| 71 | . S X=$G(^SC(IEN,"OOS"))
|
|---|
| 72 | . I X,($P(X,"^",2)=PKG) D EDIT(IEN,$G(NAME),$G(INST),$G(STOP),PKG,$G(INACT)) Q
|
|---|
| 73 | . S ERR=$$ERR(7)
|
|---|
| 74 | E D
|
|---|
| 75 | . F I="NAME","INST","STOP" I @I']"" S ERR=$$ERR(8) Q
|
|---|
| 76 | . S IEN=$$ADD(NAME,PKG) I IEN'>0 S ERR=$$ERR(9) Q
|
|---|
| 77 | . D EDIT(IEN,NAME,INST,STOP,PKG)
|
|---|
| 78 | LOCQ Q $S(ERR]"":ERR,1:IEN)
|
|---|
| 79 | ;
|
|---|
| 80 | ;
|
|---|
| 81 | ERRCHK(SC,RAD) ; check input variables for consistency
|
|---|
| 82 | ;
|
|---|
| 83 | ; if RAD defined, don't check division/institution
|
|---|
| 84 | ;
|
|---|
| 85 | N LOC,OK,X,Y
|
|---|
| 86 | S Y=""
|
|---|
| 87 | I $D(SC("IEN")) D I +Y<0 G ERRCHKQ
|
|---|
| 88 | . N IEN
|
|---|
| 89 | . S IEN=SC("IEN")
|
|---|
| 90 | . S LOC=$G(^SC(+IEN,0))
|
|---|
| 91 | . I LOC']"" S Y=$$ERR(1) Q ; invalid ptr
|
|---|
| 92 | . I '$G(RAD),'$D(^DIC(4,+$G(SC("INST")),0)) D I Y]"" Q
|
|---|
| 93 | . . I '$P(LOC,"^",4),'$P(LOC,"^",15) S Y=$$ERR(2) Q ; bad inst/div
|
|---|
| 94 | . S X=$G(^SC(IEN,"I"))
|
|---|
| 95 | . I +X,('$P(X,"^",2)!($P(X,"^",2)>DT)) S Y=$$ERR(3) Q ; inactive
|
|---|
| 96 | . S X=$G(^SC(IEN,"OOS"))
|
|---|
| 97 | . I +X,($P(X,"^",2)'=SC("PKG")) S Y=$$ERR(5) Q ; wrong pkg
|
|---|
| 98 | I PKG'>0 S Y=$$ERR(4) G ERRCHKQ ; pkg invalid
|
|---|
| 99 | I $D(SC("STOP")) D I Y]"" G ERRCHKQ
|
|---|
| 100 | . N STOP
|
|---|
| 101 | . S STOP=SC("STOP")
|
|---|
| 102 | . S STOP=$O(^DIC(40.7,"C",+STOP,0))
|
|---|
| 103 | . I 'STOP S Y=$$ERR(6) Q ; bad stop code
|
|---|
| 104 | . I '$$EX^SDCOU2(+STOP) S Y=$$ERR(10) Q ; not oos stop
|
|---|
| 105 | ERRCHKQ Q Y
|
|---|
| 106 | ;
|
|---|
| 107 | ;
|
|---|
| 108 | NONCOUNT(IEN) ; convert location to non-count
|
|---|
| 109 | ;
|
|---|
| 110 | ; Input: IEN of location to convert
|
|---|
| 111 | ; Output: none
|
|---|
| 112 | ;
|
|---|
| 113 | N DA,DIE,DR
|
|---|
| 114 | S DIE="^SC(",DA=IEN,DR="2502////Y"
|
|---|
| 115 | D ^DIE
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | ;
|
|---|
| 119 | UPD(IEN,PKG) ; update existing entry
|
|---|
| 120 | ;
|
|---|
| 121 | ; Called from within routine only...not supported
|
|---|
| 122 | ; Input: IEN as IEN of location to update
|
|---|
| 123 | ; PKG as calling package
|
|---|
| 124 | ;
|
|---|
| 125 | N SC
|
|---|
| 126 | D VAR(IEN,.SC)
|
|---|
| 127 | D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | ;
|
|---|
| 131 | NEW(IEN,PKG) ; create new entry given parameters from existing entry
|
|---|
| 132 | ;
|
|---|
| 133 | ; Called from within routine only...not supported
|
|---|
| 134 | ; Input: IEN as IEN of location to update
|
|---|
| 135 | ; PKG as calling package
|
|---|
| 136 | ;
|
|---|
| 137 | N SC
|
|---|
| 138 | D VAR(IEN,.SC)
|
|---|
| 139 | S IEN=$$ADD(SC("NAME"),PKG)
|
|---|
| 140 | D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
|
|---|
| 141 | Q IEN
|
|---|
| 142 | ;
|
|---|
| 143 | ;
|
|---|
| 144 | VAR(IEN,SC) ; set up variables for ADD and EDIT calls based on existing entry
|
|---|
| 145 | ;
|
|---|
| 146 | ; Input: IEN as IEN of existing location
|
|---|
| 147 | ; Output: SC("NAME") as name of location
|
|---|
| 148 | ; SC("INST") as institution file ptr
|
|---|
| 149 | ; SC("STOP") as IEN of clinic stop file
|
|---|
| 150 | ;
|
|---|
| 151 | N DIV,X
|
|---|
| 152 | S X=$G(^SC(+$G(IEN),0))
|
|---|
| 153 | S SC("NAME")=$P(X,"^",1)
|
|---|
| 154 | S SC("STOP")=$P(X,"^",7)
|
|---|
| 155 | I $P(X,"^",4) S SC("INST")=$P(X,"^",4) G VARQ
|
|---|
| 156 | S DIV=$P(X,"^",15),SC("INST")=$P($G(^DG(40.8,+DIV,0)),"^",7)
|
|---|
| 157 | VARQ Q
|
|---|
| 158 | ;
|
|---|
| 159 | ;
|
|---|
| 160 | PKGIEN(PKG) ; get IEN of package file entry
|
|---|
| 161 | ;
|
|---|
| 162 | ; Input: PKG as IEN, name, or abbreviation of PKG
|
|---|
| 163 | ; Output: IEN of package file
|
|---|
| 164 | ;
|
|---|
| 165 | N Y
|
|---|
| 166 | S PKG=$G(PKG)
|
|---|
| 167 | I PKG']"" S Y=-1 G PKGIENQ
|
|---|
| 168 | I PKG S Y=PKG G PKGIENQ
|
|---|
| 169 | S Y=$O(^DIC(9.4,"C",PKG,0)) I Y G PKGIENQ
|
|---|
| 170 | S Y=$O(^DIC(9.4,"B",PKG,0)) I Y G PKGIENQ
|
|---|
| 171 | S Y=-1
|
|---|
| 172 | PKGIENQ Q Y
|
|---|
| 173 | ;
|
|---|
| 174 | ;
|
|---|
| 175 | DIV(INST) ; return division associated with institution
|
|---|
| 176 | Q $O(^DG(40.8,"AD",+INST,0))
|
|---|
| 177 | ;
|
|---|
| 178 | ;
|
|---|
| 179 | CHK(IEN) ; check to see if patterns exist for IEN
|
|---|
| 180 | ;
|
|---|
| 181 | ; Input: IEN of hospital location file
|
|---|
| 182 | ; Output: 1 if ok (no patterns exist); 0 otherwise
|
|---|
| 183 | ;
|
|---|
| 184 | N I,OK
|
|---|
| 185 | S OK=1
|
|---|
| 186 | I $G(^SC(IEN,"SL"))]"" S OK=0 G CHKQ
|
|---|
| 187 | I $O(^SC(IEN,"ST",0)) S OK=0 G CHKQ
|
|---|
| 188 | I $O(^SC(IEN,"T",0)) S OK=0 G CHKQ
|
|---|
| 189 | F I=0:1:6 I $O(^SC(IEN,"T"_I,0)) S OK=0 Q
|
|---|
| 190 | CHKQ Q OK
|
|---|
| 191 | ;
|
|---|
| 192 | ;
|
|---|
| 193 | ADD(SCNAME,SCPKG) ; add new entry
|
|---|
| 194 | ;
|
|---|
| 195 | N DD,DIC,DINUM,DO,X,Y
|
|---|
| 196 | S DIC="^SC(",X=SCNAME,DIC(0)="L"
|
|---|
| 197 | S DIC("DR")="50.01////1;50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);"
|
|---|
| 198 | D FILE^DICN
|
|---|
| 199 | Q +Y
|
|---|
| 200 | ;
|
|---|
| 201 | ;
|
|---|
| 202 | EDIT(SCIEN,SCNAME,SCINST,SCSTOP,SCPKG,SCINACT) ; update fields
|
|---|
| 203 | ;
|
|---|
| 204 | N DA,DIE,DR,INST,X
|
|---|
| 205 | S DIE="^SC(",DA=SCIEN,DR=""
|
|---|
| 206 | I $G(SCNAME)]"" S DR=DR_".01///^S X=SCNAME;" ; name
|
|---|
| 207 | S DR=DR_"2////C;" ; type = clinic
|
|---|
| 208 | I $G(SCINST)]"" D
|
|---|
| 209 | . S DR=DR_"3////^S X=SCINST;" ; inst ptr
|
|---|
| 210 | . S DR=DR_"3.5////^S X=$$DIV^SCDXUAPI(SCINST);" ; division
|
|---|
| 211 | I $G(SCSTOP)]"" S DR=DR_"8////^S X=SCSTOP;" ; stop code
|
|---|
| 212 | S DR=DR_"2504////Y;" ; clinic meets here
|
|---|
| 213 | S DR=DR_"9////0;" ; service=none
|
|---|
| 214 | S DR=DR_"2502////N;" ; non-count=no
|
|---|
| 215 | S DR=DR_"2502.5////0;" ; on fileroom list = no
|
|---|
| 216 | S DR=DR_"26////1;" ; ask provider = yes
|
|---|
| 217 | S DR=DR_"27////0;" ; ask diagnosis = no
|
|---|
| 218 | S DR=DR_"2500////Y;" ; prohibit access=yes
|
|---|
| 219 | S DR=DR_"50.01////1;" ; occasion of serv loc
|
|---|
| 220 | S DR=DR_"50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);" ; calling pkg
|
|---|
| 221 | I $G(SCINACT) D
|
|---|
| 222 | . S DR=DR_"2505////^S X=SCINACT;" ; inact date
|
|---|
| 223 | . S DR=DR_"2506///@;" ; remove react date
|
|---|
| 224 | D ^DIE
|
|---|
| 225 | Q
|
|---|
| 226 | ;
|
|---|
| 227 | ;
|
|---|
| 228 | ERR(NUMBER) ; return error message corresponding to the number passed in
|
|---|
| 229 | ;
|
|---|
| 230 | ; Input: NUMBER of error message to return
|
|---|
| 231 | ; Output: -1^NUMBER^Error Message Text
|
|---|
| 232 | ;
|
|---|
| 233 | Q "-1^"_NUMBER_"^"_$P($T(ERRORS+NUMBER),";;",2)
|
|---|
| 234 | ;
|
|---|
| 235 | ;
|
|---|
| 236 | ERRORS ; list of error messages
|
|---|
| 237 | ;;Hospital Location IEN is Invalid
|
|---|
| 238 | ;;Neither institution nor division defined properly for existing entry
|
|---|
| 239 | ;;Location has an inactivation date
|
|---|
| 240 | ;;Invalid PKG variable passed in
|
|---|
| 241 | ;;IEN belongs to another package (PKG file entries don't match)
|
|---|
| 242 | ;;Invalid stop code passed
|
|---|
| 243 | ;;Invalid IEN passed to LOC call (package doesn't 'own' IEN)
|
|---|
| 244 | ;;NAME, INST, and STOP not all defined before LOC call when IEN not set
|
|---|
| 245 | ;;Unable to add entry to Hospital Location file
|
|---|
| 246 | ;;Stop code not an occassion of service stop
|
|---|
| 247 | ;
|
|---|
| 248 | ;
|
|---|
| 249 | SCREEN(PKG) ; screen to only allow OOS locations for specified package
|
|---|
| 250 | Q "I +$G(^(""OOS"")),($P(^(""OOS""),""^"",2)="_$$PKGIEN(PKG)_")"
|
|---|
| 251 | ;
|
|---|
| 252 | EXEMPT() ; screen on clinic stop file to select only OOS stops
|
|---|
| 253 | Q "I $$EX^SDCOU2(+Y)"
|
|---|
| 254 | ;
|
|---|
| 255 | PKGNM(SCPKG) ; Return Name of Package
|
|---|
| 256 | ; Input: SCPKG - Pointer to Package File (9.4)
|
|---|
| 257 | ; Returned: Name of Package or 'Bad or Missing Pointer'
|
|---|
| 258 | ;
|
|---|
| 259 | N SCOS
|
|---|
| 260 | D:$G(SCPKG) GETS^DIQ(9.4,SCPKG,.01,"E","SCOS")
|
|---|
| 261 | Q $S($D(SCOS(9.4,(+$G(SCPKG))_",",.01,"E")):SCOS(9.4,(+$G(SCPKG))_",",.01,"E"),1:"Bad or Missing Pointer")
|
|---|
