source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOER0.m@ 1147

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSGOER0 ;BIR/CML3-EDIT FIELDS FOR RENEWAL ;05 May 98 / 10:58 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**11,45,47,50,63,64,70,69,58,80,110,127,136**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191.
5 ; Reference to ^VA(200 is supported by DBIA 10060.
6 ; Reference to ^DD(55.06 is supported by DBIA 2253.
7 ; Reference to ^%DT is supported by DBIA 10003.
8 ; Reference to ^DIC is supported by DBIA 10006.
9 ;
10DATE(PSGP,PSGORD,PSGDT) ;
11 K PSGFOK,PSJNOO S F1=55.06,PSGWLL=+$G(^PS(55,PSGP,5.1)),PSGOER0=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGPDRG=+$G(^(.2)),PSGOER2=$G(^(2))
12 NEW XX S XX=$$ACTIVE^PSJORREN(PSGP,PSGORD) S:+XX=2 PSGPDRG=$P(XX,U,2)
13 I '+XX W !,"No active Orderable Item was found.",! G DONE
14 S (PSGNEDFD,PSGOERDP)=$P($$GTNEDFD^PSGOE7("U",PSGPDRG),U)
15 S PSGSCH=$P(PSGOER2,"^"),PSGST=$P(PSGOER0,"^",7),PSGS0Y=$P(PSGOER2,"^",5),PSGS0XT=$P(PSGOER2,"^",6)
16 S PSGOEPR=+$P(PSGOER0,"^",2),(PSGOPR,PSGPR)=$S($P(PSJSYSU,";",2):DUZ,1:+PSGOEPR)
17 I $G(PSJSPEED) S PSGPR=$S($P(ND,"^",2):$P(ND,"^",2),1:+PSGOEPR)
18 S PSGOSD=+$P(PSGOER2,"^",2) S PSGOFD=+$P(PSGOER2,"^",4),PSGPRN=$P($G(^VA(200,PSGPR,0)),"^"),PSGPRI=$S($P(PSJSYSU,";",2):0,1:$P($G(^("PS")),"^",4)),PSGRO=0 S:PSGPRI PSGPRI=PSGPRI'>DT I PSGPRI S (PSGOPR,PSGPR,PSGPRN)=""
19 S PSGRNSD=$S($G(PSGLI):PSGLI,1:$G(PSGDT))
20 S PSGSD=$G(PSGOSD)
21 I PSGSD="" S PSJREN=1,PSGSD=$$ENSD^PSGNE3($S(PSGST["P":"PRN",1:$P(PSGOER2,U)),PSGS0Y,PSGDT,PSGOSD) S:PSGOSD>PSGSD PSGSD=PSGOSD K PSJREN
22 S PSGSDN=$$ENDD^PSGMI(PSGSD)
2310 ;
24 ;W !,"START DATE/TIME: "_PSGSDN
25O25 ;
26 N PSGSD,PSGNEFD S PSGSD=PSGDT
27 D ENWALL^PSGNE3(PSGSD,0,PSGP)
28 S:'$G(PSGDT) PSGDT=$$DATE2^PSJUTL2($$NOW^XLFDT)
29 N PSGNESD S PSGNESD=PSGDT D ENFD^PSGNE3(PSGNESD) I $G(PSGNEFD) S (Y,PSGFD)=PSGNEFD
30 S PSGFOK(10)="" I PSGST="O" S PSGFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGRNSD,PSGP) I PSGFD]"" S Y=PSGRNSD,X=0 G 1
31D25 K DUR,DURMIN N PKGFLG S PKGFLG=$S(PSGORD["U":5,PSGORD["V":"IV",PSGORD["P":"P",1:"") I PKGFLG]"" S DUR=$$GETDUR^PSJLIVMD(PSGP,+$G(PSGORD),PKGFLG,1) I DUR]"" D
32 .S DURMIN=($$DURMIN^PSJLIVMD(DUR)\1) I DURMIN>1 S Y=$$FMADD^XLFDT(PSGRNSD,,,DURMIN) I Y>PSGRNSD S PSGFD=Y,X=0
33 I $P($G(PSGOER2),"^",4)>PSGFD S Y=$P(PSGOER2,"^",4)
34 I $G(DUR)]"",($G(PSGORD)'["P") S DURMIN=$$DURMIN^PSJLIVMD(DUR)\1 S Y=$$FMADD^XLFDT(PSGDT,,,DURMIN)
35 S:X&$P(PSJSYSW0,"^",7) $P(Y,".",2)=$P(PSJSYSW0,"^",7) S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
3625 W !,"STOP DATE/TIME: "_PSGFDN_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
37 I X="" W " "_PSGFDN G W25
38 I $E(X)="^" D FF G:Y>0 @Y G 25
39 S PSGF2=25 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,25)
40 I X=+X,X>0,X'>2000000 G 25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X,ND2=PSGOER2,$P(ND2,"^",2)=PSGRNSD W " ...dose limit..." D ENGO^PSGDL
41 K %DT S %DT="ERTX" D ^%DT K %DT G:Y'>0 25 S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
42W25 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
43 I PSGFD<PSGSD W $C(7),!!?3,"*** The STOP date must be AFTER the START date. ***" G 25
44 S PSGFOK(25)=""
45 ;Display Expected First Dose;BHW;PSJ*5*136
46 D EFDNEW^PSJUTL
47 I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S PSGFOK(1)="" Q
481 ; provider
49 G:+PSJSYSU<3&$P(PSJSYSU,";",2) CHKDD S PSGF2=1
50A1 ;
51 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
52 I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
53 I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) S PSGFOK(1)="" G CHKDD
54 I X?1."?" D ENHLP^PSGOEM(55.06,1)
55 I $E(X)="^" D FF G:Y>0 @Y G A1
56 K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="S X(1)=$G(^(""PS"")) I X(1),$S('$P((X(1)),""^"",4):1,1:DT<$P((X(1)),""^"",4))" D ^DIC K DIC I Y'>0 G A1
57 S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
58CHKDD ;
59 G:$G(PSGRENEW) 106
60 I PSGORD["P"!$$DDOK^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPDRG) G 106
61 ;I PSGORD["P"!'$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") G 106
62 I $P(PSJSYSU,";")'=3,'$P(PSJSYSP0,U,2) W !!,"This order's dispense drug is invalid, a pharmacist must renew this order." Q
63 K ^PS(53.45,PSJSYSP,1),^(2)
64 W !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
65 D ENDRG^PSGOEF1(+^PS(55,PSGP,5,+PSGORD,.2),0)
66 I $G(DUOUT)!'$G(DRG) S COMQUIT=1 Q
67106 ; nature of order
68 S PSJNOO=$$ENNOO^PSJUTL5("R") S:PSJNOO<0 COMQUIT=1
69 S:PSJNOO'<0 PSGFOK(106)=""
70DONE ;
71 K F,F0,F1,PSGF2,F3,ND2,PSGDL,PSGDLS,PSGOROE1,PSGRO,SDT Q
72FF ; "^" to another field
73 K DIC S DIC="^DD(55.06,",DIC(0)="EQ",DIC("S")="I $D(PSGFOK(+Y))",X=$E(X,2,255) D ^DIC K DIC
74 S Y=+Y Q
Note: See TracBrowser for help on using the repository browser.