Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONEW.m

    r613 r623  
    1 PSONEW  ;BIR/SAB-new rx order main driver ;07/26/96
    2         ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,94,130,268,225**;DEC 1997;Build 29
    3         ;External references L and UL^PSSLOCK supported by DBIA 2789
    4         ;External reference to ^VA(200 supported by DBIA 224
    5         ;External reference to ^XUSEC supported by DBIA 10076
    6         ;External reference to ^ORX1 supported by DBIA 2186
    7         ;External reference to ^ORX2 supported by DBIA 867
    8         ;External reference to ^TIUEDIT supported by DBIA 2410
    9         ;---------------------------------------------------------------
    10 OERR    ;backdoor new rx for v7
    11         K PSOREEDT,COPY,SPEED,PSOEDIT,DUR,DRET
    12         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
    13         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
    14 AGAIN   N VALMCNT K PSODRUG,PSOCOU,PSOCOUU,PSONOOR,PSORX("FN") W ! D HLDHDR^PSOLMUTL S (PSONEW("QFLG"),PSONEW("DFLG"))=0,PSOFROM="NEW",PSONOEDT=1
    15         K ORD D FULL^VALM1,^PSONEW1 ; Continue order entry
    16         I PSONEW("QFLG") G END
    17         I PSONEW("DFLG") W !,$C(7),"RX DELETED",! S:$G(POERR) POERR("DFLG")=1,VALMBCK="Q" G END
    18         D:$P($G(PSOPAR),"^",7)=1 AUTO^PSONRXN I $P($G(PSOPAR),"^",7)'=1 S PSOX=PSONEW("RX #") D CHECK^PSONRXN
    19         I PSONEW("DFLG")!PSONEW("QFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END
    20         D NOOR I PSONEW("DFLG") D DEL G END
    21         D ^PSONEW2 I PSONEW("DFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END ; Asks if correct
    22         G:$G(PSORX("FN")) END
    23         D EN^PSON52(.PSONEW) ; Files entry in File 52
    24         D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array
    25         S VALMBCK="R"
    26 END     D EOJ ; Clean up         
    27         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
    28         D ^PSOBUILD,BLD^PSOORUT1 S X=PSODFN_";DPT(" D ULK^ORX2 D UL^PSSLOCK(PSODFN)
    29         D RV^PSOORFL
    30         S VALMBCK="R" K PSORX("FN") Q
    31         ;----------------------------------------------------------------
    32 DEL     ;
    33         W !,$C(7),"RX DELETED",!
    34         I $P($G(PSOPAR),"^",7)=1 D
    35         . S DIE="^PS(59,",DA=PSOSITE,PSOY=$O(PSONEW("OLD LAST RX#",""))
    36         . S PSOX=PSONEW("OLD LAST RX#",PSOY)
    37         . L +^PS(59,+PSOSITE,PSOY):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
    38         . S DR=$S(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
    39         . D:PSOX<$P(^PS(59,+PSOSITE,PSOY),"^",3) ^DIE K DIE,X,Y
    40         . L -^PS(59,+PSOSITE,PSOY)
    41         . K PSOX,PSOY Q
    42 EOJ     ;
    43         I $D(PSONEW("RX #")) L -^PSRX("B",PSONEW("RX #")) ; +Lock set in PSONRXN
    44         K PSONOEDT,PSONEW,PSODRUG,ANQDATA,LSI,C,MAX,MIN,NDF,REF,SIG,SER,PSOFLAG,PSOHI,PSOLO,PSONOOR,PSOCOUU,PSOCOU,PSORX("EDIT")
    45         D CLEAN^PSOVER1
    46         K ^TMP("PSORXDC",$J),RORD,ACOM,ACNT,CRIT,DEF,F1,GG,I1,IEN,INDT,LAST,MSG,NIEN,STA,DUR,DRET,PSOPRC
    47         S RXN=$O(^TMP("PSORXN",$J,0)) I RXN D
    48         .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3))
    49         .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS","")
    50         K RXN,RXN1,^TMP("PSORXN",$J)
    51         I $G(PSONOTE) D FULL^VALM1,MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
    52         K PSONOTE
    53         Q
    54 NOOR    ;asks nature of order
    55         N PSONOODF
    56         S PSONOODF=0
    57         I $G(OR0) D  G NOORX ;front door
    58         .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)
    59         .S PSONOODF=1
    60         .D DIR I $D(DIRUT) S PSONEW("DFLG")=1 Q
    61         .S PSONOOR=Y D:$D(^XUSEC("PSORPH",DUZ)) COUN K DIR,DTOUT,DTOUT,DIRUT
    62         ;backdoor order
    63         D DIR I $D(DIRUT) S PSONEW("DFLG")=1 Q
    64         S PSONOOR=Y K DIK,DA,DIE,DR,PSOI,DIR,DUOUT,DTOUT,DIRUT
    65         G:'$D(^XUSEC("PSORPH",DUZ)) NOORX
    66 COUN    ;patient counseling
    67         G:$G(PSORX("EDIT"))&('$G(PSOSIGFL)) NOORX K DIR,DUOUT,DTOUT,DIRUT
    68         S DIR("B")="NO",DIR(0)="52,41" D ^DIR S PSOCOU=$S(Y:Y,1:0)
    69         I $D(DIRUT)!('PSOCOU) S PSOCOUU=0 D:'$G(SPEED) PRONTE Q
    70         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)
    71 PRONTE  K PSONOTE,DIR,DIRUT,DUOUT
    72         I $T(MAIN^TIUEDIT)]"",'$G(SPEED) D  K DIR,DIRUT,DUOUT
    73         .S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to enter a Progress Note",DIR("A",1)="" D ^DIR K DIR
    74         .S PSONOTE=+Y Q  ;I 'Y!($D(DIRUT)) Q
    75 NOORX   K X,Y,DIR,DUOUT,DTOUT,DIRUT
    76         Q
    77 DIR     ;ask nature of order
    78         K DIR,DTOUT,DTOUT,DIRUT I $T(NA^ORX1)]""  D  Q
    79         .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:""))
    80         .I +PSONOOR S (Y,PSONOOR)=$P(PSONOOR,"^",3) Q
    81         .S DIRUT=1 K PSONOOR
    82         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")
    83         K DIR,DTOUT,DTOUT,DIRUT S DIR("A")="Nature of Order: ",DIR("B")=$S($D(PSONOOR):PSONODF,1:"WRITTEN")
    84         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:"")
    85         D ^DIR K DF,PSONODF Q:$D(DIRUT)  S PSONOOR=Y
    86 DIRX    Q
    87         ;
    88 NOORE(PSONEW)   ;entry point for renew
    89         D NOOR I $D(DIRUT) S PSONEW("DFLG")=1 Q
    90         S PSONEW("NOO")=PSONOOR
    91         Q
     1PSONEW ;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 ;---------------------------------------------------------------
     26OERR ;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
     30AGAIN 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"
     42END 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 ;----------------------------------------------------------------
     47DEL ;
     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
     57EOJ ;
     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
     69NOOR ;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
     81COUN ;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)
     87PRONTE 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
     92NOORX K X,Y,DIR,DUOUT,DTOUT,DIRUT
     93 Q
     94DIR ;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
     103DIRX Q
     104 ;
     105NOORE(PSONEW) ;entry point for renew
     106 D NOOR I $D(DIRUT) S PSONEW("DFLG")=1 Q
     107 S PSONEW("NOO")=PSONOOR
     108 Q
Note: See TracChangeset for help on using the changeset viewer.