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