GMRVORE2 ;HIRMFO/RM,MD-USER PROMPT ROUTINE ;12/10/96 11:47
;;4.0;Vitals/Measurements;;Apr 25, 1997
ASK ; ASK PROMPTS FOR AN ORDER GMRVORDF=START^STOP^ADM SCH^SPEC INSTRUCT
; WHERE IF THE PIECE="" THEN NO DEFAULT FOR PROMPT
; THE PIECE=VALUE THEN VALUE IS DEFAULT FOR PROMPT
; THE PIECE=~VALUE THEN VALUE TO BE STUFFED WITHOUT PROMPT
; RETURNS GMRVORAN=START^STOP^ADM SCH^ADM TIME^FREQ^COMM WITH
; THE ANSWERS, AND GMROUT.
;
I ORACTION=1,'GMRVNEW W !!,"Editing order ",$P(GMRVORD(2),U,5)
STDT ;
I GMRVSTRT?1"~".E S GMRVSTRT=$E(GMRVSTRT,2,99) G SCHED
I +GMRVSTRT S Y=GMRVSTRT D D^DIQ S %DT("B")=Y
S %DT("A")="Start DATE (TIME optional): ",Y=$S($P(GMRVORD(1),U,9)'=""&(ORACTION=2):$P(GMRVORD(1),U,9),$P(GMRVORD(2),U,6)="":"NOW",1:$P(GMRVORD(2),U,6))
X ^DD("DD") S:'$D(%DT("B")) %DT("B")=Y S %DT="AETX" S:$P($G(GMRVANSR),U,2)'="" %DT(0)=-$S($P(GMRVANSR,U,2)["~":$E($P(GMRVANSR,U,2),2,99),1:$P(GMRVANSR,U,2)) D ^%DT K %DT I +Y'>0 S GMROUT=1 Q
S GMRVSTRT=+Y
SCHED ;
I GMRVAS?1"~".E D G EDCM
. S PSJX=$E(GMRVAS,2,99),PSJPP="GMRV",PSJNE=1 D ENSV^PSJEEU
. S GMRVAS=$G(PSJX)_U_PSJAT_U_PSJM
. K PSJX,PSJPP,PSJM,PSJAT,PSJY,PSJTS,PSJAX,PSJW,PSJNE
. Q
D:ORACTION=1!(ORACTION=0) ADS^GMRVORC0 Q:GMROUT
EDCM ;
I GMRVCOM?1"~".E S GMRVCOM=$E(GMRVCOM,2,99) G STOP
S GMRVDF=$P(GMRVCOM,"^") W !,"Special Instructions: "_$S(GMRVDF'="":GMRVDF_"// ",1:"") R GMRVCOM:DTIME S:'$T GMRVCOM="^^" S:$T&(GMRVDF'="")&(GMRVCOM="") GMRVCOM=GMRVDF S $P(GMRVORAN,U,6)=GMRVCOM
I "^^"[GMRVCOM S:$L(GMRVCOM) GMROUT=1 S:GMRVCOM="^^" DIROUT=1 G:'$L(GMRVCOM) STOP Q
DCM I GMRVCOM="@",GMRVDF'="" S %="" W !,?4,$C(7),"Are you sure you want to delete these SPECIAL INSTRUCTIONS" D YN^DICN G:%=2 EDCM W:%=0 !,?5,$C(7),"Answer YES or NO" G:%=0 DCM I %=1!(%=-1) S:%=-1 GMROUT=1 S:%=1 GMRVCOM="@" Q
I '($L(GMRVCOM)>2&($L(GMRVCOM)<101)&(GMRVCOM?1AN.E)) W:GMRVCOM'?1"?".E $C(7)," ??" S:GMRVCOM?2"?".E XQH="GMRV-ORD. ADDL INFO" D:GMRVCOM?2"?".E EN^XQH W:GMRVCOM?1"?".E !!,?3,"Answer must be 3-100 characters in length" S GMRVCOM="" G EDCM
STOP ;
I GMRVSTOP?1"~".E S GMRVSTOP=$E(GMRVSTOP,2,99) Q
I +GMRVSTOP S Y=GMRVSTOP D D^DIQ S %DT("B")=Y
S %DT("A")="Stop DATE (TIME optional): " I $S((ORACTION=2!($P(GMRVORD(1),U,9)=""))&$D(^GMRD(120.57,1,0)):1,1:0) S X1=GMRVSTRT,X2=+$P(^GMRD(120.57,1,0),U,2) D C^%DTC
S Y=$S(ORACTION'=2&($P(GMRVORD(1),U,9)'=""):$P(GMRVORD(1),U,9),'$D(^GMRD(120.57,1,0)):GMRVSTRT,1:X)
X ^DD("DD") S:'$D(%DT("B")) %DT("B")=Y S %DT="AETX" S:$D(GMRVANSR) %DT(0)=+$S($P(GMRVANSR,U)["~":$E($P(GMRVANSR,U),2,99),1:$P(GMRVANSR,U)) D ^%DT K %DT I +Y'>0 S GMROUT=1 Q
I Y<GMRVSTRT W !,?3,$C(7),"THE STOP DATE CANNOT BE EARLIER THAN THE START DATE" G STOP
S GMRVSTOP=+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVORE2 2746 printed Nov 22, 2024@17:07:26 Page 2
GMRVORE2 ;HIRMFO/RM,MD-USER PROMPT ROUTINE ;12/10/96 11:47
+1 ;;4.0;Vitals/Measurements;;Apr 25, 1997
ASK ; ASK PROMPTS FOR AN ORDER GMRVORDF=START^STOP^ADM SCH^SPEC INSTRUCT
+1 ; WHERE IF THE PIECE="" THEN NO DEFAULT FOR PROMPT
+2 ; THE PIECE=VALUE THEN VALUE IS DEFAULT FOR PROMPT
+3 ; THE PIECE=~VALUE THEN VALUE TO BE STUFFED WITHOUT PROMPT
+4 ; RETURNS GMRVORAN=START^STOP^ADM SCH^ADM TIME^FREQ^COMM WITH
+5 ; THE ANSWERS, AND GMROUT.
+6 ;
+7 IF ORACTION=1
IF 'GMRVNEW
WRITE !!,"Editing order ",$PIECE(GMRVORD(2),U,5)
STDT ;
+1 IF GMRVSTRT?1"~".E
SET GMRVSTRT=$EXTRACT(GMRVSTRT,2,99)
GOTO SCHED
+2 IF +GMRVSTRT
SET Y=GMRVSTRT
DO D^DIQ
SET %DT("B")=Y
+3 SET %DT("A")="Start DATE (TIME optional): "
SET Y=$SELECT($PIECE(GMRVORD(1),U,9)'=""&(ORACTION=2):$PIECE(GMRVORD(1),U,9),$PIECE(GMRVORD(2),U,6)="":"NOW",1:$PIECE(GMRVORD(2),U,6))
+4 XECUTE ^DD("DD")
if '$DATA(%DT("B"))
SET %DT("B")=Y
SET %DT="AETX"
if $PIECE($GET(GMRVANSR),U,2)'=""
SET %DT(0)=-$SELECT($PIECE(GMRVANSR,U,2)["~":$EXTRACT($PIECE(GMRVANSR,U,2),2,99),1:$PIECE(GMRVANSR,U,2))
DO ^%DT
KILL %DT
IF +Y'>0
SET GMROUT=1
QUIT
+5 SET GMRVSTRT=+Y
SCHED ;
+1 IF GMRVAS?1"~".E
Begin DoDot:1
+2 SET PSJX=$EXTRACT(GMRVAS,2,99)
SET PSJPP="GMRV"
SET PSJNE=1
DO ENSV^PSJEEU
+3 SET GMRVAS=$GET(PSJX)_U_PSJAT_U_PSJM
+4 KILL PSJX,PSJPP,PSJM,PSJAT,PSJY,PSJTS,PSJAX,PSJW,PSJNE
+5 QUIT
End DoDot:1
GOTO EDCM
+6 if ORACTION=1!(ORACTION=0)
DO ADS^GMRVORC0
if GMROUT
QUIT
EDCM ;
+1 IF GMRVCOM?1"~".E
SET GMRVCOM=$EXTRACT(GMRVCOM,2,99)
GOTO STOP
+2 SET GMRVDF=$PIECE(GMRVCOM,"^")
WRITE !,"Special Instructions: "_$SELECT(GMRVDF'="":GMRVDF_"// ",1:"")
READ GMRVCOM:DTIME
if '$TEST
SET GMRVCOM="^^"
if $TEST&(GMRVDF'="")&(GMRVCOM="")
SET GMRVCOM=GMRVDF
SET $PIECE(GMRVORAN,U,6)=GMRVCOM
+3 IF "^^"[GMRVCOM
if $LENGTH(GMRVCOM)
SET GMROUT=1
if GMRVCOM="^^"
SET DIROUT=1
if '$LENGTH(GMRVCOM)
GOTO STOP
QUIT
DCM IF GMRVCOM="@"
IF GMRVDF'=""
SET %=""
WRITE !,?4,$CHAR(7),"Are you sure you want to delete these SPECIAL INSTRUCTIONS"
DO YN^DICN
if %=2
GOTO EDCM
if %=0
WRITE !,?5,$CHAR(7),"Answer YES or NO"
if %=0
GOTO DCM
IF %=1!(%=-1)
if %=-1
SET GMROUT=1
if %=1
SET GMRVCOM="@"
QUIT
+1 IF '($LENGTH(GMRVCOM)>2&($LENGTH(GMRVCOM)<101)&(GMRVCOM?1AN.E))
if GMRVCOM'?1"?".E
WRITE $CHAR(7)," ??"
if GMRVCOM?2"?".E
SET XQH="GMRV-ORD. ADDL INFO"
if GMRVCOM?2"?".E
DO EN^XQH
if GMRVCOM?1"?".E
WRITE !!,?3,"Answer must be 3-100 characters in length"
SET GMRVCOM=""
GOTO EDCM
STOP ;
+1 IF GMRVSTOP?1"~".E
SET GMRVSTOP=$EXTRACT(GMRVSTOP,2,99)
QUIT
+2 IF +GMRVSTOP
SET Y=GMRVSTOP
DO D^DIQ
SET %DT("B")=Y
+3 SET %DT("A")="Stop DATE (TIME optional): "
IF $SELECT((ORACTION=2!($PIECE(GMRVORD(1),U,9)=""))&$DATA(^GMRD(120.57,1,0)):1,1:0)
SET X1=GMRVSTRT
SET X2=+$PIECE(^GMRD(120.57,1,0),U,2)
DO C^%DTC
+4 SET Y=$SELECT(ORACTION'=2&($PIECE(GMRVORD(1),U,9)'=""):$PIECE(GMRVORD(1),U,9),'$DATA(^GMRD(120.57,1,0)):GMRVSTRT,1:X)
+5 XECUTE ^DD("DD")
if '$DATA(%DT("B"))
SET %DT("B")=Y
SET %DT="AETX"
if $DATA(GMRVANSR)
SET %DT(0)=+$SELECT($PIECE(GMRVANSR,U)["~":$EXTRACT($PIECE(GMRVANSR,U),2,99),1:$PIECE(GMRVANSR,U))
DO ^%DT
KILL %DT
IF +Y'>0
SET GMROUT=1
QUIT
+6 IF Y<GMRVSTRT
WRITE !,?3,$CHAR(7),"THE STOP DATE CANNOT BE EARLIER THAN THE START DATE"
GOTO STOP
+7 SET GMRVSTOP=+Y
+8 QUIT
