| 1 | PSGOE3 ;BIR/CML3-ABBREV/WARD ORDER ENTRY ;09 JAN 97 / 10:42 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**58,81**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^DD(53.1 is supported by DBIA 2256.
|
---|
| 5 | ; Reference to ^PS(51.2 is supported by DBIA 2178.
|
---|
| 6 | ;
|
---|
| 7 | K PSGFOK S F1=53.1,PSGPR=$S($D(PSGOERR):PSJORPV,1:PSGOEPR),PSGMR=$S($P(PSGNEDFD,"^",2):$P(PSGNEDFD,"^",2),1:PSGOEDMR),PSGSCH=$P(PSGNEDFD,"^",4),(PSGOROE1,PSGSI,SDT,PSGMRN,PSGSM,PSGHSM,PSGUD)=""
|
---|
| 8 | S:PSGMR PSGMRN=$S('$P(PSGNEDFD,"^",2):"ORAL",'$D(^PS(51.2,PSGMR,0)):PSGMR,$P(^(0),"^")]"":$P(^(0),"^"),1:PSGMR) I PSGPR S PSGPRN=$P($G(^VA(200,PSGPR,0)),"^") S:PSGPRN="" PSGPRN=PSGPR
|
---|
| 9 | S PSGST=$S($P(PSGNEDFD,"^",3)]"":$P(PSGNEDFD,"^",3),1:"C"),PSGSTN=$$ENSTN^PSGMI(PSGST),F1=53.1 K PSGFOK S PSGFOK(2)=""
|
---|
| 10 | S:$P(PSJSYSU,";",4) PSGFOK(2)="" K ^PS(53.45,PSJSYSP,1),^(2) I PSGDRG S ^(2,0)="^53.4502P^"_PSGDRG_"^1",^(1,0)=PSGDRG,^PS(53.45,PSJSYSP,2,"B",PSGDRG,1)=""
|
---|
| 11 | ;I '$D(PSJOERR) S PSJNOO=$S($P(PSJSYSU,";",2):"E",1:"W"),PSJNOON=$S(PSJNOO="E":"PROVIDER ENTERED",1:"WRITTEN")
|
---|
| 12 | ;
|
---|
| 13 | GTFIELD ; Call ^PSGOE4 for the rest of the data to complete order entry
|
---|
| 14 | ; PSGOE3 is set only if user is using the ABBREV/WARD ORDER ENTRY.
|
---|
| 15 | NEW PSGOE3 S PSGOE3=1
|
---|
| 16 | D 109^PSGOE4 Q:PSGOROE1
|
---|
| 17 | D 3^PSGOE4 Q:PSGOROE1
|
---|
| 18 | D 26^PSGOE4 Q:PSGOROE1
|
---|
| 19 | D 8^PSGOE41 Q:PSGOROE1
|
---|
| 20 | D 10^PSGOE41 Q:PSGOROE1
|
---|
| 21 | ; Setup stop date.
|
---|
| 22 | S PSGOES=1 D ENFD^PSGNE3(PSGDT) K PSGOES
|
---|
| 23 | D ^PSGOE42
|
---|
| 24 | ;I $S($P(PSJSYSW0,"^",24):1,+PSJSYSU=3:1,$P(PSJSYSU,";",2):0,$D(PSJOERR):0,1:PSGOEORF) G ^PSGOE31
|
---|
| 25 | Q
|
---|
| 26 | ;
|
---|
| 27 | 109 ; dosage ordered
|
---|
| 28 | W !,"THIS IS THE OLD DOSAGE ORDERED PROMPT!!",!
|
---|
| 29 | Q
|
---|
| 30 | W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
|
---|
| 31 | I X="" S X=PSGDO I X="" W $C(7)," (Required)" G 109
|
---|
| 32 | I X="@" W $C(7)," (Required)" G 109
|
---|
| 33 | ; I X="@" D DEL G:%'=1 109 S PSGDO="" S PSGFOK(109)="" G 3
|
---|
| 34 | S PSGF2=109 I X?1."?" D ENHLP^PSGOEM(53.1,109) G 109
|
---|
| 35 | I $E(X)="^" D FF G:Y>0 @Y G 109
|
---|
| 36 | I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
|
---|
| 37 | I $S(X?.E1C.E:1,$L(X)>20:1,X="":1,X["^":1,X?1.P:1,1:X=+X) W $C(7)," ",$S(X?1.P!(X=""):"(Required)",1:"??") S X="?" D ENHLP^PSGOEM G 109
|
---|
| 38 | S PSGDO=X,PSGFOK(109)=""
|
---|
| 39 | ;
|
---|
| 40 | 3 ; med route
|
---|
| 41 | W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
|
---|
| 42 | I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) S PSGFOK(3)="" G 26
|
---|
| 43 | S PSGF2=3 I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,3) G 3
|
---|
| 44 | I X?1."?" D ENHLP^PSGOEM(53.1,3)
|
---|
| 45 | I $E(X)="^" D FF G:Y>0 @Y G 3
|
---|
| 46 | K DIC S DIC="^PS(51.2,",DIC(0)="EMQZ",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G 3
|
---|
| 47 | S PSGMR=+Y,PSGMRN=$P(Y(0),"^"),PSGFOK(3)=""
|
---|
| 48 | ;
|
---|
| 49 | 26 ; schedule
|
---|
| 50 | W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
|
---|
| 51 | S PSGF2=26 S:X="" X=PSGSCH I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,26) G 26
|
---|
| 52 | I X?1."?" D ENHLP^PSGOEM(53.1,26) G 26
|
---|
| 53 | I $E(X)="^" D FF G:Y>0 @Y G 26
|
---|
| 54 | D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,26) G 26
|
---|
| 55 | S PSGSCH=X,PSGST=$S(PSGS0XT="O":"O",PSGST="R":"R",X["PRN":"P",X="ON CALL":"OC",PSGST]"":PSGST,1:"C"),PSGFOK(26)=""
|
---|
| 56 | ;I $P(PSGNEDFD,"^",3)="P",PSGSCH["PRN" F Q=1:1 S Z=$S(PSGSCH[" PRN":" PRN",PSGSCH["PRN ":"PRN ",1:"PRN") S PSGSCH=$P(PSGSCH,Z)_$P(PSGSCH,Z,2) Q:PSGSCH'["PRN"
|
---|
| 57 | S $P(PSGNEDFD,"^",3)=PSGST S:PSGSCH=""!(X?1." ") PSGSCH="PRN"
|
---|
| 58 | ;
|
---|
| 59 | 8 ; special instructions
|
---|
| 60 | W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":$P(PSGSI,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
|
---|
| 61 | I X="" S X=PSGSI I X="" S PSGFOK(8)="" G 10
|
---|
| 62 | S PSGF2=8 I $E(X)="^" D FF G:Y>0 @Y G 8
|
---|
| 63 | I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
|
---|
| 64 | I X="@" D DEL G:%'=1 8 S PSGSI="",PSGFOK(8)="" G 10
|
---|
| 65 | I X?1."?" D ENHLP^PSGOEM(53.1,8) G 8
|
---|
| 66 | D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
|
---|
| 67 | S PSGSI=X I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U"),PSGFOK(8)=""
|
---|
| 68 | ;
|
---|
| 69 | 10 ; start date
|
---|
| 70 | D ^PSGNE3 S PSGSD=PSGNESDO
|
---|
| 71 | A10 W !,"START DATE/TIME: "_PSGSD_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
|
---|
| 72 | I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10) G A10
|
---|
| 73 | S PSGF2=10 I $E(X)="^" D FF G:Y>0 @Y G A10
|
---|
| 74 | I X="",PSGNESD S X=PSGNESD,PSGFOK(10)="" W " "_PSGSD G SD
|
---|
| 75 | I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGNESD=+X,PSGSD=$$ENDD^PSGMI(+X),PSGFOK(10)="" W " ",PSGSD G SD
|
---|
| 76 | NEW TMPX S TMPX=X,X1=PSGDT,X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D ^%DT K %DT I Y'>0 D ENHLP^PSGOEM G A10
|
---|
| 77 | S PSGNESD=+Y,PSGSD=$$ENDD^PSGMI(PSGNESD),PSGFOK(10)=""
|
---|
| 78 | ;
|
---|
| 79 | SD ; stop date
|
---|
| 80 | S PSGOES=1 D ENFD^PSGNE3(PSGDT) K PSGOES
|
---|
| 81 | ;
|
---|
| 82 | I $S($P(PSJSYSW0,"^",24):1,+PSJSYSU=3:1,$P(PSJSYSU,";",2):0,$D(PSJOERR):0,1:PSGOEORF) G ^PSGOE31
|
---|
| 83 | ;
|
---|
| 84 | ;
|
---|
| 85 | DONE ;
|
---|
| 86 | I PSGOROE1 K Y W $C(7)," ...order not entered..."
|
---|
| 87 | K F,F0,F1,PSGF2,F3,PSGFOK,PSGOROE1,PSGSD,SDT Q
|
---|
| 88 | ;
|
---|
| 89 | FF ; up-arrow to another field
|
---|
| 90 | S Y=-1 I '$D(PSGFOK) W $C(7)," ??" Q
|
---|
| 91 | S X=$E(X,2,99) I X=+X S Y=$S($D(PSGFOK(X)):X,1:-1) W " " W:Y>0 $$CODES2^PSIVUTL(53.1,X) W:Y'>0 $C(7),"??" Q
|
---|
| 92 | K DIC S DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I $D(PSGFOK(+Y))" D ^DIC K DIC S Y=+Y I Y>0,Y=1!(Y=2)!(Y=5)!(Y=6) S:Y=2 FB=PSGF2_"^PSGOE3" S Y=Y_"^PSGOE31"
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | DEL ;
|
---|
| 96 | W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W " <NOTHING DELETED>"
|
---|
| 97 | Q
|
---|