| 1 | PSOORED4 ;BIR/SAB - Edit front door dosing ;07/13/00
|
---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**46,91,78,99,111,117,133,159,148**;DEC 1997
|
---|
| 3 | ;External reference ^PS(51 supported by DBIA 2224
|
---|
| 4 | ;External reference to PS(51.2 supported by DBIA 2226
|
---|
| 5 | ;External reference to PS(51.1 supported by DBIA 2225
|
---|
| 6 | ;called from psoornew
|
---|
| 7 | ;
|
---|
| 8 | DOSE(PSORXED) ;
|
---|
| 9 | I '$G(PSODRUG("IEN")) W !,"DRUG NAME REQUIRED!" D 2^PSOORNW1 I '$G(PSODRUG("IEN")) S VALMSG="No Dispense Drug Selected" Q
|
---|
| 10 | K ROU,STRE,UNITN,PSODOSE M PSODOSE=PSORXED
|
---|
| 11 | D KV K FIELD,DOSEOR,DUPD,X,Y,UNITS S ENT=1,OLENT=PSORXED("ENT")
|
---|
| 12 | ASK I $G(ORD) W !!,"Possible SIG: " D
|
---|
| 13 | .;Coded only for outside orders with no Patient Instructions
|
---|
| 14 | .I $O(SIG(""))="",$G(ORD),$P($G(^PS(52.41,ORD,"EXT")),"^")'="" D SIGS^PSOHCPRS
|
---|
| 15 | .S INST=0 F S INST=$O(SIG(INST)) Q:'INST S MIG=SIG(INST) D
|
---|
| 16 | ..F SG=1:1:$L(MIG," ") W:$X+$L($P(MIG," ",SG)_" ")>IOM !?14 W $P(MIG," ",SG)_" "
|
---|
| 17 | K SG,INST,MIG
|
---|
| 18 | S ROU="PSOORED4",II=ENT D ASK^PSOBKDED K ROU,II I $G(JUMP) K JUMP G JUMP
|
---|
| 19 | G:$D(DIRUT) EXQ
|
---|
| 20 | ;
|
---|
| 21 | I $G(VERB)]"" S PSORXED("VERB",ENT)=VERB G DUPD
|
---|
| 22 | VER D VER^PSOOREDX I X[U,$L(X)>1 S FIELD="VER" G JUMP
|
---|
| 23 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 24 | I X="@" K PSORXED("VERB",ENT),VERB G DUPD
|
---|
| 25 | S:X'="" (PSORXED("VERB",ENT),VERB)=X
|
---|
| 26 | DUPD ;
|
---|
| 27 | I $G(PSORXED("DOSE",ENT))'?.N&($G(PSORXED("DOSE",ENT))'?.N1".".N)!'DOSE("LD") K PSORXED("DOSE ORDERED",ENT),DUPD G NOU1
|
---|
| 28 | D DUPD^PSOOREDX
|
---|
| 29 | S DIR("B")=$S($G(PSORXED("DOSE ORDERED",ENT))]"":PSORXED("DOSE ORDERED",ENT),1:1) S:$E($G(DIR("B")),1)="." DIR("B")="0"_$G(DIR("B")) K:DIR("B")="" DIR("B")
|
---|
| 30 | D ^DIR I X[U,$L(X)>1 S FIELD="DUPD" G JUMP
|
---|
| 31 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 32 | I X="@"!(X=0) W !,"Dispense Units Per Dose is Required!!",! G DUPD
|
---|
| 33 | D STR^PSOOREDX
|
---|
| 34 | NOU1 G:'$G(PSORXED("DOSE ORDERED",ENT)) RTE
|
---|
| 35 | D CNON^PSOORED3
|
---|
| 36 | N PSONDEF
|
---|
| 37 | I $G(NOUN)]"" S PSORXED("NOUN",ENT)=NOUN
|
---|
| 38 | NOU D NOU^PSOOREDX I X[U,$L(X)>1 S FIELD="NOU" G JUMP
|
---|
| 39 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 40 | I X="@" K PSORXED("NOUN",ENT),NOUN G RTE
|
---|
| 41 | I X'="",$G(PSONDEF)="" S NOUN=X
|
---|
| 42 | I X'="",$G(PSONDEF)'=X S NOUN=X
|
---|
| 43 | S:X'="" PSORXED("NOUN",ENT)=X
|
---|
| 44 | ;
|
---|
| 45 | RTE K JUMP S ROU="PSOORED4" D RTE^PSOBKDED K ROU
|
---|
| 46 | I $G(JUMP) K JUMP G JUMP
|
---|
| 47 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 48 | ;
|
---|
| 49 | SCH D SCH^PSOBKDED I X[U,$L(X)>1 S FIELD="SCH" G JUMP
|
---|
| 50 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 51 | S SCH=Y D SCH^PSOSIG I $G(SCH)']"" G SCH
|
---|
| 52 | S PSORXED("SCHEDULE",ENT)=SCH W " ("_SCHEX_")" K SCH,SCHEX,X,Y,PSOSCH
|
---|
| 53 | S:PSORXED("ENT")<ENT PSORXED("ENT")=ENT
|
---|
| 54 | ;
|
---|
| 55 | DUR D KV K EXP S DIR(0)="52.0113,4",DIR("A")="LIMITED DURATION (IN DAYS, HOURS OR MINUTES)"
|
---|
| 56 | S DIR("B")=$S($G(PSORXED("DURATION",ENT))]"":PSORXED("DURATION",ENT),1:"") K:DIR("B")="" DIR("B")
|
---|
| 57 | D ^DIR I X[U,$L(X)>1 S FIELD="DUR" G JUMP
|
---|
| 58 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 59 | D DUR1^PSOOREDX
|
---|
| 60 | ;
|
---|
| 61 | CON D CON^PSOOREDX I X[U,$L(X)>1 S FIELD="CON" G JUMP
|
---|
| 62 | G:$D(DTOUT)!($D(DUOUT)) EXQ
|
---|
| 63 | I X="@",$G(PSORXED("CONJUNCTION",ENT))="" W !,?10,"Invalid Entry - nothing to delete!!" G CON
|
---|
| 64 | S:X'=""&(X'="@") PSORXED("CONJUNCTION",ENT)=Y
|
---|
| 65 | I X="@",$D(PSORXED("CONJUNCTION",ENT)) D CON1^PSOOREDX G:$D(DIRUT) EXQ G:'Y CON N CKX S CKX=1 D UPD^PSOOREDX G CON
|
---|
| 66 | I $G(PSORXED("CONJUNCTION",ENT))]"" S ENT=ENT+1 K DIR G ASK
|
---|
| 67 | S X=$G(PSORXED("INS")) D SIG^PSOHELP S:$G(INS1)]"" PSORXED("SIG")=$E(INS1,2,9999999)
|
---|
| 68 | D EN^PSOFSIG(.PSORXED),VERI I $G(CKX),'$G(PSOSIGFL) D MP1 K CKX
|
---|
| 69 | I $G(PSOSIGFL)=1 S PSORXED("ENT")=ENT,SIGOK=1,VALMSG="This change will create a new prescription!",NCPDPFLG=1
|
---|
| 70 | K QTYHLD S:$G(PSORXED("QTY")) QTYHLD=PSORXED("QTY") D QTY^PSOSIG(.PSORXED) I $G(PSORXED("QTY")) S QTY=1
|
---|
| 71 | I $G(QTYHLD),'$G(PSORXED("QTY")) S PSORXED("QTY")=QTYHLD
|
---|
| 72 | K QTYHLD
|
---|
| 73 | I '$G(PSORXED("QTY")),$P(OR0,"^",10) S PSORXED("QTY")=$P(OR0,"^",10)
|
---|
| 74 | EX ;
|
---|
| 75 | K PSOBDR,PSOBDRG,PSOSCH,DUPD,STRE,UNITN,SCH,VERB,NOUN,DOSEOR,RTE,DUR,X,Y,ENTS,PSODOSE,OLENT,FIELD,FLDNM,AR,NM,ENT,STRE,UNITN,PSODOSE,ERTE,ROU
|
---|
| 76 | KV K DTOUT,DUOUT,DIR,DIRUT
|
---|
| 77 | Q
|
---|
| 78 | EXQ ;
|
---|
| 79 | K PSORXED,PSOSIGFL M PSORXED=PSODOSE D EN^PSOFSIG(.PSORXED) D MP1
|
---|
| 80 | I $D(PSOBDR) M PSODRUG=PSOBDR K PSOBDR,PSOBDRG
|
---|
| 81 | G EX Q
|
---|
| 82 | MP1 D MP1^PSOOREDX
|
---|
| 83 | Q
|
---|
| 84 | VERI ;checks for changes to dosing instructions
|
---|
| 85 | S ENTS=0
|
---|
| 86 | F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S ENTS=$G(ENTS)+1
|
---|
| 87 | I ENTS<OLENT!(ENTS>OLENT) S PSOSIGFL=1 Q
|
---|
| 88 | F I=1:1:OLENT D
|
---|
| 89 | .I PSODOSE("DOSE",I)'=$G(PSORXED("DOSE",I)) S PSOSIGFL=1
|
---|
| 90 | .I $G(PSODOSE("DURATION",I))]"" D
|
---|
| 91 | ..S DURATION=$S($E(PSODOSE("DURATION",I),1)'?.N:$E(PSODOSE("DURATION",I),2,99)_$E(PSODOSE("DURATION",I),1),1:PSODOSE("DURATION",I))
|
---|
| 92 | ..I +DURATION'=+$G(PSORXED("DURATION",I)) S PSOSIGFL=1
|
---|
| 93 | .I $G(PSODOSE("CONJUNCTION",I))'=$G(PSORXED("CONJUNCTION",I)) S PSOSIGFL=1
|
---|
| 94 | .I PSODOSE("ROUTE",I)'=$G(PSORXED("ROUTE",I)) S PSOSIGFL=1
|
---|
| 95 | .I PSODOSE("SCHEDULE",I)'=$G(PSORXED("SCHEDULE",I)) S PSOSIGFL=1
|
---|
| 96 | K DURATION Q
|
---|
| 97 | JUMP ;jump to fields
|
---|
| 98 | I $L($E(X,2,99))<3 W !,"Field Name Must Be At Least 3 Characters in Length",! G @FIELD
|
---|
| 99 | D FNM^PSOOREDX
|
---|
| 100 | I FLDNM']"" K X,NM,FLDNM W !,"INVALID FIELD NAME. PLEASE TRY AGAIN!",! G @FIELD
|
---|
| 101 | F AR=1:1:PSORXED("ENT") W !,AR_". "_$P(FLDNM,"^",2)_": "_$S(NM="ROU"&($G(PSORXED($P(FLDNM,"^"),AR))):$P(^PS(51.2,PSORXED($P(FLDNM,"^"),AR),0),"^"),1:$G(PSORXED($P(FLDNM,"^"),AR))) S AR1=AR
|
---|
| 102 | D KV S DIR("A",1)="* Indicates which fields will create a New Order",DIR("A")="Select Field to Edit by number",DIR(0)="NO^1:"_AR1 D ^DIR G:$D(DIRUT) @FIELD
|
---|
| 103 | D JFN^PSOOREDX G:FLDNM="" @FIELD G @FLDNM
|
---|
| 104 | G EX
|
---|
| 105 | Q
|
---|
| 106 | HLP ;help text for med route
|
---|
| 107 | D FULL^VALM1 W !,"Please enter how patient will use the medication!"
|
---|
| 108 | S DIC=51.2,X="??",DIC(0)="M",DIC("S")="I $P(^PS(51.2,+Y,0),""^"",4)" D ^DIC K DIC,X,Y
|
---|
| 109 | Q
|
---|
| 110 | SCHLP ;
|
---|
| 111 | D FULL^VALM1 W !,"You can choose an entry from the Administration Schedule File (#51.1),",!,"Medication Instruction File (#51) or enter free text."
|
---|
| 112 | W !,"The free text entry cannot contain more than 2 spaces or be greater than 20",!,"characters in length."
|
---|
| 113 | W ! S DIR(0)="S^A:Administration Schedule File;M:Medication Instruction File;B:Both;F:Free Text",DIR("B")="Both"
|
---|
| 114 | S DIR("A")="Do you want to list from" D ^DIR I Y="F"!($G(DIRUT)) K X,Y G X
|
---|
| 115 | S LBL=Y G @LBL
|
---|
| 116 | A ;display 51.1 entries only
|
---|
| 117 | B K X,Y,DIC S X="??",DIC="^PS(51.1,",DIC(0)="QES",DIC("W")="D DICW^PSOORED4",D="APPSJ" W ! D IX^DIC
|
---|
| 118 | K DIC,X I LBL="A"!($G(DTOUT)) K LBL G X
|
---|
| 119 | I Y=-1!($G(DUOUT)) K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to continue with the Medication Instruction File"
|
---|
| 120 | D ^DIR I 'Y!($G(DTOUT)) K DIR,X,Y G X
|
---|
| 121 | M K X,Y,DIC S DIC=51,X="??",DIC(0)="M" D ^DIC K DIC,X,Y,DTOUT,DUOUT,LBL
|
---|
| 122 | X S DIR("?")="^D SCHLP^PSOORED4",DIR("A")="Schedule: ",DIR(0)="FA^1:20^I X[""""""""!(X?.E1C.E)!($A(X)=45)!($L(X,"" "")>3)!($L(X)>20)!($L(X)<1) K X"
|
---|
| 123 | S DIR("B")=$S($D(PSOSCH)&('$D(PSORXED("SCHEDULE",ENT))):PSOSCH,$G(PSORXED("SCHEDULE",ENT))]"":PSORXED("SCHEDULE",ENT),1:"") K:DIR("B")="" DIR("B")
|
---|
| 124 | Q
|
---|
| 125 | DICW ;
|
---|
| 126 | S Z=$P(^PS(51.1,+Y,0),"^",5),Z=$S(Z="O":-1,Z="S":1,Z="R":-2,1:0) W:Z " ",$S(Z>0:"SHIFT",Z=-2:"RANGE",1:"ONE-TIME")
|
---|
| 127 | I Z'<0,$D(PSJW),$D(^(PSJPP'="PSJ"+1,PSJW,0)),$P(^(0),"^",Z+2)]"" W " ",$P(^(0),"^",Z+2)
|
---|
| 128 | ;Naked reference on DICW+2 is from DICW+1, ^PS(51.1,+Y,0)
|
---|
| 129 | Q
|
---|