- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUT2.m
r613 r623 1 PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05 2 ;;5.0; INPATIENT MEDICATIONS ;**146,175,201**;16 DEC 97;Build 2 3 ; 4 SHOR(PSJT,PSJI) ;Display outpatient remote order checks. 5 ;; PSJT = Type of order check in ^TMP 6 ;; PSJI = Index to ^TMP to find order check detail 7 ; 8 N PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN 9 S PSJD0=^TMP($J,PSJT,PSJI,0),PSJD1=^(1) 10 I PSJT="DD" S PSJRX=$P($P(PSJD0,"^",4),";"),PSJRS=$P(PSJD0,"^",5),PSJDN=$P(PSJD0,"^",2) 11 I PSJT="DC" S PSJRX=$P($P(PSJD0,"^",6),";"),PSJRS=$P(PSJD0,"^",7),PSJDN=$P(PSJD0,"^",4) 12 I PSJT="DI" S PSJRX=$P($P(PSJD0,"^",8),";"),PSJRS=$P(PSJD0,"^",9),PSJDN=$P(PSJD0,"^",2) 13 S PSJLF=$P(PSJD1,"^",3),$P(PSJULN,"-",79)="" 14 W !,PSJULN,! 15 W PSJRS I $L(PSJRS)>13 W ! 16 W ?14,"Rx #: ",$E(PSJRX,1,$L(PSJRX)-1) I $A($L(PSJRX))<54 W $E(PSJRX,$L(PSJRX)) 17 W ?39,PSJDN,! I PSJT="DI" W ?39,$P(PSJD0,"^",4)," INTERACTION",! 18 W $J("Status: ",20),$P(PSJD1,"^",2),?40,$J("Issued: ",20),$P(PSJD1,"^",9) 19 D FSIG(.FSIG) 20 W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),! 21 W $J("QTY: ",20)_$P(PSJD1,"^",5) 22 W !,$J("Provider: ",20),$P(PSJD1,"^",8),?40,$J("Refills remaining: ",20),$P(PSJD1,"^",6) 23 W !?40,$J("Last filled on: ",20),PSJLF 24 W !?40,$J("Days Supply: ",20)_$P(PSJD1,"^",4) 25 W !,PSJULN 26 Q 27 FSIG(FSIG) ;Format sig from remote site 28 ;returned in the FSIG array 29 N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I 30 F I=0:1 Q:'$D(^TMP($J,PSJT,PSJI,1,I)) S HSIG(I+1)=^(I) 31 FSTART S (FVAR,FVAR1)="",II=1 32 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 33 .S FVAR1=$P(HSIG(FFF)," ",(CNT)) 34 .S FLIM=FVAR 35 .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1) 36 I $G(FVAR)'="" S FSIG(II)=FVAR 37 I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2) 38 FQUIT Q 39 PAUSE ; 40 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W ! 41 Q 1 PSJLMUT2 ;BIR/JLC-DISPLAY UTILITIES ;22 Jun 05 2 ;;5.0; INPATIENT MEDICATIONS ;**146,175**;16 DEC 97;Build 18 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to ^PSDRUG is supported by DBIA# 2192. 6 ; Reference to ^PSSLOCK is supported by DBIA# 2789. 7 ; Reference to ^VA(200 is supported by DBIA# 10060. 8 ; 9 SHOR(PSJT,PSJI) ;Display outpatient remote order checks. 10 ;; PSJT = Type of order check in ^TMP 11 ;; PSJI = Index to ^TMP to find order check detail 12 ; 13 N PSJD0,PSJD1,PSJRX,PSJRS,FSIG,PSJULN,PSJLF,PSJDN 14 S PSJD0=^TMP($J,PSJT,PSJI,0),PSJD1=^(1) 15 I PSJT="DD" S PSJRX=$P($P(PSJD0,"^",4),";"),PSJRS=$P(PSJD0,"^",5),PSJDN=$P(PSJD0,"^",2) 16 I PSJT="DC" S PSJRX=$P($P(PSJD0,"^",6),";"),PSJRS=$P(PSJD0,"^",7),PSJDN=$P(PSJD0,"^",4) 17 I PSJT="DI" S PSJRX=$P($P(PSJD0,"^",8),";"),PSJRS=$P(PSJD0,"^",9),PSJDN=$P(PSJD0,"^",2) 18 S PSJLF=$P(PSJD1,"^",3),$P(PSJULN,"-",79)="" 19 W !,PSJULN,! 20 W PSJRS I $L(PSJRS)>13 W ! 21 W ?14,"Rx #: ",$E(PSJRX,1,$L(PSJRX)-1) I $A($L(PSJRX))<54 W $E(PSJRX,$L(PSJRX)) 22 W ?39,PSJDN,! I PSJT="DI" W ?39,$P(PSJD0,"^",4)," INTERACTION",! 23 W $J("Status: ",20),$P(PSJD1,"^",2),?40,$J("Issued: ",20),$P(PSJD1,"^",9) 24 D FSIG(.FSIG) 25 W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),! 26 W $J("QTY: ",20)_$P(PSJD1,"^",5) 27 W !,$J("Provider: ",20),$P(PSJD1,"^",8),?40,$J("Refills remaining: ",20),$P(PSJD1,"^",6) 28 W !?40,$J("Last filled on: ",20),PSJLF 29 W !?40,$J("Days Supply: ",20)_$P(PSJD1,"^",4) 30 W !,PSJULN 31 Q 32 ; 33 FSIG(FSIG) ;Format sig from remote site 34 ;returned in the FSIG array 35 N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I 36 F I=0:1 Q:'$D(^TMP($J,PSJT,PSJI,1,I)) S HSIG(I+1)=^(I) 37 FSTART S (FVAR,FVAR1)="",II=1 38 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 39 .S FVAR1=$P(HSIG(FFF)," ",(CNT)) 40 .S FLIM=FVAR 41 .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1) 42 I $G(FVAR)'="" S FSIG(II)=FVAR 43 I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2) 44 FQUIT Q 45 ; 46 DUPDRG(DFN) ;DEM - Duplicate Drug Check Ehancement 47 ; 48 ; Note: Display of Drug Interaction, Non-VA Meds, and Outpatient 49 ; orders is done by ORDCHK^PSJLMUT1. ORDCHK is called by 50 ; routine ENDDC^PSGSICHK before routine ENDDC^PSGSICHK calls 51 ; DUPDRG^PSJLMUT2. If ORDCHK finds "DD", or "DC" orders, 52 ; then ORDCHK will set "DD", or "DC" orders into 53 ; ^TMP($J,"DUPDRG",TYPE) global. 54 ; 55 K PSJDDCON ;Order continuation flag used by routine PSGSICHK. 56 S:$D(^TMP($J,"DI")) PSJDDCON("DI")=1 ;Order continuation flag used by routine PSGSICHK. 57 ; Quit if no duplicate drug orders(s), or duplicate drug class 58 ; order(s) found. 59 Q:'$D(^TMP($J,"DUPDRG","DD"))&'$D(^TMP($J,"DUPDRG","DC")) 60 S PSJDDCON("DD")=0 ;Order continuation flag used by routine PSGSICHK. 61 ; 62 ; Display orders in ^TMP($J,"DUPDRG",DUPLICATE_TYPE,ON,LINE_#) 63 ; (DUPLICATE TYPEs: "DD" - "Duplicate Drug" 64 ; "DC" - "Duplicate Drug Class" 65 ; 66 S PSJPDRG=1 ;If we are here, then set PSJPDRG=1. ORDCHK^PSJLMUT1 addresses this variable for Outpatient orders and "DI" orders. 67 N X,Y,DIR,TYPE,ON,PSJOC,PSJOCPOP,PSJSYSL 68 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"),":",!! 69 D DSPLDD ;Display patients orders for the same drug or same drug class as drug selected. 70 ; Ask user if they wish to continue in spite of an order check. 71 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," 72 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 73 K X,Y,DIR 74 S PSJDDCON("DD")=1,PSJSYSL=0 ;Order continuation flag used by routine PSGSICHK. 75 W ! 76 F D Q:('PSJOC)!(PSJOCPOP) ;Order discontinuation loop. 77 . N TYPE,ON,PSJOCSEQ 78 . S PSJOCPOP=0 79 . ; Ask user if they wish to discontinue any of the listed orders. 80 . 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," 81 . 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 82 . K X,Y,DIR 83 . W ! 84 . ; Choose for DISCONTINUE 1-PSJOC (PSJOC is the total number of duplicate and duplicate class orders). 85 . 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 86 . S PSJOCSEQ=+Y 87 . K X,Y,DIR 88 . ; 89 . ; *** Discontinue order *** 90 . S ON=$P(PSJOC(PSJOCSEQ),"^",2) 91 . I '$$LS^PSSLOCK(DFN,ON) S PSJOCPOP=1 Q 92 . S PSGSTAT=$$GTSTATUS^PSJOE(DFN,ON) 93 . D ;Set PSGOEEWF for order being discontinued - DRF 94 .. I ON["P" S PSGOEEWF="^PS(53.1,"_+ON_"," Q 95 .. I ON["U" S PSGOEEWF="^PS(55,"_DFN_",5,"_+ON_"," Q 96 .. S PSGOEEWF="^PS(55,"_DFN_",""IV"","_+ON_"," 97 . D ;The following variables must be newed or they are stomped on by the discontinue code 98 .. N %DT,CF,D,D0,DA,DI,DIC,DIE,DISYS,DQ,DR,DRG,DRGT,DRGTMP,DRGX 99 .. N DTIME,FIL,I,JJ,LOC,OCXDT,OCXI,OCXSEG,ORIFN,ORO,POP,PSGALR 100 .. N PSGDT,PSGOEAV,PSJNOO,PSGOEDMR,PSGOEPR,PSGPDRG,PSGTOO,PSGTOL 101 .. N PSGUOW,PSIVOI,PSIVX,PSJCOM,PSJDD,PSJHLMTN,PSJMSG,PSJQO,PSOC 102 .. N Q,QQ,T,VA,VADM,VAERR,VAIN,XPARSYS,XQXFLG,Y,PSJRQPND 103 .. D 104 ... S PSJRQPND=1 105 ... I ON["V" D Q ;IV order 106 .... N PSJORD 107 .... S PSJORD=ON 108 .... D DC^PSJLIACT 109 ... D DC^PSJOE(DFN,ON) ;UD order 110 .. 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. 111 ... S TYPE=$P(PSJOC(PSJOCSEQ),"^",1),ON=$P(PSJOC(PSJOCSEQ),"^",2),PSJOC=PSJOC-1 112 ... K PSJOC(PSJOCSEQ),^TMP($J,"DUPDRG",TYPE,ON),PSJOCSEQ 113 . D UNL^PSSLOCK(DFN,ON) 114 . Q:'PSJOC 115 . 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"),":",!! 116 . D DSPLDD 117 . Q 118 W ! 119 K PSJOCPOP,PSGSTAT 120 Q 121 ; 122 DSPLDD ; 123 ; Display patients orders for the same drug or same drug class as drug selected. 124 N X,REQPROV,PSJLINE,PSJFLN 125 K PSJOC 126 ; Requesting Provider 127 S PSJOC=0 128 F TYPE="DD","DC" S ON="" F S ON=$O(^TMP($J,"DUPDRG",TYPE,ON)) Q:ON="" S PSJFLN=1 D 129 . I ON["U" S REQPROV=$P(^PS(55,DFN,5,+ON,0),"^",2) 130 . I ON["V" S REQPROV=$P(^PS(55,DFN,"IV",+ON,0),"^",6) 131 . I ON["P" S REQPROV=$P(^PS(53.1,+ON,0),"^",2) 132 . S REQPROV=$S(REQPROV>0:$P($G(^VA(200,REQPROV,0)),"^",1),1:"") S:REQPROV="" REQPROV="Requesting Provider Unknown" 133 . F PSJLINE=0:0 S PSJLINE=$O(^TMP($J,"DUPDRG",TYPE,ON,PSJLINE)) Q:'PSJLINE D 134 .. I PSJFLN=1 S PSJOC=PSJOC+1,PSJOC(PSJOC)=TYPE_"^"_ON W PSJOC_".",^TMP($J,"DUPDRG",TYPE,ON,PSJLINE),! S PSJFLN=PSJFLN+1 Q 135 .. 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 136 .. Q 137 . Q 138 Q 139 ; 140 PAUSE ; 141 K DIR W ! S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR W ! 142 Q
Note:
See TracChangeset
for help on using the changeset viewer.
