Changeset 636 for FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m (modified) (3 diffs)

FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m

@@ -1 +1 @@
 PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05
- ;;5.0; INPATIENT MEDICATIONS ;**146,175,201**;16 DEC 97;Build 2
+ ;;5.0; INPATIENT MEDICATIONS ;**146,175**;16 DEC 97;Build 18
  ;
+ ; Reference to ^PS(55 is supported by DBIA# 2191.
+ ; Reference to ^PSDRUG is supported by DBIA# 2192.
+ ; Reference to ^PSSLOCK is supported by DBIA# 2789.
+ ; Reference to ^VA(200 is supported by DBIA# 10060.
+ ; 
 SHOR(PSJT,PSJI)       ;Display outpatient remote order checks.
  ;; PSJT = Type of order check in ^TMP
@@ -25 +30 @@
  W !,PSJULN
  Q
+ ;
 FSIG(FSIG) ;Format sig from remote site
  ;returned in the FSIG array
@@ -37 +43 @@
  I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
 FQUIT Q
+ ;
+DUPDRG(DFN) ;DEM - Duplicate Drug Check Ehancement
+ ;
+ ;  Note: Display of Drug Interaction, Non-VA Meds, and Outpatient
+ ;        orders is done by ORDCHK^PSJLMUT1. ORDCHK is called by
+ ;        routine ENDDC^PSGSICHK before routine ENDDC^PSGSICHK calls
+ ;        DUPDRG^PSJLMUT2. If ORDCHK finds "DD", or "DC" orders,
+ ;        then ORDCHK will set "DD", or "DC" orders into
+ ;        ^TMP($J,"DUPDRG",TYPE) global.
+ ;
+ K PSJDDCON  ;Order continuation flag used by routine PSGSICHK.
+ S:$D(^TMP($J,"DI")) PSJDDCON("DI")=1  ;Order continuation flag used by routine PSGSICHK.
+ ;  Quit if no duplicate drug orders(s), or duplicate drug class
+ ;  order(s) found.
+ Q:'$D(^TMP($J,"DUPDRG","DD"))&'$D(^TMP($J,"DUPDRG","DC"))
+ S PSJDDCON("DD")=0  ;Order continuation flag used by routine PSGSICHK.
+ ;
+ ;  Display orders in ^TMP($J,"DUPDRG",DUPLICATE_TYPE,ON,LINE_#)
+ ;  (DUPLICATE TYPEs: "DD" - "Duplicate Drug"
+ ;                    "DC" - "Duplicate Drug Class"
+ ;
+ S PSJPDRG=1  ;If we are here, then set PSJPDRG=1. ORDCHK^PSJLMUT1 addresses this variable for Outpatient orders and "DI" orders.
+ N X,Y,DIR,TYPE,ON,PSJOC,PSJOCPOP,PSJSYSL
+ W !!,"This patient is already receiving the following INPATIENT order(s) for the same drug or in the same drug class as "_$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!!
+ D DSPLDD  ;Display patients orders for the same drug or same drug class as drug selected.
+ ;  Ask user if they wish to continue in spite of an order check.
+ S DIR(0)="Y",DIR("A")="Do you wish to continue with the current order",DIR("?",1)="Enter ""N"" if you wish to exit without creating a new order,"
+ S DIR("?")="or ""Y"" to continue with the order entry process.",DIR("B")="YES" D ^DIR I 'Y S PSGORQF=1,COMQUIT=1 K X,Y,DIR W ! Q
+ K X,Y,DIR
+ S PSJDDCON("DD")=1,PSJSYSL=0  ;Order continuation flag used by routine PSGSICHK. 
+ W !
+ F  D  Q:('PSJOC)!(PSJOCPOP)  ;Order discontinuation loop.
+ . N TYPE,ON,PSJOCSEQ
+ . S PSJOCPOP=0
+ . ;  Ask user if they wish to discontinue any of the listed orders.
+ . S DIR(0)="Y",DIR("A")="Do you wish to DISCONTINUE any of the listed orders",DIR("?",1)="Enter ""N"" if you wish to exit without discontinuing any of the listed orders,"
+ . S DIR("?")="or ""Y"" to discontinue any of the listed orders.",DIR("B")="NO" D ^DIR I 'Y K X,Y,DIR S PSJOCPOP=1 W ! Q
+ . K X,Y,DIR
+ . W !
+ . ;  Choose for DISCONTINUE 1-PSJOC (PSJOC is the total number of duplicate and duplicate class orders).
+ . S DIR(0)="N^1:"_PSJOC,DIR("A")="Choose for DISCONTINUE",DIR("?")="Choose an order 1-"_PSJOC D ^DIR I 'Y K X,Y,DIR S PSJOCPOP=1 W ! Q
+ . S PSJOCSEQ=+Y
+ . K X,Y,DIR
+ . ;
+ . ;  *** Discontinue order ***
+ . S ON=$P(PSJOC(PSJOCSEQ),"^",2)
+ . I '$$LS^PSSLOCK(DFN,ON) S PSJOCPOP=1 Q
+ . S PSGSTAT=$$GTSTATUS^PSJOE(DFN,ON)
+ . D  ;Set PSGOEEWF for order being discontinued - DRF
+ .. I ON["P" S PSGOEEWF="^PS(53.1,"_+ON_"," Q
+ .. I ON["U" S PSGOEEWF="^PS(55,"_DFN_",5,"_+ON_"," Q
+ .. S PSGOEEWF="^PS(55,"_DFN_",""IV"","_+ON_","
+ . D  ;The following variables must be newed or they are stomped on by the discontinue code
+ .. N %DT,CF,D,D0,DA,DI,DIC,DIE,DISYS,DQ,DR,DRG,DRGT,DRGTMP,DRGX
+ .. N DTIME,FIL,I,JJ,LOC,OCXDT,OCXI,OCXSEG,ORIFN,ORO,POP,PSGALR
+ .. N PSGDT,PSGOEAV,PSJNOO,PSGOEDMR,PSGOEPR,PSGPDRG,PSGTOO,PSGTOL
+ .. N PSGUOW,PSIVOI,PSIVX,PSJCOM,PSJDD,PSJHLMTN,PSJMSG,PSJQO,PSOC
+ .. N Q,QQ,T,VA,VADM,VAERR,VAIN,XPARSYS,XQXFLG,Y,PSJRQPND
+ .. D
+ ... S PSJRQPND=1
+ ... I ON["V" D  Q  ;IV order
+ .... N PSJORD
+ .... S PSJORD=ON
+ .... D DC^PSJLIACT
+ ... D DC^PSJOE(DFN,ON)  ;UD order
+ .. I $$GTSTATUS^PSJOE(DFN,ON)="D" D  ;  Clean up PSJOC and ^TMP($J,"DUPDRG") arrays, and reset PSJOC counter IF and after selected order has been discontinued.
+ ... S TYPE=$P(PSJOC(PSJOCSEQ),"^",1),ON=$P(PSJOC(PSJOCSEQ),"^",2),PSJOC=PSJOC-1
+ ... K PSJOC(PSJOCSEQ),^TMP($J,"DUPDRG",TYPE,ON),PSJOCSEQ
+ . D UNL^PSSLOCK(DFN,ON)
+ . Q:'PSJOC
+ . W !!,"Now, this patient is already receiving the following INPATIENT order(s) for the same drug or in the same drug class as "_$S($G(PSJDD)]"":$P($G(^PSDRUG(PSJDD,0)),U),1:"the drug selected"),":",!!
+ . D DSPLDD
+ . Q
+ W !
+ K PSJOCPOP,PSGSTAT
+ Q
+ ;
+DSPLDD ;
+ ;  Display patients orders for the same drug or same drug class as drug selected.
+ N X,REQPROV,PSJLINE,PSJFLN
+ K PSJOC
+ ;  Requesting Provider
+ S PSJOC=0
+ F TYPE="DD","DC" S ON="" F  S ON=$O(^TMP($J,"DUPDRG",TYPE,ON)) Q:ON=""  S PSJFLN=1 D
+ . I ON["U" S REQPROV=$P(^PS(55,DFN,5,+ON,0),"^",2)
+ . I ON["V" S REQPROV=$P(^PS(55,DFN,"IV",+ON,0),"^",6)
+ . I ON["P" S REQPROV=$P(^PS(53.1,+ON,0),"^",2)
+ . S REQPROV=$S(REQPROV>0:$P($G(^VA(200,REQPROV,0)),"^",1),1:"") S:REQPROV="" REQPROV="Requesting Provider Unknown"
+ . F PSJLINE=0:0 S PSJLINE=$O(^TMP($J,"DUPDRG",TYPE,ON,PSJLINE)) Q:'PSJLINE  D
+ .. I PSJFLN=1 S PSJOC=PSJOC+1,PSJOC(PSJOC)=TYPE_"^"_ON W PSJOC_".",^TMP($J,"DUPDRG",TYPE,ON,PSJLINE),! S PSJFLN=PSJFLN+1 Q
+ .. S X=^TMP($J,"DUPDRG",TYPE,ON,PSJLINE) S:PSJFLN=2 X=$$SETSTR^VALM1(REQPROV,X,(48+$L(PSJOC_".")),25) W ?($L(PSJOC_".")),X,! S PSJFLN=PSJFLN+1 Q
+ .. Q
+ . Q
+ Q
+ ;
 PAUSE ;
  K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W !