[613] | 1 | PSIVUWL ;BIR/RGY,PR-UPDATE DAILY WARD LIST ;01 OCT 96 / 9:42 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
---|
| 3 | START S PSIVWARD="",Y=1 W !!,"Edit list for: TODAY//" R X:DTIME S:'$T X="^" S:X="" X="T" G Q:X["^" I X'["?" S %DT="EXT" D ^%DT
|
---|
| 4 | G:Y<1 START
|
---|
| 5 | I X["?" S HELP="UWL" D ^PSIVHLP S X="?" D ^%DT G START
|
---|
| 6 | S PSIVDT=Y\1 D ^PSIVWL1 G:'$D(PSIVOD)!('$D(PSIVCD)) Q
|
---|
| 7 | BEG R !!,"Enter a WARD, '^OUTPATIENT' or '^ALL': ",X:DTIME W:'$T $C(7) S:'$T X="^" G:"^"[X Q I X["?" S HELP="ZW" D ^PSIVHLP2 K DIC S DIC=42,DIC(0)="QEM" D ^DIC K DIC G BEG
|
---|
| 8 | S Y=$S("^ALL"[X:"^ALL","^OUTPATIENT"[X:"^OPT IV",1:"") W:Y'="" $P(Y,X,2) S:Y["^OPT IV" Y="^Outpatient IV"
|
---|
| 9 | I Y="" K DIC S D=0,DIC(0)="QEM",DIC=42 D IX^DIC K DIC
|
---|
| 10 | G:Y<0 BEG S (WRD,WARD)=$P(Y,"^",2) S:WRD="ALL" WRD=$O(^PS(55,"PSIVWL",PSIVSN,"")) G:WRD="" BEG
|
---|
| 11 | WARD S (X,PSIVT)="" F PSIV=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT="" S PSIVDT=PSIVOD(PSIVT) F DFN=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN)) Q:DFN="" D ENIV^PSJAC,UPD1 G:X="^" BEG
|
---|
| 12 | I WARD="ALL" S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) G:WRD="" Q G WARD
|
---|
| 13 | Q K %DT,%T,D,DFN,DIC,I,ON,PSIV,PSIVDT,PSIVNOW,PSIVOD,PSIVCD,PSIVMT,PSIVT,PSIVWARD,PSCT,PSM,WARD,WRD,Z,ZTSK D ENIVKV^PSGSETU Q
|
---|
| 14 | UPD1 S X="X" F ON=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON)) Q:'ON!(X="^") D UPD
|
---|
| 15 | Q
|
---|
| 16 | SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
|
---|
| 17 | Q
|
---|
| 18 | WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
|
---|
| 19 | CODES S X=$P($P(";"_$P(Y,"^",3),";"_X_":",2),";") Q
|
---|
| 20 | UPD Q:'$D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON)) N ON55,PSIVAC S PSIVAC="PRO",ON55=ON D GT55^PSIVORFB,ENNONUM^PSIVORV2(DFN,ON)
|
---|
| 21 | ASK K DIC S X="# of labels ^"_+^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON)_$S(+^(ON)'=($L($P(^(ON),"^",2)," ")-1):"*",1:"")_"^^DC ORDER,ON CALL,HOLD^QUX=+QUX!($E(QUX)=""^"")" D ENQ^PSIV Q:"^"[X I $E(X)="^" D FIND G:PSIVT]"" UPD Q
|
---|
| 22 | I X["?" S HELP="UWL" D ^PSIVHLP1 G ASK
|
---|
| 23 | I "DOH"[$E(X) S UWLFLAG="1.001",(PSIVAC,XX)=$E(X) D ^PSIVOPT K UWLFLAG,PSIVAC S X=XX Q
|
---|
| 24 | I X'=+X W $C(7)," ???" G ASK
|
---|
| 25 | S $P(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON),"^")=X Q
|
---|
| 26 | FIND ;
|
---|
| 27 | S X=$P(X,"^",2),DIC="^DPT(",DIC(0)="QEM" D ^DIC I Y<0 S PSIVT="" Q
|
---|
| 28 | S DFN=+Y D ENIV^PSJAC
|
---|
| 29 | S WRD=$S($P(VAIN(4),U,2)]"":$P(VAIN(4),U,2),1:"Outpatient IV")
|
---|
| 30 | A S X="Enter order number #:^^^^QUX?.N" D ENQ^PSIV S ON=X S:"^"[X PSIVT="" Q:"^"[X I X["?" S HELP="ONUWL" D ^PSIVHLP1 G A
|
---|
| 31 | S PSIVT="" F PSIV=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT="" I $D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON)) S PSIVDT=PSIVOD(PSIVT) Q
|
---|
| 32 | Q:PSIVT'=""
|
---|
| 33 | W $C(7),!!,"Patient and order number not found !" G A
|
---|