- 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 Mar 13, 2025@21:01:56 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
