PSGOEHA.m

PSGOEHA ;BIR/CML3-HOLD (OR UNHOLD) ALL ORDERS ;31 OCT 97 / 10:17 AM

 ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97

 ;

 ; Reference to ^PS(55 is supported by DBIA 2191

 ; Reference to ^PSSLOCK is supported by DBIA #2789

 ;

 I PSGOEHA,$P(ND,"^",9)="H" D HOK^PSGOEH0 Q

 I 'PSGOEHA,$P(ND,"^",9)'="H" D HOK^PSGOEH1

 Q

 ;

 ;

EN ;

 D ENCV^PSGSETU I $D(XQUIT) Q

 I 'PSJSYSU,'$P(PSJSYSP0,"^",4) W !!,"Sorry, but have not been authorized to use this option.",! S PSGP=0 G DONE

 K PSGACT D NOW^%DTC S PSGDT=%,PSHOEHA=1 D ENP^PSGGAO I PSGP'>0 W !,"No patient chosen." G DONE

 ;S X=PSGP_";DPT(" D LK^ORX2 G:'Y DONE

 N PSJLK S PSJLK=$$L^PSSLOCK(PSGP,1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) G DONE

 S PSGOEHA=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",7),1:0) W ! I PSGOEHA W !,"THIS PATIENT'S ORDERS ARE ON HOLD."

 F  W !,"DO YOU WANT TO ",$S('PSGOEHA:"PLACE",1:"TAKE")," THIS PATIENT'S ORDERS ",$S('PSGOEHA:"ON",1:"OFF OF")," HOLD" S %=1 D YN^DICN Q:%  D HM

 I %'=1 S PSGP=0 G DONE

 I 'PSGOEHA S DIE="^PS(55,",DA=PSGP,DR=62.11 W ! D ^DIE W !,"...a few moments, please..."

 F SD=$S(PSGOEHA:PSJPAD,1:PSGDT):0 S SD=$O(^PS(55,PSGP,5,"AUS",SD)) Q:'SD  F PSGORD=0:0 S PSGORD=$O(^PS(55,PSGP,5,"AUS",SD,PSGORD)) Q:'PSGORD  I $D(^PS(55,PSGP,5,PSGORD,0)) S ND=^(0),PSGND4=$G(^(4)) D PSGOEHA

 D:'$D(^PS(55,PSGP,0)) ENSET0^PSGNE3(PSGP) S $P(^PS(55,PSGP,5.1),"^",7)='PSGOEHA S:PSGOEHA $P(^(5.1),"^",10)="" W ".DONE!"

 ;S X=PSGP_";DPT(" D ULK^ORX2

 D UL^PSSLOCK(PSGP)

 ;

DONE ;

 I PSGP>0,$P(PSJSYSL,"^",2)]"" S PSGOP=PSGP D ENQL^PSGLW

 D ENKV^PSGSETU K D0,D1,ND,PSG,PSGOEHA,PSGOP,PSGORD,SD,ST,WD Q

 ;

HM ;

 W !!?2,"Enter a 'Y' to ",$S(PSGOEHA:"take off of",1:"place on")," hold all of this patient's active orders.  Enter",!,"an 'N' (or '^') to exit this option.",! Q

 ;

ENACH ;

 K DA,PSGACT S DA(1)=PSGP,PSJACSD=$S(PSGOEHA=1:+PSJPAD,1:PSGDT),PSJACHLD=1

 F PSJACSD=PSJACSD:0 S PSJACSD=$O(^PS(55,PSGP,5,"AUS",PSJACSD)) Q:'PSJACSD  F PSGORD=0:0 S (PSGORD,DA)=$O(^PS(55,PSGP,5,"AUS",PSJACSD,PSGORD)) Q:'PSGORD  I $D(^PS(55,PSGP,5,DA,0)) S ND=^(0),PSGND4=$G(^(4)) D PSGOEHA

 K PSJACHLD,PSJACSD Q

PSGOEHA   ;BIR/CML3-HOLD (OR UNHOLD) ALL ORDERS ;31 OCT 97 / 10:17 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PS(55 is supported by DBIA 2191

 +4       ; Reference to ^PSSLOCK is supported by DBIA #2789

 +5       ;

 +6        IF PSGOEHA

               IF $PIECE(ND,"^",9)="H"

                   DO HOK^PSGOEH0

                   QUIT 

 +7        IF 'PSGOEHA

               IF $PIECE(ND,"^",9)'="H"

                   DO HOK^PSGOEH1

 +8        QUIT 

 +9       ;

 +10      ;

EN        ;

 +1        DO ENCV^PSGSETU

           IF $DATA(XQUIT)

               QUIT 

 +2        IF 'PSJSYSU

               IF '$PIECE(PSJSYSP0,"^",4)

                   WRITE !!,"Sorry, but have not been authorized to use this option.",!

                   SET PSGP=0

                   GOTO DONE

 +3        KILL PSGACT

           DO NOW^%DTC

           SET PSGDT=%

           SET PSHOEHA=1

           DO ENP^PSGGAO

           IF PSGP'>0

               WRITE !,"No patient chosen."

               GOTO DONE

 +4       ;S X=PSGP_";DPT(" D LK^ORX2 G:'Y DONE

 +5        NEW PSJLK

           SET PSJLK=$$L^PSSLOCK(PSGP,1)

           IF 'PSJLK

               WRITE !,$CHAR(7),$PIECE(PSJLK,U,2)

               GOTO DONE

 +6        SET PSGOEHA=$SELECT($DATA(^PS(55,PSGP,5.1)):$PIECE(^(5.1),"^",7),1:0)

           WRITE !

           IF PSGOEHA

               WRITE !,"THIS PATIENT'S ORDERS ARE ON HOLD."

 +7        FOR 

               WRITE !,"DO YOU WANT TO ",$SELECT('PSGOEHA:"PLACE",1:"TAKE")," THIS PATIENT'S ORDERS ",$SELECT('PSGOEHA:"ON",1:"OFF OF")," HOLD"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

               DO HM

 +8        IF %'=1

               SET PSGP=0

               GOTO DONE

 +9        IF 'PSGOEHA

               SET DIE="^PS(55,"

               SET DA=PSGP

               SET DR=62.11

               WRITE !

               DO ^DIE

               WRITE !,"...a few moments, please..."

 +10       FOR SD=$SELECT(PSGOEHA:PSJPAD,1:PSGDT):0

               SET SD=$ORDER(^PS(55,PSGP,5,"AUS",SD))

               IF 'SD

                   QUIT 

               FOR PSGORD=0:0

                   SET PSGORD=$ORDER(^PS(55,PSGP,5,"AUS",SD,PSGORD))

                   IF 'PSGORD

                       QUIT 

                   IF $DATA(^PS(55,PSGP,5,PSGORD,0))

                       SET ND=^(0)

                       SET PSGND4=$GET(^(4))

                       DO PSGOEHA

 +11       IF '$DATA(^PS(55,PSGP,0))

               DO ENSET0^PSGNE3(PSGP)

           SET $PIECE(^PS(55,PSGP,5.1),"^",7)='PSGOEHA

           IF PSGOEHA

               SET $PIECE(^(5.1),"^",10)=""

           WRITE ".DONE!"

 +12      ;S X=PSGP_";DPT(" D ULK^ORX2

 +13       DO UL^PSSLOCK(PSGP)

 +14      ;

DONE      ;

 +1        IF PSGP>0

               IF $PIECE(PSJSYSL,"^",2)]""

                   SET PSGOP=PSGP

                   DO ENQL^PSGLW

 +2        DO ENKV^PSGSETU

           KILL D0,D1,ND,PSG,PSGOEHA,PSGOP,PSGORD,SD,ST,WD

           QUIT 

 +3       ;

HM        ;

 +1        WRITE !!?2,"Enter a 'Y' to ",$SELECT(PSGOEHA:"take off of",1:"place on")," hold all of this patient's active orders.  Enter",!,"an 'N' (or '^') to exit this option.",!

           QUIT 

 +2       ;

ENACH     ;

 +1        KILL DA,PSGACT

           SET DA(1)=PSGP

           SET PSJACSD=$SELECT(PSGOEHA=1:+PSJPAD,1:PSGDT)

           SET PSJACHLD=1

 +2        FOR PSJACSD=PSJACSD:0

               SET PSJACSD=$ORDER(^PS(55,PSGP,5,"AUS",PSJACSD))

               IF 'PSJACSD

                   QUIT 

               FOR PSGORD=0:0

                   SET (PSGORD,DA)=$ORDER(^PS(55,PSGP,5,"AUS",PSJACSD,PSGORD))

                   IF 'PSGORD

                       QUIT 

                   IF $DATA(^PS(55,PSGP,5,DA,0))

                       SET ND=^(0)

                       SET PSGND4=$GET(^(4))

                       DO PSGOEHA

 +3        KILL PSJACHLD,PSJACSD

           QUIT