- 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/PSJUTL.m
r613 r623 1 PSJUTL ;BIR/MLM-MISC. INPATIENT UTILITIES ;17 Mar 98 / 11:05 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**9,47,58,80,110,136,157,177,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^DIC(42 is supported by DBIA 10039. 5 ; Reference to ^PS(50.7 is supported by DBIA 2180. 6 ; Reference to ^PSDRUG( is supported by DBIA 2192. 7 ; Reference to ^DIC is supported by DBIA 10006. 8 ; Reference to ^DIC1 is supported by DBIA 10007. 9 ; Reference to ^DIR is supported by DBIA 10026. 10 ; Reference to ^VALM1 is supported by DBIA 10116. 11 ; 12 ENDL ; device look-up 13 N DA,DIC,DIE,DIX,DO,DR 14 S DIC="^%ZIS(1,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q 15 S X=Y(0,0) 16 Q 17 ; 18 ENDH(X) ; device help 19 N D,XQH,DA,DIC,DIE,DO,DR,DZ 20 S DIC="^%ZIS(1,",DIC(0)="EIM" D DO^DIC1,^DIC 21 Q 22 ; 23 READ ; hold screen 24 I $D(IOST) Q:$E(IOST)'="C" 25 W ! I $D(IOSL),$Y<(IOSL-4) G READ 26 W !?5,"Press return to continue " R X:$S($D(DTIME):DTIME,1:300) 27 Q 28 ; 29 ENOISC(PSJOI,USAGE) ;Set DIC("S") so that only Orderable Items with at 30 ;least 1 active dispense drug for the specified usage. 31 ;Input: PSJOI IEN of Orderable Item selected 32 ; USAGE - Type of drugs (UD,IV,etc) to be selected 33 ;Output: 1-At least one dispense drug found 34 ; 0-None found 35 N FOUND,PSJ 36 S PSJ=$P($G(^PS(50.7,+PSJOI,0)),U,4),FOUND=$S('PSJ:1,PSJ>DT:1,1:0) 37 I FOUND S FOUND=0 F PSJ=0:0 S PSJ=$O(^PSDRUG("ASP",PSJOI,PSJ)) Q:FOUND!'PSJ I $P($G(^PSDRUG(PSJ,2)),U,3)[USAGE,'$G(^("I"))!($G(^("I"))'<DT) S FOUND=1 38 Q FOUND 39 ; 40 AADR ; display allergies and adverse reactions 41 D ATS^PSJMUTL(60,50,1) N A,B 42 I (PSGALG=0)&(PSGADR=0) W !!,"No allergies or ADRs on file." 43 I PSGALG'=0 W !!,"Allergies: " S B="PSGALG" F S A=$Q(@B) Q:A="" W ?12,$G(@A),! S B=A 44 I PSGADR'=0 W !," ADR: " S B="PSGADR" F S A=$Q(@B) Q:A="" W ?12,$G(@A),! S B=A 45 D READ K PSGALG,PSGADR Q 46 ; 47 ENALU ; application look-up 48 N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q 49 S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X 50 Q 51 ; 52 ENAQ ; application query 53 S X=DZ N D,DA,DIC,DIE,DO,DR,DZ,XQH S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC 54 Q 55 ; 56 ENPC(PSJTYP,PSJSYSP,LEN,TEXT) ; Copy Provider Comments -> Special Instructions. 57 Q:'$D(^PS(53.1,+$G(PSJORD),12,1,0)) "" 58 N DIR,PSGSI,PSGOEE,X,Y 59 S Y="" F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X S Y=Y_^(X,0)_" " Q:$L(Y)>LEN 60 S:$G(PSJTYP)'="V" Y=$$ENSET^PSGSICHK(Y) S:$G(PSJTYP)="V" Y=$E(Y,1,$L(Y)-1) 61 I $L(Y)'<LEN S PSGOEE=0 D REDISP Q PSGSI 62 ;Display Provider Comments Prior to Asking the Copy Provider Comments Question;BHW;PSJ*5*136 63 N PSJTMP S PSJTMP=0 64 W !,"PROVIDER COMMENTS:" 65 F S PSJTMP=$O(^PS(53.1,+$G(PSJORD),12,PSJTMP)) Q:'PSJTMP W !,^PS(53.1,+$G(PSJORD),12,PSJTMP,0) 66 S PSGSI=Y W ! S DIR(0)="S^Y:Yes;N:No;!:Copy and flag for display in a BCMA Message Box",DIR("A")="Copy the Provider Comments into "_$$ENFIELD(PSJTYP)_" (Yes/No/!)",DIR("??")="^D ENPCHLP1^PSJUTL(PSJTYP)" D ^DIR 67 Q:Y="Y" PSGSI 68 Q:Y="!" PSGSI_"^1" 69 Q "" 70 ; 71 REDISP ; Redisplay Provider Comments and allow entry of Spec. Instructions. 72 D CLEAR^VALM1 F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X W ^(X,0),! 73 W !! S PSGSI="" 74 D:PSJTYP'="V" 8^PSGOE81 75 I PSJTYP="V" D 64^PSIVEDT1 S PSGSI=P("OPI") 76 Q 77 ; 78 ENPCHLP1(Y) ; Display help messages for Provider Comment copy. 79 W !,"Enter ""YES"" to copy Provider Comments into the ",$$ENFIELD(Y)," field",!,"or ""NO"" to bypass",!,"or ""!"" to copy the Provider Comments into the ",$$ENFIELD(PSJTYP)," field",!,"and flag them for display in a BCMA Message Box",!! 80 Q 81 ENPCHLP2(Y,X) ; 82 W !,"The Provider Comments entered for this order are longer than the space available",!,"in the ",$$ENFIELD(Y)," field.",!!,"Enter ""YES"" to copy the first ",X-3," characters into the ",$$ENFIELD(Y),!,"field, or ""NO"" to continue.",!! 83 Q 84 ENBCMA(PSJTYP) ; 85 N DIR,X,Y 86 W !!,"Would you like to flag the ",$$ENFIELD(PSJTYP)," field for display in a BCMA",!,"Message box?" 87 W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Flag the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR 88 K PSJCOMSI I $G(PSJCOM),$G(PSJORD)'["P" N TEXT S TEXT=$S(PSJTYP="U":$G(PSGSI),1:$G(P("OPI"))) S PSJCOMSI=$$COMSI(PSJCOM,TEXT) 89 Q:Y="Y" $S($G(PSJTYP)="U":$P(PSGSI,"^")_"^1",1:$P(P("OPI"),"^")_"^1") 90 Q $S(PSJTYP="U":$P(PSGSI,"^"),1:$P($G(P("OPI")),"^")) 91 ENFIELD(Y) ; 92 Q $S(Y="V":"Other Print Info",1:"Special Instructions") 93 ; 94 COMSI(PARENT,INSTR) ; 95 N DIR,X,Y 96 W !!!!?15,"** WARNING **",!?5,"This order is part of a complex order." 97 W !!,"Would you like to copy the ",$$ENFIELD(PSJTYP) 98 W !,"to the other orders in the complex order?" 99 S DIR(0)="S^Y:Yes;N:No",DIR("A")=" Copy the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR 100 Q:Y="Y" 1 101 Q 0 102 ; 103 ENORL(X) ; Return patient's location as variable ptr. 104 Q $S(+$G(^DIC(42,+X,44)):+$G(^(44))_";SC(",$D(^DIC(42,+X,0)):+X_";DIC(42,",1:"") 105 ; 106 ENMARD() ; validate MAR SELECTION DEFAULT string in WARD PARMS file. 107 N PSJANS,PSJX1,PSJX2,RANGE,Q 108 S RANGE="1:6" F PSJX1=1:1:6 S RANGE(PSJX1)="" 109 S:$E(X)="-" X=+RANGE_X S:$E($L(X))="-" X=X_$P(RANGE,":",2) 110 S PSJANS="" F Q=1:1:$L(X,",") S PSJX1=$P(X,",",Q) D FS Q:'$D(PSJANS) 111 Q:'$G(PSJANS) 0 112 S PSJANS=$E(PSJANS,1,$L(PSJANS)-1) F Q=1:1:$L(PSJANS,",") D Q:'$D(PSJANS) 113 .I $P(PSJANS,",",Q)=1,$L(PSJANS,",")>1 W !!,"All Medications (1) may not be selected in combination with other types." K PSJANS Q 114 .W ?47,$P(PSJANS,",",Q)," - ",$P($T(@$P(PSJANS,",",Q)),";;",2),! 115 S:$G(PSJANS) X=PSJANS Q $G(PSJANS) 116 ; 117 FS ; 118 I $S(PSJX1?1.N1"-"1.N:0,PSJX1'?1.N:1,'$D(RANGE(PSJX1)):1,1:","_PSJANS[PSJX1) K PSJANS Q 119 I PSJX1'["-" S PSJANS=PSJANS_PSJX1_"," Q 120 S PSJX2=+PSJX1,PSJANS=PSJANS_PSJX2_"," 121 F S PSJX2=$O(RANGE(PSJX2)) K:$S(X="":1,","_PSJANS[PSJX2:1,1:PSJX2>$P(PSJX1,"-",2)) PSJANS Q:'$D(PSJANS) S PSJANS=PSJANS_PSJX2_"," Q:PSJX2=$P(PSJX1,"-",2) 122 Q 123 ; 124 ENMARDH ;Help text for MAR default answer. 125 W !!?2,"Enter the number corresponding to the type of orders to be included on MARs",!,"printed for this ward. Multiple types (except 1) may be selected using ""-""",!,"or "","" as delimiters.",!!,"Choose from: ",! 126 N X F X=1:1:6 W !?13,X," - ",$P($T(@X),";;",2) 127 W ! 128 Q 129 1 ;;All Medications 130 2 ;;Non-IV Medications only 131 3 ;;IV Piggybacks 132 4 ;;LVPs 133 5 ;;TPNs 134 6 ;;Chemotherapy Medications (IV) 135 ; 136 EFD ;The following EFD Tags are used to Calculate the Expected First Dose for backdoor 137 ;orders. The call to $$ENQ^PSJORP2 is used to actually perform the calculation. 138 ;The program $$ENQ^PSJORP2 requires the variable INFO to equal the following: 139 ;BHW;PSJ*5*136 140 ; INFO (piece 1) = START DATE/TIME ;PSGNESD (NEW ORDER) 141 ; INFO (piece 2) = STOP DATE/TIME ;PSGNEFD (NEW ORDER) 142 ; INFO (piece 3) = SCHEDULE ;PSGSCH (NEW ORDER) 143 ; INFO (piece 4) = SCHEDULE TYPE ;PSGST (NEW ORDER) 144 ; INFO (piece 5) = ORDERABLE ITEM ;PSGDRG (NEW ORDER) 145 ; INFO (piece 6) = ADMIN TIMES ;PSGS0Y (NEW ORDER) 146 ; 147 EFDNEW ;Call Here if NEW or RENEWED Order 148 N INFO 149 S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGDRG))_U_($G(PSGS0Y)) 150 D EFDDISP 151 QUIT 152 EFDACT ;Call here if Editing Fields for an ACTIVE order 153 ; Field 10 = Start Date 154 ; Field 34 = Stop Date 155 ; Field 41 = Admin Times 156 N INFO,KEY,ORDER,LAST 157 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message 158 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER) I "10^34^41"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1) 159 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times 160 S LAST=$O(ORDER(99),-1) Q:'LAST 161 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit 162 S LAST=ORDER(LAST) 163 I LAST'=PSGF2 Q 164 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 165 D EFDDISP 166 QUIT 167 EFDNV ;Call here if Editing Fields for a NON-VERIFIED order 168 ; Field 10 = Start Date 169 ; Field 25 = Stop Date 170 ; Field 39 = Admin Times 171 N INFO,KEY,ORDER,LAST 172 ;Check if called during finish process 173 I '$D(PSGOEER) D D EFDDISP Q 174 . S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 175 . Q 176 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message 177 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER) I "10^25^39"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1) 178 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times 179 S LAST=$O(ORDER(99),-1) Q:'LAST 180 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit 181 S LAST=ORDER(LAST) 182 I LAST'=PSGF2 Q 183 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 184 D EFDDISP 185 QUIT 186 EFDIV(PSGZZND) ;Set variables for EFD on IV orders. 187 I $G(PSGZZND)="" D 188 .N X,ZZND,LYN,PSGS0XT,PSGS0Y,PSGOES S PSGOES=1 S X=P(9) D EN^PSGS0 S:$G(ZZND)'="" PSGZZND=ZZND 189 S PSGNESD=P(2),PSGNEFD=P(3),PSGSCH=P(9),PSGST=$P($G(PSGZZND),"^",5),PSGDRG=$P($G(P("PD")),"^"),PSGS0Y=P(11) 190 ;BHW - PSJ*5*177 Add call to check stop date. If it's in the past, Display Message 191 D CHKSTOP 192 D EFDNEW 193 W ! 194 Q 195 EFDDISP ;Display Expected First Dose 196 N Y,Z 197 Q:$G(PSGST)="OC"!($G(PSGST)="P")!($G(PSGST)="O") 198 Q:$G(PSGSCH)["ON CALL"!($G(PSGSCH)["ON-CALL")!($G(PSGSCH)["ONCALL") 199 Q:$G(PSGSCH)["PRN" 200 I '$L($G(PSGP)) N PSGP S PSGP="" 201 S Y=$$ENQ^PSJORP2(PSGP,INFO) 202 I 'Y S Y="Unable to Calculate" 203 X ^DD("DD") 204 W !,"Expected First Dose: ",Y H 2 205 Q 206 CHKSTOP ;BHW - PSJ*5*177 Warn user if the Stop Date is < now. 207 I '+$G(P(3)) Q 208 N PSNOW,%,%H,%I,X D NOW^%DTC S PSNOW=% 209 I +P(3)<PSNOW D Q 210 . W !,$C(7),"The Stop Date/Time is in the Past!!! This order will",!,"automatically EXPIRE upon Verification!!",! 211 . Q 212 Q 1 PSJUTL ;BIR/MLM-MISC. INPATIENT UTILITIES ;17 Mar 98 / 11:05 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**9,47,58,80,110,136,157,177**;16 DEC 97 3 ; 4 ; Reference to ^DIC(42 is supported by DBIA 10039. 5 ; Reference to ^PS(50.7 is supported by DBIA 2180. 6 ; Reference to ^PSDRUG( is supported by DBIA 2192. 7 ; Reference to ^DIC is supported by DBIA 10006. 8 ; Reference to ^DIC1 is supported by DBIA 10007. 9 ; Reference to ^DIR is supported by DBIA 10026. 10 ; Reference to ^VALM1 is supported by DBIA 10116. 11 ; 12 ENDL ; device look-up 13 N DA,DIC,DIE,DIX,DO,DR 14 S DIC="^%ZIS(1,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q 15 S X=Y(0,0) 16 Q 17 ; 18 ENDH(X) ; device help 19 N D,XQH,DA,DIC,DIE,DO,DR,DZ 20 S DIC="^%ZIS(1,",DIC(0)="EIM" D DO^DIC1,^DIC 21 Q 22 ; 23 READ ; hold screen 24 I $D(IOST) Q:$E(IOST)'="C" 25 W ! I $D(IOSL),$Y<(IOSL-4) G READ 26 W !?5,"Press return to continue " R X:$S($D(DTIME):DTIME,1:300) 27 Q 28 ; 29 ENOISC(PSJOI,USAGE) ;Set DIC("S") so that only Orderable Items with at 30 ;least 1 active dispense drug for the specified usage. 31 ;Input: PSJOI IEN of Orderable Item selected 32 ; USAGE - Type of drugs (UD,IV,etc) to be selected 33 ;Output: 1-At least one dispense drug found 34 ; 0-None found 35 N FOUND,PSJ 36 S PSJ=$P($G(^PS(50.7,+PSJOI,0)),U,4),FOUND=$S('PSJ:1,PSJ>DT:1,1:0) 37 I FOUND S FOUND=0 F PSJ=0:0 S PSJ=$O(^PSDRUG("ASP",PSJOI,PSJ)) Q:FOUND!'PSJ I $P($G(^PSDRUG(PSJ,2)),U,3)[USAGE,'$G(^("I"))!($G(^("I"))'<DT) S FOUND=1 38 Q FOUND 39 ; 40 AADR ; display allergies and adverse reactions 41 D ATS^PSJMUTL(60,50,1) N A,B 42 I (PSGALG=0)&(PSGADR=0) W !!,"No allergies or ADRs on file." 43 I PSGALG'=0 W !!,"Allergies: " S B="PSGALG" F S A=$Q(@B) Q:A="" W ?12,$G(@A),! S B=A 44 I PSGADR'=0 W !," ADR: " S B="PSGADR" F S A=$Q(@B) Q:A="" W ?12,$G(@A),! S B=A 45 D READ K PSGALG,PSGADR Q 46 ; 47 ENALU ; application look-up 48 N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q 49 S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X 50 Q 51 ; 52 ENAQ ; application query 53 S X=DZ N D,DA,DIC,DIE,DO,DR,DZ,XQH S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC 54 Q 55 ; 56 ENPC(PSJTYP,PSJSYSP,LEN,TEXT) ; Copy Provider Comments -> Special Instructions. 57 Q:'$D(^PS(53.1,+$G(PSJORD),12,1,0)) "" 58 N DIR,PSGSI,PSGOEE,X,Y 59 S Y="" F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X S Y=Y_^(X,0)_" " Q:$L(Y)>LEN 60 S:$G(PSJTYP)'="V" Y=$$ENSET^PSGSICHK(Y) S:$G(PSJTYP)="V" Y=$E(Y,1,$L(Y)-1) 61 I $L(Y)'<LEN S PSGOEE=0 D REDISP Q PSGSI 62 ;Display Provider Comments Prior to Asking the Copy Provider Comments Question;BHW;PSJ*5*136 63 N PSJTMP S PSJTMP=0 64 W !,"PROVIDER COMMENTS:" 65 F S PSJTMP=$O(^PS(53.1,+$G(PSJORD),12,PSJTMP)) Q:'PSJTMP W !,^PS(53.1,+$G(PSJORD),12,PSJTMP,0) 66 S PSGSI=Y W ! S DIR(0)="S^Y:Yes;N:No;!:Copy and flag for display in a BCMA Message Box",DIR("A")="Copy the Provider Comments into "_$$ENFIELD(PSJTYP)_" (Yes/No/!)",DIR("??")="^D ENPCHLP1^PSJUTL(PSJTYP)" D ^DIR 67 Q:Y="Y" PSGSI 68 Q:Y="!" PSGSI_"^1" 69 Q "" 70 ; 71 REDISP ; Redisplay Provider Comments and allow entry of Spec. Instructions. 72 D CLEAR^VALM1 F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X W ^(X,0),! 73 W !! S PSGSI="" 74 D:PSJTYP'="V" 8^PSGOE81 75 I PSJTYP="V" D 64^PSIVEDT1 S PSGSI=P("OPI") 76 Q 77 ; 78 ENPCHLP1(Y) ; Display help messages for Provider Comment copy. 79 W !,"Enter ""YES"" to copy Provider Comments into the ",$$ENFIELD(Y)," field",!,"or ""NO"" to bypass",!,"or ""!"" to copy the Provider Comments into the ",$$ENFIELD(PSJTYP)," field",!,"and flag them for display in a BCMA Message Box",!! 80 Q 81 ENPCHLP2(Y,X) ; 82 W !,"The Provider Comments entered for this order are longer than the space available",!,"in the ",$$ENFIELD(Y)," field.",!!,"Enter ""YES"" to copy the first ",X-3," characters into the ",$$ENFIELD(Y),!,"field, or ""NO"" to continue.",!! 83 Q 84 ENBCMA(PSJTYP) ; 85 N DIR,X,Y 86 W !!,"Would you like to flag the ",$$ENFIELD(PSJTYP)," field for display in a BCMA",!,"Message box?" 87 W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Flag the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR 88 K PSJCOMSI I $G(PSJCOM),$G(PSJORD)'["P" N TEXT S TEXT=$S(PSJTYP="U":$G(PSGSI),1:$G(P("OPI"))) S PSJCOMSI=$$COMSI(PSJCOM,TEXT) 89 Q:Y="Y" $S($G(PSJTYP)="U":$P(PSGSI,"^")_"^1",1:$P(P("OPI"),"^")_"^1") 90 Q $S(PSJTYP="U":$P(PSGSI,"^"),1:$P($G(P("OPI")),"^")) 91 ENFIELD(Y) ; 92 Q $S(Y="V":"Other Print Info",1:"Special Instructions") 93 ; 94 COMSI(PARENT,INSTR) ; 95 N DIR,X,Y 96 W !!!!?15,"** WARNING **",!?5,"This order is part of a complex order." 97 W !!,"Would you like to copy the ",$$ENFIELD(PSJTYP) 98 W !,"to the other orders in the complex order?" 99 S DIR(0)="S^Y:Yes;N:No",DIR("A")=" Copy the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR 100 Q:Y="Y" 1 101 Q 0 102 ; 103 ENORL(X) ; Return patient's location as variable ptr. 104 Q $S(+$G(^DIC(42,+X,44)):+$G(^(44))_";SC(",$D(^DIC(42,+X,0)):+X_";DIC(42,",1:"") 105 ; 106 ENMARD() ; validate MAR SELECTION DEFAULT string in WARD PARMS file. 107 N PSJANS,PSJX1,PSJX2,RANGE,Q 108 S RANGE="1:6" F PSJX1=1:1:6 S RANGE(PSJX1)="" 109 S:$E(X)="-" X=+RANGE_X S:$E($L(X))="-" X=X_$P(RANGE,":",2) 110 S PSJANS="" F Q=1:1:$L(X,",") S PSJX1=$P(X,",",Q) D FS Q:'$D(PSJANS) 111 Q:'$G(PSJANS) 0 112 S PSJANS=$E(PSJANS,1,$L(PSJANS)-1) F Q=1:1:$L(PSJANS,",") D Q:'$D(PSJANS) 113 .I $P(PSJANS,",",Q)=1,$L(PSJANS,",")>1 W !!,"All Medications (1) may not be selected in combination with other types." K PSJANS Q 114 .W ?47,$P(PSJANS,",",Q)," - ",$P($T(@$P(PSJANS,",",Q)),";;",2),! 115 S:$G(PSJANS) X=PSJANS Q $G(PSJANS) 116 ; 117 FS ; 118 I $S(PSJX1?1.N1"-"1.N:0,PSJX1'?1.N:1,'$D(RANGE(PSJX1)):1,1:","_PSJANS[PSJX1) K PSJANS Q 119 I PSJX1'["-" S PSJANS=PSJANS_PSJX1_"," Q 120 S PSJX2=+PSJX1,PSJANS=PSJANS_PSJX2_"," 121 F S PSJX2=$O(RANGE(PSJX2)) K:$S(X="":1,","_PSJANS[PSJX2:1,1:PSJX2>$P(PSJX1,"-",2)) PSJANS Q:'$D(PSJANS) S PSJANS=PSJANS_PSJX2_"," Q:PSJX2=$P(PSJX1,"-",2) 122 Q 123 ; 124 ENMARDH ;Help text for MAR default answer. 125 W !!?2,"Enter the number corresponding to the type of orders to be included on MARs",!,"printed for this ward. Multiple types (except 1) may be selected using ""-""",!,"or "","" as delimiters.",!!,"Choose from: ",! 126 N X F X=1:1:6 W !?13,X," - ",$P($T(@X),";;",2) 127 W ! 128 Q 129 1 ;;All Medications 130 2 ;;Non-IV Medications only 131 3 ;;IV Piggybacks 132 4 ;;LVPs 133 5 ;;TPNs 134 6 ;;Chemotherapy Medications (IV) 135 ; 136 EFD ;The following EFD Tags are used to Calculate the Expected First Dose for backdoor 137 ;orders. The call to $$ENQ^PSJORP2 is used to actually perform the calculation. 138 ;The program $$ENQ^PSJORP2 requires the variable INFO to equal the following: 139 ;BHW;PSJ*5*136 140 ; INFO (piece 1) = START DATE/TIME ;PSGNESD (NEW ORDER) 141 ; INFO (piece 2) = STOP DATE/TIME ;PSGNEFD (NEW ORDER) 142 ; INFO (piece 3) = SCHEDULE ;PSGSCH (NEW ORDER) 143 ; INFO (piece 4) = SCHEDULE TYPE ;PSGST (NEW ORDER) 144 ; INFO (piece 5) = ORDERABLE ITEM ;PSGDRG (NEW ORDER) 145 ; INFO (piece 6) = ADMIN TIMES ;PSGS0Y (NEW ORDER) 146 ; 147 EFDNEW ;Call Here if NEW or RENEWED Order 148 N INFO 149 S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGDRG))_U_($G(PSGS0Y)) 150 D EFDDISP 151 QUIT 152 EFDACT ;Call here if Editing Fields for an ACTIVE order 153 ; Field 10 = Start Date 154 ; Field 34 = Stop Date 155 ; Field 41 = Admin Times 156 N INFO,KEY,ORDER,LAST 157 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message 158 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER) I "10^34^41"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1) 159 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times 160 S LAST=$O(ORDER(99),-1) Q:'LAST 161 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit 162 S LAST=ORDER(LAST) 163 I LAST'=PSGF2 Q 164 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 165 D EFDDISP 166 QUIT 167 EFDNV ;Call here if Editing Fields for a NON-VERIFIED order 168 ; Field 10 = Start Date 169 ; Field 25 = Stop Date 170 ; Field 39 = Admin Times 171 N INFO,KEY,ORDER,LAST 172 ;Check if called during finish process 173 I '$D(PSGOEER) D D EFDDISP Q 174 . S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 175 . Q 176 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message 177 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER) I "10^25^39"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1) 178 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times 179 S LAST=$O(ORDER(99),-1) Q:'LAST 180 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit 181 S LAST=ORDER(LAST) 182 I LAST'=PSGF2 Q 183 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y)) 184 D EFDDISP 185 QUIT 186 EFDIV(PSGZZND) ;Set variables for EFD on IV orders. 187 S PSGNESD=P(2),PSGNEFD=P(3),PSGSCH=P(9),PSGST=$P($G(PSGZZND),"^",5),PSGDRG=$P($G(P("PD")),"^"),PSGS0Y=P(11) 188 ;BHW - PSJ*5*177 Add call to check stop date. If it's in the past, Display Message 189 D CHKSTOP 190 D EFDNEW 191 W ! 192 Q 193 EFDDISP ;Display Expected First Dose 194 N Y 195 Q:$G(PSGST)="OC"!($G(PSGST)="P") 196 Q:$G(PSGSCH)["ON CALL"!($G(PSGSCH)["ON-CALL")!($G(PSGSCH)["ONCALL") 197 Q:$G(PSGSCH)["PRN" 198 I '$L($G(PSGP)) N PSGP S PSGP="" 199 ; 200 S Y=$$ENQ^PSJORP2(PSGP,INFO) 201 I 'Y S Y="Unable to Calculate" 202 X ^DD("DD") 203 W !,"Expected First Dose: ",Y H 2 204 Q 205 CHKSTOP ;BHW - PSJ*5*177 Warn user if the Stop Date is < now. 206 I '+$G(P(3)) Q 207 N PSNOW,%,%H,%I,X D NOW^%DTC S PSNOW=% 208 I +P(3)<PSNOW D Q 209 . W !,$C(7),"The Stop Date/Time is in the Past!!! This order will",!,"automatically EXPIRE upon Verification!!",! 210 . Q 211 Q
Note:
See TracChangeset
for help on using the changeset viewer.
