- 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 Jan 18, 2025@02:58:26 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