- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLPII.m
r613 r623 1 PSOHLPII 2 ;;7.0;OUTPATIENT PHARMACY;**46,225**;DEC 1997;Build 29 3 4 5 6 7 8 EN 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 STUFF 60 61 62 63 64 65 66 67 68 69 F II=0:0 S II=$O(SIG(II)) Q:'II S DCOUNT=DCOUNT+1 S ^PS(52.41,PENDING,2,DCOUNT,0)=$$UNESC^ORHLESC(SIG(II))70 71 QUIT 72 SIG1 73 74 75 DAYS 76 77 NON 78 79 80 81 82 VERB 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 VERBEX 99 100 UPPER(PSOUCS) 101 102 103 LOWER(PSOLCS) 104 105 106 107 SSS 108 109 110 111 112 113 114 115 116 117 118 FRAC 119 120 121 122 123 124 125 126 127 128 129 FRACQ 130 131 NUM 132 133 134 1 PSOHLPII ;BIR/RTR-Parse out and create CPRS Instructions ;7/21/96 2 ;;7.0;OUTPATIENT PHARMACY;**46**;DEC 1997 3 ;External reference to File #50.7 supported by DBIA 2223 4 ;External reference to File #51 supported by DBIA 2224 5 ;External reference to File #51.1 supported by DBIA 2225 6 ;External reference to File #51.2 supported by DBIA 2226 7 ;External reference to File #50.606 supported by DBIA 2174 8 EN ; 9 Q:'$D(^PS(52.41,PENDING,1,0)) 10 N PISI,PSOFX,SDF,SZZ,ZZS,ZZSB,SSZZ,SCHHOLD,GGGZ,SGLFLAG,SGLOOP,ZSCHED,SPFG,PSNOUN,MEDEXP,PSDUR,NOUN,SCHED,INTERVAL,SIG0,SIG2,SIG3,SDL,WW,TODOSE,PDAYS,WWFL,PSOCJI 11 N SSS,TT,DCOUNT,PREP,VERB,FFF,GGG,SIGDS,SIGRT,PSOROUTE,PSOSG1,PSOSG2 12 N SIG 13 F PISI=0:0 S PISI=$O(^PS(52.41,PENDING,1,PISI)) Q:'PISI D:$D(^(PISI,0)) 14 .S PSOFX("DOSE",PISI)=$P($G(^PS(52.41,PENDING,1,PISI,2)),"^") I $P($G(^(2)),"^",2)'="" S PSOFX("DOSE ORDERED",PISI)=$P($G(^(2)),"^",2) 15 .S PSOFX("SCHEDULE",PISI)=$P($G(^PS(52.41,PENDING,1,PISI,1)),"^"),PSOFX("ROUTE",PISI)=$P($G(^(1)),"^",8),PSOFX("DURATION",PISI)=$P($G(^(1)),"^",2),PSOFX("NOUN",PISI)=$P($G(^(1)),"^",5),PSOFX("CONJUNCTION",PISI)=$P($G(^(1)),"^",6) 16 .I $G(PSOFX("DURATION",PISI)) S PSOFX("DURATION",PISI)="D"_$G(PSOFX("DURATION",PISI)) 17 .I $G(PSOFX("DURATION",PISI))'="" S PSOFX("DURATION",PISI)=$E(PSOFX("DURATION",PISI),2,999)_$E(PSOFX("DURATION",PISI)) 18 S TODOSE=0 F WW=0:0 S WW=$O(PSOFX("DOSE",WW)) Q:'WW S TODOSE=WW 19 Q:'TODOSE 20 S SIGDS=+$P($G(^PS(50.7,+$G(PSORDITE),0)),"^",2),VERB=$P($G(^PS(50.606,SIGDS,"MISC")),"^"),PREP=$P($G(^("MISC")),"^",3) 21 F SSS=1:1:TODOSE D 22 .S SIG0(SSS)=$S($G(PSOFX("DOSE ORDERED",SSS))'="":$G(PSOFX("DOSE ORDERED",SSS)),1:$G(PSOFX("DOSE",SSS))) 23 .S PSNOUN(SSS)=$G(PSOFX("NOUN",SSS)) 24 .;S PSOROUTE(SSS)=$S($P($G(^PS(51.2,+$G(PSOFX("ROUTE",SSS)),0)),"^",2)'="":$P(^(0),"^",2),$P($G(^(0)),"^",3)'="":$P(^(0),"^",3),1:$P($G(^(0)),"^")) S MEDEXP(SSS)=$S($P($G(^PS(51.2,+$G(PSOFX("ROUTE",SSS)),0)),"^",2)="":0,1:1) 25 .S PSOROUTE(SSS)=$S($P($G(^PS(51.2,+$G(PSOFX("ROUTE",SSS)),0)),"^",3)'="":$P($G(^(0)),"^",3),1:$P($G(^(0)),"^")) 26 .S PDAYS(SSS)=$G(PSOFX("DURATION",SSS)) 27 .I $G(PSOFX("DURATION",SSS))'="",($E(PSOFX("DURATION",SSS),$L(PSOFX("DURATION",SSS)))'?1A) S PDAYS(SSS)=PDAYS(SSS)_"D" 28 .S PSDUR(SSS)=$S($G(PDAYS(SSS))="":"NULL",1:"FOR "_$E($G(PDAYS(SSS)),1,($L($G(PDAYS(SSS)))-1))) D I PSDUR(SSS)'="NULL" S PSDUR(SSS)=PSDUR(SSS)_" "_INTERVAL 29 ..I PSDUR(SSS)'="NULL" S INTERVAL=$E(PDAYS(SSS),$L(PDAYS(SSS))),INTERVAL=$S(INTERVAL="D":"DAYS",INTERVAL="W":"WEEKS",INTERVAL="H":"HOURS",INTERVAL="L":"MONTHS",INTERVAL="M":"MINUTES",INTERVAL="S":"SECONDS",1:"") D 30 ...I $G(INTERVAL)'="",$G(PSOFX("DURATION",SSS)),$G(PSOFX("DURATION",SSS))'>1 S INTERVAL=$E(INTERVAL,1,($L(INTERVAL)-1)) 31 F GGG=1:1:TODOSE S ZSCHED(GGG)=$G(PSOFX("SCHEDULE",GGG)) 32 ;.I $G(ZSCHED(GGG))="" S SCHED(GGG)="" Q 33 ;.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 34 ;.Q:$G(SGLFLAG) 35 ;.I $G(^PS(51,"A",ZSCHED(GGG)))'="" S SCHED(GGG)=$P(^(ZSCHED(GGG)),"^") Q 36 ;.S ZZSB=0 F ZZS=1:1:$L(ZSCHED(GGG)) S SZZ=$E(ZSCHED(GGG),ZZS) I SZZ=" " S ZZSB=ZZSB+1 37 ;.S ZZSB=ZZSB+1 38 ;.K SCHHOLD F GGGZ=1:1:ZZSB S (SDL,SCHHOLD(GGGZ))=$P(ZSCHED(GGG)," ",GGGZ) D 39 ;..Q:$G(SDL)="" 40 ;..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 41 ;..Q:$G(SGLFLAG) 42 ;..I $G(^PS(51,"A",SDL))'="" S SCHHOLD(GGGZ)=$P(^(SDL),"^") 43 ;.S SCHED(GGG)="",SGLFLAG=0 F WW=1:1:ZZSB S SCHED(GGG)=SCHED(GGG)_$S($G(SGLFLAG):" ",1:"")_$G(SCHHOLD(WW)),SGLFLAG=1 44 S PREP="" 45 F FFF=0:0 S FFF=$O(SIG0(FFF)) Q:'FFF D 46 .K PSOSG1,PSOSG2 D VERB D:$G(PSNOUN(FFF))'=""&('$G(PSOSG1)) SSS 47 .D FRAC 48 .S SIG2(FFF)=$S(VERB'=""&('$G(PSOSG1)):VERB_" ",1:"")_$S($G(PSOFX("DOSE ORDERED",FFF))'="":$S($G(PSOFRAC)'="":$G(PSOFRAC),1:$G(PSOFX("DOSE ORDERED",FFF)))_" ",1:$G(PSOFX("DOSE",FFF))_" ") 49 .K PSOFRAC,PSOFRACX 50 .S SIG2(FFF)=SIG2(FFF)_$S($G(PSNOUN(FFF))'=""&('$G(PSOSG2)):$G(PSNOUN(FFF))_" ",1:"")_$S(PREP'=""&($G(MEDEXP(FFF))):PREP_" ",1:"") 51 .S SIG2(FFF)=SIG2(FFF)_$S(PSOROUTE(FFF)'="":PSOROUTE(FFF)_" ",1:"") 52 .;S SIG2(FFF)=SIG2(FFF)_$S(SCHED(FFF)'="":SCHED(FFF)_" ",1:"")_$S(PSDUR(FFF)'="NULL":PSDUR(FFF)_" ",1:"")_$S($G(PSOFX("CONJUNCTION",FFF))="A":"AND",$G(PSOFX("CONJUNCTION",FFF))="T":"THEN",$G(PSOFX("CONJUNCTION",FFF))="S":"THEN",1:"") 53 .S SIG2(FFF)=SIG2(FFF)_$S(ZSCHED(FFF)'="":ZSCHED(FFF)_$S($G(PSDUR(FFF))="NULL"&($G(PSOFX("CONJUNCTION",FFF))="")&('$O(SIG0(FFF))):"",1:" "),1:"") 54 .S PSOCJI=$G(PSOFX("CONJUNCTION",FFF)) 55 .S SIG2(FFF)=SIG2(FFF)_$S(PSDUR(FFF)'="NULL":PSDUR(FFF)_$S($G(PSOFX("CONJUNCTION",FFF))=""&('$O(SIG0(FFF))):"",1:", "),1:"")_$S($G(PSOCJI)="A":"AND",$G(PSOCJI)="T":"THEN",$G(PSOCJI)="S":"THEN",$G(PSOCJI)="X":"EXCEPT",1:"") 56 .K PSOSG1,PSOSG2 57 .K PSOUCS S SIG2(FFF)=$$UPPER(SIG2(FFF)) K PSOUCS 58 ;I $G(PSOFX("INS"))'="" S TODOSE=TODOSE+1,SIG2(TODOSE)=$G(PSOFX("INS")) 59 STUFF ; 60 S DCOUNT=0 61 I '$D(SIG2(1)) G QUIT 62 ;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 63 S (VAR,VAR1)="",II=1 64 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)>200 S SIG(II)=LIM_" ",II=II+1,VAR=VAR1 65 .S VAR1=$P(SIG2(FF)," ",(CT)) 66 .S LIM=VAR 67 .S VAR=$S(VAR="":VAR1,1:VAR_" "_VAR1) 68 I $G(VAR)'="" S SIG(II)=VAR 69 F II=0:0 S II=$O(SIG(II)) Q:'II S DCOUNT=DCOUNT+1 S ^PS(52.41,PENDING,2,DCOUNT,0)=SIG(II) 70 I DCOUNT S ^PS(52.41,PENDING,2,0)="^52.419A^"_DCOUNT_"^"_DCOUNT 71 QUIT K SSS,TT,DCOUNT,PREP,VERB,FFF,GGG,SIGDS,SIGRT,PSOROUTE,PSOSG1,PSOSG2 Q 72 SIG1 ; 73 F FFF=0:0 S FFF=$O(SIG0(FFF)) Q:'FFF S SIG2(FFF)=SIG0(FFF) 74 Q 75 DAYS I +$E($P(SIG1(TT),"^",2))!($E($P(SIG1(TT),"^",2))=0) S $P(SIG1(TT),"^",2)="D"_$P(SIG1(TT),"^",2) 76 Q 77 NON ; 78 I $P($G(SIG0(SSS)),"&",2)'="" S PSNOUN(SSS)=$P($G(SIG0(SSS)),"&",2) Q 79 Q 80 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)),"^")'="" S PSNOUN(SSS)=$P(^(0),"^") 81 Q 82 VERB ;Check if verb and noun need to be added to SIG 83 K PSOLCS,PSOUCS,PSOISL,PSOVL 84 I $G(VERB)'="" S PSOVL=$L(VERB),PSOISL=$E($G(SIG0(FFF)),1,$G(PSOVL)) I $G(PSOISL)'="" D 85 .S PSOUCS=VERB 86 .S PSOUCS=$$UPPER(PSOUCS) I PSOUCS=PSOISL S PSOSG1=1 Q 87 .S PSOUCS=$$LOWER(PSOUCS) I PSOUCS=PSOISL S PSOSG1=1 Q 88 .S PSOUCS=$$UPPER($E(PSOUCS,1))_$$LOWER($E(PSOUCS,2,99)) I PSOUCS=PSOISL S PSOSG1=1 Q 89 I $G(PSNOUN(FFF))="" G VERBEX 90 S PSOISL=$G(SIG0(FFF)) I $G(PSOISL)="" G VERBEX 91 S PSOVL=$F(PSNOUN(FFF),"(") 92 I $G(PSOVL)>2 S PSOUCS=$E(PSNOUN(FFF),1,(PSOVL-2)) 93 I $G(PSOVL)'>2 S PSOUCS=PSNOUN(FFF) 94 I $G(PSOISL)'="" D 95 .S PSOUCS=$$UPPER(PSOUCS) I PSOISL[PSOUCS S PSOSG2=1 Q 96 .S PSOUCS=$$LOWER(PSOUCS) I PSOISL[PSOUCS S PSOSG2=1 Q 97 .S PSOUCS=$$UPPER($E(PSOUCS,1))_$$LOWER($E(PSOUCS,2,99)) I PSOISL[PSOUCS S PSOSG2=1 98 VERBEX K PSOLCS,PSOUCS,PSOISL,PSOVL Q 99 ; 100 UPPER(PSOUCS) ; 101 Q $TR(PSOUCS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 102 ; 103 LOWER(PSOLCS) ; 104 Q $TR(PSOLCS,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") 105 Q 106 ; 107 SSS ; 108 K PSOFNL,PSOFNLF,PSOFNLX 109 Q:$G(PSNOUN(FFF))="" 110 Q:$L(PSNOUN(FFF))'>3 111 Q:'$G(PSOFX("DOSE ORDERED",FFF)) 112 ;Q:$G(PSOFX("DOSE ORDERED",FFF))>1 113 S PSOFNL=$E(PSNOUN(FFF),($L(PSNOUN(FFF))-2),$L(PSNOUN(FFF))) 114 I $G(PSOFNL)="(S)"!($G(PSOFNL)="(s)") D 115 .I $G(PSOFX("DOSE ORDERED",FFF))'>1 S PSNOUN(FFF)=$E(PSNOUN(FFF),1,($L(PSNOUN(FFF))-3)) 116 .I $G(PSOFX("DOSE ORDERED",FFF))>1 S PSNOUN(FFF)=$E(PSNOUN(FFF),1,($L(PSNOUN(FFF))-3))_$E(PSOFNL,2) 117 Q 118 FRAC ; 119 K PSOFRAC,PSOFRACX,PSOFRAC1,PSOFRAC2 120 I $G(PSOFX("DOSE ORDERED",FFF))="" Q 121 I $G(PSOFX("DOSE ORDERED",FFF))'["." S (PSOFRAC1,PSOFRAC)=$G(PSOFX("DOSE ORDERED",FFF)) D NUM D G FRACQ 122 .I $G(PSOFRAC1)=$G(PSOFRAC) K PSOFRAC,PSOFRAC1 Q 123 .S PSOFRAC=$G(PSOFRAC1) 124 S PSOFRAC1=$P(PSOFX("DOSE ORDERED",FFF),"."),PSOFRAC2=$P(PSOFX("DOSE ORDERED",FFF),".",2) 125 S PSOFRACX="."_$G(PSOFRAC2) 126 S PSOFRAC=$S(PSOFRACX=".5":"ONE-HALF",PSOFRACX=".25":"ONE-FOURTH",PSOFRACX=".33":"ONE-THIRD",PSOFRACX=".34":"ONE-THIRD",PSOFRACX=".50":"ONE-HALF",PSOFRACX=".66":"TWO-THIRDS",PSOFRACX=".67":"TWO-THIRDS",PSOFRACX=".75":"THREE-FOURTHS",1:"") 127 I $G(PSOFRAC)="" K PSOFRAC G FRACQ 128 I $G(PSOFRAC1)'="",+$G(PSOFRAC1) D NUM S PSOFRAC=$G(PSOFRAC1)_" AND "_$G(PSOFRAC) 129 FRACQ K PSOFRAC1,PSOFRAC2 130 Q 131 NUM ; 132 Q:$G(PSOFRAC1)="" 133 S PSOFRAC1=$S(PSOFRAC1="1":"ONE",PSOFRAC1="2":"TWO",PSOFRAC1="3":"THREE",PSOFRAC1="4":"FOUR",PSOFRAC1="5":"FIVE",PSOFRAC1="6":"SIX",PSOFRAC1="7":"SEVEN",PSOFRAC1="8":"EIGHT",PSOFRAC1="9":"NINE",PSOFRAC1="10":"TEN",1:PSOFRAC1) 134 Q
Note:
See TracChangeset
for help on using the changeset viewer.
