source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE91.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PSGOE91 ;BIR/CML3-ACTIVE ORDER EDIT (CONT.) ;10 JUL 96 / 7:54 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**50,64,58,110,111,136**;16 DEC 97
3 ;
4 ;Reference to ^PS(55 is supported by DBIA #2191.
5 ;
641 ; admin times
7 S MSG=0,PSGF2=41 S:PSGOEEF(PSGF2) BACK="41^PSGOE91"
8 I $$ODD^PSGS0(PSGS0XT) G DONE
9A41 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
10 . W !!?5,"ADMIN TIMES may not be edited for active complex orders." D PAUSE^VALM1
11 W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
12 I X="" G DONE
13 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A41
14 I X="@",'PSGAT!(PSGS0XT="D")!(PSGSCH["@") I ((",P,R,")'[(","_$G(PSGST)_",")) D G A41
15 .W $C(7)," ??" S X="?" W:PSGS0XT="D"!(PSGSCH["@") !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(55.06,41)
16 I X="@" D DEL G:%'=1 A41 S PSGAT="" G DONE
17 I X?1."?" D ENHLP^PSGOEM(55.06,41) G A41
18 D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,41) G A41
19 S (PSGS0Y,PSGAT)=X G DONE
20 ;
218 ; special instructions
22 S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE91"
23A8 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
24 . 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)
25 . 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)
26 N DIR S DIR(0)="FO^1:180^D ^PSGSICHK",DIR("A")="SPECIAL INSTRUCTIONS",DIR("??")="^D ENHLP^PSGOEM(55.06,8)" S:$G(PSGSI)]"" DIR("B")=$P(PSGSI,"^") D ^DIR I $D(DUOUT)!$D(DTOUT) S PSGOEE=0 G DONE
27 I $E(X)=U D ENFF^PSGOE92 G:Y>0 @Y G A8
28 I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
29 I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
30 I Y="",PSGSI="" G DONE
31 S PSGSI=$S(Y]"":Y,1:PSGSI),PSGSI=$$ENBCMA^PSJUTL("U") G DONE
32 Q
33 W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":PSGSI_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
34 I X="" S X=PSGSI I X="" G DONE
35 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A8
36 I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
37 I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
38 I X?1."?" D ENHLP^PSGOEM(55.06,8) G A8
39 D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,8) G A8
40 S PSGSI=X G DONE
41 ;
4210 ; start date/time
43 S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE91"
44A10 ;
45 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
46 . W !!?5,"Start Date/Time may not be edited for active complex orders." D PAUSE^VALM1
47 K PSGSDX
48 W !,"START DATE/TIME: "_$S($P(PSGSDN,"^")]"":$P(PSGSDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
49 I X="",PSGSD W " "_PSGSDN G DONE
50 I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G DONE
51 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,10)
52 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A10
53 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(55.06,10) G A10
54 I PSGFD<Y W $C(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",! S MSG=1 G A10
55 S (PSGSDX,PSGSD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) G DONE
56 ;
5734 ; stop date
58 S MSG=0,PSGF2=34 S:PSGOEEF(PSGF2) BACK="34^PSGOE91"
59A34 ;
60 K PSGFDX
61 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
62 . W !!?5,"Stop Date/Time may not be edited for active complex orders." D PAUSE^VALM1
63 W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
64 I X="",PSGFD W " "_$P(PSGFDN,"^") G W34
65 I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A34
66 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,34)
67 I X=+X,(X>0),(X'>2000000) G A34:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D ENE^PSGDL
68 K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT G:Y'>0 A34 S (PSGFDX,PSGFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
69W34 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S MSG=1
70 ;
71 ;
72DONE ;
73 ;Display Expected First Dose;BHW;PSJ*5*136
74 D EFDACT^PSJUTL
75 I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
76 K F,F0,F1,PSGF2,F3,PSG,SDT Q
77 ;
78FF ; up-arrow to another field
79 D ENFF^PSGOEM I Y>0,Y'=41,Y'=8,Y'=10,Y'=34 S Y=Y_"^PSGOE9"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE91"
80 Q
81 ;
82DEL ; delete entry
83 W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
84 Q
Note: See TracBrowser for help on using the repository browser.