GMRVORC0.m

GMRVORC0 ;HIRMFO/RM,MD-CANCEL AND PURGE ACTIONS FOR AN ORDER ;4/15/95

 ;;4.0;Vitals/Measurements;**6**;Apr 25, 1997

EN1 ; ENTRY FROM ORDER CANCEL ACTIONS

 I +ORSTS=2 W !,$C(7),?3,"Completed orders cannot be discontinued" Q

 D NOW^%DTC S ORETURN("ORSTOP")=%,ORETURN("ORSTS")=1,ORETURN("OREVENT")="" D RETURN^ORX K %,%H

 Q

EN2 ; ENTRY FROM ORDER PURGE ACTIONS

 S DA=ORIFN,DIK="^GMR(120.55," D ^DIK

 Q

ADS ;

 S GMRVDF=$P(GMRVAS,"^"),ORTX=$S($D(GMRVORD(2)):$P(GMRVORD(2),U,5),1:"")

RA W !,"Schedule:"_$S(GMRVDF="":"",1:" "_GMRVDF_"//")_" " R X:DTIME S:'$T X="^"

 I X="",GMRVDF'="" S X=GMRVDF

 I X="" W !?4,$C(7),"This response is required." G RA

 I "^^"[X S GMROUT=1 S:X="^^" DIROUT=1 Q

 S X=$$UP^XLFSTR(X)

 S PSJPP="GMRV",PSJX=X D ENSV^PSJEEU I '$D(PSJX) W !?4,$C(7),"INVALID SCHEDULE" G RA

 I $G(PSJX)?1"?".E G RA

 S X=PSJX G ADSL

YNNS W !?4,"You have selected a non-standard schedule.  Are you sure that ",!?4,"'",PSJX,"' is the schedule that you want" S %=1 D YN^DICN W:'% !?7,$C(7),"ANSWER YES OR NO" G YNNS:'%,RA:%=2 I %=-1 S GMROUT=1 S:%Y="^^" DIROUT=1 Q

ADSL S:$P(GMRVAS,"^")'=PSJX ORTX=$P(ORTX," - ")_" - "_PSJX S GMRVAS=PSJX_"^"_PSJAT_"^"_PSJM K PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY

 Q

GMRVORC0  ;HIRMFO/RM,MD-CANCEL AND PURGE ACTIONS FOR AN ORDER ;4/15/95

 +1       ;;4.0;Vitals/Measurements;**6**;Apr 25, 1997

EN1       ; ENTRY FROM ORDER CANCEL ACTIONS

 +1        IF +ORSTS=2

               WRITE !,$CHAR(7),?3,"Completed orders cannot be discontinued"

               QUIT 

 +2        DO NOW^%DTC

           SET ORETURN("ORSTOP")=%

           SET ORETURN("ORSTS")=1

           SET ORETURN("OREVENT")=""

           DO RETURN^ORX

           KILL %,%H

 +3        QUIT 

EN2       ; ENTRY FROM ORDER PURGE ACTIONS

 +1        SET DA=ORIFN

           SET DIK="^GMR(120.55,"

           DO ^DIK

 +2        QUIT 

ADS       ;

 +1        SET GMRVDF=$PIECE(GMRVAS,"^")

           SET ORTX=$SELECT($DATA(GMRVORD(2)):$PIECE(GMRVORD(2),U,5),1:"")

RA         WRITE !,"Schedule:"_$SELECT(GMRVDF="":"",1:" "_GMRVDF_"//")_" "

           READ X:DTIME

           IF '$TEST

               SET X="^"

 +1        IF X=""

               IF GMRVDF'=""

                   SET X=GMRVDF

 +2        IF X=""

               WRITE !?4,$CHAR(7),"This response is required."

               GOTO RA

 +3        IF "^^"[X

               SET GMROUT=1

               IF X="^^"

                   SET DIROUT=1

               QUIT 

 +4        SET X=$$UP^XLFSTR(X)

 +5        SET PSJPP="GMRV"

           SET PSJX=X

           DO ENSV^PSJEEU

           IF '$DATA(PSJX)

               WRITE !?4,$CHAR(7),"INVALID SCHEDULE"

               GOTO RA

 +6        IF $GET(PSJX)?1"?".E

               GOTO RA

 +7        SET X=PSJX

           GOTO ADSL

YNNS       WRITE !?4,"You have selected a non-standard schedule.  Are you sure that ",!?4,"'",PSJX,"' is the schedule that you want"

           SET %=1

           DO YN^DICN

           IF '%

               WRITE !?7,$CHAR(7),"ANSWER YES OR NO"

           IF '%

               GOTO YNNS

           IF %=2

               GOTO RA

           IF %=-1

               SET GMROUT=1

               IF %Y="^^"

                   SET DIROUT=1

               QUIT 

ADSL       IF $PIECE(GMRVAS,"^")'=PSJX

               SET ORTX=$PIECE(ORTX," - ")_" - "_PSJX

           SET GMRVAS=PSJX_"^"_PSJAT_"^"_PSJM

           KILL PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY

 +1        QUIT