PSGOE5.m

PSGOE5 ;BIR/CML3-UTILITIES FOR ORDER ENTRY ;19 OCT 94 / 4:50 PM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

PROF ;

 F  W !!,"Do you want a profile for ",$P(PSGP(0),"^") S %=2 D YN^DICN Q:%  W !!,"Enter 'YES' to print a profile of this patient's orders, including any new",!,"orders or changes.  Enter 'NO' (or '^') to continue without a profile."

 Q:%'=1  D ENL^PSGOU Q:"^"[PSGOL  N PSGSS,PSGSSH S (PSGOEPRF,PSGPRWD,PSGPRWDN,PSGPRWG,PSGPRWGN)="",PSGSS="P0",PSGPRA="N",PSGPRP="P" D ENDEV^PSGPR

 K PSGOEPRF Q

 ;

ENMAR ;

 D NOW^%DTC I $O(^PS(55,PSGP,5,"AUS",%)) F Q=%:0 S Q=$O(^PS(55,PSGP,5,"AUS",Q)) Q:'Q  F QQ=0:0 S QQ=$O(^PS(55,PSGP,5,"AUS",Q,QQ)) Q:'QQ  I $D(^PS(55,PSGP,5,QQ,4)),$P(^(4),"^",10) Q

 Q:'$T  F  W !!,"Do you want to print an MAR for this patient" S %=2 D YN^DICN Q:%  W !!,"  Enter 'YES' to print an MAR for this patient.  Enter 'NO' (or '^') to",!,"continue without an MAR."

 Q:%'=1  S DIR(0)="SOBA^7:7 DAY MAR;1:14 DAY MAR;2:24 HOUR MAR",DIR("A")="Select MAR to print: ",DIR("?",1)="Select one of the following:",DIR("?",2)="   7 DAY MAR",DIR("?",3)="   14 DAY MAR",DIR("?",4)="   24 HOUR MAR",DIR("?",5)=""

 S DIR("?")="Press RETURN (or enter '^') to abort this MAR print." W ! D ^DIR Q:"^"[Y

 N PSGSS,PSGSSH,PSGOP S PSGPAT=PSGP,PSGPAT(PSGP)="",PSGMARB=0,PSGSS="P" I $E(Y)'=2 S PSGMARDF=$S(Y=1:14,1:7) D ENOE^PSGMMAR Q

 D ENDATE^PSGMAR Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGOE5   1372     printed  Apr 09, 2024@21:09:36                                                                                                                                                                                                      Page 2

PSGOE5    ;BIR/CML3-UTILITIES FOR ORDER ENTRY ;19 OCT 94 / 4:50 PM

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

 +2       ;

PROF      ;

 +1        FOR 

               WRITE !!,"Do you want a profile for ",$PIECE(PSGP(0),"^")

               SET %=2

               DO YN^DICN

               if %

                   QUIT 

               WRITE !!,"Enter 'YES' to print a profile of this patient's orders, including any new",!,"orders or changes.  Enter 'NO' (or '^') to continue without a profile."

 +2        if %'=1

               QUIT 

           DO ENL^PSGOU

           if "^"[PSGOL

               QUIT 

           NEW PSGSS,PSGSSH

           SET (PSGOEPRF,PSGPRWD,PSGPRWDN,PSGPRWG,PSGPRWGN)=""

           SET PSGSS="P0"

           SET PSGPRA="N"

           SET PSGPRP="P"

           DO ENDEV^PSGPR

 +3        KILL PSGOEPRF

           QUIT 

 +4       ;

ENMAR     ;

 +1        DO NOW^%DTC

           IF $ORDER(^PS(55,PSGP,5,"AUS",%))

               FOR Q=%:0

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

                   if 'Q

                       QUIT 

                   FOR QQ=0:0

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

                       if 'QQ

                           QUIT 

                       IF $DATA(^PS(55,PSGP,5,QQ,4))

                           IF $PIECE(^(4),"^",10)

                               QUIT 

 +2        if '$TEST

               QUIT 

           FOR 

               WRITE !!,"Do you want to print an MAR for this patient"

               SET %=2

               DO YN^DICN

               if %

                   QUIT 

               WRITE !!,"  Enter 'YES' to print an MAR for this patient.  Enter 'NO' (or '^') to",!,"continue without an MAR."

 +3        if %'=1

               QUIT 

           SET DIR(0)="SOBA^7:7 DAY MAR;1:14 DAY MAR;2:24 HOUR MAR"

           SET DIR("A")="Select MAR to print: "

           SET DIR("?",1)="Select one of the following:"

           SET DIR("?",2)="   7 DAY MAR"

           SET DIR("?",3)="   14 DAY MAR"

           SET DIR("?",4)="   24 HOUR MAR"

           SET DIR("?",5)=""

 +4        SET DIR("?")="Press RETURN (or enter '^') to abort this MAR print."

           WRITE !

           DO ^DIR

           if "^"[Y

               QUIT 

 +5        NEW PSGSS,PSGSSH,PSGOP

           SET PSGPAT=PSGP

           SET PSGPAT(PSGP)=""

           SET PSGMARB=0

           SET PSGSS="P"

           IF $EXTRACT(Y)'=2

               SET PSGMARDF=$SELECT(Y=1:14,1:7)

               DO ENOE^PSGMMAR

               QUIT 

 +6        DO ENDATE^PSGMAR

           QUIT