- 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
- 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