source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVUWL.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: 2.5 KB
Line 
1PSIVUWL ;BIR/RGY,PR-UPDATE DAILY WARD LIST ;01 OCT 96 / 9:42 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3START 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
7BEG 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
11WARD 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
13Q 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
14UPD1 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
16SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
17 Q
18WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
19CODES S X=$P($P(";"_$P(Y,"^",3),";"_X_":",2),";") Q
20UPD 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)
21ASK 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
26FIND ;
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")
30A 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
Note: See TracBrowser for help on using the repository browser.