| 1 | PSIVEDRG ;BIR/MLM-ENTER/EDIT DRUGS FOR IV ORDER ;16 Mar 99 / 2:14 PM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**21,33,50,65,74,84,128,147**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ; References to ^PS(52.6 supported by DBIA# 1231.
|
---|
| 5 | ; References to ^PS(52.7 supported by DBIA# 2173.
|
---|
| 6 | ; Reference to EN^PSOORDRG supported by DBIA# 2190.
|
---|
| 7 | ;
|
---|
| 8 | DRG ; Edit Additive/Solution data
|
---|
| 9 | NEW DRGOC,PSGORQF ;If PSGORQF=1 abort order after order check.
|
---|
| 10 | K PSIVOLD S DRG(2)="" I $D(DRG(DRGT)) S DRGI=+$O(DRG(DRGT,0)) I DRGI S PSIVOLD=1 D SETDRG
|
---|
| 11 | DRG1 ;
|
---|
| 12 | Q:$G(PSGORQF)
|
---|
| 13 | I $G(X)="?" K DUOUT
|
---|
| 14 | D FULL^VALM1
|
---|
| 15 | W !,"Select ",DRGTN,": "
|
---|
| 16 | I DRGT=$G(PSIVOI),($G(PSIVOI("DILIST",0))>1) D GTADSOL Q
|
---|
| 17 | W:DRG(2)]"" DRG(2),"//" R X:DTIME S:'$T X="^" S:X=U DONE=1 Q:X["^"!(X=""&(DRG(2)=""))
|
---|
| 18 | DRG1A I X="" W !,DRGTN,": ",DRG(2),"//" R X:DTIME S:'$T X="^" Q:X="^" I X="" S Y=1 D DRG3 G:DRGT="AD"!($G(P(4))="H") DRG1 Q
|
---|
| 19 | I X="@",DRG(2)]"" D DEL G:%'=1 DRG1A K DRG(DRGT,DRGI) S DRGI=+$O(DRG(DRGT,0)) S:'DRGI DRG(DRGT,0)=0 D SETDRG G DRG1
|
---|
| 20 | I X["???",($E(P("OT"))="M"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G DRG1
|
---|
| 21 | I X'["?" S %=0 D:$D(DRG(DRGT)) CHK G:%=1 DRG1A D DRG2 Q:$G(Y)>0&($G(P(4))'="H"&(DRGT="SOL")) G DRG1
|
---|
| 22 | I $D(DRG(DRGT)) W !,"This order includes the following ",DRGTN,"S:",! F Y=0:0 S Y=$O(DRG(DRGT,Y)) Q:'Y W !,$P(DRG(DRGT,Y),U,2)
|
---|
| 23 | W !,"YOU MAY ENTER A NEW ",DRGTN,", IF YOU WISH",! D GTSCRN(X) S DIC(0)="EQM" D ^DIC K DIC G DRG1
|
---|
| 24 | Q
|
---|
| 25 | ;
|
---|
| 26 | SETDRG ; Put Drug data into DRG(x).
|
---|
| 27 | F X=1:1:6 S DRG(X)=$P(DRG(DRGT,DRGI),U,X)
|
---|
| 28 | S X="" I DRG(2)="",DRG(1) S DRG(2)="*** Undefined ***"
|
---|
| 29 | Q
|
---|
| 30 | DRG2 ;
|
---|
| 31 | D GTSCRN(X) N PSIVX S PSIVX=X,DIC(0)="EQMZ" D ^DIC K DIC Q:Y<0
|
---|
| 32 | S PSJIVIEN=+Y
|
---|
| 33 | NEW PSJNF D NFIV^PSJDIN($S(DRGT="AD":52.6,1:52.7),+PSJIVIEN,.PSJNF)
|
---|
| 34 | W PSJNF("NF")
|
---|
| 35 | S PSIVNEW=1,DRGTMP=+Y_U_$P(Y(0),U)_U_$S(DRGT="SOL":$P(Y(0),U,3),1:"")_U_U_$P(Y(0),U,13)_U_$P(Y(0),U,11)
|
---|
| 36 | I '$D(ON55) NEW ON55 S ON55=ON
|
---|
| 37 | D ORDERCHK(DFN,ON55,1) I $G(PSGORQF) S X=U,DONE=1 Q
|
---|
| 38 | D DINIV^PSJDIN($S(DRGT="AD":52.6,1:52.7),+DRGTMP)
|
---|
| 39 | S (DRG(DRGT,0),DRGI)=$G(DRG(DRGT,0))+1,DRG(DRGT,DRGI)=DRGTMP K PSIVOLD
|
---|
| 40 | I (PSIVAC="PN"!(PSIVAC="CF")),(DRGT="AD"),$D(^PS(52.6,"C",PSIVX,+DRGTMP)) D ^PSIVQUI Q:$G(PSIVSTR)="QUICK CODE"!$G(PSGORQF)
|
---|
| 41 | DRG3 ;
|
---|
| 42 | D:DRG(2)]"" DINIV^PSJDIN(FIL,+DRG(1))
|
---|
| 43 | D SETDRG
|
---|
| 44 | I DRGT="AD" S X=$P($G(^PS(FIL,+DRG(1),0)),U,3) W !!,"(The units of strength for this additive are in ",$$ENU^PSIVUTL(DRG(1)),")"
|
---|
| 45 | AMT ;
|
---|
| 46 | I DRGT="SOL",'$G(PSIVOLD),($G(P(4))_$G(P(23))'["S") G DRG4
|
---|
| 47 | 1 ; Strength/Volume
|
---|
| 48 | W !,$S(DRGT="AD":"Strength: ",1:"Volume: ") W:+DRG(3) DRG(3),"//" R X:DTIME S:'$T X="^" Q:X="^" G:X=""&DRG(3) 2 I X="" W $C(7),$S(DRGT="AD":"Strength",1:"Volume")," is REQUIRED!" G 1
|
---|
| 49 | D:$D(X) IT G:'$D(X)!($G(X)["?") AMT S DRG(3)=X I X="" D FIELD^DID($S(DRGT="AD":53.157,1:53.158),1,"","XECUTABLE HELP","PSJEX") X PSJEX("XECUTABLE HELP") K PSJEX G AMT
|
---|
| 50 | 2 I DRGT="AD",$G(P("DTYP"))>1,P(4)'="S",P(23)'="S" K DIR S DIR(0)="53.157,2" S:DRG(4)]"" DIR("B")=DRG(4) D ^DIR Q:$D(DTOUT)!$D(DUOUT) S:Y DRG(4)=Y
|
---|
| 51 | DRG4 ;
|
---|
| 52 | F X=1:1:6 S $P(DRG(DRGT,DRGI),U,X)=DRG(X)
|
---|
| 53 | S DRG(2)=""
|
---|
| 54 | Q
|
---|
| 55 | ;
|
---|
| 56 | GTSCRN(PSIVX) ;Set DIC("S") if MD OE or matching drug has already been selected.
|
---|
| 57 | D:"?"[PSIVX HOLDHDR^PSJOE
|
---|
| 58 | S X=PSIVX
|
---|
| 59 | K DA,DIC S DIC=FIL,DIC("S")=$$IVDRGSC^PSIVUTL
|
---|
| 60 | I $E(PSIVAC)'="P",($P(P("OT"),U)="F") S X(1)=" I $P(X(1),U,13)",DIC("S")=$G(DIC("S"))_$S(DRGT="AD":X(1),$E(PSIVAC)="O":X(1),1:"")
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | IT ; Input Transform for Strength/Volume.
|
---|
| 64 | I X?1.N,$L(X)>20 S X="?"
|
---|
| 65 | I X["?" W $C(7) S F1=53.15_$S(DRGT="AD":7,1:8),F2=1 D ENHLP^PSIVORC1 Q
|
---|
| 66 | I DRGT="AD" K:X'?.6N0.1".".8N!('X) X I $D(X) S:(X<1)&($P(X,".")'=0) X=0_X S X=X_" "_$$ENU^PSIVUTL(DRG(1)) W " ",X Q
|
---|
| 67 | I $D(X) K:X=""!(X'?.N0.1".".N)!(X>9999)!(X<.01) X I $D(X) S:(X<1)&($P(X,".")'=0) X=0_X S X=X_" ML" W " ",X
|
---|
| 68 | W:'$D(X) $C(7),"??"
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | ORDERCHK(DFN,ON,X) ; Do order check
|
---|
| 72 | ;* If X is define, include the DRG(X) to the order check
|
---|
| 73 | I X M:$D(DRG) DRGOC(ON)=DRG
|
---|
| 74 | NEW TMPDRG,X,XX,Y,PSIVNEW,PSGDRG,PSGDRGN,PSJDD,PSGP
|
---|
| 75 | D SAVEDRG(.TMPDRG,.DRG) ;Store DRG array in TMPDRG array
|
---|
| 76 | S PSIVNEW=1,PSGDRGN=$P($G(DRGTMP),U,2)
|
---|
| 77 | S (PSJDD,PSGDRG)=$P(^PS(FIL,+DRGTMP,0),U,2),PSGP=DFN
|
---|
| 78 | I FIL="52.6" D ENDDC^PSGSICHK(DFN,PSGDRG)
|
---|
| 79 | I FIL="52.7" D
|
---|
| 80 | . D EN^PSOORDRG(DFN,PSGDRG)
|
---|
| 81 | . N INTERVEN,PSJIREQ,PSJRXREQ S Y=1,(PSJIREQ,PSJRXREQ,INTERVEN,X)=""
|
---|
| 82 | . S DFN=PSGP K PSJPDRG
|
---|
| 83 | . D IVSOL^PSGSICHK
|
---|
| 84 | D SAVEDRG(.DRG,.TMPDRG) ;Restore DRG array from TMPDRG array
|
---|
| 85 | D ENSTOP^PSIVCAL
|
---|
| 86 | Q
|
---|
| 87 | SAVEDRG(NEW,OLD) ;Store/restore DRG array.
|
---|
| 88 | S:$G(OLD) NEW=OLD
|
---|
| 89 | F X=0:0 S X=$O(OLD(X)) Q:'X S NEW(X)=OLD(X)
|
---|
| 90 | F XX="AD","SOL" D
|
---|
| 91 | . I $D(OLD(XX,0))#10=1 S NEW(XX,0)=OLD(XX,0)
|
---|
| 92 | . F X=0:0 S X=$O(OLD(XX,X)) Q:'X S NEW(XX,X)=OLD(XX,X)
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | CHK ; Check if drug is already part of order
|
---|
| 96 | N DDONE,I,TDRG,TDRGP F TDRG=0:0 S TDRG=$O(DRG(DRGT,TDRG)) Q:'TDRG!$G(DDONE) D
|
---|
| 97 | .I $$UPPER^VALM1($E($P(DRG(DRGT,+TDRG),U,2),1,$L(X)))=$$UPPER^VALM1(X) W $P($$UPPER^VALM1($P(DRG(DRGT,+TDRG),U,2)),$$UPPER^VALM1(X),2) D ASKCHK Q
|
---|
| 98 | .S TDRGP=$P(DRG(DRGT,TDRG),U) F J=0:0 S J=$O(^PS(FIL,TDRGP,3,J)) Q:'J!$G(DDONE) I $$UPPER^VALM1($E($P(^PS(FIL,TDRGP,3,J,0),U),1,$L(X)))=$$UPPER^VALM1(X) D D ASKCHK Q
|
---|
| 99 | ..W $P($$UPPER^VALM1($P(^PS(FIL,TDRGP,3,J,0),U)),$$UPPER^VALM1(X),2)," ",$P(DRG(DRGT,TDRG),U,2)
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|
| 102 | ASKCHK ; Do you want a drug that was previously selected.
|
---|
| 103 | S I=DRG(DRGT,TDRG) W " ",$P(I,U,3),$S($P(I,U,4):" ("_$P(I,U,4)_")",1:""),!,"...OK" S %=1 D YN^DICN
|
---|
| 104 | I %=1 S X="",DRGI=TDRG,(DDONE,PSIVOLD)=1 D SETDRG Q
|
---|
| 105 | W !,X
|
---|
| 106 | Q
|
---|
| 107 | ;
|
---|
| 108 | DEL ;
|
---|
| 109 | W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN S X="" I %'=1 W " <NOTHING DELETED>"
|
---|
| 110 | Q
|
---|
| 111 | GTADSOL ;If there're multiple ad/sol matched to an OI then display so user to select ad/sol
|
---|
| 112 | ;PSIVOI array is defined in GTIVDRG^PSIVORC2
|
---|
| 113 | NEW DIR,ND,X,Y
|
---|
| 114 | S DIR(0)="LA^1:"_+PSIVOI("DILIST",0)
|
---|
| 115 | S DIR("?")="Please select "_$S(PSIVOI="AD":"an Additive or Quick Code",1:"a Solution")_" from the list"
|
---|
| 116 | F X=0:0 S X=$O(PSIVOI("DILIST",X)) Q:'X D
|
---|
| 117 | . S DIR("A",X)=" "_X_" "_$S($P(PSIVOI("DILIST",X,0),U,4)="QC":" - "_$P(PSIVOI("DILIST",X,0),U,2)_" -",1:$P(PSIVOI("DILIST",X,0),U,2))_$S(PSIVOI="SOL":" "_$P(PSIVOI("DILIST",X,0),U,3),1:"")
|
---|
| 118 | S DIR("A")="Select (1 - "_+PSIVOI("DILIST",0)_"): "
|
---|
| 119 | D ^DIR
|
---|
| 120 | I +Y D
|
---|
| 121 | . NEW PSIVOIND S PSIVOIND=PSIVOI("DILIST",+Y,0)
|
---|
| 122 | . W " "_$P(PSIVOIND,U,2)_$S(PSIVOI="SOL":" "_$P(PSIVOIND,U,3),1:"")
|
---|
| 123 | . S ND=$G(^PS($S(PSIVOI="AD":52.6,1:52.7),+PSIVOIND,0))
|
---|
| 124 | . S DRG(PSIVOI,0)=1
|
---|
| 125 | . S DRG(PSIVOI,1)=+PSIVOIND_U_$P(ND,U)_U_$S(PSIVOI="SOL":$P(ND,U,3),1:"")_U_U_$P(ND,U,13)_U_$P(ND,U,11)
|
---|
| 126 | . S DRGI=1 D SETDRG
|
---|
| 127 | . I $P(PSIVOI("DILIST",+Y,0),U,4)="QC",DRGT="AD",$D(^PS(52.6,"C",$P(PSIVOI("DILIST",+Y,0),U,2),+PSIVOI("DILIST",+Y,0))) D Q:$G(PSIVSTR)="QUICK CODE"!$G(PSGORQF)
|
---|
| 128 | .. S (X,PSIVX)=$P(PSIVOI("DILIST",+Y,0),U,2),(PSJIVIEN,Y)=+PSIVOI("DILIST",+Y,0) D
|
---|
| 129 | ... N PSJNF D NFIV^PSJDIN(52.6,+PSJIVIEN,.PSJNF) W PSJNF("NF")
|
---|
| 130 | ... S DRGTMP=DRG(DRGT,1)
|
---|
| 131 | ... I '$D(ON55) N ON55 S ON55=ON
|
---|
| 132 | ... D ORDERCHK(DFN,ON55,1) I $G(PSGORQF) S X=U,DONE=1 Q
|
---|
| 133 | ... D DINIV^PSJDIN(52.6,+DRGTMP)
|
---|
| 134 | ... D ^PSIVQUI
|
---|
| 135 | . I $P(PSIVOI("DILIST",+Y,0),U,4)'="QC" S DRGTMP=DRG(DRGT,1) D ORDERCHK(DFN,ON55,1) I $G(PSGORQF) S X=U,DONE=1 Q
|
---|
| 136 | . I PSIVOI="AD" D
|
---|
| 137 | .. N FIL S FIL=52.6 D DRG3
|
---|
| 138 | K PSIVOI
|
---|
| 139 | Q
|
---|