Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCDXUAPI

SCDXUAPI.m

Go to the documentation of this file. 
  1. SCDXUAPI ;ALB/MLI - Utility API to add OOS clinic locations ; 10/8/96
  1.  ;;5.3;Scheduling;**63,1015**;AUG 13, 1993;Build 21
  1.  ;
  1.  ; This utility should be called only by the lab or radiology packages
  1.  ; or other applications designated as needing clinics which are
  1.  ; exempted from classification and check-out information.  It will
  1.  ; create clinic locations which are editable only using this API.
  1.  ; These locations will be set up to not allow clinic patterns to be
  1.  ; built (no appointments may be made to the clinics).
  1.  ;
  1. RAD(IEN,PKG) ; radiology call
  1.  ;
  1.  ; Description:
  1.  ; This call will accept the IEN of a location currently defined. 
  1.  ; It will check to look for clinic patterns.  If none exist, it
  1.  ; will update the location fields for an occasion of service
  1.  ; location.  If there are clinic patterns set up, it will convert
  1.  ; the existing entry to non-count and create a new entry with the
  1.  ; appropriate fields defined.  It will return the IEN of the entry
  1.  ; used (either the same as the incoming IEN or the IEN of the new
  1.  ; entry which had to be created).
  1.  ; 
  1.  ;  Input:  IEN of existing entry in the Hospital Location file
  1.  ;          PKG as either name, namespace, or IEN of package file
  1.  ; Output:  same IEN or different one if new one had to be created
  1.  ;          - OR- -1^code^description of error encountered
  1.  ;
  1.  N ERR,I,OK,SDERR,X,Y
  1.  S PKG=$$PKGIEN(PKG)
  1.  F I="IEN","PKG" S SDERR(I)=@I
  1.  S ERR=$$ERRCHK(.SDERR,1)
  1.  I ERR]"" G RADQ ; error encountered
  1.  S OK=$$CHK(IEN)                                          ; patterns?
  1.  I OK D UPD(IEN,PKG)
  1.  I 'OK D
  1.  . D NONCOUNT(IEN)
  1.  . S IEN=$$NEW(IEN,PKG)
  1. RADQ Q $S(ERR]"":ERR,1:IEN)
  1.  ;
  1.  ;
  1. LOC(NAME,INST,STOP,PKG,IEN,INACT) ; add/edit location for ancillary app
  1.  ;
  1.  ; Description:
  1.  ; This call will accept the name, division, and stop code (DSS ID)
  1.  ; of the clinic location to be add/edited.  If the IEN is passed in,
  1.  ; the entry with that IEN will be updated.  Otherwise, a new entry will
  1.  ; be added.  If the INACT variable is set to a date, it will INACTIVATE
  1.  ; the location (if it exists).
  1.  ;
  1.  ;  Input:  NAME of clinic to be created (optional)
  1.  ;          INST as pointer to the institution file (optional)
  1.  ;          STOP as number of stop code (not IEN) for
  1.  ;                occasion of service range of codes (optional)
  1.  ;          PKG as package file IEN, name, or namespace - required!
  1.  ;          IEN as IEN of location if you want to update an already
  1.  ;                existing location (optional.  If not defined, NAME,
  1.  ;                INST, STOP become required)
  1.  ;          INACT as a date if you want to inactivate the location that
  1.  ;                has the IEN you defined (optional)
  1.  ;
  1.  ; Output:  IEN of location created/inactivated - OR - 
  1.  ;          -1^error message if problem encountered
  1.  N ERR,I,SCERR,X
  1.  S PKG=$$PKGIEN(PKG)
  1.  F I="NAME","INST","STOP","INACT","IEN","PKG" I $G(@I) S SCERR(I)=@I
  1.  S ERR=$$ERRCHK(.SCERR)
  1.  I ERR]"" G LOCQ
  1.  I $D(STOP) S STOP=$O(^DIC(40.7,"C",+STOP,0)) I 'STOP S Y=$$ERR(6) G LOCQ
  1.  I $G(IEN)]"" D
  1.  . N X
  1.  . S X=$G(^SC(IEN,"OOS"))
  1.  . I X,($P(X,"^",2)=PKG) D EDIT(IEN,$G(NAME),$G(INST),$G(STOP),PKG,$G(INACT)) Q
  1.  . S ERR=$$ERR(7)
  1.  E  D
  1.  . F I="NAME","INST","STOP" I @I']"" S ERR=$$ERR(8) Q
  1.  . S IEN=$$ADD(NAME,PKG) I IEN'>0 S ERR=$$ERR(9) Q
  1.  . D EDIT(IEN,NAME,INST,STOP,PKG)
  1. LOCQ Q $S(ERR]"":ERR,1:IEN)
  1.  ;
  1.  ;
  1. ERRCHK(SC,RAD) ; check input variables for consistency
  1.  ;
  1.  ; if RAD defined, don't check division/institution
  1.  ;
  1.  N LOC,OK,X,Y
  1.  S Y=""
  1.  I $D(SC("IEN")) D  I +Y<0 G ERRCHKQ
  1.  . N IEN
  1.  . S IEN=SC("IEN")
  1.  . S LOC=$G(^SC(+IEN,0))
  1.  . I LOC']"" S Y=$$ERR(1) Q                                ; invalid ptr
  1.  . I '$G(RAD),'$D(^DIC(4,+$G(SC("INST")),0)) D  I Y]"" Q
  1.  . . I '$P(LOC,"^",4),'$P(LOC,"^",15) S Y=$$ERR(2) Q       ; bad inst/div
  1.  . S X=$G(^SC(IEN,"I"))
  1.  . I +X,('$P(X,"^",2)!($P(X,"^",2)>DT)) S Y=$$ERR(3) Q     ; inactive
  1.  . S X=$G(^SC(IEN,"OOS"))
  1.  . I +X,($P(X,"^",2)'=SC("PKG")) S Y=$$ERR(5) Q            ; wrong pkg
  1.  I PKG'>0 S Y=$$ERR(4) G ERRCHKQ                                   ; pkg invalid
  1.  I $D(SC("STOP")) D  I Y]"" G ERRCHKQ
  1.  . N STOP
  1.  . S STOP=SC("STOP")
  1.  . S STOP=$O(^DIC(40.7,"C",+STOP,0))
  1.  . I 'STOP S Y=$$ERR(6) Q                                  ; bad stop code
  1.  . I '$$EX^SDCOU2(+STOP) S Y=$$ERR(10) Q                    ; not oos stop
  1. ERRCHKQ Q Y
  1.  ;
  1.  ;
  1. NONCOUNT(IEN) ; convert location to non-count
  1.  ;
  1.  ;  Input:  IEN of location to convert
  1.  ; Output:  none
  1.  ;
  1.  N DA,DIE,DR
  1.  S DIE="^SC(",DA=IEN,DR="2502////Y"
  1.  D ^DIE
  1.  Q
  1.  ;
  1.  ;
  1. UPD(IEN,PKG) ; update existing entry
  1.  ;
  1.  ;  Called from within routine only...not supported
  1.  ;  Input:  IEN as IEN of location to update
  1.  ;          PKG as calling package
  1.  ;
  1.  N SC
  1.  D VAR(IEN,.SC)
  1.  D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
  1.  Q
  1.  ;
  1.  ;
  1. NEW(IEN,PKG) ; create new entry given parameters from existing entry
  1.  ;
  1.  ;  Called from within routine only...not supported
  1.  ;  Input:  IEN as IEN of location to update
  1.  ;          PKG as calling package
  1.  ;
  1.  N SC
  1.  D VAR(IEN,.SC)
  1.  S IEN=$$ADD(SC("NAME"),PKG)
  1.  D EDIT(IEN,SC("NAME"),SC("INST"),SC("STOP"),PKG)
  1.  Q IEN
  1.  ;
  1.  ;
  1. VAR(IEN,SC) ; set up variables for ADD and EDIT calls based on existing entry
  1.  ;
  1.  ;  Input:  IEN as IEN of existing location
  1.  ; Output:  SC("NAME") as name of location
  1.  ;          SC("INST") as institution file ptr
  1.  ;          SC("STOP") as IEN of clinic stop file
  1.  ;
  1.  N DIV,X
  1.  S X=$G(^SC(+$G(IEN),0))
  1.  S SC("NAME")=$P(X,"^",1)
  1.  S SC("STOP")=$P(X,"^",7)
  1.  I $P(X,"^",4) S SC("INST")=$P(X,"^",4) G VARQ
  1.  S DIV=$P(X,"^",15),SC("INST")=$P($G(^DG(40.8,+DIV,0)),"^",7)
  1. VARQ Q
  1.  ;
  1.  ;
  1. PKGIEN(PKG) ; get IEN of package file entry
  1.  ;
  1.  ;  Input:  PKG as IEN, name, or abbreviation of PKG
  1.  ; Output:  IEN of package file
  1.  ;
  1.  N Y
  1.  S PKG=$G(PKG)
  1.  I PKG']"" S Y=-1 G PKGIENQ
  1.  I PKG S Y=PKG G PKGIENQ
  1.  S Y=$O(^DIC(9.4,"C",PKG,0)) I Y G PKGIENQ
  1.  S Y=$O(^DIC(9.4,"B",PKG,0)) I Y G PKGIENQ
  1.  S Y=-1
  1. PKGIENQ Q Y
  1.  ;
  1.  ;
  1. DIV(INST) ; return division associated with institution
  1.  Q $O(^DG(40.8,"AD",+INST,0))
  1.  ;
  1.  ;
  1. CHK(IEN) ; check to see if patterns exist for IEN
  1.  ;
  1.  ;  Input:  IEN of hospital location file
  1.  ; Output:  1 if ok (no patterns exist); 0 otherwise
  1.  ;
  1.  N I,OK
  1.  S OK=1
  1.  I $G(^SC(IEN,"SL"))]"" S OK=0 G CHKQ
  1.  I $O(^SC(IEN,"ST",0)) S OK=0 G CHKQ
  1.  I $O(^SC(IEN,"T",0)) S OK=0 G CHKQ
  1.  F I=0:1:6 I $O(^SC(IEN,"T"_I,0)) S OK=0 Q
  1. CHKQ Q OK
  1.  ;
  1.  ;
  1. ADD(SCNAME,SCPKG) ; add new entry
  1.  ;
  1.  N DD,DIC,DINUM,DO,X,Y
  1.  S DIC="^SC(",X=SCNAME,DIC(0)="L"
  1.  S DIC("DR")="50.01////1;50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);"
  1.  D FILE^DICN
  1.  Q +Y
  1.  ;
  1.  ;
  1. EDIT(SCIEN,SCNAME,SCINST,SCSTOP,SCPKG,SCINACT) ; update fields
  1.  ;
  1.  N DA,DIE,DR,INST,X
  1.  S DIE="^SC(",DA=SCIEN,DR=""
  1.  I $G(SCNAME)]"" S DR=DR_".01///^S X=SCNAME;"    ; name
  1.  S DR=DR_"2////C;"                               ; type = clinic
  1.  I $G(SCINST)]"" D
  1.  . S DR=DR_"3////^S X=SCINST;"                   ; inst ptr
  1.  . S DR=DR_"3.5////^S X=$$DIV^SCDXUAPI(SCINST);" ; division
  1.  I $G(SCSTOP)]"" S DR=DR_"8////^S X=SCSTOP;"     ; stop code
  1.  S DR=DR_"2504////Y;"                            ; clinic meets here
  1.  S DR=DR_"9////0;"                               ; service=none
  1.  S DR=DR_"2502////N;"                            ; non-count=no
  1.  S DR=DR_"2502.5////0;"                          ; on fileroom list = no
  1.  S DR=DR_"26////1;"                              ; ask provider = yes
  1.  S DR=DR_"27////0;"                              ; ask diagnosis = no
  1.  S DR=DR_"2500////Y;"                            ; prohibit access=yes
  1.  S DR=DR_"50.01////1;"                           ; occasion of serv loc
  1.  S DR=DR_"50.02////^S X=$$PKGIEN^SCDXUAPI(SCPKG);"  ; calling pkg
  1.  I $G(SCINACT) D
  1.  . S DR=DR_"2505////^S X=SCINACT;"              ; inact date
  1.  . S DR=DR_"2506///@;"                          ; remove react date
  1.  D ^DIE
  1.  Q
  1.  ;
  1.  ;
  1. ERR(NUMBER) ; return error message corresponding to the number passed in
  1.  ;
  1.  ;  Input:  NUMBER of error message to return
  1.  ; Output:  -1^NUMBER^Error Message Text
  1.  ;
  1.  Q "-1^"_NUMBER_"^"_$P($T(ERRORS+NUMBER),";;",2)
  1.  ;
  1.  ;
  1. ERRORS ; list of error messages
  1.  ;;Hospital Location IEN is Invalid
  1.  ;;Neither institution nor division defined properly for existing entry
  1.  ;;Location has an inactivation date
  1.  ;;Invalid PKG variable passed in
  1.  ;;IEN belongs to another package (PKG file entries don't match)
  1.  ;;Invalid stop code passed
  1.  ;;Invalid IEN passed to LOC call (package doesn't 'own' IEN)
  1.  ;;NAME, INST, and STOP not all defined before LOC call when IEN not set
  1.  ;;Unable to add entry to Hospital Location file
  1.  ;;Stop code not an occassion of service stop
  1.  ;
  1.  ;
  1. SCREEN(PKG) ; screen to only allow OOS locations for specified package
  1.  Q "I +$G(^(""OOS"")),($P(^(""OOS""),""^"",2)="_$$PKGIEN(PKG)_")"
  1.  ;
  1. EXEMPT() ; screen on clinic stop file to select only OOS stops
  1.  Q "I $$EX^SDCOU2(+Y)"
  1.  ;
  1. PKGNM(SCPKG) ; Return Name of Package
  1.  ;  Input:     SCPKG - Pointer to Package File (9.4)
  1.  ;  Returned:  Name of Package or 'Bad or Missing Pointer'
  1.  ;
  1.  N SCOS
  1.  D:$G(SCPKG) GETS^DIQ(9.4,SCPKG,.01,"E","SCOS")
  1.  Q $S($D(SCOS(9.4,(+$G(SCPKG))_",",.01,"E")):SCOS(9.4,(+$G(SCPKG))_",",.01,"E"),1:"Bad or Missing Pointer")