source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREF2.m@ 861

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1PSOREF2 ;ISC-BIRM/SAB - asks all questions for barcode refill rx order entry ; 09/30/96
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3 ;
4START ;
5 S (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
6 S X1=DT,X2=-180 D C^%DTC S PSOREF("ISSUE DATE")=X
7 S:$G(PSORX("BAR CODE"))&($G(PSOBBC1("FROM"))="NEW") PSOREF("ISSUE DATE")=DT
8 K X,X1,X2
9 ;
10 ;
111 S PSOREF("FLD")=1 D FILLDT^PSODIR3(.PSOREF) ; Get Fill date
12 G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
13 ;
142 S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="MAIL" D MW^PSODIR3(.PSOREF)
15 G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
16 ;
173 I $G(DUZ("AG"))="I" S PSOREF("FLD")=3 D CLERK^PSODIR3(.PSOREF) ; Get Clerk Code
18 G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
19 ;
204 I $G(DUZ("AG"))="I" S PSOREF("FLD")=4 D EXP^PSODIR3(.PSOREF) ; Get Expiration Date - Indian Health Service ONLY
21 G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
22 ;
23END ;
24 K PSOREF1
25 Q
26JUMP ;
27 S PSOREF("FIELD")=$S(+Y=22:1,+Y=11:2,+Y=16:3,+Y=29:4,1:PSOREF("FLD"))
28 I PSOREF("FIELD")>PSOREF("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSOREF("FIELD")=PSOREF("FLD")
29 Q
30 ;
31EN(PSOREF) ;
32 D START
33 Q
34LOOK ;this entry is used to try and find current med order
35 S (PSOY,STA,PSOX)="",DRUG=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^")
36 I $G(PSOSD) W "Looking..." F S STA=$O(PSOSD(STA)) Q:STA="" F S PSOX=$O(PSOSD(STA,PSOX)) Q:PSOX']"" W "." I DRUG=PSOX,+PSOSD(STA,PSOX) S PSOY=PSOSD(STA,PSOX),PSOREF("IRXN")=+PSOSD(STA,PSOX),PSODF=1,PSOBBC("DONE")=PSOREF("IRXN")_"," Q
37 W ! K DRUG Q
Note: See TracBrowser for help on using the repository browser.