| 1 | PSONEW ;BIR/SAB-new rx order main driver ; 11/5/06 6:35pm
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,94,130,268,208**;DEC 1997;Build 39
|
|---|
| 3 | ; Modified from FOIA VISTA,
|
|---|
| 4 | ; Copyright (C) 2007 WorldVistA
|
|---|
| 5 | ;
|
|---|
| 6 | ; This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ; it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ; the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ; (at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ; This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ; GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ; You should have received a copy of the GNU General Public License
|
|---|
| 17 | ; along with this program; if not, write to the Free Software
|
|---|
| 18 | ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
|---|
| 19 | ;External references L and UL^PSSLOCK supported by DBIA 2789
|
|---|
| 20 | ;External reference to ^VA(200 supported by DBIA 224
|
|---|
| 21 | ;External reference to ^XUSEC supported by DBIA 10076
|
|---|
| 22 | ;External reference to ^ORX1 supported by DBIA 2186
|
|---|
| 23 | ;External reference to ^ORX2 supported by DBIA 867
|
|---|
| 24 | ;External reference to ^TIUEDIT supported by DBIA 2410
|
|---|
| 25 | ;---------------------------------------------------------------
|
|---|
| 26 | OERR ;backdoor new rx for v7
|
|---|
| 27 | K PSOREEDT,COPY,SPEED,PSOEDIT,DUR,DRET
|
|---|
| 28 | S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q
|
|---|
| 29 | K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q
|
|---|
| 30 | AGAIN N VALMCNT K PSODRUG,PSOCOU,PSOCOUU,PSONOOR,PSORX("FN") W ! D HLDHDR^PSOLMUTL S (PSONEW("QFLG"),PSONEW("DFLG"))=0,PSOFROM="NEW",PSONOEDT=1
|
|---|
| 31 | K ORD D FULL^VALM1,^PSONEW1 ; Continue order entry
|
|---|
| 32 | I PSONEW("QFLG") G END
|
|---|
| 33 | I PSONEW("DFLG") W !,$C(7),"RX DELETED",! S:$G(POERR) POERR("DFLG")=1,VALMBCK="Q" G END
|
|---|
| 34 | D:$P($G(PSOPAR),"^",7)=1 AUTO^PSONRXN I $P($G(PSOPAR),"^",7)'=1 S PSOX=PSONEW("RX #") D CHECK^PSONRXN
|
|---|
| 35 | I PSONEW("DFLG")!PSONEW("QFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END
|
|---|
| 36 | D NOOR I PSONEW("DFLG") D DEL G END
|
|---|
| 37 | D ^PSONEW2 I PSONEW("DFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END ; Asks if correct
|
|---|
| 38 | G:$G(PSORX("FN")) END
|
|---|
| 39 | D EN^PSON52(.PSONEW) ; Files entry in File 52
|
|---|
| 40 | D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array
|
|---|
| 41 | S VALMBCK="R"
|
|---|
| 42 | END D EOJ ; Clean up
|
|---|
| 43 | I '$G(PSORX("FN")) W ! K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Another New Order for "_PSORX("NAME") D ^DIR K DIR,DIRUT,DUOUT,DTOUT I Y K PSONEW,PSDRUG,ORD G AGAIN
|
|---|
| 44 | D ^PSOBUILD,BLD^PSOORUT1 S X=PSODFN_";DPT(" D ULK^ORX2 D UL^PSSLOCK(PSODFN)
|
|---|
| 45 | S VALMBCK="R" K PSORX("FN") Q
|
|---|
| 46 | ;----------------------------------------------------------------
|
|---|
| 47 | DEL ;
|
|---|
| 48 | W !,$C(7),"RX DELETED",!
|
|---|
| 49 | I $P($G(PSOPAR),"^",7)=1 D
|
|---|
| 50 | . S DIE="^PS(59,",DA=PSOSITE,PSOY=$O(PSONEW("OLD LAST RX#",""))
|
|---|
| 51 | . S PSOX=PSONEW("OLD LAST RX#",PSOY)
|
|---|
| 52 | . L +^PS(59,+PSOSITE,PSOY):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
|
|---|
| 53 | . S DR=$S(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
|
|---|
| 54 | . D:PSOX<$P(^PS(59,+PSOSITE,PSOY),"^",3) ^DIE K DIE,X,Y
|
|---|
| 55 | . L -^PS(59,+PSOSITE,PSOY)
|
|---|
| 56 | . K PSOX,PSOY Q
|
|---|
| 57 | EOJ ;
|
|---|
| 58 | I $D(PSONEW("RX #")) L -^PSRX("B",PSONEW("RX #")) ; +Lock set in PSONRXN
|
|---|
| 59 | K PSONOEDT,PSONEW,PSODRUG,ANQDATA,LSI,C,MAX,MIN,NDF,REF,SIG,SER,PSOFLAG,PSOHI,PSOLO,PSONOOR,PSOCOUU,PSOCOU,PSORX("EDIT")
|
|---|
| 60 | D CLEAN^PSOVER1
|
|---|
| 61 | K ^TMP("PSORXDC",$J),RORD,ACOM,ACNT,CRIT,DEF,F1,GG,I1,IEN,INDT,LAST,MSG,NIEN,STA,DUR,DRET,PSOPRC
|
|---|
| 62 | S RXN=$O(^TMP("PSORXN",$J,0)) I RXN D
|
|---|
| 63 | .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3))
|
|---|
| 64 | .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS","")
|
|---|
| 65 | K RXN,RXN1,^TMP("PSORXN",$J)
|
|---|
| 66 | I $G(PSONOTE) D FULL^VALM1,MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
|
|---|
| 67 | K PSONOTE
|
|---|
| 68 | Q
|
|---|
| 69 | NOOR ;asks nature of order
|
|---|
| 70 | N PSONOODF
|
|---|
| 71 | S PSONOODF=0
|
|---|
| 72 | I $G(OR0) D G NOORX ;front door
|
|---|
| 73 | .S PSOI=$S($G(PSOSIGFL):1,$G(PSODRUG("OI"))'=$P(OR0,"^",8):1,1:0) I 'PSOI S PSONOOR="" D:$D(^XUSEC("PSORPH",DUZ)) COUN Q ;NoO $P(OR0,"^",7)
|
|---|
| 74 | .S PSONOODF=1
|
|---|
| 75 | .D DIR I $D(DIRUT) S PSONEW("DFLG")=1 Q
|
|---|
| 76 | .S PSONOOR=Y D:$D(^XUSEC("PSORPH",DUZ)) COUN K DIR,DTOUT,DTOUT,DIRUT
|
|---|
| 77 | ;backdoor order
|
|---|
| 78 | D DIR I $D(DIRUT) S PSONEW("DFLG")=1 Q
|
|---|
| 79 | S PSONOOR=Y K DIK,DA,DIE,DR,PSOI,DIR,DUOUT,DTOUT,DIRUT
|
|---|
| 80 | G:'$D(^XUSEC("PSORPH",DUZ)) NOORX
|
|---|
| 81 | COUN ;patient counseling
|
|---|
| 82 | G:$G(PSORX("EDIT"))&('$G(PSOSIGFL)) NOORX K DIR,DUOUT,DTOUT,DIRUT
|
|---|
| 83 | I $G(PSOAFYN)'="Y" S DIR("B")="NO",DIR(0)="52,41" D ^DIR S PSOCOU=$S(Y:Y,1:0) ;vfam
|
|---|
| 84 | I $G(PSOAFYN)="Y" S PSOCOU=0 ;vfam No Patient Counseling by AutoFinihs
|
|---|
| 85 | I $D(DIRUT)!('PSOCOU) S PSOCOUU=0 D:'$G(SPEED) PRONTE Q
|
|---|
| 86 | K:'$G(PSOCOU) PSOCOUU K DIR,DUOUT,DTOUT,DIRUT I Y S DIR(0)="52,42",DIR("B")="NO" D ^DIR S PSOCOUU=$S(Y:Y,1:0)
|
|---|
| 87 | PRONTE K PSONOTE,DIR,DIRUT,DUOUT
|
|---|
| 88 | I $T(MAIN^TIUEDIT)]"",'$G(SPEED) D K DIR,DIRUT,DUOUT
|
|---|
| 89 | .I $G(PSOAFYN)'="Y" S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to enter a Progress Note",DIR("A",1)="" D ^DIR K DIR ;vfam
|
|---|
| 90 | .I $G(PSOAFYN)="Y" S Y="0" ;vfam No Progress Notes in AutoFinish
|
|---|
| 91 | .S PSONOTE=+Y Q ;I 'Y!($D(DIRUT)) Q
|
|---|
| 92 | NOORX K X,Y,DIR,DUOUT,DTOUT,DIRUT
|
|---|
| 93 | Q
|
|---|
| 94 | DIR ;ask nature of order
|
|---|
| 95 | K DIR,DTOUT,DTOUT,DIRUT I $T(NA^ORX1)]"" D Q
|
|---|
| 96 | .S PSONOOR=$$NA^ORX1($S($G(PSONOODF)!($G(PSONOBCK)):"S",1:"W"),0,"B","Nature of Order",0,"WPSDIVR"_$S(+$G(^VA(200,DUZ,"PS")):"E",1:""))
|
|---|
| 97 | .I +PSONOOR S (Y,PSONOOR)=$P(PSONOOR,"^",3) Q
|
|---|
| 98 | .S DIRUT=1 K PSONOOR
|
|---|
| 99 | I $D(PSONOOR) S DF=PSONOOR,PSONODF=$S(DF="E":"PROVIDER ENTERED",DF="V":"VERBAL",DF="P":"TELEPHONE",DF="D":"DUPLICATE",DF="S":"SERVICE CORRECTED",DF="I":"POLICY",DF="R":"SERVICE REJECTED",1:"WRITTEN")
|
|---|
| 100 | K DIR,DTOUT,DTOUT,DIRUT S DIR("A")="Nature of Order: ",DIR("B")=$S($D(PSONOOR):PSONODF,1:"WRITTEN")
|
|---|
| 101 | S DIR(0)="SA^W:WRITTEN;V:VERBAL;P:TELEPHONE;S:SERVICE CORRECTED;D:DUPLICATE;I:POLICY;R:SERVICE REJECTED"_$S(+$G(^VA(200,DUZ,"PS")):";E:PROVIDER ENTERED",1:"")
|
|---|
| 102 | D ^DIR K DF,PSONODF Q:$D(DIRUT) S PSONOOR=Y
|
|---|
| 103 | DIRX Q
|
|---|
| 104 | ;
|
|---|
| 105 | NOORE(PSONEW) ;entry point for renew
|
|---|
| 106 | D NOOR I $D(DIRUT) S PSONEW("DFLG")=1 Q
|
|---|
| 107 | S PSONEW("NOO")=PSONOOR
|
|---|
| 108 | Q
|
|---|
