PSS51P1 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1 ;5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,108,118,94**;9/30/97;Build 26
;
ZERO(PSSIEN,PSSFT,PSSPP,PSSTSCH,LIST) ;
;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;PSSPP - PACKAGE PREFIX field (#4) in ADMINISTRATION SCHEDULE file (#51.1). Screens for Administration
;Schedules for the Package Prefix passed.
;PSSTSCH - TYPE OF SCHEDULE field (#5) of ADMINISTRATION SCHEDULE file (#51.1). Screens for
; One-time "O" if PSSTSCH passed in.
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
;MAXIMUM DAYS FOR ORDERS field (#2.5), PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5),
;STANDARD SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), and OTHER LANGUAGE EXPANSIONS field (#8.1)
;of ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS51P1,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSTSCH)]"",PSSTSCH'="O" S PSSTSCH=""
S SCR("S")="" I $G(PSSTSCH)]""!$G(PSSPP)]"" D SETSCR
I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,"B",SCR("S"),"") D
.I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.S ^TMP($J,LIST,0)=1
.D GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1","IE","PSS51P1") S PSS(1)=0
.F S PSS(1)=$O(PSS51P1(51.1,PSS(1))) Q:'PSS(1) D SETZRO^PSS51P1B
I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
.I PSSFT["??" D LOOP^PSS51P1B(1) Q
.D FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
.I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
.I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51P1 D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1","IE","PSS51P1") S PSS(1)=0
..F S PSS(1)=$O(PSS51P1(51.1,PSS(1))) Q:'PSS(1) D SETZRO^PSS51P1B
K ^TMP("DILIST",$J)
Q
;
WARD(PSSIEN,PSSFT,PSSIEN2,LIST) ;
;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;PSSIEN2 - IEN of entry in WARD sub-file (#51.11)
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
;of ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS51P1,PSS,CNT
S CNT=0
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN2)]"",+$G(PSSIEN2)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D WARD^PSS51P1C
Q
;
HOSP(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), HOSPITAL LOCATION multiple (#51.17) HOSPITAL LOCATION field (#.01), ADMINISTRATION TIMES field (#1),
;and SHIFTS field (#2) of ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS51P1,SCR,PSS,CNT
I $G(LIST)']"" Q
D HOSP^PSS51P1A
Q
;
IEN(PSSFT,LIST) ;
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01) and STANDARD ADMINISTRATION TIMES field (#1) of ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS51P1,SCR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D IEN^PSS51P1A
Q
;
AP(PSSPP,PSSFT,PSSWDIEN,PSSTYP,LIST,PSSFREQ) ;
;PSSPP - PACKAGE PREFIX in ADMINISTRATION SCHEDULE file (#51.1).
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;PSSWDIEN - IEN of entry of WARD multiple in ADMINISTRATION SCHEDULE file (#51.1).
;PSSSTYP - TYPE OF SCHEDULE field (#5) in ADMINISTRATION SCHEDULE file (#51.1).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), and PACKAGE PREFIX field (#4)
;of ADMINISTRATION SCHEDULE file (#51.1).
;If PSSWDIEN is passed in then the WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
;of ADMINISTRATION SCHEDULE file (#51.1) is returned.
N DIERR,ZZERR,PSS51P1,SCR,PSS,PSSIEN,PSSVAL,PSSTMP
I $G(PSSFREQ)']"" S PSSFREQ=""
I $G(LIST)']"" Q
D AP^PSS51P1A
Q
;
IX(PSSFT,PSSPP,LIST) ;
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;PSSPP - PACKAGE PREFIX in ADMINISTRATION SCHEDULE file (#51.1).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
;MAXIMUM DAYS FOR ORDERS field (#2.5),PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5), STANDARD
;SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), and OTHER LANGUAGE EXPANSION field (#8.1) of
;ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS51P1,PSS
I $G(LIST)']"" Q
D IX^PSS51P1A
Q
;
ADM(PSSADM) ; admin times
N X S X=PSSADM
I $S($L($P(X,"-"))>4:1,$L(X)>119:1,$L(X)<2:1,X'>0:1,1:X'?.ANP) K X Q "^"
S X(1)=$P(X,"-") I X(1)'?2N,X(1)'?4N K X Q "^"
S X(1)=$L(X(1)) F X(2)=2:1:$L(X,"-") S X(3)=$P(X,"-",X(2)) I $S($L(X(3))'=X(1):1,X(3)>$S(X(1)=2:24,1:2400):1,1:X(3)'>$P(X,"-",X(2)-1)) K X Q
I '$D(X) Q "^"
K:$D(X) X(1),X(2),X(3) Q PSSADM
;
ALL(PSSIEN,PSSFT,LIST) ;
;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
; Field Number of the data piece being returned.
;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
;MAXIMUM DAYS FOR ORDERS field (#2.5), PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5),
;STANDARD SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), OTHER LANGUAGE EXPANSIONS field (#8.1),
; HOSPITAL LOCATION multiple (#51.17) HOSPITAL LOCATION field (#.01), ADMINISTRATION TIMES field (#1),
;SHIFTS field (#2), WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
;of ADMINISTRATION SCHEDULE file (#51.1).
N DIERR,ZZERR,PSS
I $G(LIST)']"" Q
K ^TMP($J,LIST)
I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
D ALL^PSS51P1C
Q
;
SETSCR ;Set Screen for One-time schedule type
;Naked reference below refers to ^PS(51.1,+Y,0)
I $G(PSSTSCH)]"" S SCR("S")="I $P(^(0),""^"",5)=""O"""
;Naked reference below refers to ^PS(51.1,+Y,0)
I $G(PSSPP)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $P(^(0),""^"",4)=PSSPP",1:"I $P(^(0),""^"",4)=PSSPP")
Q
FREQ(PSSVAL,PSSFREQ) ; VALIDATES FREQUNCY FIELD
S PSSTMP=0
I PSSVAL>PSSFREQ S PSSTMP=1
I PSSVAL<1 S PSSTMP=1
I PSSFREQ="" S PSSTMP=0
Q PSSTMP
PSSDQ ;DQ^DICQ call on 51.1
N DIC,D,DZ S DIC="^PS(51.1,",D="B",DIC(0)="EQS",DZ="??" D DQ^DICQ Q
;
SCHED(PSSWIEN,PSSARRY) ;
I $G(PSSWIEN)="" S PSSWIEN=0
D SCHED^PSSSCHED(PSSWIEN,.PSSARRY) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS51P1 8146 printed Oct 16, 2024@18:30:47 Page 2
PSS51P1 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1 ;5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,108,118,94**;9/30/97;Build 26
+2 ;
ZERO(PSSIEN,PSSFT,PSSPP,PSSTSCH,LIST) ;
+1 ;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;PSSPP - PACKAGE PREFIX field (#4) in ADMINISTRATION SCHEDULE file (#51.1). Screens for Administration
+4 ;Schedules for the Package Prefix passed.
+5 ;PSSTSCH - TYPE OF SCHEDULE field (#5) of ADMINISTRATION SCHEDULE file (#51.1). Screens for
+6 ; One-time "O" if PSSTSCH passed in.
+7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+8 ; Field Number of the data piece being returned.
+9 ;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
+10 ;MAXIMUM DAYS FOR ORDERS field (#2.5), PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5),
+11 ;STANDARD SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), and OTHER LANGUAGE EXPANSIONS field (#8.1)
+12 ;of ADMINISTRATION SCHEDULE file (#51.1).
+13 NEW DIERR,ZZERR,PSS51P1,SCR,PSS
+14 IF $GET(LIST)']""
QUIT
+15 KILL ^TMP($JOB,LIST)
+16 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+17 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+18 IF $GET(PSSTSCH)]""
IF PSSTSCH'="O"
SET PSSTSCH=""
+19 SET SCR("S")=""
IF $GET(PSSTSCH)]""!$GET(PSSPP)]""
DO SETSCR
+20 IF +$GET(PSSIEN)>0
NEW PSSIEN2
SET PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,"B",SCR("S"),"")
Begin DoDot:1
+21 IF +PSSIEN2'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+22 SET ^TMP($JOB,LIST,0)=1
+23 DO GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1","IE","PSS51P1")
SET PSS(1)=0
+24 FOR
SET PSS(1)=$ORDER(PSS51P1(51.1,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO^PSS51P1B
End DoDot:1
+25 IF +$GET(PSSIEN)'>0
IF $GET(PSSFT)]""
Begin DoDot:1
+26 IF PSSFT["??"
DO LOOP^PSS51P1B(1)
QUIT
+27 DO FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
+28 IF +$GET(^TMP("DILIST",$JOB,0))=0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+29 IF +^TMP("DILIST",$JOB,0)>0
SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
NEW PSSXX
SET PSSXX=0
FOR
SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
if 'PSSXX
QUIT
Begin DoDot:2
+30 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
KILL PSS51P1
DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1","IE","PSS51P1")
SET PSS(1)=0
+31 FOR
SET PSS(1)=$ORDER(PSS51P1(51.1,PSS(1)))
if 'PSS(1)
QUIT
DO SETZRO^PSS51P1B
End DoDot:2
End DoDot:1
+32 KILL ^TMP("DILIST",$JOB)
+33 QUIT
+34 ;
WARD(PSSIEN,PSSFT,PSSIEN2,LIST) ;
+1 ;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;PSSIEN2 - IEN of entry in WARD sub-file (#51.11)
+4 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+5 ; Field Number of the data piece being returned.
+6 ;Returns NAME field (#.01), WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
+7 ;of ADMINISTRATION SCHEDULE file (#51.1).
+8 NEW DIERR,ZZERR,PSS51P1,PSS,CNT
+9 SET CNT=0
+10 IF $GET(LIST)']""
QUIT
+11 KILL ^TMP($JOB,LIST)
+12 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+13 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+14 IF $GET(PSSIEN2)]""
IF +$GET(PSSIEN2)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+15 DO WARD^PSS51P1C
+16 QUIT
+17 ;
HOSP(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ; Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), HOSPITAL LOCATION multiple (#51.17) HOSPITAL LOCATION field (#.01), ADMINISTRATION TIMES field (#1),
+6 ;and SHIFTS field (#2) of ADMINISTRATION SCHEDULE file (#51.1).
+7 NEW DIERR,ZZERR,PSS51P1,SCR,PSS,CNT
+8 IF $GET(LIST)']""
QUIT
+9 DO HOSP^PSS51P1A
+10 QUIT
+11 ;
IEN(PSSFT,LIST) ;
+1 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+3 ; Field Number of the data piece being returned.
+4 ;Returns NAME field (#.01) and STANDARD ADMINISTRATION TIMES field (#1) of ADMINISTRATION SCHEDULE file (#51.1).
+5 NEW DIERR,ZZERR,PSS51P1,SCR,PSS
+6 IF $GET(LIST)']""
QUIT
+7 KILL ^TMP($JOB,LIST)
+8 IF $GET(PSSFT)']""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+9 DO IEN^PSS51P1A
+10 QUIT
+11 ;
AP(PSSPP,PSSFT,PSSWDIEN,PSSTYP,LIST,PSSFREQ) ;
+1 ;PSSPP - PACKAGE PREFIX in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;PSSWDIEN - IEN of entry of WARD multiple in ADMINISTRATION SCHEDULE file (#51.1).
+4 ;PSSSTYP - TYPE OF SCHEDULE field (#5) in ADMINISTRATION SCHEDULE file (#51.1).
+5 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+6 ; Field Number of the data piece being returned.
+7 ;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), and PACKAGE PREFIX field (#4)
+8 ;of ADMINISTRATION SCHEDULE file (#51.1).
+9 ;If PSSWDIEN is passed in then the WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
+10 ;of ADMINISTRATION SCHEDULE file (#51.1) is returned.
+11 NEW DIERR,ZZERR,PSS51P1,SCR,PSS,PSSIEN,PSSVAL,PSSTMP
+12 IF $GET(PSSFREQ)']""
SET PSSFREQ=""
+13 IF $GET(LIST)']""
QUIT
+14 DO AP^PSS51P1A
+15 QUIT
+16 ;
IX(PSSFT,PSSPP,LIST) ;
+1 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSPP - PACKAGE PREFIX in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ; Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
+6 ;MAXIMUM DAYS FOR ORDERS field (#2.5),PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5), STANDARD
+7 ;SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), and OTHER LANGUAGE EXPANSION field (#8.1) of
+8 ;ADMINISTRATION SCHEDULE file (#51.1).
+9 NEW DIERR,ZZERR,PSS51P1,PSS
+10 IF $GET(LIST)']""
QUIT
+11 DO IX^PSS51P1A
+12 QUIT
+13 ;
ADM(PSSADM) ; admin times
+1 NEW X
SET X=PSSADM
+2 IF $SELECT($LENGTH($PIECE(X,"-"))>4:1,$LENGTH(X)>119:1,$LENGTH(X)<2:1,X'>0:1,1:X'?.ANP)
KILL X
QUIT "^"
+3 SET X(1)=$PIECE(X,"-")
IF X(1)'?2N
IF X(1)'?4N
KILL X
QUIT "^"
+4 SET X(1)=$LENGTH(X(1))
FOR X(2)=2:1:$LENGTH(X,"-")
SET X(3)=$PIECE(X,"-",X(2))
IF $SELECT($LENGTH(X(3))'=X(1):1,X(3)>$SELECT(X(1)=2:24,1:2400):1,1:X(3)'>$PIECE(X,"-",X(2)-1))
KILL X
QUIT
+5 IF '$DATA(X)
QUIT "^"
+6 if $DATA(X)
KILL X(1),X(2),X(3)
QUIT PSSADM
+7 ;
ALL(PSSIEN,PSSFT,LIST) ;
+1 ;PSSIEN - IEN of entry in ADMINISTRATION SCHEDULE file (#51.1).
+2 ;PSSFT - Free Text name in ADMINISTRATION SCHEDULE file (#51.1).
+3 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
+4 ; Field Number of the data piece being returned.
+5 ;Returns NAME field (#.01), STANDARD ADMINISTRATION TIMES field (#1), FREQUENCY (IN MINUTES) field (#2),
+6 ;MAXIMUM DAYS FOR ORDERS field (#2.5), PACKAGE PREFIX field (#4), TYPE OF SCHEDULE field (#5),
+7 ;STANDARD SHIFTS field (#6), OUTPATIENT EXPANSION field (#8), OTHER LANGUAGE EXPANSIONS field (#8.1),
+8 ; HOSPITAL LOCATION multiple (#51.17) HOSPITAL LOCATION field (#.01), ADMINISTRATION TIMES field (#1),
+9 ;SHIFTS field (#2), WARD multiple (#51.11) WARD field (#.01), and WARD ADMINISTRATION TIMES field (#1)
+10 ;of ADMINISTRATION SCHEDULE file (#51.1).
+11 NEW DIERR,ZZERR,PSS
+12 IF $GET(LIST)']""
QUIT
+13 KILL ^TMP($JOB,LIST)
+14 IF +$GET(PSSIEN)'>0
IF ($GET(PSSFT)']"")
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+15 IF $GET(PSSIEN)]""
IF +$GET(PSSIEN)'>0
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+16 DO ALL^PSS51P1C
+17 QUIT
+18 ;
SETSCR ;Set Screen for One-time schedule type
+1 ;Naked reference below refers to ^PS(51.1,+Y,0)
+2 IF $GET(PSSTSCH)]""
SET SCR("S")="I $P(^(0),""^"",5)=""O"""
+3 ;Naked reference below refers to ^PS(51.1,+Y,0)
+4 IF $GET(PSSPP)]""
SET SCR("S")=$SELECT(SCR("S")]"":SCR("S")_" I $P(^(0),""^"",4)=PSSPP",1:"I $P(^(0),""^"",4)=PSSPP")
+5 QUIT
FREQ(PSSVAL,PSSFREQ) ; VALIDATES FREQUNCY FIELD
+1 SET PSSTMP=0
+2 IF PSSVAL>PSSFREQ
SET PSSTMP=1
+3 IF PSSVAL<1
SET PSSTMP=1
+4 IF PSSFREQ=""
SET PSSTMP=0
+5 QUIT PSSTMP
PSSDQ ;DQ^DICQ call on 51.1
+1 NEW DIC,D,DZ
SET DIC="^PS(51.1,"
SET D="B"
SET DIC(0)="EQS"
SET DZ="??"
DO DQ^DICQ
QUIT
+2 ;
SCHED(PSSWIEN,PSSARRY) ;
+1 IF $GET(PSSWIEN)=""
SET PSSWIEN=0
+2 DO SCHED^PSSSCHED(PSSWIEN,.PSSARRY)
QUIT
