source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOE41.m@ 738

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PSGOE41 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:13 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**50,63,64,69,58,111,136**;16 DEC 97
3 ;
4 ; Reference to %DT is supported by DBIA 10003.
5 ; Reference to %DTC is supported by DBIA 10000.
6 ; Reference to ^DICN is supported by DBIA 10009.
7 ;
839 ; admin times
9 G:$P(PSGNEDFD,"^",3)="P" 8
10 I $$ODD^PSGS0(PSGS0XT) G 8
11 W !,"ADMIN TIMES: "_$S(PSGS0Y:PSGS0Y_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
12 I X="",($G(PSGS0XT)'="D") S PSGFOK(39)="" G 8
13 I X="",$G(PSGS0XT)="D" I $L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S (PSGAT,PSGS0Y)=$P(PSGSCH,"@",2) G 8
14 S PSGF2=39 I $E(X)="^" D FF G:Y>0 @Y G 39
15 I (PSGS0XT="D")&('$G(X)!(X["@"&($P($G(X),"@",2)))) I ((",P,R,")'[(","_$G(PSGST)_",")) D G 39
16 .W $C(7)," ??" S X="?" W !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(53.1,39)
17 ;I X="@",'PSGS0Y!(PSGS0XT="D")!(PSGSCH["@") 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(53.1,39) G 39
18 I X="@" D DEL G:%'=1 39 S (PSGFOK(39),PSGS0Y)="" G 8
19 I X?1."?" D ENHLP^PSGOEM(53.1,39) G 39
20 D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,39) G 39
21 S (PSGAT,PSGS0Y)=X,PSGFOK(39)=""
22 ;
238 ; special instructions
24 W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":$P(PSGSI,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
25 I X="" S X=PSGSI I X="" S PSGFOK(8)="" G:'$G(PSGOE3) 10
26 S PSGF2=8 I $E(X)="^" D FF G:Y>0 @Y G 8
27 I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
28 I X="@" D DEL G:%'=1 8 S (PSGFOK(8),PSGSI)="" G:'$G(PSGOE3) 10
29 I X?1."?" D ENHLP^PSGOEM(53.1,8) G 8
30 D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
31 S PSGSI=X I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U"),PSGFOK(8)=""
32 Q:$G(PSGOE3)
33 ;
3410 ; start date/time
35 D ^PSGNE3
36 S:'$D(PSGNESDO) PSGNESDO=$$ENDD^PSGMI(PSGNESD) S PSGSD=PSGNESDO
37A10 W !,"START DATE/TIME: "_PSGSD_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
38 I X="",PSGNESD W " "_PSGSD G O25
39 I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGNESD=+X,PSGSD=$$ENDD^PSGMI(+X) W " ",PSGSD G O25
40 S PSGF2=10 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10)
41 I $E(X)="^" D FF G:Y>0 @Y G A10
42 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(53.1,10) G A10
43 S PSGNESD=+Y,PSGSD=$$ENDD^PSGMI(+Y),(PSGNEFD,PSGFD)=""
44 ;
45O25 ;
46 S PSGFOK(10)="" I $P(PSGNEDFD,"^",3)="O" S PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP) I PSGNEFD]"" S PSGFD=$$ENDD^PSGMI(PSGNEFD)
47 ;
4825 ; stop date
49 Q:$G(PSGOE3)
50 I 'PSGNEFD D ENFD^PSGNE3(PSGDT) S PSGFD=PSGNEFDO
51A25 W !,"STOP DATE/TIME: "_$S(PSGFD]"":PSGFD_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
52 I X="",PSGNEFD W " "_PSGFD S PSGFOK(25)="" G W25
53 S PSGF2=25 I $E(X)="^" D FF G:Y>0 @Y G A25
54 ;I X=+X,(X'>0) S X="?"
55 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
56 I X=+X,(X>0),(X'>2000000) G A25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D EN1^PSGDL
57 K %DT S %DT="ERTX",%DT(0)=PSGNESD D ^%DT K %DT G:Y'>0 A25 S PSGNEFD=+Y,PSGFD=$$ENDD^PSGMI(+Y),PSGFOK(25)=""
58W25 I PSGNEFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
59 ;Display Expected First Dose;BHW;PSJ*5*136
60 D EFDNEW^PSJUTL
61 ;
62NEXT ;
63 ;G:$S($D(PSJOERR):0,+PSJSYSU=3:1,1:'$P(PSJSYSU,";",2)) 1^PSGOE42 G:$P(PSJSYSW0,"^",24) 5^PSGOE42 G:PSGOEORF&'$P(PSJSYSU,";",2) 106^PSGOE42
64 G 1^PSGOE42
65 ;
66DONE ;
67 I PSGOROE1 K Y W $C(7)," ...order not entered..."
68 K F,F0,F1,PSGF2,F3,PSG,SDT Q
69 ;
70FF ; up-arrow to another field
71 D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:$P(Y,U)=2 FB=PSGF2_"^PSGOE41"
72 Q
73 ;
74DEL ; delete entry
75 W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
76 Q
Note: See TracBrowser for help on using the repository browser.