- PSGOE0 ;BIR/CML3-PROFILE AND ORDER ENTRY ;25 SEP 97 / 7:42 AM
- ;;5.0; INPATIENT MEDICATIONS ;**110**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA #2191.
- ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- ;
- START ; print orders
- W:X]"" $P("^PROFILE",X,2) D ENL^PSGOU G:PSGOL="^" DONE G:PSGOL="N" ASK K PSGPR S PSGOEAV=0,PSJNARC=1,PSJOPC="UD" D ^PSGO I 'PSGON G ASK
- ;
- ENVO ; view/act on orders
- S PSGLMT=PSGON D ENASR^PSGON G:"^"[X ASK G:X["^^" DONE
- I X="D" D EN^PSGOECS G:'$D(X) ENVO S X="^PROFILE" G START
- I X="R" D EN^PSGOERS G:'$D(X) ENVO S X="^PROFILE" G START
- I X="V" D EN^PSGOEVS G:'$D(X) ENVO S X="^PROFILE" G START
- I X="F" D EN^PSGOESF G:'$D(X) ENVO S X="^PROFILE" G START
- I PSGODDD S PSGOEA=""
- I F PSGOE=1:1:PSGODDD F PSGOE1=1:1:$L(PSGODDD(PSGOE),",")-1 S PSGOE2=$P(PSGODDD(PSGOE),",",PSGOE1) D EN1^PSGVW K CONT D Q:'$D(PSGODDD)!($G(PSGOEA)["^")
- .Q:$G(PSGOEA)["^" I $D(PSGPRF) W !!,"Press RETURN to continue: " R CONT:DTIME W @IOF S:CONT["^" PSGOEA="^"
- .D ^PSGOE1:'$D(PSGPRF) Q:$G(PSGOEA)["^" I $D(PSGPRF),PSGORD["N",'$D(CONT) K DIR S DIR(0)="E" W ! D ^DIR Q:X["^"!$D(DIRUT)
- ;
- ;
- ASK ; new orders entered here
- K ^TMP("PSJON",$J),DIR,DIROUT,DIRUT,DRGI,DTOUT,DUOUT,PRI,PSGLMT,PSGODDD,PSGOE1,PSGOE2,PSGOEA,PSGOEE,PSGON,PSGONC,PSGONF,PSGONR,PSGONV Q:$D(PSGPRF) K PSGCANFL,PSGOL Q:'PSJPCAF
- F W !!,"New order(s) for ",$P(PSGP(0),"^"),"? Y// " R X:DTIME W:'$T $C(7) S:'$T X="^" S:X="" X="Y" G:$P("^PROFILE",X)=""&(X'="^") START Q:"^YyNn"[X D:X?1."?" AM W:X'?1."?" $C(7)," ??"
- W:"Nn"[X " (NO)" G:"^Nn"[X DONE W " (YES)"
- I '$P(PSJSYSU,";",2) S PR=$P($G(^PS(55,PSGP,5.1)),"^",2) I PR D
- .S X=$G(^VA(200,PR,"PS")) I $S('X:1,'$P(X,"^",4):0,1:DT'>$P(X,"^",4)) D:'$D(^PS(55,PSGP,0)) ENSET0^PSGNE3(PSGP) S $P(^PS(55,PSGP,5.1),"^",2)="",PR=""
- S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU,PSGOEDMR=$O(^PS(51.2,"B","ORAL",0)),PSGOEPR=$S($P(PSJSYSU,";",2):DUZ,1:PR) S:'PSGOEPR PSGOEPR=PSJPTSP
- ;
- DRG ;
- D ^PSGOE7 G:Y<0 DONE G:$P("^PROFILE",X)="" START I X?1"S."1.E D ^PSGOES G DRG
- W ! D ^PSGOE3:$P(PSJSYSP0,"^",12),^PSGOE4:'$P(PSJSYSP0,"^",12) K PSGOEE,PSGOEOS D:$D(Y) ^PSGOETO G DRG
- ;
- DONE ;
- K DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGNEWDT
- K PSGOEPR,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJNARC,PSJOPC
- Q
- ;
- AM ;
- W !!?2,"Answer 'YES' (or press the RETURN key) to enter new UNIT DOSE orders for this",!,"patient. Answer 'NO' (or '^') if there are no new orders for this patient." Q
- PSGOE0 ;BIR/CML3-PROFILE AND ORDER ENTRY ;25 SEP 97 / 7:42 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**110**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA #2191.
- +4 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- +5 ;
- START ; print orders
- +1 IF X]""
- WRITE $PIECE("^PROFILE",X,2)
- DO ENL^PSGOU
- IF PSGOL="^"
- GOTO DONE
- IF PSGOL="N"
- GOTO ASK
- KILL PSGPR
- SET PSGOEAV=0
- SET PSJNARC=1
- SET PSJOPC="UD"
- DO ^PSGO
- IF 'PSGON
- GOTO ASK
- +2 ;
- ENVO ; view/act on orders
- +1 SET PSGLMT=PSGON
- DO ENASR^PSGON
- IF "^"[X
- GOTO ASK
- IF X["^^"
- GOTO DONE
- +2 IF X="D"
- DO EN^PSGOECS
- IF '$DATA(X)
- GOTO ENVO
- SET X="^PROFILE"
- GOTO START
- +3 IF X="R"
- DO EN^PSGOERS
- IF '$DATA(X)
- GOTO ENVO
- SET X="^PROFILE"
- GOTO START
- +4 IF X="V"
- DO EN^PSGOEVS
- IF '$DATA(X)
- GOTO ENVO
- SET X="^PROFILE"
- GOTO START
- +5 IF X="F"
- DO EN^PSGOESF
- IF '$DATA(X)
- GOTO ENVO
- SET X="^PROFILE"
- GOTO START
- +6 IF PSGODDD
- SET PSGOEA=""
- +7 IF $TEST
- FOR PSGOE=1:1:PSGODDD
- FOR PSGOE1=1:1:$LENGTH(PSGODDD(PSGOE),",")-1
- SET PSGOE2=$PIECE(PSGODDD(PSGOE),",",PSGOE1)
- DO EN1^PSGVW
- KILL CONT
- Begin DoDot:1
- +8 IF $GET(PSGOEA)["^"
- QUIT
- IF $DATA(PSGPRF)
- WRITE !!,"Press RETURN to continue: "
- READ CONT:DTIME
- WRITE @IOF
- IF CONT["^"
- SET PSGOEA="^"
- +9 IF '$DATA(PSGPRF)
- DO ^PSGOE1
- IF $GET(PSGOEA)["^"
- QUIT
- IF $DATA(PSGPRF)
- IF PSGORD["N"
- IF '$DATA(CONT)
- KILL DIR
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- IF X["^"!$DATA(DIRUT)
- QUIT
- End DoDot:1
- IF '$DATA(PSGODDD)!($GET(PSGOEA)["^")
- QUIT
- +10 ;
- +11 ;
- ASK ; new orders entered here
- +1 KILL ^TMP("PSJON",$JOB),DIR,DIROUT,DIRUT,DRGI,DTOUT,DUOUT,PRI,PSGLMT,PSGODDD,PSGOE1,PSGOE2,PSGOEA,PSGOEE,PSGON,PSGONC,PSGONF,PSGONR,PSGONV
- IF $DATA(PSGPRF)
- QUIT
- KILL PSGCANFL,PSGOL
- IF 'PSJPCAF
- QUIT
- +2 FOR
- WRITE !!,"New order(s) for ",$PIECE(PSGP(0),"^"),"? Y// "
- READ X:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET X="^"
- IF X=""
- SET X="Y"
- IF $PIECE("^PROFILE",X)=""&(X'="^")
- GOTO START
- IF "^YyNn"[X
- QUIT
- IF X?1."?"
- DO AM
- IF X'?1."?"
- WRITE $CHAR(7)," ??"
- +3 IF "Nn"[X
- WRITE " (NO)"
- IF "^Nn"[X
- GOTO DONE
- WRITE " (YES)"
- +4 IF '$PIECE(PSJSYSU,";",2)
- SET PR=$PIECE($GET(^PS(55,PSGP,5.1)),"^",2)
- IF PR
- Begin DoDot:1
- +5 SET X=$GET(^VA(200,PR,"PS"))
- IF $SELECT('X:1,'$PIECE(X,"^",4):0,1:DT'>$PIECE(X,"^",4))
- IF '$DATA(^PS(55,PSGP,0))
- DO ENSET0^PSGNE3(PSGP)
- SET $PIECE(^PS(55,PSGP,5.1),"^",2)=""
- SET PR=""
- End DoDot:1
- +6 SET PSGOEAV=$PIECE(PSJSYSP0,"^",9)&PSJSYSU
- SET PSGOEDMR=$ORDER(^PS(51.2,"B","ORAL",0))
- SET PSGOEPR=$SELECT($PIECE(PSJSYSU,";",2):DUZ,1:PR)
- IF 'PSGOEPR
- SET PSGOEPR=PSJPTSP
- +7 ;
- DRG ;
- +1 DO ^PSGOE7
- IF Y<0
- GOTO DONE
- IF $PIECE("^PROFILE",X)=""
- GOTO START
- IF X?1"S."1.E
- DO ^PSGOES
- GOTO DRG
- +2 WRITE !
- IF $PIECE(PSJSYSP0,"^",12)
- DO ^PSGOE3
- IF '$PIECE(PSJSYSP0,"^",12)
- DO ^PSGOE4
- KILL PSGOEE,PSGOEOS
- IF $DATA(Y)
- DO ^PSGOETO
- GOTO DRG
- +3 ;
- DONE ;
- +1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSG,PSGDL,PSGDLS,PSGDO,PSGDRG,PSGDRGN,PSGFD,PSGHSM,PSGMR,PSGMRN,PSGNEDFD,PSGNEFD,PSGNESD,PSGNEWDT
- +2 KILL PSGOEPR,PSGOES,PSGOPR,PSGORD,PSGOROE1,PSGPR,PSGPRN,PSGS0XT,PSGS0Y,PSGSCH,PSGSD,PSGSI,PSGSM,PSGST,PSGSTN,PSGUD,PSGX,PSJNARC,PSJOPC
- +3 QUIT
- +4 ;
- AM ;
- +1 WRITE !!?2,"Answer 'YES' (or press the RETURN key) to enter new UNIT DOSE orders for this",!,"patient. Answer 'NO' (or '^') if there are no new orders for this patient."
- QUIT
