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

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