| 1 | PSJOE0 ;BIR/CML3-INPATIENT PROFILE AND ORDER ENTRY ;17 SEP 97 / 1:41 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**47,56,110,133,162**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(51.2 is supported by DBIA 2178.
|
|---|
| 5 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 6 | ; Reference to ^VA(200 is supported by DBIA 10060.
|
|---|
| 7 | ; Reference to ^DIR is supported by DBIA 10026.
|
|---|
| 8 | ;
|
|---|
| 9 | START ; print orders
|
|---|
| 10 | W:X]"" $P("^PROFILE",X,2) D ENL^PSJO3 G:PSJOL="^" DONE Q:PSJOL="N" K PSJPR S PSGOEAV=0,PSJNARC=1 D ^PSJO I 'PSJON Q
|
|---|
| 11 | ;
|
|---|
| 12 | ENVW ; ask user to select or view any of the orders shown
|
|---|
| 13 | S (PSGONC,PSGONR,PSGONV)=0,PSGLMT=PSJON S:$D(PSJPRF) PSGPRF=1 D ENASR^PSGON K PSGPRF
|
|---|
| 14 | ;G:X="^" DONE I X]"" S PSGOEA=""
|
|---|
| 15 | G:X["^" DONE I X]"" S PSGOEA=""
|
|---|
| 16 | K PSJDLW
|
|---|
| 17 | I F PSJOE=1:1:PSGODDD S PSGOE=PSJOE F PSJOE1=1:1:$L(PSGODDD(PSJOE),",")-1 S PSJOE2=$P(PSGODDD(PSJOE),",",PSJOE1),(PSGORD,PSJORD)=^TMP("PSJON",$J,PSJOE2) G:$D(PSJDLW) DONE D
|
|---|
| 18 | .I PSJORD=+PSJORD N PSJO,PSJO1 S PSJO=PSJORD,PSJO1=0 F S PSJO1=$O(^PS(53.1,"ACX",PSJO,PSJO1)) Q:'PSJO1 Q:PSGOEA["^" Q:$D(PSJDLW) S PSJORD=PSJO1_"P" D GODO S PSJORD=""
|
|---|
| 19 | .Q:PSJORD="" Q:PSGOEA["^"
|
|---|
| 20 | .D GODO Q:PSGOEA["^"
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | LMNEW(PSGP,PSJPROT) ;Entry point for new order entry from listman.
|
|---|
| 24 | ; PSGP = DFN
|
|---|
| 25 | ; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
|
|---|
| 26 | ;
|
|---|
| 27 | ;S VALM("BM")=9 D CKNEW
|
|---|
| 28 | D CKNEW N PSJUDPRF S PSJNEWOE=1
|
|---|
| 29 | S PSGPTS=PSJPTS,PSGOEAV=$P(PSJSYSP0,U,9)&PSJSYSU,PSGOEDMR=$O(^PS(51.2,"B","ORAL",0)),PSGOEPR=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",2),1:0),PSJORQF=0,PSJOEPF=""
|
|---|
| 30 | I PSGOEPR>0,$D(^VA(200,+PSGOEPR,"PS")) S PSGOEPR=$S('$P(^("PS"),"^",4):PSGOEPR,($P(^("PS"),"^",4)<DT):0,1:PSGOEPR)
|
|---|
| 31 | S:'PSGOEPR PSGOEPR=PSJPTSP
|
|---|
| 32 | ;* F PSJOE=0:0 Q:PSJORQF D:PSJPCAF&(PSJPROT'=2) EN^PSJOE1 K PSGEFN,PSGOEF I PSJPROT>1,(+PSJSYSU=3) D ENIN^PSIVORE
|
|---|
| 33 | ;F PSJOE=0:0 Q:PSJORQF D:PSJPCAF&(PSJPROT'=2) EN^PSJOE1 K PSGEFN,PSGOEF I PSJPROT>1 D ENIN^PSIVORE
|
|---|
| 34 | ; line below fixes bug in line above - infinite loop when selecting New Order in Unit Dose OE for Outpatient.
|
|---|
| 35 | F PSJOE=0:0 Q:PSJORQF!('(PSJPCAF&(PSJPROT'=2))&(PSJPROT'>1)) D:PSJPCAF&(PSJPROT'=2) EN^PSJOE1 K PSGEFN,PSGOEF I PSJPROT>1 D ENIN^PSIVORE
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | DONE ;
|
|---|
| 39 | K PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJDLW,PSJLM,PSJNARC,PSIVAC
|
|---|
| 40 | K P,PSGEFN,PSGOEEF
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | CKNEW ;
|
|---|
| 44 | K CF,CHK,OD,PSGLMT,PSGODDD,PSGOEA,PSGON,PSGONC,PSGONR,PSGONV,PSGORD,PSJCOM,PSJOE1,PSJOE2 Q:$D(PSJPRF)
|
|---|
| 45 | I $P(PSJPDD,"^",3) W !!?2,"Patient is shown as deceased. You may not enter orders for this patient." D CONT Q
|
|---|
| 46 | I 'PSJPCAF W !!,"(NOTE: You cannot enter Unit Dose orders for this patient.)" D CONT
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | CONT ;
|
|---|
| 50 | K DIR S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | GODO ;Display selected order.
|
|---|
| 54 | S PSIVAC="C" I $S(PSJORD["V":1,PSJORD["P":$P($G(^PS(53.1,+PSJORD,0)),"^",4)="F",1:0) D @$S($D(PSJPRP):"ENINP^PSIVOPT(DFN,PSJORD)",1:"ENIN^PSIVOPT") G GODO1
|
|---|
| 55 | I '$D(PSJPRP),(PSJORD["P"),($P($G(^PS(53.1,+PSJORD,0)),U,4)="I") D ASKTYP Q:$D(DIRUT) I Y="I" D ENIN^PSIVOPT G GODO1
|
|---|
| 56 | S PSGORD=PSJORD D EN2^PSGVW,^PSGOE1:'$D(PSJPRF)
|
|---|
| 57 | GODO1 ;
|
|---|
| 58 | I $D(PSJPRP),'PSJPR K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!$D(DTOUT) PSJDLW=1 Q:$D(PSJDLW) W:$Y @IOF
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ASKTYP ; Ask if completing as IV or UD.
|
|---|
| 62 | Q
|
|---|
| 63 | W !! D PIV^PSIVUTL(+PSJORD_"P")
|
|---|
| 64 | I $G(PSJPDD) S DIR(0)="E" D ^DIR S Y="I" Q
|
|---|
| 65 | W ! K DIR S DIR(0)="SOA^U:Unit Dose;I:IV Medication",DIR("A")="Do you wish to complete this as an IV or Unit Dose order (I/U)? ",DIR("?")="^D PENDIU^PSJO3" D ^DIR
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | OLDCOM(DFN,PSJORD) ;
|
|---|
| 69 | Q:$$COMPLEX^PSJOE(DFN,PSJORD)
|
|---|
| 70 | N DURFLG S DURFLG=$S($G(PSJORD)["P":$G(^PS(53.1,+PSJORD,2.5)),$G(PSJORD)["V":$G(^PS(55,DFN,"IV",+PSJORD,2.5)),1:$G(^PS(55,DFN,5,+PSJORD,2.5))) I $P(DURFLG,"^",2)]"" D
|
|---|
| 71 | . D CLEAR^VALM1 W !!!!!?21," * WARNING * "
|
|---|
| 72 | . W !!!?5,"The following order contains a Requested Duration"
|
|---|
| 73 | . W !?12,"and may be part of a complex dose!"
|
|---|
| 74 | . W !!," Review the entire profile to determine appropriate action(s).",!!!!!!! D PAUSE^VALM1
|
|---|
| 75 | . D CLEAR^VALM1 W !!!!!?21," * WARNING * "
|
|---|
| 76 | . W !!!?5,"The following order contains a Requested Duration"
|
|---|
| 77 | . W !?12,"and may be part of a complex dose!"
|
|---|
| 78 | . W !!," Review the entire profile to determine appropriate action(s).",!!!!!!! D PAUSE^VALM1
|
|---|
| 79 | Q
|
|---|
| 80 | AM ;
|
|---|
| 81 | W !!?2,"Enter a 'Y' (or press the RETURN key) to enter new INPATIENT orders for this",!,"patient. Enter an 'N' (or an '^') if there are no new orders for this patient."
|
|---|
| 82 | W:'PSJPCAF !!?2,"PLEASE NOTE: The patient selected is NOT shown as currently admitted.",!,"Therefore, you cannot enter Unit Dose orders for this patient. (You can enter",!,"IV orders.)" Q
|
|---|
