source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m@ 1073

PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05

 ;;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

 ;; PSJI = Index to ^TMP to find order check detail

 ;

 N PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN

 S PSJD0=^TMP($J,PSJT,PSJI,0),PSJD1=^(1)

 I PSJT="DD" S PSJRX=$P($P(PSJD0,"^",4),";"),PSJRS=$P(PSJD0,"^",5),PSJDN=$P(PSJD0,"^",2)

 I PSJT="DC" S PSJRX=$P($P(PSJD0,"^",6),";"),PSJRS=$P(PSJD0,"^",7),PSJDN=$P(PSJD0,"^",4)

 I PSJT="DI" S PSJRX=$P($P(PSJD0,"^",8),";"),PSJRS=$P(PSJD0,"^",9),PSJDN=$P(PSJD0,"^",2)

 S PSJLF=$P(PSJD1,"^",3),$P(PSJULN,"-",79)=""

 W !,PSJULN,!

 W PSJRS I $L(PSJRS)>13 W !

 W ?14,"Rx #: ",$E(PSJRX,1,$L(PSJRX)-1) I $A($L(PSJRX))<54 W $E(PSJRX,$L(PSJRX))

 W ?39,PSJDN,! I PSJT="DI" W ?39,$P(PSJD0,"^",4)," INTERACTION",!

 W $J("Status: ",20),$P(PSJD1,"^",2),?40,$J("Issued: ",20),$P(PSJD1,"^",9)

 D FSIG(.FSIG)

 W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I))  W ?20,FSIG(I),!

 W $J("QTY: ",20)_$P(PSJD1,"^",5)

 W !,$J("Provider: ",20),$P(PSJD1,"^",8),?40,$J("Refills remaining: ",20),$P(PSJD1,"^",6)

 W !?40,$J("Last filled on: ",20),PSJLF

 W !?40,$J("Days Supply: ",20)_$P(PSJD1,"^",4)

 W !,PSJULN

 Q

 ;

FSIG(FSIG) ;Format sig from remote site

 ;returned in the FSIG array

 N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I

 F I=0:1 Q:'$D(^TMP($J,PSJT,PSJI,1,I))  S HSIG(I+1)=^(I)

FSTART S (FVAR,FVAR1)="",II=1

 F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF  S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D  I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1

 .S FVAR1=$P(HSIG(FFF)," ",(CNT))

 .S FLIM=FVAR

 .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)

 I $G(FVAR)'="" S FSIG(II)=FVAR

 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 !

 Q