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