PSSOUTSC ;BIR/RTR-Outpatient Schedule processor ;08/21/00
;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
;
EN(PSSJSCHZ) ;
Q:$G(PSSJSCHZ)=""
I $G(PSSJSCHZ)[""""!($A(PSSJSCHZ)=45)!(PSSJSCHZ?.E1C.E)!($L(PSSJSCHZ," ")>3)!($L(PSSJSCHZ)>20)!($L(PSSJSCHZ)<1) K PSSJSCHZ
Q
EN1 ;called from schedule field of Pharmacy Orderable Item File
N PSSTRI,PSSTRO,PSSTLP
S (PSSTRI,PSSTRO)=0
S PSSTLP="" F S PSSTLP=$O(^PSDRUG("ASP",DA,PSSTLP)) Q:PSSTLP="" D
.I $P($G(^PSDRUG(PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
.I $P($G(^PSDRUG(PSSTLP,2)),"^",3)["O" S PSSTRO=1
.I $P($G(^PSDRUG(PSSTLP,2)),"^",3)["I"!($P($G(^(2)),"^",3)["U") S PSSTRI=1
I $G(PSSTRI) G PASS
S PSSTLP="" F S PSSTLP=$O(^PS(52.6,"AOI",DA,PSSTLP)) Q:PSSTLP="" D
.I $P($G(^PS(52.6,PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
.S PSSTRI=1
I $G(PSSTRI) G PASS
S PSSTLP="" F S PSSTLP=$O(^PS(52.7,"AOI",DA,PSSTLP)) Q:PSSTLP="" D
.I $P($G(^PS(52.7,PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
.S PSSTRI=1
PASS ;
I $G(PSSTRO),'$G(PSSTRI) D OUT Q
D SCH^PSSDDUT I $D(X)#2,'$G(PSGS0Y),$G(PSGS0XT) D EN^DDIOL(" Every "_$G(PSGS0XT)_" minutes","","?0")
I $G(X)'="",$G(PSSTRO) D OUT
K PSSTRO,PSSTRI
Q
OUT ;Outpatient Input Transform and echo of Outpatient expansion
N SCH
S SCH=$G(X)
D OUTZ I $G(SCHEX)'="" D EN^DDIOL("Outpatient Expansion:","","!!") D EN^DDIOL($G(SCHEX)) D EN^DDIOL(" ","","!")
Q
OUTZ ;
N SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST
K SCHEX S SQFLAG=0
I $G(SCH)="" S SCHEX="" Q
F SCLOOP=0:0 S SCLOOP=$O(^PS(51.1,"B",SCH,SCLOOP)) Q:'SCLOOP!(SQFLAG) I $P($G(^PS(51.1,SCLOOP,0)),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SQFLAG=1
Q:SQFLAG
I $P($G(^PS(51,"A",SCH)),"^")'="" S SCHEX=$P(^(SCH),"^") Q
S SCLOOP=0 F SCLP=1:1:$L(SCH) S SCLPS=$E(SCH,SCLP) I SCLPS=" " S SCLOOP=SCLOOP+1
I SCLOOP=0 S SCHEX=SCH Q
S SCLOOP=SCLOOP+1
K SCLHOLD F SCIN=1:1:SCLOOP S (SODL,SCLHOLD(SCIN))=$P(SCH," ",SCIN) D
.Q:$G(SODL)=""
.S SQFLAG=0 F SST=0:0 S SST=$O(^PS(51.1,"B",SODL,SST)) Q:'SST!($G(SQFLAG)) I $P($G(^PS(51.1,SST,0)),"^",8)'="" S SCLHOLD(SCIN)=$P($G(^(0)),"^",8),SQFLAG=1
.Q:$G(SQFLAG)
.I $P($G(^PS(51,"A",SODL)),"^")'="" S SCLHOLD(SCIN)=$P(^(SODL),"^")
S SCHEX="",SQFLAG=0 F SST=1:1:SCLOOP S SCHEX=SCHEX_$S($G(SQFLAG):" ",1:"")_$G(SCLHOLD(SST)),SQFLAG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSOUTSC 2293 printed Oct 16, 2024@18:34:14 Page 2
PSSOUTSC ;BIR/RTR-Outpatient Schedule processor ;08/21/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
+2 ;
EN(PSSJSCHZ) ;
+1 if $GET(PSSJSCHZ)=""
QUIT
+2 IF $GET(PSSJSCHZ)[""""!($ASCII(PSSJSCHZ)=45)!(PSSJSCHZ?.E1C.E)!($LENGTH(PSSJSCHZ," ")>3)!($LENGTH(PSSJSCHZ)>20)!($LENGTH(PSSJSCHZ)<1)
KILL PSSJSCHZ
+3 QUIT
EN1 ;called from schedule field of Pharmacy Orderable Item File
+1 NEW PSSTRI,PSSTRO,PSSTLP
+2 SET (PSSTRI,PSSTRO)=0
+3 SET PSSTLP=""
FOR
SET PSSTLP=$ORDER(^PSDRUG("ASP",DA,PSSTLP))
if PSSTLP=""
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^PSDRUG(PSSTLP,"I")),"^")
IF $PIECE($GET(^("I")),"^")'>DT
QUIT
+5 IF $PIECE($GET(^PSDRUG(PSSTLP,2)),"^",3)["O"
SET PSSTRO=1
+6 IF $PIECE($GET(^PSDRUG(PSSTLP,2)),"^",3)["I"!($PIECE($GET(^(2)),"^",3)["U")
SET PSSTRI=1
End DoDot:1
+7 IF $GET(PSSTRI)
GOTO PASS
+8 SET PSSTLP=""
FOR
SET PSSTLP=$ORDER(^PS(52.6,"AOI",DA,PSSTLP))
if PSSTLP=""
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(^PS(52.6,PSSTLP,"I")),"^")
IF $PIECE($GET(^("I")),"^")'>DT
QUIT
+10 SET PSSTRI=1
End DoDot:1
+11 IF $GET(PSSTRI)
GOTO PASS
+12 SET PSSTLP=""
FOR
SET PSSTLP=$ORDER(^PS(52.7,"AOI",DA,PSSTLP))
if PSSTLP=""
QUIT
Begin DoDot:1
+13 IF $PIECE($GET(^PS(52.7,PSSTLP,"I")),"^")
IF $PIECE($GET(^("I")),"^")'>DT
QUIT
+14 SET PSSTRI=1
End DoDot:1
PASS ;
+1 IF $GET(PSSTRO)
IF '$GET(PSSTRI)
DO OUT
QUIT
+2 DO SCH^PSSDDUT
IF $DATA(X)#2
IF '$GET(PSGS0Y)
IF $GET(PSGS0XT)
DO EN^DDIOL(" Every "_$GET(PSGS0XT)_" minutes","","?0")
+3 IF $GET(X)'=""
IF $GET(PSSTRO)
DO OUT
+4 KILL PSSTRO,PSSTRI
+5 QUIT
OUT ;Outpatient Input Transform and echo of Outpatient expansion
+1 NEW SCH
+2 SET SCH=$GET(X)
+3 DO OUTZ
IF $GET(SCHEX)'=""
DO EN^DDIOL("Outpatient Expansion:","","!!")
DO EN^DDIOL($GET(SCHEX))
DO EN^DDIOL(" ","","!")
+4 QUIT
OUTZ ;
+1 NEW SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST
+2 KILL SCHEX
SET SQFLAG=0
+3 IF $GET(SCH)=""
SET SCHEX=""
QUIT
+4 FOR SCLOOP=0:0
SET SCLOOP=$ORDER(^PS(51.1,"B",SCH,SCLOOP))
if 'SCLOOP!(SQFLAG)
QUIT
IF $PIECE($GET(^PS(51.1,SCLOOP,0)),"^",8)'=""
SET SCHEX=$PIECE($GET(^(0)),"^",8)
SET SQFLAG=1
+5 if SQFLAG
QUIT
+6 IF $PIECE($GET(^PS(51,"A",SCH)),"^")'=""
SET SCHEX=$PIECE(^(SCH),"^")
QUIT
+7 SET SCLOOP=0
FOR SCLP=1:1:$LENGTH(SCH)
SET SCLPS=$EXTRACT(SCH,SCLP)
IF SCLPS=" "
SET SCLOOP=SCLOOP+1
+8 IF SCLOOP=0
SET SCHEX=SCH
QUIT
+9 SET SCLOOP=SCLOOP+1
+10 KILL SCLHOLD
FOR SCIN=1:1:SCLOOP
SET (SODL,SCLHOLD(SCIN))=$PIECE(SCH," ",SCIN)
Begin DoDot:1
+11 if $GET(SODL)=""
QUIT
+12 SET SQFLAG=0
FOR SST=0:0
SET SST=$ORDER(^PS(51.1,"B",SODL,SST))
if 'SST!($GET(SQFLAG))
QUIT
IF $PIECE($GET(^PS(51.1,SST,0)),"^",8)'=""
SET SCLHOLD(SCIN)=$PIECE($GET(^(0)),"^",8)
SET SQFLAG=1
+13 if $GET(SQFLAG)
QUIT
+14 IF $PIECE($GET(^PS(51,"A",SODL)),"^")'=""
SET SCLHOLD(SCIN)=$PIECE(^(SODL),"^")
End DoDot:1
+15 SET SCHEX=""
SET SQFLAG=0
FOR SST=1:1:SCLOOP
SET SCHEX=SCHEX_$SELECT($GET(SQFLAG):" ",1:"")_$GET(SCLHOLD(SST))
SET SQFLAG=1
+16 QUIT
