82 lines
5.3 KiB
Mathematica
82 lines
5.3 KiB
Mathematica
PSOHLSIG ;BIR/RTR-Parse out and create possible Sig ; 7/21/96
|
|
;;7.0;OUTPATIENT PHARMACY;**1,18,41,60**;DEC 1997
|
|
;External reference to File #50.7 supported by DBIA 2223
|
|
;External reference to File #51 supported by DBIA 2224
|
|
;External reference to File #51.1 supported by DBIA 2225
|
|
;External reference to File #51.2 supported by DBIA 2226
|
|
;External reference to File #50.606 supported by DBIA 2174
|
|
Q:'$D(^PS(52.41,PENDING,1,0))
|
|
N SDF,SZZ,ZZS,ZZSB,SSZZ,SCHHOLD,GGGZ,SGLFLAG,SGLOOP,ZSCHED,SPFG,PSNOUN,MEDEXP,PSDUR,NOUN,SCHED,INTERVAL,SIG0,SIG2,SIG3,SDL,WW
|
|
S SIGRT=$P(^PS(52.41,PENDING,0),"^",15),SIGDS=$P(^PS(50.7,$P(^(0),"^",8),0),"^",2),VERB=$P($G(^PS(50.606,SIGDS,"MISC")),"^"),PREP=$P($G(^("MISC")),"^",3)
|
|
F SSS=0:0 S SSS=$O(^PS(52.41,PENDING,1,SSS)) Q:'SSS S SIG0(SSS)=$G(^PS(52.41,PENDING,1,SSS,0)),SIG1(SSS)=$G(^(1)) D NON
|
|
;I SIG0(1)'["&" D SIG1 G STUFF
|
|
S PSOROUTE=$S($P($G(^PS(51.2,+SIGRT,0)),"^",2)'="":$P(^(0),"^",2),$P($G(^(0)),"^",3)'="":$P(^(0),"^",3),1:$P($G(^(0)),"^")) S MEDEXP=$S($P($G(^PS(51.2,+SIGRT,0)),"^",2)="":0,1:1)
|
|
F GGG=0:0 S GGG=$O(SIG1(GGG)) Q:'GGG S ZSCHED(GGG)=$P(SIG1(GGG),"^") D
|
|
.I $G(ZSCHED(GGG))="" S SCHED(GGG)="" Q
|
|
.S SGLFLAG=0 F WW=0:0 S WW=$O(^PS(51.1,"B",ZSCHED(GGG),WW)) Q:'WW!($G(SGLFLAG)) I $P($G(^PS(51.1,WW,0)),"^",8)'="" S SCHED(GGG)=$P($G(^(0)),"^",8),SGLFLAG=1
|
|
.Q:$G(SGLFLAG)
|
|
.I $G(^PS(51,"A",ZSCHED(GGG)))'="" S SCHED(GGG)=$P(^(ZSCHED(GGG)),"^") Q
|
|
.S ZZSB=0 F ZZS=1:1:$L(ZSCHED(GGG)) S SZZ=$E(ZSCHED(GGG),ZZS) I SZZ=" " S ZZSB=ZZSB+1
|
|
.S ZZSB=ZZSB+1
|
|
.K SCHHOLD F GGGZ=1:1:ZZSB S (SDL,SCHHOLD(GGGZ))=$P(ZSCHED(GGG)," ",GGGZ) D
|
|
..Q:$G(SDL)=""
|
|
..S SGLFLAG=0 F WW=0:0 S WW=$O(^PS(51.1,"B",SDL,WW)) Q:'WW!($G(SGLFLAG)) I $P($G(^PS(51.1,WW,0)),"^",8)'="" S SCHHOLD(GGGZ)=$P($G(^(0)),"^",8),SGLFLAG=1
|
|
..Q:$G(SGLFLAG)
|
|
..I $G(^PS(51,"A",SDL))'="" S SCHHOLD(GGGZ)=$P(^(SDL),"^")
|
|
.S SCHED(GGG)="",SGLFLAG=0 F WW=1:1:ZZSB S SCHED(GGG)=SCHED(GGG)_$S($G(SGLFLAG):" ",1:"")_$G(SCHHOLD(WW)),SGLFLAG=1
|
|
F TT=0:0 S TT=$O(SIG1(TT)) Q:'TT D DAYS S PSDUR(TT)=$S($P(SIG1(TT),"^",2)=""!($E($P(SIG1(TT),"^",2))="I"):"NULL",1:"FOR "_$E($P(SIG1(TT),"^",2),2,$L($P(SIG1(TT),"^",2)))) D I PSDUR(TT)'="NULL" S PSDUR(TT)=PSDUR(TT)_" "_INTERVAL
|
|
.I PSDUR(TT)'="NULL" S INTERVAL=$P(SIG1(TT),"^",2),INTERVAL=$S($E(INTERVAL)="D":"DAY(S)",$E(INTERVAL)="W":"WEEK(S)",$E(INTERVAL)="H":"HOUR(S)",$E(INTERVAL)="L":"MONTH(S)",$E(INTERVAL)="M":"MINUTE(S)",$E(INTERVAL)="S":"SECOND(S)",1:"")
|
|
F FFF=0:0 S FFF=$O(SIG0(FFF)) Q:'FFF D
|
|
.;I SIG0(FFF)'["&" S SIG2(FFF)=SIG0(FFF) Q
|
|
.;S SIG2(FFF)=VERB_" "_$P($P(SIG0(FFF),"^"),"&")_" "_$G(PSNOUN(FFF))_" "_PREP_" "_PSOROUTE_$S(SCHED(FFF)'="":" "_SCHED(FFF),1:"")_$S(PSDUR(FFF)'="NULL":PSDUR(FFF),1:"")_$S($P(SIG1(FFF),"^",6)="A":" AND",$P(SIG1(FFF),"^",6)="S":" THEN",1:"")
|
|
.K PSOSG1,PSOSG2 D VERB
|
|
.S SIG2(FFF)=$S(VERB'=""&('$G(PSOSG1)):VERB_" ",1:"")_$S($P($P(SIG0(FFF),"^"),"&")'="":$P($P(SIG0(FFF),"^"),"&")_" ",1:"")_$S($G(PSNOUN(FFF))'=""&('$G(PSOSG2)):$G(PSNOUN(FFF))_" ",1:"")_$S(PREP'=""&($G(MEDEXP)):PREP_" ",1:"")
|
|
.S SIG2(FFF)=SIG2(FFF)_$S(PSOROUTE'="":PSOROUTE_" ",1:"")
|
|
.S SIG2(FFF)=SIG2(FFF)_$S(SCHED(FFF)'="":SCHED(FFF)_" ",1:"")_$S(PSDUR(FFF)'="NULL":PSDUR(FFF)_" ",1:"")_$S($P(SIG1(FFF),"^",6)="A":"AND",$P(SIG1(FFF),"^",6)="S":"THEN",1:"")
|
|
.K PSOSG1,PSOSG2
|
|
STUFF ;
|
|
S DCOUNT=0
|
|
I '$D(SIG2(1)) G QUIT
|
|
I '$O(SIG2(1)),$L(SIG2(1))<71 S ^PS(52.41,PENDING,"SIG",0)="^52.4124A^"_1_"^"_1 S ^PS(52.41,PENDING,"SIG",1,0)=SIG2(1) G QUIT
|
|
S (VAR,VAR1)="",II=1
|
|
F FF=0:0 S FF=$O(SIG2(FF)) Q:'FF S CT=0 F NN=1:1:$L(SIG2(FF)) I $E(SIG2(FF),NN)=" "!($L(SIG2(FF))=NN) S CT=CT+1 D I $L(VAR)>70 S SIG3(II)=LIM_" ",II=II+1,VAR=VAR1
|
|
.S VAR1=$P(SIG2(FF)," ",(CT))
|
|
.S LIM=VAR
|
|
.S VAR=$S(VAR="":VAR1,1:VAR_" "_VAR1)
|
|
I $G(VAR)'="" S SIG3(II)=VAR
|
|
F II=0:0 S II=$O(SIG3(II)) Q:'II S DCOUNT=DCOUNT+1 S ^PS(52.41,PENDING,"SIG",DCOUNT,0)=SIG3(II)
|
|
I DCOUNT S ^PS(52.41,PENDING,"SIG",0)="^52.4124A^"_DCOUNT_"^"_DCOUNT
|
|
QUIT K SSS,TT,DCOUNT,PREP,VERB,FFF,GGG,SIGDS,SIGRT,PSOROUTE,PSOSG1,PSOSG2 Q
|
|
SIG1 ;
|
|
F FFF=0:0 S FFF=$O(SIG0(FFF)) Q:'FFF S SIG2(FFF)=SIG0(FFF)
|
|
Q
|
|
DAYS I +$E($P(SIG1(TT),"^",2))!($E($P(SIG1(TT),"^",2))=0) S $P(SIG1(TT),"^",2)="D"_$P(SIG1(TT),"^",2)
|
|
Q
|
|
NON ;
|
|
I $P($G(SIG0(SSS)),"&",2)'="" S PSNOUN(SSS)=$P($G(SIG0(SSS)),"&",2) Q
|
|
F NOUN=0:0 S NOUN=$O(^PS(50.606,SIGDS,"NOUN",NOUN)) Q:'NOUN!($G(PSNOUN(SSS))'="") I $P($G(^PS(50.606,SIGDS,"NOUN",NOUN,0)),"^")'="",$P($G(^(0)),"^",3) S PSNOUN(SSS)=$P(^(0),"^")
|
|
Q
|
|
VERB ;Check if verb and noun need to be added to SIG
|
|
K PSOLCS,PSOUCS,PSOISL,PSOVL
|
|
I $G(VERB)'="" S PSOVL=$L(VERB),PSOISL=$E($P($P(SIG0(FFF),"^"),"&"),1,$G(PSOVL)) I $G(PSOISL)'="" D
|
|
.S PSOUCS=VERB
|
|
.S PSOUCS=$$UPPER(PSOUCS) I PSOUCS=PSOISL S PSOSG1=1 Q
|
|
.S PSOUCS=$$LOWER(PSOUCS) I PSOUCS=PSOISL S PSOSG1=1 Q
|
|
.S PSOUCS=$$UPPER($E(PSOUCS,1))_$$LOWER($E(PSOUCS,2,99)) I PSOUCS=PSOISL S PSOSG1=1 Q
|
|
I $G(PSNOUN(FFF))="" G VERBEX
|
|
S PSOISL=$P($P(SIG0(FFF),"^"),"&") I $G(PSOISL)="" G VERBEX
|
|
S PSOVL=$F(PSNOUN(FFF),"(")
|
|
I $G(PSOVL)>2 S PSOUCS=$E(PSNOUN(FFF),1,(PSOVL-2))
|
|
I $G(PSOVL)'>2 S PSOUCS=PSNOUN(FFF)
|
|
I $G(PSOISL)'="" D
|
|
.S PSOUCS=$$UPPER(PSOUCS) I PSOISL[PSOUCS S PSOSG2=1 Q
|
|
.S PSOUCS=$$LOWER(PSOUCS) I PSOISL[PSOUCS S PSOSG2=1 Q
|
|
.S PSOUCS=$$UPPER($E(PSOUCS,1))_$$LOWER($E(PSOUCS,2,99)) I PSOISL[PSOUCS S PSOSG2=1
|
|
VERBEX K PSOLCS,PSOUCS,PSOISL,PSOVL Q
|
|
;
|
|
UPPER(PSOUCS) ;
|
|
Q $TR(PSOUCS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
;
|
|
LOWER(PSOLCS) ;
|
|
Q $TR(PSOLCS,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
|