| [613] | 1 | PSSOUTSC ;BIR/RTR-Outpatient Schedule processor ;08/21/00
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
|
|---|
| 3 | ;
|
|---|
| 4 | EN(PSSJSCHZ) ;
|
|---|
| 5 | Q:$G(PSSJSCHZ)=""
|
|---|
| 6 | I $G(PSSJSCHZ)[""""!($A(PSSJSCHZ)=45)!(PSSJSCHZ?.E1C.E)!($L(PSSJSCHZ," ")>3)!($L(PSSJSCHZ)>20)!($L(PSSJSCHZ)<1) K PSSJSCHZ
|
|---|
| 7 | Q
|
|---|
| 8 | EN1 ;called from schedule field of Pharmacy Orderable Item File
|
|---|
| 9 | N PSSTRI,PSSTRO,PSSTLP
|
|---|
| 10 | S (PSSTRI,PSSTRO)=0
|
|---|
| 11 | S PSSTLP="" F S PSSTLP=$O(^PSDRUG("ASP",DA,PSSTLP)) Q:PSSTLP="" D
|
|---|
| 12 | .I $P($G(^PSDRUG(PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
|
|---|
| 13 | .I $P($G(^PSDRUG(PSSTLP,2)),"^",3)["O" S PSSTRO=1
|
|---|
| 14 | .I $P($G(^PSDRUG(PSSTLP,2)),"^",3)["I"!($P($G(^(2)),"^",3)["U") S PSSTRI=1
|
|---|
| 15 | I $G(PSSTRI) G PASS
|
|---|
| 16 | S PSSTLP="" F S PSSTLP=$O(^PS(52.6,"AOI",DA,PSSTLP)) Q:PSSTLP="" D
|
|---|
| 17 | .I $P($G(^PS(52.6,PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
|
|---|
| 18 | .S PSSTRI=1
|
|---|
| 19 | I $G(PSSTRI) G PASS
|
|---|
| 20 | S PSSTLP="" F S PSSTLP=$O(^PS(52.7,"AOI",DA,PSSTLP)) Q:PSSTLP="" D
|
|---|
| 21 | .I $P($G(^PS(52.7,PSSTLP,"I")),"^"),$P($G(^("I")),"^")'>DT Q
|
|---|
| 22 | .S PSSTRI=1
|
|---|
| 23 | PASS ;
|
|---|
| 24 | I $G(PSSTRO),'$G(PSSTRI) D OUT Q
|
|---|
| 25 | D SCH^PSSDDUT I $D(X)#2,'$G(PSGS0Y),$G(PSGS0XT) D EN^DDIOL(" Every "_$G(PSGS0XT)_" minutes","","?0")
|
|---|
| 26 | I $G(X)'="",$G(PSSTRO) D OUT
|
|---|
| 27 | K PSSTRO,PSSTRI
|
|---|
| 28 | Q
|
|---|
| 29 | OUT ;Outpatient Input Transform and echo of Outpatient expansion
|
|---|
| 30 | N SCH
|
|---|
| 31 | S SCH=$G(X)
|
|---|
| 32 | D OUTZ I $G(SCHEX)'="" D EN^DDIOL("Outpatient Expansion:","","!!") D EN^DDIOL($G(SCHEX)) D EN^DDIOL(" ","","!")
|
|---|
| 33 | Q
|
|---|
| 34 | OUTZ ;
|
|---|
| 35 | N SQFLAG,SCLOOP,SCLP,SCLPS,SCLHOLD,SCIN,SODL,SST
|
|---|
| 36 | K SCHEX S SQFLAG=0
|
|---|
| 37 | I $G(SCH)="" S SCHEX="" Q
|
|---|
| 38 | 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
|
|---|
| 39 | Q:SQFLAG
|
|---|
| 40 | I $P($G(^PS(51,"A",SCH)),"^")'="" S SCHEX=$P(^(SCH),"^") Q
|
|---|
| 41 | S SCLOOP=0 F SCLP=1:1:$L(SCH) S SCLPS=$E(SCH,SCLP) I SCLPS=" " S SCLOOP=SCLOOP+1
|
|---|
| 42 | I SCLOOP=0 S SCHEX=SCH Q
|
|---|
| 43 | S SCLOOP=SCLOOP+1
|
|---|
| 44 | K SCLHOLD F SCIN=1:1:SCLOOP S (SODL,SCLHOLD(SCIN))=$P(SCH," ",SCIN) D
|
|---|
| 45 | .Q:$G(SODL)=""
|
|---|
| 46 | .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
|
|---|
| 47 | .Q:$G(SQFLAG)
|
|---|
| 48 | .I $P($G(^PS(51,"A",SODL)),"^")'="" S SCLHOLD(SCIN)=$P(^(SODL),"^")
|
|---|
| 49 | S SCHEX="",SQFLAG=0 F SST=1:1:SCLOOP S SCHEX=SCHEX_$S($G(SQFLAG):" ",1:"")_$G(SCLHOLD(SST)),SQFLAG=1
|
|---|
| 50 | Q
|
|---|
