PSSEXLST ; SLC/SS - One-time administration schedules excluded from start stop dates modifications ;Jan 09, 2024@15:08:20
;;1.0;PHARMACY DATA MANAGEMENT;**259**;9/30/97;Build 6
;
; Reference to SITE^VASITE in ICR #10112
; Reference to ^DIC(4 in ICR #10090
; Reference to ^XTV(8989.51,"B", in ICR #2992
; Reference to EDITPAR^XPAREDIT in ICR #2336
; Reference to ^SC( in ICR #10040
; Reference to ^DIC(4.2 in ICR #1966
; Reference to ENVAL^XPAR in ICR #2263
; Reference to GET1^DIQ in ICR #2056
; Reference to ^DIR in ICR #10026
; Reference to ^SC(IEN,42 in ICR #10040
;
EN ;set One-time administration schedules excluded from start stop dates modifications for division and site
N DIR,X,Y
W @IOF
W "ONE-TIME administration schedules that would be excluded"
W !,"from start/stop date and time modifications in CPRS.",!
S DIR(0)="SO^E:Edit exclusion ONE-TIME items from start/stop modification;D:Display excluded ONE-TIME administration schedules"
S DIR("A")="Enter Selection"
D ^DIR
I Y="E" D ENTER G EN
I Y="D" D DSPLY G EN
Q
;
ENTER ; Enter One-time administration schedules excluded from start stop dates modifications for Division and Site"
N PARAM
S PARAM=$O(^XTV(8989.51,"B","PSS EXCLUDE 1TIME STRSTP MODS",""))
I PARAM="" Q ;parameter doesn't exist
D EDITPAR^XPAREDIT(+PARAM)
Q
;
DSPLY ; Display parameter for Division and System
N DIR,Y,X,FLR,PARAM,LOCTYP,LOCNAM,ORARY,HDCON,SCHED
W !
S DIR(0)="SO^D:Divisions;S:Systems;A:All"
S DIR("A")="Enter Selection"
D ^DIR
I Y=""!(Y="^")!($G(DIRUT)) K DIRUT Q
S FLR=$S(Y="D":4,Y="S":4.2,1:0)
S PARAM=$O(^XTV(8989.51,"B","PSS EXCLUDE 1TIME STRSTP MODS",""))
I PARAM="" Q ;parameter doesn't exist
S HDCON=0
D GETDATA(.ORARY)
I '$G(ORARY) W !,"Nothing to display" I $$PRESSKEY() Q
D HDR
S LOCTYP="" F S LOCTYP=$O(ORARY(LOCTYP)) Q:LOCTYP="" D
. S LOCNAM="" F S LOCNAM=$O(ORARY(LOCTYP,LOCNAM)) Q:LOCNAM="" D
.. S SCHED="" F S SCHED=$O(ORARY(LOCTYP,LOCNAM,SCHED)) Q:SCHED="" D
... I $Y+5>IOSL W ! Q:$$PRESSKEY() D HDR
... N DISP S DISP=$G(ORARY(LOCTYP,LOCNAM,SCHED))
... W !,LOCTYP,?14,LOCNAM,?43,$P(DISP,U),?58,$P(DISP,U,3)
I $$PRESSKEY()
Q
;
GETDATA(ORARY) ; Sort and filter entries for display
N ENT,VAL,CNT,LOCNAME,ORLST,PREF
S CNT=0,ENT="",ORARY=0
D GET I '$G(ORLST) Q
F S ENT=$O(ORLST(ENT)) Q:ENT="" D
. N FILENO,IEN
. S FILENO=+$P(ENT,"DIC(",2)
. I FLR>0,FLR'=FILENO Q
. S LOCNAME=$$GET1^DIQ(FILENO,+ENT,.01)
. S CNT=0
. F S CNT=$O(ORLST(ENT,CNT)) Q:CNT="" D
.. S IEN=+$G(ORLST(ENT,CNT))
.. Q:IEN=0
.. S VAL=$$GET1^DIQ(51.1,IEN,.01)
.. S PREF=$$GET1^DIQ(51.1,IEN,4)
.. S ORARY=ORARY+1,ORARY($S(FILENO=4:"Division",FILENO=4.2:"System",1:"Unknown"),$E(LOCNAME,1,27),IEN)=$E(VAL,1,24)_U_PREF_U_CNT
Q
;
HDR ; header
W @IOF
W "Location type",?14,"Location Name",?43,"Schedule",?58,"Entry #"
W !,"-------------",?14,"----------------------------",?43,"--------------",?58,"-------"
Q
;
GET ; get the values for parameter PSS EXCLUDE 1TIME STRSTP MODS
D ENVAL^XPAR(.ORLST,"PSS EXCLUDE 1TIME STRSTP MODS")
Q
;
;Prevents duplicates - validates if the parameter value was already added in the multiple
; PSSVAL - the IEN of #51.1 selected/entered (e.g. 79)
; PSSENT - entity (e.g. "400;DIC(4.2,")
; CURINST - the entry # of the multiple, that the user has selected to add a new value
;returns
; 1 -passed (can be added)
; 0 -failed (cannot be added)
;Example of usage "I '$$VALIDAT^PSSEXLST(+Y,ENT,INST) K X"
VALIDAT(PSSVAL,PSSENT,CURINST) ;
I PSSVAL=0,PSSENT="" Q 0
N PSSINST
N PSSLST D ENVAL^XPAR(.PSSLST,"PSS EXCLUDE 1TIME STRSTP MODS")
S PSSINST=+$$IFEXISTS(.PSSLST,PSSENT,PSSVAL)
; if found and the user does NOT confirm the same entry (INST) then we cannot add a duplicate
I PSSINST,PSSINST'=CURINST W !,"Was added previously." Q 0
Q 1
;
;Do we have this value in the specified ENTITY in the multiple?
;Parameters:
; PSSLST - arrays with the content of parameter received by using ENVAL^XPAR
; PSSENTIT - entity (e.g. "400;DIC(4.2,")
; PSSVAL - the IEN of #51.1 selected/entered (e.g. 79)
;Returns:
; not found : 0
; if found : instance # ^ PSSENTIT (e.g. "79^400;DIC(4.2,"
IFEXISTS(PSSLST,PSSENTIT,PSSVAL) ;
I '$D(PSSLST) Q 0
N PSSX,PSSFOUND S (PSSX,PSSFOUND)=0
F S PSSX=$O(PSSLST(PSSENTIT,PSSX)) Q:+PSSX=0 I PSSVAL=$G(PSSLST(PSSENTIT,PSSX)) S PSSFOUND=PSSX_U_PSSENTIT Q
Q PSSFOUND
;
;API to call from "ADMIN ORWDPS2" RPC
;Checks:
; 1. if invalid parameters or if SCHED is not a ONE-TIME SCHEDULE then return 0
; 2. if this schedule is excluded from the start/stop override:
; - first check on the system/site level, if excluded then return "1^Y",
; - if not excluded the system/site level then check the "division" level
; specified via HOSPLOC parameter (IEN of the file (#44),
; and if excluded then return "1^Y"
; - if ONE-TIME SCHEDULE is not excluded on neither levels then return "1^N"
;Note:
; The ADMIN SCHEDULES (#51.1) file may have duplicate entries with the same name.
; The purpose of this API to check whether the admin schedule selected by the CPRS user is excluded or not.
; The CPRS user will not see any duplicates on the screen because the list of available schedules for the
; user is prepared by "ORWDPS1 SCHALL" RPC, which has a special logic to eliminate duplicates, and it is
; implemented in SCHED^PSSSCHED. Thus, if in $$CHK1TIME^PSSEXLST we use the same API then we will get the
; same list of schedules as the user sees. And then when we locate the admin schedule by its name in that
; list we always locate exactly the same admin schedule that was selected by user - just because other
; duplicate names (if we have them) cannot be selected by the user.
;
;Input parameters:
; SCHED - (#.01) field value of (#51.1) file. (used for ONE-TIME entries that have "PSJ" in the field (#4) and "O" in the field (#5),
; others cannot be selected for the parameter "PSS EXCLUDE 1TIME STRSTP MODS" in #8989.51 file and therefore cannot be
; excluded - see the screening logic there)
; HOSPLOC - IEN of the HOSPITAL LOCATION FILE (#44)
;
;Returns:
; 0 if invalid parameters
; 0 if SCHED is not an ONE-TIME schedule
; 1^Y if SCHED excluded from start/stop override
; 1^N if SCHED NOT excluded from start/stop override
CHK1TIME(SCHED,HOSPLOC) ;
N PSSX,DIVST,PSSSYS,PSSLST,SYST,SCHEDIEN,WARDLOC
; if no admin schedule
I $G(SCHED)']"" Q 0
I $G(HOSPLOC)']"" Q 0
;get WARD location
S WARDLOC=+$$GET1^DIQ(44,HOSPLOC_",",42,"I")
I $G(WARDLOC)']"" Q 0
; find IEN of the schedule with the name passed by GUI via RPC "ORWDPS2 ADMIN"
; that has the type="O" and which is compatible with the location.
S SCHEDIEN=$$SCHEDIEN(+WARDLOC,SCHED)
; in the SCHED parameter is not an ONE-TIME schedule
I SCHEDIEN=0 Q 0
S (PSSX,DIVST,PSSSYS)=0
; "division", i.e. INSTITUTION (#4)
S PSSX=$$DIVSYS(+HOSPLOC)
; "system", i.e. DOMAIN (#4.2)
S PSSSYS=+$P(PSSX,U,2)
; get all entries in the parameter
D ENVAL^XPAR(.PSSLST,"PSS EXCLUDE 1TIME STRSTP MODS")
; determine the system level
S SYST=+PSSSYS_";DIC(4.2,"
; check on the system level
I $$IFEXISTS(.PSSLST,SYST,SCHEDIEN) Q "1^Y"
; check on the user's division level
I $G(DUZ(2))>0 S DIVST=+DUZ(2)_";DIC(4," I $$IFEXISTS(.PSSLST,DIVST,SCHEDIEN) Q "1^Y"
Q "1^N"
;
; We need to find IEN of the ONE-TIME schedule (type="O") with the name that was passed to GUI
; and which is compatible with patient's location.
; We use the same logic that is used by the "ORWDPS1 SCHALL" RPC to prepare list of schedules
; for the CPRS user, only these schedules can be selected by the provider in GUI.
;
;Input:
; WARDIEN - location, IEN of the WARD LOCATION (#42)
; SCHNAME - schedule name (#.01) of the file #51.1
;Output:
; if found return IEN of the file #51.1
; if not found return 0
SCHEDIEN(WARDIEN,SCHNAME) ;
N ARR,IEN,INDX
S ARR="",IEN=0
Q:'$G(WARDIEN) 0
Q:$G(SCHNAME)="" 0
D SCHED^PSSSCHED(WARDIEN,.ARR)
; find schedule with the SCHNAME name and type="O"
; Note: SCHED^PSSSCHED returns only one schedule per name, it does not allow duplicates - see comments for SCHED^PSSSCHED for details
; Therefore the first entry SCHNAME found is the only one with this name.
S INDX=0 F S INDX=$O(ARR(INDX)) Q:+INDX=0 I $P(ARR(INDX),U,2)=SCHNAME,$P(ARR(INDX),U,4)="O" S IEN=+ARR(INDX) Q
Q IEN
;press any key
PRESSKEY() ;
W ! K DIR S DIR(0)="E" D ^DIR
I 'Y Q 1 ; if "^"
Q 0 ;if "Enter key"
;
;
;Determine 'division' (INSTITUTION #4) and system (DOMAIN #4.2) by the HOSPITAL LOCATION (#44)
;Parameter:
; PTR44 - (#44) HOSPITAL LOCATION
;Returns:
; PTR4 - IEN of INSTITUTION (#4) - called 'division' in the PARAMETERS file (#8989.5)
; PTR42 - IEN of DOMAIN (#4.2) - called 'system' in the PARAMETERS file (#8989.5)
DIVSYS(PTR44) ;
N PTR4,PTR42
S (PTR4,PTR42)=0
; determine institution IEN (#4)
S PTR4=$$GET1^DIQ(44,PTR44_",",3,"I") ; ICR #10040
S PTR42=$$GET1^DIQ(4,PTR4_",",60,"I") ; ICR #10090
Q PTR4_U_PTR42
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSEXLST 9135 printed Nov 22, 2024@17:41:32 Page 2
PSSEXLST ; SLC/SS - One-time administration schedules excluded from start stop dates modifications ;Jan 09, 2024@15:08:20
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**259**;9/30/97;Build 6
+2 ;
+3 ; Reference to SITE^VASITE in ICR #10112
+4 ; Reference to ^DIC(4 in ICR #10090
+5 ; Reference to ^XTV(8989.51,"B", in ICR #2992
+6 ; Reference to EDITPAR^XPAREDIT in ICR #2336
+7 ; Reference to ^SC( in ICR #10040
+8 ; Reference to ^DIC(4.2 in ICR #1966
+9 ; Reference to ENVAL^XPAR in ICR #2263
+10 ; Reference to GET1^DIQ in ICR #2056
+11 ; Reference to ^DIR in ICR #10026
+12 ; Reference to ^SC(IEN,42 in ICR #10040
+13 ;
EN ;set One-time administration schedules excluded from start stop dates modifications for division and site
+1 NEW DIR,X,Y
+2 WRITE @IOF
+3 WRITE "ONE-TIME administration schedules that would be excluded"
+4 WRITE !,"from start/stop date and time modifications in CPRS.",!
+5 SET DIR(0)="SO^E:Edit exclusion ONE-TIME items from start/stop modification;D:Display excluded ONE-TIME administration schedules"
+6 SET DIR("A")="Enter Selection"
+7 DO ^DIR
+8 IF Y="E"
DO ENTER
GOTO EN
+9 IF Y="D"
DO DSPLY
GOTO EN
+10 QUIT
+11 ;
ENTER ; Enter One-time administration schedules excluded from start stop dates modifications for Division and Site"
+1 NEW PARAM
+2 SET PARAM=$ORDER(^XTV(8989.51,"B","PSS EXCLUDE 1TIME STRSTP MODS",""))
+3 ;parameter doesn't exist
IF PARAM=""
QUIT
+4 DO EDITPAR^XPAREDIT(+PARAM)
+5 QUIT
+6 ;
DSPLY ; Display parameter for Division and System
+1 NEW DIR,Y,X,FLR,PARAM,LOCTYP,LOCNAM,ORARY,HDCON,SCHED
+2 WRITE !
+3 SET DIR(0)="SO^D:Divisions;S:Systems;A:All"
+4 SET DIR("A")="Enter Selection"
+5 DO ^DIR
+6 IF Y=""!(Y="^")!($GET(DIRUT))
KILL DIRUT
QUIT
+7 SET FLR=$SELECT(Y="D":4,Y="S":4.2,1:0)
+8 SET PARAM=$ORDER(^XTV(8989.51,"B","PSS EXCLUDE 1TIME STRSTP MODS",""))
+9 ;parameter doesn't exist
IF PARAM=""
QUIT
+10 SET HDCON=0
+11 DO GETDATA(.ORARY)
+12 IF '$GET(ORARY)
WRITE !,"Nothing to display"
IF $$PRESSKEY()
QUIT
+13 DO HDR
+14 SET LOCTYP=""
FOR
SET LOCTYP=$ORDER(ORARY(LOCTYP))
if LOCTYP=""
QUIT
Begin DoDot:1
+15 SET LOCNAM=""
FOR
SET LOCNAM=$ORDER(ORARY(LOCTYP,LOCNAM))
if LOCNAM=""
QUIT
Begin DoDot:2
+16 SET SCHED=""
FOR
SET SCHED=$ORDER(ORARY(LOCTYP,LOCNAM,SCHED))
if SCHED=""
QUIT
Begin DoDot:3
+17 IF $Y+5>IOSL
WRITE !
if $$PRESSKEY()
QUIT
DO HDR
+18 NEW DISP
SET DISP=$GET(ORARY(LOCTYP,LOCNAM,SCHED))
+19 WRITE !,LOCTYP,?14,LOCNAM,?43,$PIECE(DISP,U),?58,$PIECE(DISP,U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF $$PRESSKEY()
+21 QUIT
+22 ;
GETDATA(ORARY) ; Sort and filter entries for display
+1 NEW ENT,VAL,CNT,LOCNAME,ORLST,PREF
+2 SET CNT=0
SET ENT=""
SET ORARY=0
+3 DO GET
IF '$GET(ORLST)
QUIT
+4 FOR
SET ENT=$ORDER(ORLST(ENT))
if ENT=""
QUIT
Begin DoDot:1
+5 NEW FILENO,IEN
+6 SET FILENO=+$PIECE(ENT,"DIC(",2)
+7 IF FLR>0
IF FLR'=FILENO
QUIT
+8 SET LOCNAME=$$GET1^DIQ(FILENO,+ENT,.01)
+9 SET CNT=0
+10 FOR
SET CNT=$ORDER(ORLST(ENT,CNT))
if CNT=""
QUIT
Begin DoDot:2
+11 SET IEN=+$GET(ORLST(ENT,CNT))
+12 if IEN=0
QUIT
+13 SET VAL=$$GET1^DIQ(51.1,IEN,.01)
+14 SET PREF=$$GET1^DIQ(51.1,IEN,4)
+15 SET ORARY=ORARY+1
SET ORARY($SELECT(FILENO=4:"Division",FILENO=4.2:"System",1:"Unknown"),$EXTRACT(LOCNAME,1,27),IEN)=$EXTRACT(VAL,1,24)_U_PREF_U_CNT
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
HDR ; header
+1 WRITE @IOF
+2 WRITE "Location type",?14,"Location Name",?43,"Schedule",?58,"Entry #"
+3 WRITE !,"-------------",?14,"----------------------------",?43,"--------------",?58,"-------"
+4 QUIT
+5 ;
GET ; get the values for parameter PSS EXCLUDE 1TIME STRSTP MODS
+1 DO ENVAL^XPAR(.ORLST,"PSS EXCLUDE 1TIME STRSTP MODS")
+2 QUIT
+3 ;
+4 ;Prevents duplicates - validates if the parameter value was already added in the multiple
+5 ; PSSVAL - the IEN of #51.1 selected/entered (e.g. 79)
+6 ; PSSENT - entity (e.g. "400;DIC(4.2,")
+7 ; CURINST - the entry # of the multiple, that the user has selected to add a new value
+8 ;returns
+9 ; 1 -passed (can be added)
+10 ; 0 -failed (cannot be added)
+11 ;Example of usage "I '$$VALIDAT^PSSEXLST(+Y,ENT,INST) K X"
VALIDAT(PSSVAL,PSSENT,CURINST) ;
+1 IF PSSVAL=0
IF PSSENT=""
QUIT 0
+2 NEW PSSINST
+3 NEW PSSLST
DO ENVAL^XPAR(.PSSLST,"PSS EXCLUDE 1TIME STRSTP MODS")
+4 SET PSSINST=+$$IFEXISTS(.PSSLST,PSSENT,PSSVAL)
+5 ; if found and the user does NOT confirm the same entry (INST) then we cannot add a duplicate
+6 IF PSSINST
IF PSSINST'=CURINST
WRITE !,"Was added previously."
QUIT 0
+7 QUIT 1
+8 ;
+9 ;Do we have this value in the specified ENTITY in the multiple?
+10 ;Parameters:
+11 ; PSSLST - arrays with the content of parameter received by using ENVAL^XPAR
+12 ; PSSENTIT - entity (e.g. "400;DIC(4.2,")
+13 ; PSSVAL - the IEN of #51.1 selected/entered (e.g. 79)
+14 ;Returns:
+15 ; not found : 0
+16 ; if found : instance # ^ PSSENTIT (e.g. "79^400;DIC(4.2,"
IFEXISTS(PSSLST,PSSENTIT,PSSVAL) ;
+1 IF '$DATA(PSSLST)
QUIT 0
+2 NEW PSSX,PSSFOUND
SET (PSSX,PSSFOUND)=0
+3 FOR
SET PSSX=$ORDER(PSSLST(PSSENTIT,PSSX))
if +PSSX=0
QUIT
IF PSSVAL=$GET(PSSLST(PSSENTIT,PSSX))
SET PSSFOUND=PSSX_U_PSSENTIT
QUIT
+4 QUIT PSSFOUND
+5 ;
+6 ;API to call from "ADMIN ORWDPS2" RPC
+7 ;Checks:
+8 ; 1. if invalid parameters or if SCHED is not a ONE-TIME SCHEDULE then return 0
+9 ; 2. if this schedule is excluded from the start/stop override:
+10 ; - first check on the system/site level, if excluded then return "1^Y",
+11 ; - if not excluded the system/site level then check the "division" level
+12 ; specified via HOSPLOC parameter (IEN of the file (#44),
+13 ; and if excluded then return "1^Y"
+14 ; - if ONE-TIME SCHEDULE is not excluded on neither levels then return "1^N"
+15 ;Note:
+16 ; The ADMIN SCHEDULES (#51.1) file may have duplicate entries with the same name.
+17 ; The purpose of this API to check whether the admin schedule selected by the CPRS user is excluded or not.
+18 ; The CPRS user will not see any duplicates on the screen because the list of available schedules for the
+19 ; user is prepared by "ORWDPS1 SCHALL" RPC, which has a special logic to eliminate duplicates, and it is
+20 ; implemented in SCHED^PSSSCHED. Thus, if in $$CHK1TIME^PSSEXLST we use the same API then we will get the
+21 ; same list of schedules as the user sees. And then when we locate the admin schedule by its name in that
+22 ; list we always locate exactly the same admin schedule that was selected by user - just because other
+23 ; duplicate names (if we have them) cannot be selected by the user.
+24 ;
+25 ;Input parameters:
+26 ; SCHED - (#.01) field value of (#51.1) file. (used for ONE-TIME entries that have "PSJ" in the field (#4) and "O" in the field (#5),
+27 ; others cannot be selected for the parameter "PSS EXCLUDE 1TIME STRSTP MODS" in #8989.51 file and therefore cannot be
+28 ; excluded - see the screening logic there)
+29 ; HOSPLOC - IEN of the HOSPITAL LOCATION FILE (#44)
+30 ;
+31 ;Returns:
+32 ; 0 if invalid parameters
+33 ; 0 if SCHED is not an ONE-TIME schedule
+34 ; 1^Y if SCHED excluded from start/stop override
+35 ; 1^N if SCHED NOT excluded from start/stop override
CHK1TIME(SCHED,HOSPLOC) ;
+1 NEW PSSX,DIVST,PSSSYS,PSSLST,SYST,SCHEDIEN,WARDLOC
+2 ; if no admin schedule
+3 IF $GET(SCHED)']""
QUIT 0
+4 IF $GET(HOSPLOC)']""
QUIT 0
+5 ;get WARD location
+6 SET WARDLOC=+$$GET1^DIQ(44,HOSPLOC_",",42,"I")
+7 IF $GET(WARDLOC)']""
QUIT 0
+8 ; find IEN of the schedule with the name passed by GUI via RPC "ORWDPS2 ADMIN"
+9 ; that has the type="O" and which is compatible with the location.
+10 SET SCHEDIEN=$$SCHEDIEN(+WARDLOC,SCHED)
+11 ; in the SCHED parameter is not an ONE-TIME schedule
+12 IF SCHEDIEN=0
QUIT 0
+13 SET (PSSX,DIVST,PSSSYS)=0
+14 ; "division", i.e. INSTITUTION (#4)
+15 SET PSSX=$$DIVSYS(+HOSPLOC)
+16 ; "system", i.e. DOMAIN (#4.2)
+17 SET PSSSYS=+$PIECE(PSSX,U,2)
+18 ; get all entries in the parameter
+19 DO ENVAL^XPAR(.PSSLST,"PSS EXCLUDE 1TIME STRSTP MODS")
+20 ; determine the system level
+21 SET SYST=+PSSSYS_";DIC(4.2,"
+22 ; check on the system level
+23 IF $$IFEXISTS(.PSSLST,SYST,SCHEDIEN)
QUIT "1^Y"
+24 ; check on the user's division level
+25 IF $GET(DUZ(2))>0
SET DIVST=+DUZ(2)_";DIC(4,"
IF $$IFEXISTS(.PSSLST,DIVST,SCHEDIEN)
QUIT "1^Y"
+26 QUIT "1^N"
+27 ;
+28 ; We need to find IEN of the ONE-TIME schedule (type="O") with the name that was passed to GUI
+29 ; and which is compatible with patient's location.
+30 ; We use the same logic that is used by the "ORWDPS1 SCHALL" RPC to prepare list of schedules
+31 ; for the CPRS user, only these schedules can be selected by the provider in GUI.
+32 ;
+33 ;Input:
+34 ; WARDIEN - location, IEN of the WARD LOCATION (#42)
+35 ; SCHNAME - schedule name (#.01) of the file #51.1
+36 ;Output:
+37 ; if found return IEN of the file #51.1
+38 ; if not found return 0
SCHEDIEN(WARDIEN,SCHNAME) ;
+1 NEW ARR,IEN,INDX
+2 SET ARR=""
SET IEN=0
+3 if '$GET(WARDIEN)
QUIT 0
+4 if $GET(SCHNAME)=""
QUIT 0
+5 DO SCHED^PSSSCHED(WARDIEN,.ARR)
+6 ; find schedule with the SCHNAME name and type="O"
+7 ; Note: SCHED^PSSSCHED returns only one schedule per name, it does not allow duplicates - see comments for SCHED^PSSSCHED for details
+8 ; Therefore the first entry SCHNAME found is the only one with this name.
+9 SET INDX=0
FOR
SET INDX=$ORDER(ARR(INDX))
if +INDX=0
QUIT
IF $PIECE(ARR(INDX),U,2)=SCHNAME
IF $PIECE(ARR(INDX),U,4)="O"
SET IEN=+ARR(INDX)
QUIT
+10 QUIT IEN
+11 ;press any key
PRESSKEY() ;
+1 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+2 ; if "^"
IF 'Y
QUIT 1
+3 ;if "Enter key"
QUIT 0
+4 ;
+5 ;
+6 ;Determine 'division' (INSTITUTION #4) and system (DOMAIN #4.2) by the HOSPITAL LOCATION (#44)
+7 ;Parameter:
+8 ; PTR44 - (#44) HOSPITAL LOCATION
+9 ;Returns:
+10 ; PTR4 - IEN of INSTITUTION (#4) - called 'division' in the PARAMETERS file (#8989.5)
+11 ; PTR42 - IEN of DOMAIN (#4.2) - called 'system' in the PARAMETERS file (#8989.5)
DIVSYS(PTR44) ;
+1 NEW PTR4,PTR42
+2 SET (PTR4,PTR42)=0
+3 ; determine institution IEN (#4)
+4 ; ICR #10040
SET PTR4=$$GET1^DIQ(44,PTR44_",",3,"I")
+5 ; ICR #10090
SET PTR42=$$GET1^DIQ(4,PTR4_",",60,"I")
+6 QUIT PTR4_U_PTR42
+7 ;
