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

PSSEXLST.m

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