source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE82.m@ 1093

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1PSGOE82 ;BIR/CML3-NON-VERIFIED ORDER EDIT (CONT.) ;27 Jan 98 / 9:32 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**2,35,50,67,58,81,127,168**;16 DEC 97
3 ;
4 ; Reference to ^DD(53.1 is supported by DBIA #2256.
5 ; Reference to ^VA(200 is supported by DBIA #10060.
6 ; Reference to ^DIE is supported by DBIA #10018.
7 ; Reference to ^DIC is supported by DBIA #10006.
8 ; Reference to ^DICN is supported by DBIA #10009.
9 ;
101 ; provider
11 S MSG=0,PSGF2=1 S:PSGOEEF(PSGF2) BACK="1^PSGOE82"
12A1 I $G(PSGORD)["P",$G(PSGP) I $$LASTREN^PSJLMPRI(PSGP,PSGORD) D Q
13 . W !?5,"This order has been renewed. Provider may not be edited at this point. " D PAUSE^VALM1
14 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
15 I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(53.1,1) G A1
16 I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W:0 " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) G DONE
17 I X?1."?" D ENHLP^PSGOEM(53.1,1)
18 I $E(X)="^" D ENFF G:Y>0 @Y G A1
19 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
20 S PSGPR=+Y,PSGPRN=Y(0,0) G DONE
21 ;
225 ; self med
23 S MSG=0,PSGF2=5 S:PSGOEEF(PSGF2) BACK="5^PSGOE82" K PSGOEEF(6) S:PSGSM PSGOEEF(6)=1
24A5 W !,"SELF MED: " W $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
25 ;I "01"[X,$L(X)<2 S:PSGSM=""&(X]"") PSGSM=X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE S PSGOEEF(6)=1 G 6
26 I "01"[X,$L(X)<2 S:X]"" PSGSM=+X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE S PSGOEEF(6)=1 G 6
27 I X="@" W $C(7)," (Required)" G A5
28 I X?1"^".E D ENFF G:Y>0 @Y G A5
29 I X?1."?" D ENHLP^PSGOEM(53.1,5) G A5
30 D YN I S PSGSM=$E(X)="Y" K PSGOEEF(6) G:'PSGSM DONE S PSGOEEF(6)=1 G 6
31 W $C(7) D ENHLP^PSGOEM(53.1,5) G A5
32 ;
336 ; hospital supplied self med
34 S MSG=0,PSGF2=6 S:PSGOEEF(PSGF2) BACK="6^PSGOE82"
35A6 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
36 I "01"[X,$L(X)=1 S:X]"" PSGHSM=+X W " (",$P("NO^YES","^",PSGHSM+1),")" S MSG=0,PSGF2=5 G DONE
37 I X="@" W $C(7)," (Required)" G A6
38 I X?1"^".E D ENFF G:Y>0 @Y G A6
39 I X?1."?" D ENHLP^PSGOEM(53.1,6) G A6
40 D YN I S PSGHSM=$E(X)="Y" S MSG=0,PSGF2=5 G DONE
41 W $C(7) D ENHLP^PSGOEM(53.1,6) G A6
42 ;
432 ; dispense drug multiple
44 S MSG=0,PSGF2=2,BACK="2^PSGOE82" K PSGOEEND
45 N PSGX,PSGXX F PSGXX=0:0 S PSGX=PSGXX,PSGXX=$O(^PS(53.45,PSJSYSP,2,PSGXX)) Q:'PSGXX
46 N PSJPNDRN I $G(PSGORD) I $E(PSGORD,$L(PSGORD))="P",$P($G(^PS(53.1,+PSGORD,0)),"^",24)="R" S PSJPNDRN=1 D
47 .S $P(PSJPNDRN,"^",2)="Dispense drugs for renewal orders cannot be deleted, but can be given an INACTIVE DATE. "
48 N DA,DIC,DIE,DR,DIR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=".01;.02"_$S($G(PSJPNDRN):";.03",1:"") D ^DIE
49 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
50 D DDOC(PSGX)
51 NEW PSJDOSE
52 D DOSECHK^PSJDOSE
53 I +$G(PSJDSFLG) D DSPWARN^PSJDOSE S PSGOEEF(109)=1
54 G DONE
55 ;
5640 ; comments
57 S MSG=0,PSGF2=40,BACK="40^PSGOE82",DA=PSJSYSP,DR=1,DIE="^PS(53.45," D ^DIE W ! G DONE
58 ;
5966 ; provider comments
60 ;S MSG=0,PSGF2=66,BACK="66^PSGOE82",DA=PSJSYSP,DR=4,DIE="^PS(53.45," D ^DIE W ! G DONE
61 ;
62DONE ;
63 I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
64 K F,F0,PSGF2,F3,PSG,SDT Q
65 ;
66ENFF ; up-arrow to another field
67 S Y=-1 I '$D(PSGOEEF)!(X?1"^"1.9N) W $C(7)," ??" Q
68 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
69 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
70 ;
71DEL ; delete entry
72 W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
73 Q
74 ;
75YN ; yes/no as a set of codes
76 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))
77 F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
78 Q
79DDOC(PSGX) ; Order check on additional dispens drug for allergy and adv. reactions.
80 N PSGY,PSGND1,PSGND3 S PSGY=0 F S PSGX=$O(^PS(53.45,PSJSYSP,2,PSGX)) Q:'PSGX S PSGY=$P($G(^PS(53.45,PSJSYSP,2,PSGX,0)),"^") Q:PSGY="" D
81 . N INTERVEN,PSJDDI,PSJIREQ,PSJRXREQ,PSJDD,PSGORQF,PSJPDRG S PSJDD=PSGY
82 . S Y=1,(PSJIREQ,PSJRXREQ,INTERVEN,X)=""
83 . D IVSOL^PSGSICHK
84 . I ($D(PSGORQF)) D
85 .. K ^PS(53.45,PSJSYSP,2,PSGX),^PS(53.45,PSJSYSP,2,"B",PSGY)
86 Q
87 ;
88F101 ;;101^PSGOE8
89F109 ;;109^PSGOE8
90F3 ;;3^PSGOE8
91F7 ;;7^PSGOE8
92PSGF26 ;;26^PSGOE8
93F39 ;;39^PSGOE81
94F8 ;;8^PSGOE81
95F10 ;;10^PSGOE81
96PSGF25 ;;25^PSGOE81
97F1 ;;1^PSGOE82
98F5 ;;5^PSGOE82
99PSGF2 ;;2^PSGOE82
Note: See TracBrowser for help on using the repository browser.