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

PSSSCHED.m

Go to the documentation of this file.
  1. PSSSCHED ;BIR/JMC-BUILD SCHEDULE LIST FOR CPRS GUI SELECTION ;Feb 12, 2021@13:11
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**94,189,249**;9/30/97;Build 2
  1. ;
  1. ; Reference to SCHE^PSOSIG supported by DBIA 7227
  1. ;
  1. Q ;Cannot be called directly. Must use API
  1. ;
  1. SCHED(PSSWIEN,PSSARRY) ;Receive ward IEN from CPRS and return list of schedules.
  1. ;
  1. ;PSSWIEN = Ward IEN
  1. ;PSSARRY = array passed by reference from CPRS
  1. ;
  1. ;If there is a duplicate schedule, and if one of them contains
  1. ;ward-specific admin times for the ward location of the patient,
  1. ;the schedule returned for inclusion in the list of selectable
  1. ;schedules to CPRS will be the one with the ward-specific admin
  1. ;times. If neither duplicate has ward-specific admin times,
  1. ;then the current functionality of the schedule with the lowest
  1. ;IEN number will remain in place. If both (or more than one)
  1. ;duplicate schedules have ward-specific admin times for the ward
  1. ;location of the patient, then the one with the lowest IEN number
  1. ;will be the schedule returned to CPRS.
  1. ;
  1. ;Example: Patient's ward location is ICU
  1. ;^PS(51.1,"APPSJ","BID",1)=""
  1. ;^PS(51.1,"APPSJ","BID",2)=""
  1. ;
  1. ;If ^PS(51.1,1 does not have ward-specific admin times for
  1. ;the ICU, but ^PS(51.1,2 does, ^PS(51.1,2 will be in the list
  1. ;of schedules returned to CPRS.
  1. ;
  1. ;If neither schedule has ward-specific admin times for the ICU
  1. ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
  1. ;
  1. ;If both schedules have ward-specific admin times for the ICU
  1. ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
  1. ;
  1. ;The returned array to CPRS will be in the format:
  1. ;PSSARRY(n)=IEN^NAME^OUTPATIENT EXPANSION^SCHEDULE TYPE^ADMIN TIME
  1. ;
  1. N PSSSKED,PSSSKED1,PSSSK
  1. K ^TMP("PSSADMIN"),^TMP("PSSDUP")
  1. I $G(PSSWIEN)="" S PSSWIEN=0
  1. S PSSSKED=""
  1. F S PSSSKED=$O(^PS(51.1,"APPSJ",PSSSKED)) Q:PSSSKED="" D
  1. . S PSSSKED1="",PSSSK=1
  1. . F S PSSSKED1=$O(^PS(51.1,"APPSJ",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
  1. . . Q:$P($G(^PS(51.1,PSSSKED1,0)),"^",5)=""
  1. . . Q:$$GET1^DIQ(51.1,PSSSKED1,12,"I") ;Schedule is marked Inactive
  1. . . S ^TMP("PSSDUP",$J,PSSSKED,PSSSK)=PSSSKED1 ;Identify duplicate schedules to work with.
  1. . . S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$S($P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)'="":$P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2),1:$P($G(^PS(51.1,PSSSKED1,0)),"^",2))
  1. . . S PSSSK=PSSSK+1
  1. . I '$D(^TMP("PSSDUP",$J,PSSSKED,2)) K ^TMP("PSSDUP",$J,PSSSKED)
  1. I $D(^TMP("PSSDUP")) D DUP,FORMAT,KILL Q ;Duplicate schedules - determine if any have ward-specific admin times
  1. I '$D(^TMP("PSSDUP")) D FORMAT,KILL Q ;No duplicates in the schedule file - format for proper return to CPRS
  1. Q
  1. KILL ;
  1. K ^TMP("PSSADMIN"),PSSSKED,PSSSKED1,PSSSK,PSSWIEN
  1. Q
  1. DUP ;Compare duplicates to see if any have ward-specific admin times.
  1. S PSSSKED="",PSSSKED1=""
  1. F S PSSSKED=$O(^TMP("PSSDUP",$J,PSSSKED)) Q:PSSSKED="" D
  1. . S PSSSK=""
  1. . F S PSSSK=$O(^TMP("PSSDUP",$J,PSSSKED,PSSSK)) Q:PSSSK="" D
  1. . . S PSSSKED1=$G(^TMP("PSSDUP",$J,PSSSKED,PSSSK))
  1. . . I '$D(^TMP("PSSADMIN",$J,"STD",PSSSKED)) S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$P($G(^PS(51.1,PSSSKED1,0)),"^",2)
  1. . . I '$D(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),PSSSK>1 K ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1) Q
  1. . . I $D(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),'$D(^TMP("PSSADMIN",$J,"WARD",PSSSKED)) S ^TMP("PSSADMIN",$J,"WARD",PSSSKED,PSSSKED1)=$P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)
  1. . . I $D(^TMP("PSSADMIN",$J,"WARD",PSSSKED)) D Q
  1. . . . K ^TMP("PSSADMIN",$J,"STD",PSSSKED)
  1. . . . S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$G(^TMP("PSSADMIN",$J,"WARD",PSSSKED,PSSSKED1))
  1. . . . K ^TMP("PSSADMIN",$J,"WARD",PSSSKED)
  1. K ^TMP("PSSDUP")
  1. Q
  1. FORMAT ;Format array for proper return to CPRS
  1. N PSSCNTR,PSSTMP,PSSEXP,PSSEXP1
  1. S PSSSKED="",PSSSKED1="",PSSCNTR=1
  1. F S PSSSKED=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED)) Q:PSSSKED="" D
  1. . F S PSSSKED1=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
  1. . . S PSSTMP=$G(^PS(51.1,PSSSKED1,0))
  1. . . S PSSEXP=$P(PSSTMP,"^",8) I PSSEXP="",$T(SCHE^PSOSIG)]"" S PSSEXP1=$$SCHE^PSOSIG(PSSSKED) S:PSSEXP1'=PSSSKED PSSEXP=PSSEXP1
  1. . . S PSSARRY(PSSCNTR)=PSSSKED1_"^"_PSSSKED_"^"_PSSEXP_"^"_$P(PSSTMP,"^",5)_"^"_$G(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1))
  1. . . S PSSCNTR=PSSCNTR+1
  1. K PSSCNTR,PSSTMP