- PSSSCHED ;BIR/JMC-BUILD SCHEDULE LIST FOR CPRS GUI SELECTION ;Feb 12, 2021@13:11
- ;;1.0;PHARMACY DATA MANAGEMENT;**94,189,249**;9/30/97;Build 2
- ;
- ; Reference to SCHE^PSOSIG supported by DBIA 7227
- ;
- Q ;Cannot be called directly. Must use API
- ;
- SCHED(PSSWIEN,PSSARRY) ;Receive ward IEN from CPRS and return list of schedules.
- ;
- ;PSSWIEN = Ward IEN
- ;PSSARRY = array passed by reference from CPRS
- ;
- ;If there is a duplicate schedule, and if one of them contains
- ;ward-specific admin times for the ward location of the patient,
- ;the schedule returned for inclusion in the list of selectable
- ;schedules to CPRS will be the one with the ward-specific admin
- ;times. If neither duplicate has ward-specific admin times,
- ;then the current functionality of the schedule with the lowest
- ;IEN number will remain in place. If both (or more than one)
- ;duplicate schedules have ward-specific admin times for the ward
- ;location of the patient, then the one with the lowest IEN number
- ;will be the schedule returned to CPRS.
- ;
- ;Example: Patient's ward location is ICU
- ;^PS(51.1,"APPSJ","BID",1)=""
- ;^PS(51.1,"APPSJ","BID",2)=""
- ;
- ;If ^PS(51.1,1 does not have ward-specific admin times for
- ;the ICU, but ^PS(51.1,2 does, ^PS(51.1,2 will be in the list
- ;of schedules returned to CPRS.
- ;
- ;If neither schedule has ward-specific admin times for the ICU
- ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
- ;
- ;If both schedules have ward-specific admin times for the ICU
- ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
- ;
- ;The returned array to CPRS will be in the format:
- ;PSSARRY(n)=IEN^NAME^OUTPATIENT EXPANSION^SCHEDULE TYPE^ADMIN TIME
- ;
- N PSSSKED,PSSSKED1,PSSSK
- K ^TMP("PSSADMIN"),^TMP("PSSDUP")
- I $G(PSSWIEN)="" S PSSWIEN=0
- S PSSSKED=""
- F S PSSSKED=$O(^PS(51.1,"APPSJ",PSSSKED)) Q:PSSSKED="" D
- . S PSSSKED1="",PSSSK=1
- . F S PSSSKED1=$O(^PS(51.1,"APPSJ",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
- . . Q:$P($G(^PS(51.1,PSSSKED1,0)),"^",5)=""
- . . Q:$$GET1^DIQ(51.1,PSSSKED1,12,"I") ;Schedule is marked Inactive
- . . S ^TMP("PSSDUP",$J,PSSSKED,PSSSK)=PSSSKED1 ;Identify duplicate schedules to work with.
- . . 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))
- . . S PSSSK=PSSSK+1
- . I '$D(^TMP("PSSDUP",$J,PSSSKED,2)) K ^TMP("PSSDUP",$J,PSSSKED)
- I $D(^TMP("PSSDUP")) D DUP,FORMAT,KILL Q ;Duplicate schedules - determine if any have ward-specific admin times
- I '$D(^TMP("PSSDUP")) D FORMAT,KILL Q ;No duplicates in the schedule file - format for proper return to CPRS
- Q
- KILL ;
- K ^TMP("PSSADMIN"),PSSSKED,PSSSKED1,PSSSK,PSSWIEN
- Q
- DUP ;Compare duplicates to see if any have ward-specific admin times.
- S PSSSKED="",PSSSKED1=""
- F S PSSSKED=$O(^TMP("PSSDUP",$J,PSSSKED)) Q:PSSSKED="" D
- . S PSSSK=""
- . F S PSSSK=$O(^TMP("PSSDUP",$J,PSSSKED,PSSSK)) Q:PSSSK="" D
- . . S PSSSKED1=$G(^TMP("PSSDUP",$J,PSSSKED,PSSSK))
- . . I '$D(^TMP("PSSADMIN",$J,"STD",PSSSKED)) S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$P($G(^PS(51.1,PSSSKED1,0)),"^",2)
- . . I '$D(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),PSSSK>1 K ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1) Q
- . . 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)
- . . I $D(^TMP("PSSADMIN",$J,"WARD",PSSSKED)) D Q
- . . . K ^TMP("PSSADMIN",$J,"STD",PSSSKED)
- . . . S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$G(^TMP("PSSADMIN",$J,"WARD",PSSSKED,PSSSKED1))
- . . . K ^TMP("PSSADMIN",$J,"WARD",PSSSKED)
- K ^TMP("PSSDUP")
- Q
- FORMAT ;Format array for proper return to CPRS
- N PSSCNTR,PSSTMP,PSSEXP,PSSEXP1
- S PSSSKED="",PSSSKED1="",PSSCNTR=1
- F S PSSSKED=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED)) Q:PSSSKED="" D
- . F S PSSSKED1=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
- . . S PSSTMP=$G(^PS(51.1,PSSSKED1,0))
- . . S PSSEXP=$P(PSSTMP,"^",8) I PSSEXP="",$T(SCHE^PSOSIG)]"" S PSSEXP1=$$SCHE^PSOSIG(PSSSKED) S:PSSEXP1'=PSSSKED PSSEXP=PSSEXP1
- . . S PSSARRY(PSSCNTR)=PSSSKED1_"^"_PSSSKED_"^"_PSSEXP_"^"_$P(PSSTMP,"^",5)_"^"_$G(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1))
- . . S PSSCNTR=PSSCNTR+1
- K PSSCNTR,PSSTMP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSSCHED 4359 printed Jan 18, 2025@03:35:02 Page 2
- 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
- +2 ;
- +3 ; Reference to SCHE^PSOSIG supported by DBIA 7227
- +4 ;
- +5 ;Cannot be called directly. Must use API
- QUIT
- +6 ;
- SCHED(PSSWIEN,PSSARRY) ;Receive ward IEN from CPRS and return list of schedules.
- +1 ;
- +2 ;PSSWIEN = Ward IEN
- +3 ;PSSARRY = array passed by reference from CPRS
- +4 ;
- +5 ;If there is a duplicate schedule, and if one of them contains
- +6 ;ward-specific admin times for the ward location of the patient,
- +7 ;the schedule returned for inclusion in the list of selectable
- +8 ;schedules to CPRS will be the one with the ward-specific admin
- +9 ;times. If neither duplicate has ward-specific admin times,
- +10 ;then the current functionality of the schedule with the lowest
- +11 ;IEN number will remain in place. If both (or more than one)
- +12 ;duplicate schedules have ward-specific admin times for the ward
- +13 ;location of the patient, then the one with the lowest IEN number
- +14 ;will be the schedule returned to CPRS.
- +15 ;
- +16 ;Example: Patient's ward location is ICU
- +17 ;^PS(51.1,"APPSJ","BID",1)=""
- +18 ;^PS(51.1,"APPSJ","BID",2)=""
- +19 ;
- +20 ;If ^PS(51.1,1 does not have ward-specific admin times for
- +21 ;the ICU, but ^PS(51.1,2 does, ^PS(51.1,2 will be in the list
- +22 ;of schedules returned to CPRS.
- +23 ;
- +24 ;If neither schedule has ward-specific admin times for the ICU
- +25 ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
- +26 ;
- +27 ;If both schedules have ward-specific admin times for the ICU
- +28 ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
- +29 ;
- +30 ;The returned array to CPRS will be in the format:
- +31 ;PSSARRY(n)=IEN^NAME^OUTPATIENT EXPANSION^SCHEDULE TYPE^ADMIN TIME
- +32 ;
- +33 NEW PSSSKED,PSSSKED1,PSSSK
- +34 KILL ^TMP("PSSADMIN"),^TMP("PSSDUP")
- +35 IF $GET(PSSWIEN)=""
- SET PSSWIEN=0
- +36 SET PSSSKED=""
- +37 FOR
- SET PSSSKED=$ORDER(^PS(51.1,"APPSJ",PSSSKED))
- if PSSSKED=""
- QUIT
- Begin DoDot:1
- +38 SET PSSSKED1=""
- SET PSSSK=1
- +39 FOR
- SET PSSSKED1=$ORDER(^PS(51.1,"APPSJ",PSSSKED,PSSSKED1))
- if PSSSKED1=""
- QUIT
- Begin DoDot:2
- +40 if $PIECE($GET(^PS(51.1,PSSSKED1,0)),"^",5)=""
- QUIT
- +41 ;Schedule is marked Inactive
- if $$GET1^DIQ(51.1,PSSSKED1,12,"I")
- QUIT
- +42 ;Identify duplicate schedules to work with.
- SET ^TMP("PSSDUP",$JOB,PSSSKED,PSSSK)=PSSSKED1
- +43 SET ^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1)=$SELECT($PIECE($GET(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)'="":$PIECE($GET(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2),1:$PIECE($GET(^PS(51.1,PSSSKED1,0)),"^",2))
- +44 SET PSSSK=PSSSK+1
- End DoDot:2
- +45 IF '$DATA(^TMP("PSSDUP",$JOB,PSSSKED,2))
- KILL ^TMP("PSSDUP",$JOB,PSSSKED)
- End DoDot:1
- +46 ;Duplicate schedules - determine if any have ward-specific admin times
- IF $DATA(^TMP("PSSDUP"))
- DO DUP
- DO FORMAT
- DO KILL
- QUIT
- +47 ;No duplicates in the schedule file - format for proper return to CPRS
- IF '$DATA(^TMP("PSSDUP"))
- DO FORMAT
- DO KILL
- QUIT
- +48 QUIT
- KILL ;
- +1 KILL ^TMP("PSSADMIN"),PSSSKED,PSSSKED1,PSSSK,PSSWIEN
- +2 QUIT
- DUP ;Compare duplicates to see if any have ward-specific admin times.
- +1 SET PSSSKED=""
- SET PSSSKED1=""
- +2 FOR
- SET PSSSKED=$ORDER(^TMP("PSSDUP",$JOB,PSSSKED))
- if PSSSKED=""
- QUIT
- Begin DoDot:1
- +3 SET PSSSK=""
- +4 FOR
- SET PSSSK=$ORDER(^TMP("PSSDUP",$JOB,PSSSKED,PSSSK))
- if PSSSK=""
- QUIT
- Begin DoDot:2
- +5 SET PSSSKED1=$GET(^TMP("PSSDUP",$JOB,PSSSKED,PSSSK))
- +6 IF '$DATA(^TMP("PSSADMIN",$JOB,"STD",PSSSKED))
- SET ^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1)=$PIECE($GET(^PS(51.1,PSSSKED1,0)),"^",2)
- +7 IF '$DATA(^PS(51.1,PSSSKED1,1,PSSWIEN,0))
- IF PSSSK>1
- KILL ^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1)
- QUIT
- +8 IF $DATA(^PS(51.1,PSSSKED1,1,PSSWIEN,0))
- IF '$DATA(^TMP("PSSADMIN",$JOB,"WARD",PSSSKED))
- SET ^TMP("PSSADMIN",$JOB,"WARD",PSSSKED,PSSSKED1)=$PIECE($GET(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)
- +9 IF $DATA(^TMP("PSSADMIN",$JOB,"WARD",PSSSKED))
- Begin DoDot:3
- +10 KILL ^TMP("PSSADMIN",$JOB,"STD",PSSSKED)
- +11 SET ^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1)=$GET(^TMP("PSSADMIN",$JOB,"WARD",PSSSKED,PSSSKED1))
- +12 KILL ^TMP("PSSADMIN",$JOB,"WARD",PSSSKED)
- End DoDot:3
- QUIT
- End DoDot:2
- End DoDot:1
- +13 KILL ^TMP("PSSDUP")
- +14 QUIT
- FORMAT ;Format array for proper return to CPRS
- +1 NEW PSSCNTR,PSSTMP,PSSEXP,PSSEXP1
- +2 SET PSSSKED=""
- SET PSSSKED1=""
- SET PSSCNTR=1
- +3 FOR
- SET PSSSKED=$ORDER(^TMP("PSSADMIN",$JOB,"STD",PSSSKED))
- if PSSSKED=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET PSSSKED1=$ORDER(^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1))
- if PSSSKED1=""
- QUIT
- Begin DoDot:2
- +5 SET PSSTMP=$GET(^PS(51.1,PSSSKED1,0))
- +6 SET PSSEXP=$PIECE(PSSTMP,"^",8)
- IF PSSEXP=""
- IF $TEXT(SCHE^PSOSIG)]""
- SET PSSEXP1=$$SCHE^PSOSIG(PSSSKED)
- if PSSEXP1'=PSSSKED
- SET PSSEXP=PSSEXP1
- +7 SET PSSARRY(PSSCNTR)=PSSSKED1_"^"_PSSSKED_"^"_PSSEXP_"^"_$PIECE(PSSTMP,"^",5)_"^"_$GET(^TMP("PSSADMIN",$JOB,"STD",PSSSKED,PSSSKED1))
- +8 SET PSSCNTR=PSSCNTR+1
- End DoDot:2
- End DoDot:1
- +9 KILL PSSCNTR,PSSTMP