1 | PSODIR3 ;ISC-BIRM/SAB - rx order entry contd ;4/25/07 8:28am
|
---|
2 | ;;7.0;OUTPATIENT PHARMACY;**3,46,184,222,206**;DEC 1997;Build 39
|
---|
3 | ;
|
---|
4 | EXP(PSODIR) ;
|
---|
5 | K DIC,DIR
|
---|
6 | I $G(PSODRUG("EXPIRATION DATE"))]"" S Y=PSODRUG("EXPIRATION DATE") X ^DD("DD") S PSORX("EXPIRATION DATE")=Y
|
---|
7 | S DIR("A")="EXPIRES",DIR("B")=$S($G(PSORX("EXPIRATION DATE"))]"":PSORX("EXPIRATION DATE"),1:"T+6M")
|
---|
8 | S DIR(0)="D^NOW::EX",DIR("?")="Both the month and date are required." D ^DIR
|
---|
9 | G:PSODIR("DFLG")!PSODIR("FIELD") EXPX
|
---|
10 | S PSODIR("EXPIRATION DATE")=Y
|
---|
11 | EXPX K X,Y
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | MW(PSODIR) ;
|
---|
15 | K DIR,DIC
|
---|
16 | S DIR(0)="52,11"
|
---|
17 | S DIR("B")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),1:"WINDOW")
|
---|
18 | D DIR G:PSODIR("DFLG")!PSODIR("FIELD") MWX
|
---|
19 | I $G(Y(0))']"" S PSODIR("DFLG")=1 G MWX
|
---|
20 | S PSODIR("MAIL/WINDOW")=Y,PSORX("MAIL/WINDOW")=Y(0)
|
---|
21 | I $G(PSORX("EDIT"))]"",PSODIR("MAIL/WINDOW")'="W" K PSODIR("METHOD OF PICK-UP")
|
---|
22 | MW1 G:PSODIR("MAIL/WINDOW")'="W"!('$P($G(PSOPAR),"^",12)) MWX
|
---|
23 | S DIR(0)="52,35O"
|
---|
24 | S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP")
|
---|
25 | D DIR G:PSODIR("DFLG") MWX
|
---|
26 | I X[U W !,"Cannot jump to another field ..",! G MW1
|
---|
27 | S (PSODIR("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y
|
---|
28 | MWX K X,Y
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | FILLDT(PSODIR) ;
|
---|
32 | K DIR,DIC
|
---|
33 | S DIR("A")="FILL DATE",DIR("B")=$S($G(PSORX("FILL DATE"))]"":PSORX("FILL DATE"),1:"TODAY")
|
---|
34 | S DIR(0)="D^"_$S($G(PSODIR("ISSUE DATE"))]"":PSODIR("ISSUE DATE"),1:DT)_$S($G(DUZ("AG"))="I":":"_DT_":EX",1:"::EX")
|
---|
35 | S DIR("?",1)="The earliest fill date allowed is determined by the ISSUE DATE,"
|
---|
36 | S DIR("?",2)="the FILL DATE cannot be before the ISSUE DATE."
|
---|
37 | S DIR("?")="Both the month and date are required."
|
---|
38 | D DIR G:PSODIR("DFLG")!PSODIR("FIELD") FILLDTX
|
---|
39 | S PSODIR("FILL DATE")=Y
|
---|
40 | X ^DD("DD") S PSORX("FILL DATE")=Y
|
---|
41 | FILLDTX K X,Y
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | CLERK(PSODIR) ;
|
---|
45 | I $G(DUZ("AG"))'="I",$G(DUZ) S PSODIR("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P($G(^VA(200,DUZ,0)),"^") G CLERKX
|
---|
46 | K DIR,DIC
|
---|
47 | S DIR("A")="CLERK",DIR("B")=$S($G(PSORX("CLERK CODE"))]"":PSORX("CLERK CODE"),1:$P($G(^VA(200,DUZ,0)),"^",2)),DIR(0)="52,16"
|
---|
48 | D DIR G:PSODIR("DFLG")!PSODIR("FIELD") CLERKX
|
---|
49 | S PSODIR("CLERK CODE")=+Y,PSORX("CLERK CODE")=$P(Y,"^")
|
---|
50 | CLERKX Q
|
---|
51 | ;
|
---|
52 | DIR ;
|
---|
53 | S PSODIR("FIELD")=0
|
---|
54 | G:$G(DIR(0))']"" DIRX
|
---|
55 | D ^DIR K DIR,DIE,DIC,DA
|
---|
56 | I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)),$L($G(X))'>1!(Y="") S PSODIR("DFLG")=1 G DIRX
|
---|
57 | I X[U,$L(X)>1 D JUMP
|
---|
58 | DIRX K DIRUT,DTOUT,DUOUT,DIROUT,PSOX
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | JUMP ;
|
---|
62 | I $G(PSOEDIT)!($G(OR0)) S PSODIR("DFLG")=1 Q
|
---|
63 | S X=$P(X,"^",2),DIC="^DD(52,",DIC(0)="QM" D ^DIC K DIC
|
---|
64 | I Y=-1 S PSODIR("FIELD")=PSODIR("FLD") G JUMPX
|
---|
65 | I $G(PSONEW1)=0 D JUMP^PSONEW1 G JUMPX
|
---|
66 | I $G(PSONEW3)=0 D JUMP^PSONEW3 G JUMPX
|
---|
67 | I $G(PSORENW3)=0 D JUMP^PSORENW3 G JUMPX
|
---|
68 | JUMPX S X="^"_X
|
---|
69 | Q
|
---|
70 | ;Continued from PSODIR1, Tag REFOR, Added PSOCS set and changed G REFILLX references to a QUIT
|
---|
71 | REFOR ;
|
---|
72 | F DEA=1:1 Q:$E($G(PSODRUG("DEA")),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOCS,"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOCS,"^",2)=1
|
---|
73 | I $G(PSOCS) D
|
---|
74 | .S (PSOX,PSOMAX)=$S($G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSODIR("DAYS SUPPLY")=7):1,$D(CLOZPAT):0,1:5)
|
---|
75 | .S PSOX=$S('PSOX:0,PSODIR("DAYS SUPPLY")=90:1,1:PSOX),PSDY=PSODIR("DAYS SUPPLY"),PSDY1=$S(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
|
---|
76 | E D
|
---|
77 | .S (PSOX,PSOMAX)=$S($G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSODIR("DAYS SUPPLY")=7):1,$D(CLOZPAT):0,1:11)
|
---|
78 | .S PSDY=PSODIR("DAYS SUPPLY"),PSDY1=$S(PSDY<60:11,PSDY'<60&(PSDY'>89):5,PSDY=90:3,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
|
---|
79 | K PSOELSE I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A"&($G(PSODRUG("DEA"))'["B")!($G(PSODRUG("DEA"))["F")!($G(PSODRUG("DEA"))[1)!($G(PSODRUG("DEA"))[2) D Q
|
---|
80 | .S VALMSG="No refills allowed on "_$S($G(PSODRUG("DEA"))["A":"this narcotic drug.",1:"this drug.")
|
---|
81 | .W !,VALMSG,!
|
---|
82 | .S:$D(PSODIR("FIELD")) PSODIR("FIELD")=0 S PSODIR("# OF REFILLS")=0
|
---|
83 | I $D(CLOZPAT) D
|
---|
84 | .S PSOX=$S($G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSODIR("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSODIR("DAYS SUPPLY")=7):1,1:0)
|
---|
85 | .S (PSODIR("# OF REFILLS"),PSODIR("N# REF"))=PSOX
|
---|
86 | S DIR(0)="N^0:"_PSOX,DIR("A")="# OF REFILLS"
|
---|
87 | S DIR("B")=$S($G(POERR)&($G(PSODIR("# OF REFILLS"))):PSODIR("# OF REFILLS"),$G(PSODIR("N# REF"))]"":PSODIR("N# REF"),$G(PSODIR("# OF REFILLS"))]"":PSODIR("# OF REFILLS"),$G(PSOX1)]""&(PSOX>PSOX1):PSOX1,1:PSOX)
|
---|
88 | S DIR("?")="Enter a whole number. The maximum is set by the DAYS SUPPLY field."
|
---|
89 | D DIR Q:PSODIR("DFLG")!PSODIR("FIELD")
|
---|
90 | S (PSODIR("N# REF"),PSODIR("# OF REFILLS"))=Y
|
---|
91 | Q
|
---|