- PSGOEH0 ;BIR/CML3-TAKE (OR MARK TO BE TAKEN) ORDERS OFF OF HOLD ;30 OCT 97 / 4:06 PM
- ;;5.0; INPATIENT MEDICATIONS ;**51**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ;
- S PSGND4=$G(^PS(55,PSGP,5,+PSGORD,4)) I 'PSJSYSU,'$P(PSJSYSP0,"^",4) D MARK G DONE
- F W !!,"Do you wish to take this order 'OFF OF HOLD'" S %=1 D YN^DICN Q:% D HM
- G DONE:%'=1
- S PSJNOO=$$ENNOO^PSJUTL5("H") S %=$S(PSJNOO<0:0,1:1)
- G HOK:%=1,DONE:'$P(PSGND4,"^",18)!'$P(PSGND4,"^",19)
- F W !!,"This order has been marked to be taken off of hold.",!,"Do you want to unmark it" S %=2 D YN^DICN Q:% D UM
- I %=1 K DA S $P(^PS(55,PSGP,5,+PSGORD,4),"^",22,24)="^^",PSGAL("C")=21085+PSJSYSU,DA(1)=PSGP,DA=+PSGORD D ^PSGAL5
- G DONE
- ;
- HOK ;
- I $P(PSGND4,"^",26),'$G(PSGORFG) W $C(7),!!,"This order was placed ON HOLD thru OE/RR, and can only be taken OFF HOLD",!,"thru OE/RR.",!! Q
- D NOW^%DTC S PSGDT=% W:'$D(PSJACHLD) "." S $P(PSGND4,"^",22,24)="1^^"_PSGDT,$P(PSGND4,"^",18,20)="^^"
- I $P(PSGND4,"^",26),$G(PSGORFG)>0 S $P(PSGND4,"^",26)=""
- I PSJSYSU,$P(PSGND4,"^",+PSJSYSU=1*2+1),$P(PSGND4,"^",15),'$P(PSGND4,"^",16) S $P(PSGND4,"^",15,17)="^^"
- I $S('$D(PSGOEAV):1,1:'PSGOEAV),PSJSYSU S $P(PSGND4,"^",+PSJSYSU,+PSJSYSU+1)=DUZ_"^"_PSGDT,$P(PSGND4,"^",+PSJSYSU=1+9)=1
- S EXPF=$S($D(^PS(55,PSGP,5,+PSGORD,2)):$P(^(2),"^",4)'>PSGDT,1:1),PSGAL("C")=PSJSYSU*10+8000,PSGALR=40,DIE="^PS(55,"_PSGP_",5,",DA=+PSGORD,DA(1)=PSGP,DR=$S($D(PSGACT):"15;",1:"")_"28////"_$S('EXPF:$P(PSGND4,"^",21),1:"E")
- W:'$D(PSJACHLD) "." D ^PSGAL5 W:'$D(PSJACHLD) "." D ^DIE W:'$D(PSJACHLD) "."
- S PSOC=$S('EXPF:"OE",1:"SC") D EN1^PSJHL2(PSGP,PSOC,PSGORD)
- S ^PS(55,"AUE",PSGP,+PSGORD)="" I PSJSYSL,$S(PSJSYSL<3:1,1:$P(PSGND4,"^",+PSJSYSU'=3+9)) S $P(^PS(55,PSGP,5,+PSGORD,7),"^",1,2)=PSGDT_"^H0",PSGTOL=2,PSGUOW=DUZ,PSGTOO=1 D ENL^PSGVDS
- I '$D(PSJACHLD) S PSGCANFL=-1
- ;
- DONE ;
- S:PSGND4]"" ^PS(55,PSGP,5,+PSGORD,4)=PSGND4
- I $D(PSJLMPRO) K DIR S DIR(0)="E" D ^DIR
- K DA,DIE,DP,DR,EXPF,H,ND,PSGAL,PSGALR,PSGND4,PSGTOL,PSGTOO,PSGUOW Q
- ;
- MARK ;
- I $P(PSGND4,"^",22),$P(PSGND4,"^",23) W $C(7),!!,"THIS ORDER HAS ALREADY BEEN UNMARKED." Q
- K DA S $P(PSGND4,"^",22,24)="1^"_DUZ_"^"_PSGDT,PSGAL("C")=13085,DA(1)=PSGP,DA=+PSGORD D ^PSGAL5 Q
- ;
- HM ;
- W !!?2,"Answer 'YES' to take this order off of hold. Answer 'NO' (or '^') if you do",!,"not wish to take this order off of hold." Q
- ;
- UM ;
- I H'?1."?" W $C(7)," ??" Q
- W !!,"Enter a 'Y' to unmark this order. Enter an 'N' (or '^') to leave it as is." Q
- ;
- ENOR ;
- S ND=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGND4=$G(^(4)) I 'PSJSYSU D MARK G DONE
- G HOK
- PSGOEH0 ;BIR/CML3-TAKE (OR MARK TO BE TAKEN) ORDERS OFF OF HOLD ;30 OCT 97 / 4:06 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**51**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191.
- +4 ;
- +5 SET PSGND4=$GET(^PS(55,PSGP,5,+PSGORD,4))
- IF 'PSJSYSU
- IF '$PIECE(PSJSYSP0,"^",4)
- DO MARK
- GOTO DONE
- +6 FOR
- WRITE !!,"Do you wish to take this order 'OFF OF HOLD'"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- DO HM
- +7 IF %'=1
- GOTO DONE
- +8 SET PSJNOO=$$ENNOO^PSJUTL5("H")
- SET %=$SELECT(PSJNOO<0:0,1:1)
- +9 IF %=1
- GOTO HOK
- IF '$PIECE(PSGND4,"^",18)!'$PIECE(PSGND4,"^",19)
- GOTO DONE
- +10 FOR
- WRITE !!,"This order has been marked to be taken off of hold.",!,"Do you want to unmark it"
- SET %=2
- DO YN^DICN
- IF %
- QUIT
- DO UM
- +11 IF %=1
- KILL DA
- SET $PIECE(^PS(55,PSGP,5,+PSGORD,4),"^",22,24)="^^"
- SET PSGAL("C")=21085+PSJSYSU
- SET DA(1)=PSGP
- SET DA=+PSGORD
- DO ^PSGAL5
- +12 GOTO DONE
- +13 ;
- HOK ;
- +1 IF $PIECE(PSGND4,"^",26)
- IF '$GET(PSGORFG)
- WRITE $CHAR(7),!!,"This order was placed ON HOLD thru OE/RR, and can only be taken OFF HOLD",!,"thru OE/RR.",!!
- QUIT
- +2 DO NOW^%DTC
- SET PSGDT=%
- IF '$DATA(PSJACHLD)
- WRITE "."
- SET $PIECE(PSGND4,"^",22,24)="1^^"_PSGDT
- SET $PIECE(PSGND4,"^",18,20)="^^"
- +3 IF $PIECE(PSGND4,"^",26)
- IF $GET(PSGORFG)>0
- SET $PIECE(PSGND4,"^",26)=""
- +4 IF PSJSYSU
- IF $PIECE(PSGND4,"^",+PSJSYSU=1*2+1)
- IF $PIECE(PSGND4,"^",15)
- IF '$PIECE(PSGND4,"^",16)
- SET $PIECE(PSGND4,"^",15,17)="^^"
- +5 IF $SELECT('$DATA(PSGOEAV):1,1:'PSGOEAV)
- IF PSJSYSU
- SET $PIECE(PSGND4,"^",+PSJSYSU,+PSJSYSU+1)=DUZ_"^"_PSGDT
- SET $PIECE(PSGND4,"^",+PSJSYSU=1+9)=1
- +6 SET EXPF=$SELECT($DATA(^PS(55,PSGP,5,+PSGORD,2)):$PIECE(^(2),"^",4)'>PSGDT,1:1)
- SET PSGAL("C")=PSJSYSU*10+8000
- SET PSGALR=40
- SET DIE="^PS(55,"_PSGP_",5,"
- SET DA=+PSGORD
- SET DA(1)=PSGP
- SET DR=$SELECT($DATA(PSGACT):"15;",1:"")_"28////"_$SELECT('EXPF:$PIECE(PSGND4,"^",21),1:"E")
- +7 IF '$DATA(PSJACHLD)
- WRITE "."
- DO ^PSGAL5
- IF '$DATA(PSJACHLD)
- WRITE "."
- DO ^DIE
- IF '$DATA(PSJACHLD)
- WRITE "."
- +8 SET PSOC=$SELECT('EXPF:"OE",1:"SC")
- DO EN1^PSJHL2(PSGP,PSOC,PSGORD)
- +9 SET ^PS(55,"AUE",PSGP,+PSGORD)=""
- IF PSJSYSL
- IF $SELECT(PSJSYSL<3:1,1:$PIECE(PSGND4,"^",+PSJSYSU'=3+9))
- SET $PIECE(^PS(55,PSGP,5,+PSGORD,7),"^",1,2)=PSGDT_"^H0"
- SET PSGTOL=2
- SET PSGUOW=DUZ
- SET PSGTOO=1
- DO ENL^PSGVDS
- +10 IF '$DATA(PSJACHLD)
- SET PSGCANFL=-1
- +11 ;
- DONE ;
- +1 IF PSGND4]""
- SET ^PS(55,PSGP,5,+PSGORD,4)=PSGND4
- +2 IF $DATA(PSJLMPRO)
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +3 KILL DA,DIE,DP,DR,EXPF,H,ND,PSGAL,PSGALR,PSGND4,PSGTOL,PSGTOO,PSGUOW
- QUIT
- +4 ;
- MARK ;
- +1 IF $PIECE(PSGND4,"^",22)
- IF $PIECE(PSGND4,"^",23)
- WRITE $CHAR(7),!!,"THIS ORDER HAS ALREADY BEEN UNMARKED."
- QUIT
- +2 KILL DA
- SET $PIECE(PSGND4,"^",22,24)="1^"_DUZ_"^"_PSGDT
- SET PSGAL("C")=13085
- SET DA(1)=PSGP
- SET DA=+PSGORD
- DO ^PSGAL5
- QUIT
- +3 ;
- HM ;
- +1 WRITE !!?2,"Answer 'YES' to take this order off of hold. Answer 'NO' (or '^') if you do",!,"not wish to take this order off of hold."
- QUIT
- +2 ;
- UM ;
- +1 IF H'?1."?"
- WRITE $CHAR(7)," ??"
- QUIT
- +2 WRITE !!,"Enter a 'Y' to unmark this order. Enter an 'N' (or '^') to leave it as is."
- QUIT
- +3 ;
- ENOR ;
- +1 SET ND=$GET(^PS(55,PSGP,5,+PSGORD,0))
- SET PSGND4=$GET(^(4))
- IF 'PSJSYSU
- DO MARK
- GOTO DONE
- +2 GOTO HOK
