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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVORC0 1210 printed Dec 13, 2024@01:57:14 Page 2
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
