PSJO3.m

PSJO3 ;BIR/CML3,PR-GET AND PRINT INPATIENT ORDERS ;08 MAR 95 / 1:12 PM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

ENGET ;

 S ENGET=1

 S PG=$D(PSGVWA),(ON,SLS)="",$P(SLS," -",15)="",TF=1

 S RB=$S(PSJPRB]"":PSJPRB,1:"* NF *")

 ;

ENNP I PSJON,'PSJDEV W $C(7) R !," '^' TO QUIT ",NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" *13,"                     ",*13,# Q

 I PSJON,PSJDEV D BOT

 ;

ENHEAD ; print new page, name, ssn, dob, and ward

 S PG=PG+1

 S PSJOPC="ALL" S PSJTEAM=$S($D(PSJSEL("TM")):1,1:0)

 D ENTRY^PSJHEAD(DFN,PSJOPC,PG,$G(PSJNARC),PSJTEAM)

 W:PG>1 !,LN2 K ENGET Q

 ;

BOT ; print name, ssn, and dob on bottom of page

 F Q=$Y:1:IOSL-4 W !

 W !,?2,$P(PSGP(0),"^"),?40,PSJPPID,?70,$E($P(PSJPDOB,"^",2),1,8) Q

 ;

ENL ;

 I $D(PSJEXTP) S PSJOL="L" Q

 F  W !!,"SHORT, LONG, or NO Profile?  ",$S('$D(PSJPWD):"SHORT",PSJPWD:"SHORT",1:"LONG"),"// " R PSJOL:DTIME W:'$T $C(7) S:'$T PSJOL="^" Q:PSJOL="^"  D LCHK Q:"^SLN"[PSJOL&($L(PSJOL)=1)

 Q

 ;

LCHK ;

 I PSJOL?1."?" D LM Q

 I PSJOL="" S PSJOL=$S('$D(PSJPWD):"S",PSJPWD:"S",1:"L") W $P("  SHORT^  LONG","^",PSJOL="L"+1) Q

 I PSJOL?.ANP,PSJOL?.E1L.E F Q=1:1:$L(PSJOL) I $E(PSJOL,Q)?.L S PSJOL=$E(PSJOL,1,Q-1)_$C($A(PSJOL,Q)-32)_$E(PSJOL,Q+1,$L(PSJOL))

 I PSJOL?.ANP F X="NO PROFILE","LONG","SHORT" I $P(X,PSJOL)="" W $P(X,PSJOL,2) S PSJOL=$E(PSJOL) Q

 W:'$T $C(7),"  ??" Q

 ;

LM D FULL^VALM1 W !!?2,"Enter 'SHORT' (or 'S', or press the RETURN key) to exclude this patient's",!,"discontinued and expired orders in the following profile.  Enter 'LONG' (or 'L') to include those orders."

 W "  Enter 'NO' (or 'N') to bypass the profile com-",!,"pletely.  Enter '^' if you wish to go no further with this patient." D PAUSE^PSJLMUTL Q

 ;

PENDIU ; Help when asking if pending med order is to be an IV or UD.

 W !!,?5,"Enter ""I"" to complete this as an IV Medication order.",!,?5,"Enter ""U"" to complete this as an Unit Dose Medication order.",!!

 Q

PSJO3     ;BIR/CML3,PR-GET AND PRINT INPATIENT ORDERS ;08 MAR 95 / 1:12 PM

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

 +2       ;

ENGET     ;

 +1        SET ENGET=1

 +2        SET PG=$DATA(PSGVWA)

           SET (ON,SLS)=""

           SET $PIECE(SLS," -",15)=""

           SET TF=1

 +3        SET RB=$SELECT(PSJPRB]"":PSJPRB,1:"* NF *")

 +4       ;

ENNP       IF PSJON

               IF 'PSJDEV

                   WRITE $CHAR(7)

                   READ !," '^' TO QUIT ",NP:DTIME

                   IF '$TEST

                       WRITE $CHAR(7)

                   IF '$TEST

                       SET NP="^"

                   IF NP'["^"

                       WRITE *13,"                     ",*13,#

                   QUIT 

 +1        IF PSJON

               IF PSJDEV

                   DO BOT

 +2       ;

ENHEAD    ; print new page, name, ssn, dob, and ward

 +1        SET PG=PG+1

 +2        SET PSJOPC="ALL"

           SET PSJTEAM=$SELECT($DATA(PSJSEL("TM")):1,1:0)

 +3        DO ENTRY^PSJHEAD(DFN,PSJOPC,PG,$GET(PSJNARC),PSJTEAM)

 +4        IF PG>1

               WRITE !,LN2

           KILL ENGET

           QUIT 

 +5       ;

BOT       ; print name, ssn, and dob on bottom of page

 +1        FOR Q=$Y:1:IOSL-4

               WRITE !

 +2        WRITE !,?2,$PIECE(PSGP(0),"^"),?40,PSJPPID,?70,$EXTRACT($PIECE(PSJPDOB,"^",2),1,8)

           QUIT 

 +3       ;

ENL       ;

 +1        IF $DATA(PSJEXTP)

               SET PSJOL="L"

               QUIT 

 +2        FOR 

               WRITE !!,"SHORT, LONG, or NO Profile?  ",$SELECT('$DATA(PSJPWD):"SHORT",PSJPWD:"SHORT",1:"LONG"),"// "

               READ PSJOL:DTIME

               IF '$TEST

                   WRITE $CHAR(7)

               IF '$TEST

                   SET PSJOL="^"

               IF PSJOL="^"

                   QUIT 

               DO LCHK

               IF "^SLN"[PSJOL&($LENGTH(PSJOL)=1)

                   QUIT 

 +3        QUIT 

 +4       ;

LCHK      ;

 +1        IF PSJOL?1."?"

               DO LM

               QUIT 

 +2        IF PSJOL=""

               SET PSJOL=$SELECT('$DATA(PSJPWD):"S",PSJPWD:"S",1:"L")

               WRITE $PIECE("  SHORT^  LONG","^",PSJOL="L"+1)

               QUIT 

 +3        IF PSJOL?.ANP

               IF PSJOL?.E1L.E

                   FOR Q=1:1:$LENGTH(PSJOL)

                       IF $EXTRACT(PSJOL,Q)?.L

                           SET PSJOL=$EXTRACT(PSJOL,1,Q-1)_$CHAR($ASCII(PSJOL,Q)-32)_$EXTRACT(PSJOL,Q+1,$LENGTH(PSJOL))

 +4        IF PSJOL?.ANP

               FOR X="NO PROFILE","LONG","SHORT"

                   IF $PIECE(X,PSJOL)=""

                       WRITE $PIECE(X,PSJOL,2)

                       SET PSJOL=$EXTRACT(PSJOL)

                       QUIT 

 +5        IF '$TEST

               WRITE $CHAR(7),"  ??"

           QUIT 

 +6       ;

LM         DO FULL^VALM1

           WRITE !!?2,"Enter 'SHORT' (or 'S', or press the RETURN key) to exclude this patient's",!,"discontinued and expired orders in the following profile.  Enter 'LONG' (or 'L') to include those orders."

 +1        WRITE "  Enter 'NO' (or 'N') to bypass the profile com-",!,"pletely.  Enter '^' if you wish to go no further with this patient."

           DO PAUSE^PSJLMUTL

           QUIT 

 +2       ;

PENDIU    ; Help when asking if pending med order is to be an IV or UD.

 +1        WRITE !!,?5,"Enter ""I"" to complete this as an IV Medication order.",!,?5,"Enter ""U"" to complete this as an Unit Dose Medication order.",!!

 +2        QUIT