source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSOUTSC.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSSOUTSC ;BIR/RTR-Outpatient Schedule processor ;08/21/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
3 ;
4EN(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
8EN1 ;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
23PASS ;
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
29OUT ;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
34OUTZ ;
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
Note: See TracBrowser for help on using the repository browser.