| 1 | PSOSIGNO ;BHAM ISC/RTR-Check new Sig for Route and Schedule ; 10/10/96
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ;Pass in IEN from Pending File, and New Sig
|
|---|
| 5 | ;Returned PSOSIGFL=0 no new order (common Routes and Schedules)
|
|---|
| 6 | ; PSOSIGFL=1 new order (no Route to having route) or
|
|---|
| 7 | ; (no Schedule to having schedule) or
|
|---|
| 8 | ; (visa versa, or discrepency)
|
|---|
| 9 | ;
|
|---|
| 10 | ;Also returned are arrays with Original and New Routes & Schedules:
|
|---|
| 11 | ;
|
|---|
| 12 | ; PSOMDRTE array (original route) PSOMDRTE(1)="ORAL"
|
|---|
| 13 | ;
|
|---|
| 14 | ; PSONEWMD array (new routes) PSONEWMD(1)="ORAL"
|
|---|
| 15 | ; PSONEWMD(22)="BOTH EYES"
|
|---|
| 16 | ;
|
|---|
| 17 | ; PSOSCH array (original schedules) PSOSCH("Q12H")=""
|
|---|
| 18 | ; PSOSCH("Q4H")=""
|
|---|
| 19 | ;
|
|---|
| 20 | ; PSONEWSD array (new schedules) PSONEWSD("Q4H")=""
|
|---|
| 21 | ; PSONEWSD("Q8H")=""
|
|---|
| 22 | ;
|
|---|
| 23 | EN(PSPENIEN,PSPENSIG) ;
|
|---|
| 24 | K PSONEWMD,PSOMDRTE,PSOSCH,PSONEWSD N AA,GGG,PSONULL,XXX,XXXX,ZZZZ
|
|---|
| 25 | ;S PSOSIGFL=0
|
|---|
| 26 | I $P($G(^PS(52.41,PSPENIEN,0)),"^",15),$P($G(^PS(51.2,+$P(^(0),"^",15),0)),"^")'="" S PSOMDRTE($P(^PS(52.41,PSPENIEN,0),"^",15))=$P(^PS(51.2,+$P(^(0),"^",15),0),"^")
|
|---|
| 27 | F ZZZZ=0:0 S ZZZZ=$O(^PS(52.41,PSPENIEN,1,ZZZZ)) Q:'ZZZZ I $P($G(^PS(52.41,PSPENIEN,1,ZZZZ,1)),"^")'="" S PSOSCH($P(^(1),"^"))=""
|
|---|
| 28 | F GGG=1:1:$L(PSPENSIG," ") S XXX=$P(PSPENSIG," ",GGG) D:XXX]""
|
|---|
| 29 | .I $D(^PS(51,"A",XXX)) D
|
|---|
| 30 | ..S XXXX=$O(^PS(51,"B",XXX,0)) D:XXXX
|
|---|
| 31 | ...I $P($G(^PS(51,XXXX,0)),"^",5),$P($G(^PS(51.2,+$P(^(0),"^",5),0)),"^")'="" S PSONEWMD($P(^PS(51,XXXX,0),"^",5))=$P(^PS(51.2,$P(^(0),"^",5),0),"^")
|
|---|
| 32 | ...I $P($G(^PS(51,XXXX,0)),"^",6)'="" S PSONEWSD($P(^(0),"^",6))=""
|
|---|
| 33 | NEW ;Check for new order
|
|---|
| 34 | S PSONULL=""
|
|---|
| 35 | I $O(PSOMDRTE(0)),'$O(PSONEWMD(0)) S PSOSIGFL=1
|
|---|
| 36 | Q:$G(PSOSIGFL) I $O(PSONEWMD(0)),'$O(PSOMDRTE(0)) S PSOSIGFL=1
|
|---|
| 37 | Q:$G(PSOSIGFL) I $O(PSOSCH(PSONULL))="",$O(PSONEWSD(PSONULL))'="" S PSOSIGFL=1
|
|---|
| 38 | Q:$G(PSOSIGFL) I $O(PSONEWSD(PSONULL))="",$O(PSOSCH(PSONULL))'="" S PSOSIGFL=1
|
|---|
| 39 | Q:$G(PSOSIGFL)
|
|---|
| 40 | ERROR ;check for error
|
|---|
| 41 | ;This is also a new order now
|
|---|
| 42 | F AA=0:0 S AA=$O(PSOMDRTE(AA)) Q:'AA!($G(PSOSIGFL)) I '$D(PSONEWMD(AA)) S PSOSIGFL=1
|
|---|
| 43 | Q:$G(PSOSIGFL) F AA=0:0 S AA=$O(PSONEWMD(AA)) Q:'AA!($G(PSOSIGFL)) I '$D(PSOMDRTE(AA)) S PSOSIGFL=1
|
|---|
| 44 | Q:$G(PSOSIGFL) S AA="" F S AA=$O(PSOSCH(AA)) Q:AA=""!($G(PSOSIGFL)) I '$D(PSONEWSD(AA)) S PSOSIGFL=1
|
|---|
| 45 | Q:$G(PSOSIGFL) S AA="" F S AA=$O(PSONEWSD(AA)) Q:AA=""!($G(PSOSIGFL)) I '$D(PSOSCH(AA)) S PSOSIGFL=1
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | EN1(PSRENIEN,PSRENSIG) ;
|
|---|
| 49 | ;Same as above, only for a new Sig from File 52
|
|---|
| 50 | ;Pass in IEN from 52, and new Sig
|
|---|
| 51 | K PSONEWMD,PSOMDRTE,PSOSCH,PSONEWSD N AA,GGG,PSONULL,XXX,XXXX,ZZZZ
|
|---|
| 52 | ;S PSOSIGFL=0
|
|---|
| 53 | F GGG=0:0 S GGG=$O(^PSRX(PSRENIEN,"MEDR",GGG)) Q:'GGG S ZZZZ=+$P(^(GGG,0),"^") I ZZZZ,$P($G(^PS(51.2,ZZZZ,0)),"^")'="" S PSOMDRTE(ZZZZ)=$P(^(0),"^")
|
|---|
| 54 | F ZZZZ=0:0 S ZZZZ=$O(^PSRX(PSRENIEN,"SCH",ZZZZ)) Q:'ZZZZ I $P(^(ZZZZ,0),"^")'="" S PSOSCH($P(^(0),"^"))=""
|
|---|
| 55 | F GGG=1:1:$L(PSRENSIG," ") S XXX=$P(PSRENSIG," ",GGG) D:XXX]""
|
|---|
| 56 | .I $D(^PS(51,"A",XXX)) D
|
|---|
| 57 | ..S XXXX=$O(^PS(51,"B",XXX,0)) D:XXXX
|
|---|
| 58 | ...I $P($G(^PS(51,XXXX,0)),"^",5),$P($G(^PS(51.2,+$P(^(0),"^",5),0)),"^")'="" S PSONEWMD($P(^PS(51,XXXX,0),"^",5))=$P(^PS(51.2,$P(^(0),"^",5),0),"^")
|
|---|
| 59 | ...I $P($G(^PS(51,XXXX,0)),"^",6)'="" S PSONEWSD($P(^(0),"^",6))=""
|
|---|
| 60 | NEWOR ;Check for new order
|
|---|
| 61 | G NEW
|
|---|
| 62 | ;
|
|---|
| 63 | POP(PSOPOPRX) ;Pass in Internal Rx number, will populate Med Route and
|
|---|
| 64 | ;schedule fields from BACK door Sig
|
|---|
| 65 | N BACKSIG,BBB,LLL,LLLL,POPMD,POPSC
|
|---|
| 66 | Q:'$D(^PSRX(PSOPOPRX,0))
|
|---|
| 67 | Q:$P($G(^PSRX(PSOPOPRX,"SIG")),"^")=""!($P($G(^("SIG")),"^",2))
|
|---|
| 68 | S BACKSIG=$P(^PSRX(PSOPOPRX,"SIG"),"^")
|
|---|
| 69 | F BBB=1:1:$L(BACKSIG," ") S LLL=$P(BACKSIG," ",BBB) D:LLL]""
|
|---|
| 70 | .I $D(^PS(51,"A",LLL)) D
|
|---|
| 71 | ..S LLLL=$O(^PS(51,"B",LLL,0)) D:LLLL
|
|---|
| 72 | ...I $P($G(^PS(51,LLLL,0)),"^",5),$P($G(^PS(51.2,+$P(^(0),"^",5),0)),"^")'="" S POPMD($P(^PS(51,LLLL,0),"^",5))=""
|
|---|
| 73 | ...I $P($G(^PS(51,LLLL,0)),"^",6)'="" S POPSC($P(^(0),"^",6))=""
|
|---|
| 74 | K ^PSRX(PSOPOPRX,"MEDR"),^PSRX(PSOPOPRX,"SCH")
|
|---|
| 75 | S LLLL=1 F LLL=0:0 S LLL=$O(POPMD(LLL)) Q:'LLL S ^PSRX(PSOPOPRX,"MEDR",LLLL,0)=LLL,^PSRX(PSOPOPRX,"MEDR",0)="^52.037PA^"_LLLL_"^"_LLLL S LLLL=LLLL+1
|
|---|
| 76 | S LLLL=1,LLL="" F S LLL=$O(POPSC(LLL)) Q:LLL="" S ^PSRX(PSOPOPRX,"SCH",LLLL,0)=LLL,^PSRX(PSOPOPRX,"SCH",0)="^52.038A^"_LLLL_"^"_LLLL S LLLL=LLLL+1
|
|---|
| 77 | K PSOPOPRX
|
|---|
| 78 | Q
|
|---|
