- 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/PSODIR3.m
r613 r623 1 PSODIR3 ;ISC-BIRM/SAB - rx order entry contd ;4/25/07 8:28am2 ;;7.0;OUTPATIENT PHARMACY;**3,46,184,222,206**;DEC 1997;Build 39 3 4 EXP(PSODIR) 5 6 7 8 9 10 11 EXPX 12 13 14 MW(PSODIR) 15 16 17 18 19 20 21 22 MW1 23 24 25 26 27 28 MWX 29 30 31 FILLDT(PSODIR) 32 33 34 35 36 37 38 39 40 41 FILLDTX 42 43 44 CLERK(PSODIR) 45 46 47 48 49 50 CLERKX 51 52 DIR 53 54 55 56 57 58 DIRX 59 60 61 JUMP 62 63 64 65 66 67 68 JUMPX 69 70 71 REFOR 72 73 74 75 76 77 78 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 Q80 .S VALMSG="No refills allowed on "_$S($G(PSODRUG("DEA"))["A":"this narcotic drug.",1:"this drug.")81 82 83 84 85 86 87 88 89 90 91 1 PSODIR3 ;ISC-BIRM/SAB - rx order entry contd ;09/27/96 2 ;;7.0;OUTPATIENT PHARMACY;**3,46,184,222**;DEC 1997;Build 12 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") D Q 80 .S VALMSG="No refills allowed on "_$S($G(PSODRUG("DEA"))["F":"this drug.",1:"Narcotics ..") 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
Note:
See TracChangeset
for help on using the changeset viewer.
