| 1 | PSGS0 ;BIR/CML3-SCHEDULE PROCESSOR ;29 Jan 99 / 8:04 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**12,25,26,50,63,74,83,116,110,111,133,138,174**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(51.1 is supported by DBIA 2177
|
|---|
| 5 | ; Reference to ^PS(55 is supported by DBIA 2191
|
|---|
| 6 | ;
|
|---|
| 7 | ENA ; entry point for train option
|
|---|
| 8 | D ENCV^PSGSETU Q:$D(XQUIT)
|
|---|
| 9 | F S (PSGS0Y,PSGS0XT)="" R !!,"Select STANDARD SCHEDULE: ",X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" ENQ^PSGSH I X'?1."?" D EN W:$D(X)[0 $C(7)," ??" I $D(X)#2,'PSGS0Y,PSGS0XT W " Every ",PSGS0XT," minutes"
|
|---|
| 10 | K DIC,DIE,PSGS0XT,PSGS0Y,Q,X,Y,PSGDT Q
|
|---|
| 11 | ;
|
|---|
| 12 | EN3 ;
|
|---|
| 13 | S PSGST=$P($G(^PS(53.1,DA,0)),"^",7) G EN
|
|---|
| 14 | ;
|
|---|
| 15 | EN5 ;
|
|---|
| 16 | S PSGST=$P($G(^PS(55,DA(1),5,DA,0)),"^",7)
|
|---|
| 17 | ;
|
|---|
| 18 | EN ; validate
|
|---|
| 19 | K PSGS0Y
|
|---|
| 20 | I X[""""!($A(X)=45)!(X?.E1C.E)!($L(X)>70)!($L(X)<1) K X Q
|
|---|
| 21 | S X=$$TRIM^XLFSTR(X,"R"," ")
|
|---|
| 22 | I X?.E1L.E S X=$$ENLU^PSGMI(X) I '$D(PSGOES) D EN^DDIOL(" ("_X_")")
|
|---|
| 23 | ;
|
|---|
| 24 | ENOS ; order set entry
|
|---|
| 25 | N X0,Y0,PSJXI,PSJDIC2
|
|---|
| 26 | I $G(X)="",$G(P(2)),$G(P(3)) S X=$G(P(9))
|
|---|
| 27 | I $G(X)="" Q
|
|---|
| 28 | S PSGXT=$G(PSGS0XT),(PSGS0XT,PSGS0Y,XT,Y,PSJNSS)=""
|
|---|
| 29 | S X0=X I X?2.4N1"-".E!(X?2.4N) D ENCHK S:$D(X) Y=X G Q
|
|---|
| 30 | I X["PRN",$$PRNOK(X),'$D(^PS(51.1,"AC","PSJ",X)) D G Q
|
|---|
| 31 | .I X["@"!$$DOW^PSIVUTL($P(X," PRN")) N DOW D I $G(DOW) S (Y0,Y,PSGS0Y)=$P($P(X,"@",2)," ")
|
|---|
| 32 | ..N TMP S TMP=X N X S X=$P(TMP," PRN") D DW I $G(X)]"" S DOW=1
|
|---|
| 33 | ..I $G(DOW),$G(PSGST)]"" I ",P,R,"'[(","_PSGST_",") S (XT,PSGS0XT)="D"
|
|---|
| 34 | D DIC I $G(XT)]""!$G(Y0)!($G(X)]""&$G(PSJXI)) D I $G(X)]"" G:$D(^PS(51.1,"AC","PSJ",X)) Q3 I $P(X,"@")]"" G:$D(^PS(51.1,"AC","PSJ",$P(X,"@"))) Q3
|
|---|
| 35 | .S PSGS0XT=XT S:$G(Y0) (Y,PSGS0Y)=Y0 S:'PSGS0Y&((PSGS0XT)="D")&(X["@") PSGS0Y=$P(X,"@",2)
|
|---|
| 36 | .S PSGS0Y=$P(PSGS0Y," ")
|
|---|
| 37 | N TMPSCHX S TMPSCHX=X I $L(X,"@")<3 S TMPX=X D DW I $G(X)]"" K PSJNSS S (PSGS0XT,XT)="D" D G Q
|
|---|
| 38 | .S Y=$S(($G(TMPSCHX)["@"):$P(TMPSCHX,"@",2),1:"")
|
|---|
| 39 | .I Y,(X'["@"),(TMPSCHX["@") S X=TMPSCHX
|
|---|
| 40 | S X=TMPSCHX
|
|---|
| 41 | I X'="" I $D(^PS(51.1,"AC","PSJ",X)) K PSJNSS G Q
|
|---|
| 42 | ;
|
|---|
| 43 | NS I ($G(X)="^")!($G(X)="") K X S Y="" Q
|
|---|
| 44 | N NS S NS=0,PSJNSS=0
|
|---|
| 45 | I $G(Y)'>0 S X=X0,Y="",NS=1,PSJNSS=1
|
|---|
| 46 | Q ;
|
|---|
| 47 | S PSGS0XT=$S(XT]"":XT,1:$G(PSGS0XT)),PSGS0Y=$S($G(Y):Y,$G(PSGS0Y):PSGS0Y,1:"") S:PSGS0XT<0 PSGS0XT=""
|
|---|
| 48 | I ('$G(PSGS0Y)&'$G(PSJDIC2)&$G(PSGAT))&'$G(PSJNEWOE)&$G(PSGS0XT) I PSGS0XT<1441 I ($L($G(PSGAT),"-")=PSGS0XT/1440)!($G(X)]""&($G(PSGSCH)=$G(X))) S PSGS0Y=$G(PSGAT)
|
|---|
| 49 | Q2 K YY
|
|---|
| 50 | I '$G(PSJNSS),'$G(PSGS0Y),$G(YY) S PSGS0Y=YY
|
|---|
| 51 | I $G(X)]"",$$SCHREQ^PSJLIVFD(.P) D
|
|---|
| 52 | .I $$DOW^PSIVUTL(X)!$$PRNOK(X)!$D(^PS(51.1,"AC","PSJ",X)) S PSJNSS=0 Q
|
|---|
| 53 | .I $G(P(2))&$G(P(3)) D NSSCONT(X,PSGS0XT) S TMPX="" K X
|
|---|
| 54 | I ($G(PSJNSS)&($G(VALMBCK)'="Q"))!($G(PSJNSS)&$G(PSJLIFNI))!($G(PSJNSS)&$G(PSJTUD)) D
|
|---|
| 55 | .I $G(P(2))&$G(P(3)) Q
|
|---|
| 56 | .I ($G(X)]"") I ($G(PSGS0XT)'="D") D NSSCONT(X,PSGS0XT) S TMPX="" K X
|
|---|
| 57 | Q3 I $G(X)]"" I $D(^PS(51.1,"AC","PSJ",X)) K PSJNSS
|
|---|
| 58 | K QX,SDW,SWD,X0,XT,Z Q
|
|---|
| 59 | ;
|
|---|
| 60 | NSSCONT(SCH,FREQ) ;
|
|---|
| 61 | Q:SCH=""!($G(VALMBCK)]"")!$G(PSGMARSD)!$G(PSIVFN1)
|
|---|
| 62 | I $G(PSGOES),'$G(NSFF) Q
|
|---|
| 63 | N PSGS0XT,PSGSCH,DIR,X,Y S PSGSCH=SCH,PSGS0XT=FREQ,PSJNSS=1
|
|---|
| 64 | D NSSMSG I ($L(PSJNSS)>2),'$G(PSJXI) W !!,PSJNSS,! S PSJNSS=1
|
|---|
| 65 | S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR
|
|---|
| 66 | K NSFF Q
|
|---|
| 67 | ;
|
|---|
| 68 | NSSMSG ;
|
|---|
| 69 | Q:$G(PSJXI)
|
|---|
| 70 | I '(",O,"[(","_$G(PSGST)_",")),$G(PSJNSS),$G(PSGSCH)]"" D
|
|---|
| 71 | .S PSJNSS=" WARNING - "_PSGSCH_" is an invalid schedule."
|
|---|
| 72 | S PSGSCH="",PSGS0XT=""
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | NSO(FQ) ;
|
|---|
| 76 | Q:'FQ!(FQ<0)!(",D,O,"[(","_$G(PSGST)_",")) ""
|
|---|
| 77 | K FRQOUT S FRQOUT=$S(FQ<60:(FQ_"minute"),(FQ<1440)&(FQ#60):(FQ_" minute"),(FQ<1440)!(FQ#1440):(FQ/60_" hour"),1:(FQ/1440_" day")) D
|
|---|
| 78 | . S:(+FRQOUT'=1) FRQOUT=FRQOUT_"s"
|
|---|
| 79 | Q FRQOUT
|
|---|
| 80 | ;
|
|---|
| 81 | ENCHK ;
|
|---|
| 82 | I $S($L($P(X,"-"))>4:1,$L(X)>119:1,$L(X)<2:1,X'>0:1,1:X'?.ANP) K X Q
|
|---|
| 83 | S X(1)=$P(X,"-") I X(1)'?2N,X(1)'?4N K X Q
|
|---|
| 84 | S X(1)=$L(X(1)) I X'["-"&((X>$E(2400,1,X(1))!($E(X,3,4)>59))) K X Q
|
|---|
| 85 | F X(2)=2:1:$L(X,"-") S X(3)=$P(X,"-",X(2)) I $S($L(X(3))'=X(1):1,X(3)>$E(2400,1,X(1)):1,$E(X(3),3,4)>59:1,1:X(3)'>$P(X,"-",X(2)-1)) K X Q
|
|---|
| 86 | K:$D(X) X(1),X(2),X(3) Q
|
|---|
| 87 | ;
|
|---|
| 88 | DIC ;
|
|---|
| 89 | K Y0,PSJXI N Y
|
|---|
| 90 | S Z=0 F PSJXI=0:1 S Z=$O(^PS(51.1,"AC","PSJ",X,Z)) Q:'Z
|
|---|
| 91 | I $G(X)]"",'$G(PSJSLUP) D
|
|---|
| 92 | .I $D(^PS(51.1,"AC","PSJ",X)) D Q:$G(PSGS0Y)&($G(PSGS0XT)]"")
|
|---|
| 93 | ..I $$DOW^PSIVUTL(X) S PSGS0XT="D",PSJNSS=0 S:X["@" (Y0,PSGS0Y)=$P(X,"@",2) Q
|
|---|
| 94 | ..I $G(NSFF) S Y0=$S($G(PSGS0Y):PSGS0Y,$G(PSGAT)&'$G(PSJNEWOE):PSGAT,1:"") S:Y0 PSGS0Y=Y0
|
|---|
| 95 | .; Check for duplicate schedules - force selection
|
|---|
| 96 | .Q:PSJXI>1&('$G(PSGOES))&($G(PSGS0XT)]"")
|
|---|
| 97 | .I $D(^PS(51.1,"AC","PSJ",X)) N FREQ,ADMATCH S FREQ=PSGS0XT D
|
|---|
| 98 | ..N PSGS0XT,PSGS0Y,PSGST D ADMIN^PSJORPOE S:$G(PSGS0XT) XT=PSGS0XT S:$G(PSGS0Y) (Y0,Y)=PSGS0Y
|
|---|
| 99 | .S:$G(XT)]"" PSGS0XT=XT S:$G(Y) PSGS0Y=Y
|
|---|
| 100 | .I $$DOW^PSIVUTL(X) S:PSGS0XT="" (XT,PSGS0XT)="D" S:PSGS0Y="" (Y0,PSGS0Y)=$S($P(X,"@",2):$P(X,"@",2),1:"")
|
|---|
| 101 | I $G(PSJLIFNI)!($G(P(4))]""&($G(P(2))]"")) I '$D(^PS(51.1,"AC","PSJ",X))!($G(PSJXI)>1) S PSJSLUP=1
|
|---|
| 102 | I $G(NSFF),$G(PSJXI)>1 D
|
|---|
| 103 | .I $G(PSGS0XT)="",$G(NSFF),$G(PSGXT)]"" S PSGS0XT=PSGXT Q
|
|---|
| 104 | .I $G(PSGS0XT)=""!($G(PSGS0Y)="") S PSJSLUP=1
|
|---|
| 105 | I '$G(PSJSLUP) Q:$G(PSGS0XT)]""&($G(PSGS0Y)]"") Q:($G(PSGS0XT)="D"&('$D(^PS(51.1,"AC","PSJ",X))))
|
|---|
| 106 | Q:$G(PSGOES)=2
|
|---|
| 107 | Q:$G(PSGS0XT)]""&(PSJXI=1)
|
|---|
| 108 | K PSJSLUP
|
|---|
| 109 | ;
|
|---|
| 110 | K DIC S DIC="^PS(51.1,",DIC(0)=$E("E",'$D(PSGOES))_"ISZ",DIC("W")="W "" "","_$S('$D(PSJPWD):"$P(^(0),""^"",2)",'PSJPWD:"$P(^(0),""^"",2)",1:"$S($D(^PS(51.1,+Y,1,+PSJPWD,0)):$P(^(0),""^"",2),1:$P(^PS(51.1,+Y,0),""^"",2))"),D="APPSJ"
|
|---|
| 111 | I $D(PSGST) ;S DIC("S")="I $P(^(0),""^"",5)"_$E("'",PSGST'="O")_"=""O"""
|
|---|
| 112 | S PSJDIC2=1
|
|---|
| 113 | D IX^DIC K DIC S:$D(DIE)#2 DIC=DIE I Y'>0 D Q
|
|---|
| 114 | .I '$$DOW^PSIVUTL(X),'$$PRNOK(X) S X="",PSJNSS=1,XT="",PSJXI=""
|
|---|
| 115 | S XT=$S("C"[$P(Y(0),"^",5):$P(Y(0),"^",3),1:$P(Y(0),"^",5))
|
|---|
| 116 | S X=+Y,Y="" I $D(PSJPWD),$D(^PS(51.1,+X,1,+PSJPWD,0)) S Y=$P(^(0),"^",2)
|
|---|
| 117 | S (X,X0)=Y(0,0) S:$G(Y)="" Y=$P(Y(0),"^",2)
|
|---|
| 118 | S (PSGS0Y,Y0)=$G(Y),Y0(0)=Y(0) I $P(Y(0),"^",3) S XT=$P(Y(0),"^",3)
|
|---|
| 119 | I $G(PSGS0XT)="",$$DOW^PSIVUTL(X) S (XT,PSGS0XT)="D"
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | DW ;
|
|---|
| 123 | N Y
|
|---|
| 124 | Q:($L(X,"@")>2)
|
|---|
| 125 | N AT I X["@" S AT=$P(X,"@",2)
|
|---|
| 126 | S SWD="SUNDAYS^MONDAYS^TUESDAYS^WEDNESDAYS^THURSDAYS^FRIDAYS^SATURDAYS",SDW=X,X=$P(X,"@",2) N XABB S XABB=""
|
|---|
| 127 | I X]"" D ENCHK Q:'$D(X)
|
|---|
| 128 | S X=$P(SDW,"@"),X(1)="-" I X?.E1P.E,X'["-" ;F QX=1:1:$L(X) I $E(X,QX)?1P S X(1)=$E(X,QX) Q
|
|---|
| 129 | F Q=1:1:$L(X,X(1)) K:SWD="" X Q:SWD="" S Z=$P(X,X(1),Q) D DWC Q:'$D(X)
|
|---|
| 130 | I $D(X) F II=1:1:$L(X,X(1)) S XABB=$G(XABB)_$E($P(X,X(1),II),1,2)_"-"
|
|---|
| 131 | K X(1) S:$D(X) X=SDW I $G(X)]"" I $TR(XABB,"-")]"" S X=$E($G(XABB),1,$L(XABB)-1)
|
|---|
| 132 | I $G(AT) S PSGS0Y=AT
|
|---|
| 133 | Q
|
|---|
| 134 | DWC I $L(Z)<2 K X Q
|
|---|
| 135 | F QX=1:1:$L(SWD,"^") S Y=$P(SWD,"^",QX) I $P(Y,Z)="" S SWD=$P(SWD,Y,2) S:$L(SWD) SWD=$E(SWD,2,50) Q
|
|---|
| 136 | E K X
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | PRNOK(PSCH) ;
|
|---|
| 140 | Q:PSCH'["PRN" 0
|
|---|
| 141 | I $TR(PSCH," ")="PRN" Q 1
|
|---|
| 142 | N BASE,I,OK S OK=0 S I=$P(PSCH," PRN") I I]"",$D(^PS(51.1,"AC","PSJ",I)) S OK=1
|
|---|
| 143 | I 'OK D
|
|---|
| 144 | .I PSCH["@" I $D(^PS(51.1,"AC","PSJ",$P(PSCH,"@")))!$$DOW^PSIVUTL($P(PSCH,"@")) S OK=1 Q
|
|---|
| 145 | .I $$DOW^PSIVUTL($P(PSCH," PRN")) S OK=1
|
|---|
| 146 | Q OK
|
|---|
| 147 | ODD(PSF) ;determine if this is an odd schedule
|
|---|
| 148 | I PSF>1439,PSF#1440 Q 1
|
|---|
| 149 | I PSF,PSF<1440,1440#PSF Q 1
|
|---|
| 150 | Q 0
|
|---|
