source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE92.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1PSGOE92 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;27 Jan 98 / 9:32 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**2,35,50,58,81,110**;16 DEC 97
3 ;
4 ;Reference to ^DD(53.1 is supported by DBIA #2256.
5 ;Reference to ^PS(55 is supported by DBIA #2191.
6 ;
71 ; provider
8 S MSG=0,PSGF2=1 S:PSGOEEF(PSGF2) BACK="1^PSGOE92"
9A1 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
10 . W !!?5,"Provider may not be edited for active complex orders." D PAUSE^VALM1
11 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
12 I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
13 I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W:0 " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) G DONE
14 I X?1."?" D ENHLP^PSGOEM(55.06,1)
15 I $E(X)="^" D ENFF G:Y>0 @Y G A1
16 K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)" D ^DIC K DIC I Y'>0 G A1
17 S PSGPR=+Y,PSGPRN=Y(0,0) G DONE
18 ;
195 ; self med
20 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
21 . W !!?5,"Self Med may not be edited for active complex orders." D PAUSE^VALM1
22 S MSG=0,PSGF2=5 S:PSGOEEF(PSGF2) BACK="5^PSGOE92" K PSGOEEF(6) S:PSGSM PSGOEEF(6)=""
23A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
24 ;I "01"[X,$L(X)<2 S:PSGSM=""&(X]"") PSGSM=X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE G 6
25 I "01"[X,$L(X)<2 S:X]"" PSGSM=+X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE S PSGOEEF(6)="" G 6
26 I X="@" W $C(7)," (Required)" G A5
27 I X?1"^".E D ENFF G:Y>0 @Y G A5
28 I X?1."?" D ENHLP^PSGOEM(55.06,5) G A5
29 D YN I S PSGSM=$E(X)="Y" K PSGOEEF(6) G:'PSGSM DONE S PSGOEEF(6)="" G 6
30 W $C(7) D ENHLP^PSGOEM(55.06,5) G A5
31 ;
326 ; hospital supplied self med
33 S MSG=0,PSGF2=6 S:PSGOEEF(PSGF2) BACK="6^PSGOE92"
34A6 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
35 . W !!?5,"Hospital Supplied Self Med may not be edited for active complex orders." D PAUSE^VALM1
36 W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
37 I "01"[X,$L(X)=1 S:X]"" PSGHSM=+X W " (",$P("NO^YES","^",PSGHSM+1),")" S MSG=0,PSGF2=5 G DONE
38 I X="@" W $C(7)," (Required)" G A6
39 I X?1"^".E D ENFF G:Y>0 @Y G A6
40 I X?1."?" D ENHLP^PSGOEM(55.06,6) G A6
41 D YN I S PSGHSM=$E(X)="Y" S MSG=0,PSGF2=5 G DONE
42 W $C(7) D ENHLP^PSGOEM(55.06,6) G A6
43 ;
442 ; dispense drug multiple
45 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
46 . N X,Y,PARENT,P2ND S P2ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,.2)),1:$G(^PS(53.1,+PSGORD,.2))),PARENT=$P(P2ND,"^",8)
47 . I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
48 S MSG=0,PSGF2=2,BACK="2^PSGOE92",PSGOEEND=1
49 NEW PSGX,PSGXX F PSGXX=0:0 S PSGX=PSGXX,PSGXX=$O(^PS(53.45,PSJSYSP,2,PSGXX)) Q:'PSGXX
50 K PSGXX
51 N DA,DIE,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=".02//1;.03" D ^DIE
52 I '$O(^PS(53.45,PSJSYSP,2,0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!",! S MSG=1
53 D DDOC^PSGOE82(PSGX) ;* Perform allergy/adv. reaction order checks
54 NEW PSJDOSE
55 D DOSECHK^PSJDOSE
56 I +$G(PSJDSFLG) D DSPWARN^PSJDOSE S PSGOEEF(109)=1
57 K PSGOEEND G DONE
58 ;
5915 ; comments
60 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
61 . W !!?5,"Comments may not be edited for active complex orders." D PAUSE^VALM1
62 S MSG=0,PSGF2=15,BACK="15^PSGOE92",DA=PSJSYSP,DR=1,DIE="^PS(53.45," D ^DIE W ! G DONE
63 ;
6472 ; provider comments
65 ;S MSG=0,PSGF2=72,BACK="72^PSGOE92",DA=PSJSYSP,DR=4,DIE="^PS(53.45," D ^DIE W ! G DONE
66 ;
67DONE ;
68 I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
69 K F,F0,PSGF2,F3,PSG,SDT Q
70 ;
71ENFF ; up-arrow to another field
72 S Y=-1 I '$D(PSGOEEF) W $C(7)," ??" Q
73 S X=$E(X,2,99) I X=+X S Y=$S($D(PSGOEEF(X)):X,1:-1) W " " W:Y>0 $$CODES2^PSIVUTL(53.1,X) W:Y'>0 $C(7),"??" Q
74 K DIC S DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I $D(PSGOEEF(+Y))" D ^DIC K DIC S Y=+Y S:Y>0 Y=$P($T(@("F"_Y)),";",3) Q
75 ;
76DEL ; delete entry
77 W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
78 Q
79 ;
80YN ; yes/no as a set of codes
81 I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
82 F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
83 Q
84 ;
85F101 ;;101^PSGOE9
86F109 ;;109^PSGOE9
87F3 ;;3^PSGOE9
88F7 ;;7^PSGOE9
89PSGF26 ;;26^PSGOE9
90F41 ;;41^PSGOE91
91F8 ;;8^PSGOE91
92F10 ;;10^PSGOE91
93F34 ;;34^PSGOE91
94F1 ;;1^PSGOE92
95F5 ;;5^PSGOE92
96PSGF2 ;;2^PSGOE92
Note: See TracBrowser for help on using the repository browser.