- ORWNSS ;JDL/SLC Non-Standard Schedule ;11/24/06
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,243**;Dec 17, 1997;Build 242
- NSSOK(ORY,ORX) ;Check availability for Non-standard schedule
- N VAL
- S VAL=$$PATCH^XPDUTL("PSJ*5.0*113")
- S ORY=VAL
- Q
- NSSMSG(ORY) ;Retrieve site message for None-Standard Schedule
- N ORSRV
- S ORY=""
- S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
- S ORY=$$GET^XPAR("SRV.`"_+$G(ORSRV)_"^DIV^SYS","ORWIM NSS MESSAGE",1,"I")
- Q
- VALSCH(ORY,ORID) ;Validate a schedule for IM order; 1: valid, 0: invalid
- ;
- S ORY=0
- Q:'$D(^OR(100,+ORID,0))
- N IPGRP,ORGRP
- S IPGRP=$O(^ORD(100.98,"B","UD RX",0))
- S ORGRP=$P($G(^OR(100,+ORID,0)),U,11)
- I ORGRP'=IPGRP S ORY=1 Q
- N SCH,IDX,SCHVAL S (SCH,SCHVAL)=""
- I $D(^OR(100,+ORID,4.5,"ID","SCHEDULE")) S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
- I SCH="" S ORY=1 Q
- S IDX=0 F S IDX=$O(^OR(100,+ORID,4.5,SCH,IDX)) Q:'IDX D
- . S SCHVAL=$G(^OR(100,+ORID,4.5,SCH,IDX))
- . Q:'$L(SCHVAL)
- . D VALSCH^ORWDPS33(.ORY,SCHVAL,"I")
- . I ORY=0 Q
- Q
- QOSCH(ORY,QOID) ;Validate IM QO schedule
- ;QOID: Inpt Pharmacy QO
- S ORY=""
- N QOSCH,SCHID,SCHVAL,RST
- S SCHID=$O(^ORD(101.41,"B","OR GTX SCHEDULE",0))
- S (QOSCH,SCHVAL)="",RST=1
- I '$D(^ORD(101.41,+QOID,6,"D",SCHID)) S ORY="schedule is not defined." Q
- S QOSCH=$O(^ORD(101.41,+QOID,6,"D",SCHID,0))
- I 'QOSCH S ORY="schedule is not defined." Q
- N IDX S IDX=0
- F S IDX=$O(^ORD(101.41,+QOID,6,QOSCH,IDX)) Q:'IDX!('RST) D
- . S SCHVAL=^ORD(101.41,+QOID,6,QOSCH,IDX)
- . I $$UP^XLFSTR(SCHVAL)="OTHER" S ORY="OTHER" Q
- . D VALSCH^ORWDPS33(.RST,SCHVAL,"I")
- . I RST=0 S ORY="This quick order contains a non-standard administration schedule." Q
- Q
- CHKSCH(ORY,SCH) ;Validate schedule
- Q:SCH=""
- D VALSCH^ORWDPS33(.ORY,SCH,"I")
- Q
- ORWNSS ;JDL/SLC Non-Standard Schedule ;11/24/06
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,243**;Dec 17, 1997;Build 242
- NSSOK(ORY,ORX) ;Check availability for Non-standard schedule
- +1 NEW VAL
- +2 SET VAL=$$PATCH^XPDUTL("PSJ*5.0*113")
- +3 SET ORY=VAL
- +4 QUIT
- NSSMSG(ORY) ;Retrieve site message for None-Standard Schedule
- +1 NEW ORSRV
- +2 SET ORY=""
- +3 SET ORSRV=$GET(^VA(200,DUZ,5))
- IF +ORSRV>0
- SET ORSRV=$PIECE(ORSRV,U)
- +4 SET ORY=$$GET^XPAR("SRV.`"_+$GET(ORSRV)_"^DIV^SYS","ORWIM NSS MESSAGE",1,"I")
- +5 QUIT
- VALSCH(ORY,ORID) ;Validate a schedule for IM order; 1: valid, 0: invalid
- +1 ;
- +2 SET ORY=0
- +3 IF '$DATA(^OR(100,+ORID,0))
- QUIT
- +4 NEW IPGRP,ORGRP
- +5 SET IPGRP=$ORDER(^ORD(100.98,"B","UD RX",0))
- +6 SET ORGRP=$PIECE($GET(^OR(100,+ORID,0)),U,11)
- +7 IF ORGRP'=IPGRP
- SET ORY=1
- QUIT
- +8 NEW SCH,IDX,SCHVAL
- SET (SCH,SCHVAL)=""
- +9 IF $DATA(^OR(100,+ORID,4.5,"ID","SCHEDULE"))
- SET SCH=$ORDER(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
- +10 IF SCH=""
- SET ORY=1
- QUIT
- +11 SET IDX=0
- FOR
- SET IDX=$ORDER(^OR(100,+ORID,4.5,SCH,IDX))
- IF 'IDX
- QUIT
- Begin DoDot:1
- +12 SET SCHVAL=$GET(^OR(100,+ORID,4.5,SCH,IDX))
- +13 IF '$LENGTH(SCHVAL)
- QUIT
- +14 DO VALSCH^ORWDPS33(.ORY,SCHVAL,"I")
- +15 IF ORY=0
- QUIT
- End DoDot:1
- +16 QUIT
- QOSCH(ORY,QOID) ;Validate IM QO schedule
- +1 ;QOID: Inpt Pharmacy QO
- +2 SET ORY=""
- +3 NEW QOSCH,SCHID,SCHVAL,RST
- +4 SET SCHID=$ORDER(^ORD(101.41,"B","OR GTX SCHEDULE",0))
- +5 SET (QOSCH,SCHVAL)=""
- SET RST=1
- +6 IF '$DATA(^ORD(101.41,+QOID,6,"D",SCHID))
- SET ORY="schedule is not defined."
- QUIT
- +7 SET QOSCH=$ORDER(^ORD(101.41,+QOID,6,"D",SCHID,0))
- +8 IF 'QOSCH
- SET ORY="schedule is not defined."
- QUIT
- +9 NEW IDX
- SET IDX=0
- +10 FOR
- SET IDX=$ORDER(^ORD(101.41,+QOID,6,QOSCH,IDX))
- IF 'IDX!('RST)
- QUIT
- Begin DoDot:1
- +11 SET SCHVAL=^ORD(101.41,+QOID,6,QOSCH,IDX)
- +12 IF $$UP^XLFSTR(SCHVAL)="OTHER"
- SET ORY="OTHER"
- QUIT
- +13 DO VALSCH^ORWDPS33(.RST,SCHVAL,"I")
- +14 IF RST=0
- SET ORY="This quick order contains a non-standard administration schedule."
- QUIT
- End DoDot:1
- +15 QUIT
- CHKSCH(ORY,SCH) ;Validate schedule
- +1 IF SCH=""
- QUIT
- +2 DO VALSCH^ORWDPS33(.ORY,SCH,"I")
- +3 QUIT