- PSGOE9 ;BIR/CML3 - EDIT ORDERS IN 55 ; 7/6/11 9:45am
- ;;5.0;INPATIENT MEDICATIONS ;**11,47,50,72,110,111,188,192,207,113,223,269,315,338,352,366,380**;16 DEC 97;Build 10
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ; Reference to ^PS(50.7 is supported by DBIA# 2180
- ; Reference to ^PS(51.1 is supported by DBIA 2177
- ; Reference to ^PS(51.2 is supported by DBIA# 2178
- ; Reference to ^PS(55 is supported by DBIA #2191
- ; Reference to ^PSDRUG is supported by DBIA# 2192
- ;
- 101 ; Orderable Item (AKA primary drug)
- S MSG=0,PSGF2=101,PSGOOPD=PSGPD,PSGOOPDN=PSGPDN S:PSGOEEF(PSGF2) BACK="101^PSGOE9"
- I $G(PSGOROE1)'=1 S %=1 W !!,$C(7),"WARNING! If you change the drug of an order, the Dosage Ordered and Dispense",!,"Drug(s) are deleted." F W !,"Do you wish to continue" S %=2 D YN^DICN Q:% D DH^PSGOE8
- I %'=1 G DONE
- A101 ;
- I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
- . W !!?5,"Orderable Item may not be edited for active complex orders." D PAUSE^VALM1
- W !,"ORDERABLE ITEM: ",$S(PSGPD:PSGPDN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="",PSGPD S X=PSGPDN I PSGPD'=PSGPDN,$D(^PS(50.7,PSGPD,0)) G DONE
- I $S(X="@":1,X]"":0,1:'PSGPD) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,101) G A101
- I X?1."?" D ENHLP^PSGOEM(55.06,101)
- I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A101
- ;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
- K DIC,D S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("S")="I $$ENOISC^PSJUTL(Y,""U"")",D="B^C" D MIX^DIC1 K DIC,D I Y'>0 G A101
- I +Y=PSGPD G DONE ;PSJ*5*269 - No change to Orderable Item
- F S %=2 D DH^PSGOE8,YN^DICN Q:%
- I %'=1 G A101
- S (PSGPDRG,PSGPD)=+Y,(PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
- S PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
- S PSGPDNX=1,PSGPD=+Y,PSGPDN=$$OINAME^PSJLMUTL(PSGPD),PSGDO="" K ^PS(53.45,PSJSYSP,2) S X=$O(^PSDRUG("ASP",PSGPD,0)) I X,'$O(^(X)) S ^PS(53.45,PSJSYSP,2,0)="^53.4502P^1^1",^(1,0)=X,^PS(53.45,PSJSYSP,2,"B",X,1)="" G DONE
- D ENDRG^PSGOEF1(PSGPD,0)
- I $S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0) S PSGOROE1=1 G DONE
- ;G DONE
- ;
- 109 ; dosage ordered
- S MSG=0,PSGF2=109 S:$G(PSGOEEF(PSGF2)) BACK="109^PSGOE9"
- A109 ;
- I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
- . W !!?5,"Dosage may not be edited for active complex orders." D PAUSE^VALM1
- D EDITDOSE^PSJDOSE S X=PSGDO G DONE
- W !,"DOSAGE ORDERED: ",$S(PSGDO]"":PSGDO_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X=""&(PSGDO]"") S X=PSGDO
- I $$CHECK^PSGOE8(PSJSYSP)&(X="")&(PSGDO']"") W $C(7)," (Required) " G A109
- I $$CHECK^PSGOE8(PSJSYSP)&(X="@") W $C(7)," (Required)" G A109
- I '$$CHECK^PSGOE8(PSJSYSP)&(X="@") S PSGDO="" G DONE
- I X?1."?" D ENHLP^PSGOEM(55.06,109) G A109
- I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A109
- I $E(X,$L(X))=" " F S X=$E(X,1,$L(X)-1) Q:$E(X,$L(X))'=" "
- I $S(X?.E1C.E:1,$L(X)>20:1,X="":0,X["^":1,X?1.P:1,1:X=+X) W $C(7)," ",$S(X?1.P!(X=""):"(Required)",1:"??") D ENHLP^PSGOEM(55.06,109) G A109
- S PSGDO=X G DONE
- ;
- 3 ; med route
- N PSGS0XT
- S MSG=0,PSGF2=3 S:PSGOEEF(PSGF2) BACK="3^PSGOE9"
- A3 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
- . W !!?5,"Med Route may not be edited for active complex orders." D PAUSE^VALM1
- W !,"MED ROUTE: ",$S(PSGMR:PSGMRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="",PSGMR S X=PSGMRN I PSGMR'=PSGMRN,$D(^PS(51.2,PSGMR,0)) W " "_$P(^(0),"^",3) G DONE
- I $S(X="@":1,X]"":0,1:'PSGMR) W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,3) G A3
- I X="?" D MRSL^PSGOE4 ;*366
- I X?1."?" D ENHLP^PSGOEM(55.06,3)
- I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A3
- D CKMRSL^PSGOE4 ;*366
- K DIC S DIC="^PS(51.2,",DIC(0)="EMQZX",DIC("S")="I $P(^(0),""^"",4)" D ^DIC K DIC I Y'>0 G A3
- S PSGMR=+Y,PSGMRN=Y(0,0) G DONE
- ;
- 7 ; schedule type
- S MSG=0,PSGF2=7 S:PSGOEEF(PSGF2) BACK="7^PSGOE9"
- A7 I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
- . N X,Y,PARENT,P2ND S P2ND=$S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,.2)),1:$G(^PS(53.1,+PSGORD,.2))),PARENT=$P(P2ND,"^",8)
- . I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
- W !,"SCHEDULE TYPE: "_$S(PSGSTN]"":PSGSTN_"// ",1:"") R X:DTIME S X=$TR(X,"coprocf","COPROCF") I X="^"!'$T S PSGOEE=0 W $C(7) G DONE
- I X="" S X=PSGST,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN G DONE
- S:X="F" X="R"
- I ",?,??,C,O,OC,P,R,"'[(","_X_",") W " ??" G A7
- I $$PRNOK^PSGS0($G(PSGSCH)),X="C" W " ??" G A7
- I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,7) G A7
- I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A7
- ;*223 Don't allow O sched type on C orders
- I X="O",$$SCHTP^PSGOE8(PSGSCH)'="O" W !," SCHEDULE ("_PSGSCH_") is not a ONE TIME Schedule." G A7
- ;*269 Don't allow C sched type on O orders
- I X="C",$$SCHTP^PSGOE8(PSGSCH)="O" W !," SCHEDULE ("_PSGSCH_") is not a CONTINUOUS Schedule." G A7
- S PSGOST=PSGST
- S PSGST=X,PSGSTN=$$ENSTN^PSGMI(X) W:PSGSTN]"" " ",PSGSTN
- I X="P",$G(PSGAT)]"" S PSGOAT=PSGAT S PSGAT="" D
- .W !!,"NOTE: This change in schedule type also changes the ADMIN TIMES.",!
- .S MSG=1,PSGOEEF(39)=1
- .I $G(PSJNEWOE) D PAUSE^VALM1
- G DONE
- ;
- 26 ; schedule
- S MSG=0,PSGF2=26 S:PSGOEEF(PSGF2) BACK="26^PSGOE9"
- A26 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D G DONE
- . W !!?5,"Schedule may not be edited for active complex orders." D PAUSE^VALM1
- W !,"SCHEDULE: ",$S(PSGSCH]"":PSGSCH_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- S:X="" X=PSGSCH,PSGSCH="" I "@"[X W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
- S DOW=0 I $$DOW^PSIVUTL($$ENLU^PSGMI(X)) S DOW=1
- I X?1."?" D ENHLP^PSGOEM(55.06,26) G A26
- I $E(X)="^" D ENFF^PSGOE92 G:Y>0 @Y G A26
- ;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
- N PSJSLUP,PSGSFLG S PSJSLUP=1,PSGSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(55.06,26) G A26
- I X'=PSGSCH D
- . N XX
- . K PSGDUR,PSGRMVT,PSGRMV,ND2P1 ;*315 Removal times are tied to ADMIN times.
- . S PSGSCH=X
- . I PSGS0Y'=PSGAT S PSGAT=PSGS0Y ;Change so that any schedule change will adjust the type and default the admin times - DRF
- . D ;Change schedule type to agree with schedule
- .. I $G(DOW) S PSGST="C",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
- .. I (PSGSCH[" PRN")!(PSGSCH="PRN") I $$PRNOK^PSGS0(PSGSCH) S PSGOST=PSGST,PSGST="P",PSGSTN=$$ENSTN^PSGMI(PSGST) Q
- .. I '$G(PSGSCIEN),PSGSCH]"" S XX=+$O(^PS(51.1,"AC","PSJ",PSGSCH,0)),PSGSCIEN=XX ;PSGSCIEN should be set by call to EN^PSGS0
- .. S PSGST=$P($G(^PS(51.1,PSGSCIEN,0)),"^",5) I PSGST="D" S PSGST="C" ;DOW schedules are converted to Continuous
- .. S PSGSTN=$$ENSTN^PSGMI(PSGST)
- . W !!,"NOTE: This change in schedule also changes the ADMIN TIMES and SCHEDULE TYPE.",!
- . S MSG=1,PSGOEEF(39)=1
- . I ($G(PSGRF)>1),PSGST="C" D
- .. S PSGF2=41,BACK="41^PSGOE91",PSGOEEF(PSGF2)=1 D 41^PSGOE91 S BACK="26^PSGOE9",PSGF2=26,PSGOAT=PSGAT ;*315 Prompt for Admin to get DOA
- ..Q
- . I $G(PSJNEWOE) D PAUSE^VALM1
- I PSGST="O" S PSGOEEF(7)=1 I +$G(PSGRF) S PSGOEEF(34)=1 D 34^PSGOE91 S PSGF2=26
- ;
- DONE ;
- I PSGOEE G:'$G(PSGOEEF(PSGF2)) @BACK S PSGOEE=PSGOEEF(PSGF2)
- K F,F0,PSGF2 Q
- ;
- DEL ; delete entry
- W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOE9 7498 printed Mar 13, 2025@21:06:54 Page 2
- PSGOE9 ;BIR/CML3 - EDIT ORDERS IN 55 ; 7/6/11 9:45am
- +1 ;;5.0;INPATIENT MEDICATIONS ;**11,47,50,72,110,111,188,192,207,113,223,269,315,338,352,366,380**;16 DEC 97;Build 10
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ; Reference to ^PS(50.7 is supported by DBIA# 2180
- +4 ; Reference to ^PS(51.1 is supported by DBIA 2177
- +5 ; Reference to ^PS(51.2 is supported by DBIA# 2178
- +6 ; Reference to ^PS(55 is supported by DBIA #2191
- +7 ; Reference to ^PSDRUG is supported by DBIA# 2192
- +8 ;
- 101 ; Orderable Item (AKA primary drug)
- +1 SET MSG=0
- SET PSGF2=101
- SET PSGOOPD=PSGPD
- SET PSGOOPDN=PSGPDN
- if PSGOEEF(PSGF2)
- SET BACK="101^PSGOE9"
- +2 IF $GET(PSGOROE1)'=1
- SET %=1
- WRITE !!,$CHAR(7),"WARNING! If you change the drug of an order, the Dosage Ordered and Dispense",!,"Drug(s) are deleted."
- FOR
- WRITE !,"Do you wish to continue"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- DO DH^PSGOE8
- +3 IF %'=1
- GOTO DONE
- A101 ;
- +1 IF $GET(PSJORD)
- IF $GET(PSGP)
- IF $$COMPLEX^PSJOE(PSGP,PSJORD)
- SET PSGOEE=0
- Begin DoDot:1
- +2 WRITE !!?5,"Orderable Item may not be edited for active complex orders."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO DONE
- +3 WRITE !,"ORDERABLE ITEM: ",$SELECT(PSGPD:PSGPDN_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +4 IF X=""
- IF PSGPD
- SET X=PSGPDN
- IF PSGPD'=PSGPDN
- IF $DATA(^PS(50.7,PSGPD,0))
- GOTO DONE
- +5 IF $SELECT(X="@":1,X]"":0,1:'PSGPD)
- WRITE $CHAR(7)," (Required)"
- SET X="?"
- DO ENHLP^PSGOEM(55.06,101)
- GOTO A101
- +6 IF X?1."?"
- DO ENHLP^PSGOEM(55.06,101)
- +7 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE92
- if Y>0
- GOTO @Y
- GOTO A101
- +8 ;BHW;PSJ*5.0*192;Modify ^DIC call to use MIX^DIC and only B/C cross-references
- +9 KILL DIC,D
- SET DIC="^PS(50.7,"
- SET DIC(0)="EMQZ"
- SET DIC("S")="I $$ENOISC^PSJUTL(Y,""U"")"
- SET D="B^C"
- DO MIX^DIC1
- KILL DIC,D
- IF Y'>0
- GOTO A101
- +10 ;PSJ*5*269 - No change to Orderable Item
- IF +Y=PSGPD
- GOTO DONE
- +11 FOR
- SET %=2
- DO DH^PSGOE8
- DO YN^DICN
- if %
- QUIT
- +12 IF %'=1
- GOTO A101
- +13 SET (PSGPDRG,PSGPD)=+Y
- SET (PSGPDN,PSGPDRGN)=$$OINAME^PSJLMUTL(PSGPDRG)
- +14 SET PSGNEDFD=$$GTNEDFD^PSGOE7("U",PSGPDRG)
- +15 SET PSGPDNX=1
- SET PSGPD=+Y
- SET PSGPDN=$$OINAME^PSJLMUTL(PSGPD)
- SET PSGDO=""
- KILL ^PS(53.45,PSJSYSP,2)
- SET X=$ORDER(^PSDRUG("ASP",PSGPD,0))
- IF X
- IF '$ORDER(^(X))
- SET ^PS(53.45,PSJSYSP,2,0)="^53.4502P^1^1"
- SET ^(1,0)=X
- SET ^PS(53.45,PSJSYSP,2,"B",X,1)=""
- GOTO DONE
- +16 DO ENDRG^PSGOEF1(PSGPD,0)
- +17 IF $SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,$DATA(DIRUT):1,1:0)
- SET PSGOROE1=1
- GOTO DONE
- +18 ;G DONE
- +19 ;
- 109 ; dosage ordered
- +1 SET MSG=0
- SET PSGF2=109
- if $GET(PSGOEEF(PSGF2))
- SET BACK="109^PSGOE9"
- A109 ;
- +1 IF $GET(PSJORD)
- IF $GET(PSGP)
- IF $$COMPLEX^PSJOE(PSGP,PSJORD)
- SET PSGOEE=0
- Begin DoDot:1
- +2 WRITE !!?5,"Dosage may not be edited for active complex orders."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO DONE
- +3 DO EDITDOSE^PSJDOSE
- SET X=PSGDO
- GOTO DONE
- +4 WRITE !,"DOSAGE ORDERED: ",$SELECT(PSGDO]"":PSGDO_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +5 IF X=""&(PSGDO]"")
- SET X=PSGDO
- +6 IF $$CHECK^PSGOE8(PSJSYSP)&(X="")&(PSGDO']"")
- WRITE $CHAR(7)," (Required) "
- GOTO A109
- +7 IF $$CHECK^PSGOE8(PSJSYSP)&(X="@")
- WRITE $CHAR(7)," (Required)"
- GOTO A109
- +8 IF '$$CHECK^PSGOE8(PSJSYSP)&(X="@")
- SET PSGDO=""
- GOTO DONE
- +9 IF X?1."?"
- DO ENHLP^PSGOEM(55.06,109)
- GOTO A109
- +10 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE92
- if Y>0
- GOTO @Y
- GOTO A109
- +11 IF $EXTRACT(X,$LENGTH(X))=" "
- FOR
- SET X=$EXTRACT(X,1,$LENGTH(X)-1)
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- +12 IF $SELECT(X?.E1C.E:1,$LENGTH(X)>20:1,X="":0,X["^":1,X?1.P:1,1:X=+X)
- WRITE $CHAR(7)," ",$SELECT(X?1.P!(X=""):"(Required)",1:"??")
- DO ENHLP^PSGOEM(55.06,109)
- GOTO A109
- +13 SET PSGDO=X
- GOTO DONE
- +14 ;
- 3 ; med route
- +1 NEW PSGS0XT
- +2 SET MSG=0
- SET PSGF2=3
- if PSGOEEF(PSGF2)
- SET BACK="3^PSGOE9"
- A3 IF $GET(PSJORD)
- IF $GET(PSGP)
- IF $$COMPLEX^PSJOE(PSGP,PSJORD)
- SET PSGOEE=0
- Begin DoDot:1
- +1 WRITE !!?5,"Med Route may not be edited for active complex orders."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO DONE
- +2 WRITE !,"MED ROUTE: ",$SELECT(PSGMR:PSGMRN_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +3 IF X=""
- IF PSGMR
- SET X=PSGMRN
- IF PSGMR'=PSGMRN
- IF $DATA(^PS(51.2,PSGMR,0))
- WRITE " "_$PIECE(^(0),"^",3)
- GOTO DONE
- +4 IF $SELECT(X="@":1,X]"":0,1:'PSGMR)
- WRITE $CHAR(7)," (Required)"
- SET X="?"
- DO ENHLP^PSGOEM(55.06,3)
- GOTO A3
- +5 ;*366
- IF X="?"
- DO MRSL^PSGOE4
- +6 IF X?1."?"
- DO ENHLP^PSGOEM(55.06,3)
- +7 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE92
- if Y>0
- GOTO @Y
- GOTO A3
- +8 ;*366
- DO CKMRSL^PSGOE4
- +9 KILL DIC
- SET DIC="^PS(51.2,"
- SET DIC(0)="EMQZX"
- SET DIC("S")="I $P(^(0),""^"",4)"
- DO ^DIC
- KILL DIC
- IF Y'>0
- GOTO A3
- +10 SET PSGMR=+Y
- SET PSGMRN=Y(0,0)
- GOTO DONE
- +11 ;
- 7 ; schedule type
- +1 SET MSG=0
- SET PSGF2=7
- if PSGOEEF(PSGF2)
- SET BACK="7^PSGOE9"
- A7 IF $GET(PSGP)
- IF $GET(PSGORD)
- IF $$COMPLEX^PSJOE(PSGP,PSGORD)
- Begin DoDot:1
- +1 NEW X,Y,PARENT,P2ND
- SET P2ND=$SELECT(PSGORD["U":$GET(^PS(55,PSGP,5,+PSGORD,.2)),1:$GET(^PS(53.1,+PSGORD,.2)))
- SET PARENT=$PIECE(P2ND,"^",8)
- +2 IF PARENT
- DO FULL^VALM1
- WRITE !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order."
- DO CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
- End DoDot:1
- +3 WRITE !,"SCHEDULE TYPE: "_$SELECT(PSGSTN]"":PSGSTN_"// ",1:"")
- READ X:DTIME
- SET X=$TRANSLATE(X,"coprocf","COPROCF")
- IF X="^"!'$TEST
- SET PSGOEE=0
- WRITE $CHAR(7)
- GOTO DONE
- +4 IF X=""
- SET X=PSGST
- SET PSGSTN=$$ENSTN^PSGMI(X)
- if PSGSTN]""
- WRITE " ",PSGSTN
- GOTO DONE
- +5 if X="F"
- SET X="R"
- +6 IF ",?,??,C,O,OC,P,R,"'[(","_X_",")
- WRITE " ??"
- GOTO A7
- +7 IF $$PRNOK^PSGS0($GET(PSGSCH))
- IF X="C"
- WRITE " ??"
- GOTO A7
- +8 IF X="@"!(X?1."?")
- if X="@"
- WRITE $CHAR(7)," (Required)"
- if X="@"
- SET X="?"
- DO ENHLP^PSGOEM(55.06,7)
- GOTO A7
- +9 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE92
- if Y>0
- GOTO @Y
- GOTO A7
- +10 ;*223 Don't allow O sched type on C orders
- +11 IF X="O"
- IF $$SCHTP^PSGOE8(PSGSCH)'="O"
- WRITE !," SCHEDULE ("_PSGSCH_") is not a ONE TIME Schedule."
- GOTO A7
- +12 ;*269 Don't allow C sched type on O orders
- +13 IF X="C"
- IF $$SCHTP^PSGOE8(PSGSCH)="O"
- WRITE !," SCHEDULE ("_PSGSCH_") is not a CONTINUOUS Schedule."
- GOTO A7
- +14 SET PSGOST=PSGST
- +15 SET PSGST=X
- SET PSGSTN=$$ENSTN^PSGMI(X)
- if PSGSTN]""
- WRITE " ",PSGSTN
- +16 IF X="P"
- IF $GET(PSGAT)]""
- SET PSGOAT=PSGAT
- SET PSGAT=""
- Begin DoDot:1
- +17 WRITE !!,"NOTE: This change in schedule type also changes the ADMIN TIMES.",!
- +18 SET MSG=1
- SET PSGOEEF(39)=1
- +19 IF $GET(PSJNEWOE)
- DO PAUSE^VALM1
- End DoDot:1
- +20 GOTO DONE
- +21 ;
- 26 ; schedule
- +1 SET MSG=0
- SET PSGF2=26
- if PSGOEEF(PSGF2)
- SET BACK="26^PSGOE9"
- A26 IF $GET(PSJORD)
- IF $GET(PSGP)
- IF $$COMPLEX^PSJOE(PSGP,PSJORD)
- SET PSGOEE=0
- Begin DoDot:1
- +1 WRITE !!?5,"Schedule may not be edited for active complex orders."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO DONE
- +2 WRITE !,"SCHEDULE: ",$SELECT(PSGSCH]"":PSGSCH_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- if '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +3 if X=""
- SET X=PSGSCH
- SET PSGSCH=""
- IF "@"[X
- WRITE $CHAR(7)," (Required)"
- SET X="?"
- DO ENHLP^PSGOEM(55.06,26)
- GOTO A26
- +4 SET DOW=0
- IF $$DOW^PSIVUTL($$ENLU^PSGMI(X))
- SET DOW=1
- +5 IF X?1."?"
- DO ENHLP^PSGOEM(55.06,26)
- GOTO A26
- +6 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE92
- if Y>0
- GOTO @Y
- GOTO A26
- +7 ;BHW;PSJ*5*188;Add flag and IEN return variable for PSGS0 (PSJ*5*134), Highlight Admin Times if they changed.
- +8 NEW PSJSLUP,PSGSFLG
- SET PSJSLUP=1
- SET PSGSFLG=1
- DO EN^PSGS0
- IF '$DATA(X)
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(55.06,26)
- GOTO A26
- +9 IF X'=PSGSCH
- Begin DoDot:1
- +10 NEW XX
- +11 ;*315 Removal times are tied to ADMIN times.
- KILL PSGDUR,PSGRMVT,PSGRMV,ND2P1
- +12 SET PSGSCH=X
- +13 ;Change so that any schedule change will adjust the type and default the admin times - DRF
- IF PSGS0Y'=PSGAT
- SET PSGAT=PSGS0Y
- +14 ;Change schedule type to agree with schedule
- Begin DoDot:2
- +15 IF $GET(DOW)
- SET PSGST="C"
- SET PSGSTN=$$ENSTN^PSGMI(PSGST)
- QUIT
- +16 IF (PSGSCH[" PRN")!(PSGSCH="PRN")
- IF $$PRNOK^PSGS0(PSGSCH)
- SET PSGOST=PSGST
- SET PSGST="P"
- SET PSGSTN=$$ENSTN^PSGMI(PSGST)
- QUIT
- +17 ;PSGSCIEN should be set by call to EN^PSGS0
- IF '$GET(PSGSCIEN)
- IF PSGSCH]""
- SET XX=+$ORDER(^PS(51.1,"AC","PSJ",PSGSCH,0))
- SET PSGSCIEN=XX
- +18 ;DOW schedules are converted to Continuous
- SET PSGST=$PIECE($GET(^PS(51.1,PSGSCIEN,0)),"^",5)
- IF PSGST="D"
- SET PSGST="C"
- +19 SET PSGSTN=$$ENSTN^PSGMI(PSGST)
- End DoDot:2
- +20 WRITE !!,"NOTE: This change in schedule also changes the ADMIN TIMES and SCHEDULE TYPE.",!
- +21 SET MSG=1
- SET PSGOEEF(39)=1
- +22 IF ($GET(PSGRF)>1)
- IF PSGST="C"
- Begin DoDot:2
- +23 ;*315 Prompt for Admin to get DOA
- SET PSGF2=41
- SET BACK="41^PSGOE91"
- SET PSGOEEF(PSGF2)=1
- DO 41^PSGOE91
- SET BACK="26^PSGOE9"
- SET PSGF2=26
- SET PSGOAT=PSGAT
- +24 QUIT
- End DoDot:2
- +25 IF $GET(PSJNEWOE)
- DO PAUSE^VALM1
- End DoDot:1
- +26 IF PSGST="O"
- SET PSGOEEF(7)=1
- IF +$GET(PSGRF)
- SET PSGOEEF(34)=1
- DO 34^PSGOE91
- SET PSGF2=26
- +27 ;
- DONE ;
- +1 IF PSGOEE
- if '$GET(PSGOEEF(PSGF2))
- GOTO @BACK
- SET PSGOEE=PSGOEEF(PSGF2)
- +2 KILL F,F0,PSGF2
- QUIT
- +3 ;
- DEL ; delete entry
- +1 WRITE !?3,"SURE YOU WANT TO DELETE"
- SET %=0
- DO YN^DICN
- IF %'=1
- WRITE $CHAR(7)," <NOTHING DELETED>"
- +2 QUIT
