- PSIVUWL ;BIR/RGY,PR-UPDATE DAILY WARD LIST ;01 OCT 96 / 9:42 AM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- 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
- G:Y<1 START
- I X["?" S HELP="UWL" D ^PSIVHLP S X="?" D ^%DT G START
- S PSIVDT=Y\1 D ^PSIVWL1 G:'$D(PSIVOD)!('$D(PSIVCD)) Q
- 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
- S Y=$S("^ALL"[X:"^ALL","^OUTPATIENT"[X:"^OPT IV",1:"") W:Y'="" $P(Y,X,2) S:Y["^OPT IV" Y="^Outpatient IV"
- I Y="" K DIC S D=0,DIC(0)="QEM",DIC=42 D IX^DIC K DIC
- G:Y<0 BEG S (WRD,WARD)=$P(Y,"^",2) S:WRD="ALL" WRD=$O(^PS(55,"PSIVWL",PSIVSN,"")) G:WRD="" BEG
- 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
- I WARD="ALL" S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) G:WRD="" Q G WARD
- 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
- 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
- Q
- SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
- Q
- WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
- CODES S X=$P($P(";"_$P(Y,"^",3),";"_X_":",2),";") Q
- 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)
- 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
- I X["?" S HELP="UWL" D ^PSIVHLP1 G ASK
- I "DOH"[$E(X) S UWLFLAG="1.001",(PSIVAC,XX)=$E(X) D ^PSIVOPT K UWLFLAG,PSIVAC S X=XX Q
- I X'=+X W $C(7)," ???" G ASK
- S $P(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON),"^")=X Q
- FIND ;
- S X=$P(X,"^",2),DIC="^DPT(",DIC(0)="QEM" D ^DIC I Y<0 S PSIVT="" Q
- S DFN=+Y D ENIV^PSJAC
- S WRD=$S($P(VAIN(4),U,2)]"":$P(VAIN(4),U,2),1:"Outpatient IV")
- 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
- 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
- Q:PSIVT'=""
- W $C(7),!!,"Patient and order number not found !" G A
- PSIVUWL ;BIR/RGY,PR-UPDATE DAILY WARD LIST ;01 OCT 96 / 9:42 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- START SET PSIVWARD=""
- SET Y=1
- WRITE !!,"Edit list for: TODAY//"
- READ X:DTIME
- IF '$TEST
- SET X="^"
- IF X=""
- SET X="T"
- IF X["^"
- GOTO Q
- IF X'["?"
- SET %DT="EXT"
- DO ^%DT
- +1 IF Y<1
- GOTO START
- +2 IF X["?"
- SET HELP="UWL"
- DO ^PSIVHLP
- SET X="?"
- DO ^%DT
- GOTO START
- +3 SET PSIVDT=Y\1
- DO ^PSIVWL1
- IF '$DATA(PSIVOD)!('$DATA(PSIVCD))
- GOTO Q
- BEG READ !!,"Enter a WARD, '^OUTPATIENT' or '^ALL': ",X:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET X="^"
- IF "^"[X
- GOTO Q
- IF X["?"
- SET HELP="ZW"
- DO ^PSIVHLP2
- KILL DIC
- SET DIC=42
- SET DIC(0)="QEM"
- DO ^DIC
- KILL DIC
- GOTO BEG
- +1 SET Y=$SELECT("^ALL"[X:"^ALL","^OUTPATIENT"[X:"^OPT IV",1:"")
- IF Y'=""
- WRITE $PIECE(Y,X,2)
- IF Y["^OPT IV"
- SET Y="^Outpatient IV"
- +2 IF Y=""
- KILL DIC
- SET D=0
- SET DIC(0)="QEM"
- SET DIC=42
- DO IX^DIC
- KILL DIC
- +3 IF Y<0
- GOTO BEG
- SET (WRD,WARD)=$PIECE(Y,"^",2)
- IF WRD="ALL"
- SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,""))
- IF WRD=""
- GOTO BEG
- WARD SET (X,PSIVT)=""
- FOR PSIV=0:0
- SET PSIVT=$ORDER(PSIVOD(PSIVT))
- IF PSIVT=""
- QUIT
- SET PSIVDT=PSIVOD(PSIVT)
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN))
- IF DFN=""
- QUIT
- DO ENIV^PSJAC
- DO UPD1
- IF X="^"
- GOTO BEG
- +1 IF WARD="ALL"
- SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD))
- IF WRD=""
- GOTO Q
- GOTO WARD
- Q KILL %DT,%T,D,DFN,DIC,I,ON,PSIV,PSIVDT,PSIVNOW,PSIVOD,PSIVCD,PSIVMT,PSIVT,PSIVWARD,PSCT,PSM,WARD,WRD,Z,ZTSK
- DO ENIVKV^PSGSETU
- QUIT
- UPD1 SET X="X"
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON))
- IF 'ON!(X="^")
- QUIT
- DO UPD
- +1 QUIT
- SETP SET Y=^PS(55,DFN,"IV",ON,0)
- FOR X=1:1:23
- SET P(X)=$PIECE(Y,"^",X)
- +1 QUIT
- WD XECUTE ^DD("DD")
- WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
- QUIT
- CODES SET X=$PIECE($PIECE(";"_$PIECE(Y,"^",3),";"_X_":",2),";")
- QUIT
- UPD IF '$DATA(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON))
- QUIT
- NEW ON55,PSIVAC
- SET PSIVAC="PRO"
- SET ON55=ON
- DO GT55^PSIVORFB
- DO ENNONUM^PSIVORV2(DFN,ON)
- ASK KILL DIC
- SET X="# of labels ^"_+^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON)_$SELECT(+^(ON)'=($LENGTH($PIECE(^(ON),"^",2)," ")-1):"*",1:"")_"^^DC ORDER,ON CALL,HOLD^QUX=+QUX!($E(QUX)=""^"")"
- DO ENQ^PSIV
- IF "^"[X
- QUIT
- IF $EXTRACT(X)="^"
- DO FIND
- IF PSIVT]""
- GOTO UPD
- QUIT
- +1 IF X["?"
- SET HELP="UWL"
- DO ^PSIVHLP1
- GOTO ASK
- +2 IF "DOH"[$EXTRACT(X)
- SET UWLFLAG="1.001"
- SET (PSIVAC,XX)=$EXTRACT(X)
- DO ^PSIVOPT
- KILL UWLFLAG,PSIVAC
- SET X=XX
- QUIT
- +3 IF X'=+X
- WRITE $CHAR(7)," ???"
- GOTO ASK
- +4 SET $PIECE(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON),"^")=X
- QUIT
- FIND ;
- +1 SET X=$PIECE(X,"^",2)
- SET DIC="^DPT("
- SET DIC(0)="QEM"
- DO ^DIC
- IF Y<0
- SET PSIVT=""
- QUIT
- +2 SET DFN=+Y
- DO ENIV^PSJAC
- +3 SET WRD=$SELECT($PIECE(VAIN(4),U,2)]"":$PIECE(VAIN(4),U,2),1:"Outpatient IV")
- A SET X="Enter order number #:^^^^QUX?.N"
- DO ENQ^PSIV
- SET ON=X
- IF "^"[X
- SET PSIVT=""
- IF "^"[X
- QUIT
- IF X["?"
- SET HELP="ONUWL"
- DO ^PSIVHLP1
- GOTO A
- +1 SET PSIVT=""
- FOR PSIV=0:0
- SET PSIVT=$ORDER(PSIVOD(PSIVT))
- IF PSIVT=""
- QUIT
- IF $DATA(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON))
- SET PSIVDT=PSIVOD(PSIVT)
- QUIT
- +2 IF PSIVT'=""
- QUIT
- +3 WRITE $CHAR(7),!!,"Patient and order number not found !"
- GOTO A
