- ORWNSS ;JDL/SLC Non-Standard Schedule ; 6/15/10 1:11pm
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,243,327,362**;Dec 17, 1997;Build 1
- ;
- ;Reference to ^SC("AE" supported by IA #4422
- ;
- 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,DGRP,LOC,AIPM ;*327,362 - Add IV, clinic display groups
- S LOC=+$P($G(^OR(100,+ORID,0)),U,10),AIPM=$D(^SC("AE",1,LOC))
- S DGRP=$S($G(AIPM):"C RX",$G(^OR(100,+ORID,4))["V":"IV RX",1:"UD RX")
- S IPGRP=$O(^ORD(100.98,"B",DGRP,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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWNSS 2035 printed Feb 19, 2025@00:03:18 Page 2
- ORWNSS ;JDL/SLC Non-Standard Schedule ; 6/15/10 1:11pm
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195,243,327,362**;Dec 17, 1997;Build 1
- +2 ;
- +3 ;Reference to ^SC("AE" supported by IA #4422
- +4 ;
- 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 ;*327,362 - Add IV, clinic display groups
- NEW IPGRP,ORGRP,DGRP,LOC,AIPM
- +5 SET LOC=+$PIECE($GET(^OR(100,+ORID,0)),U,10)
- SET AIPM=$DATA(^SC("AE",1,LOC))
- +6 SET DGRP=$SELECT($GET(AIPM):"C RX",$GET(^OR(100,+ORID,4))["V":"IV RX",1:"UD RX")
- +7 SET IPGRP=$ORDER(^ORD(100.98,"B",DGRP,0))
- +8 SET ORGRP=$PIECE($GET(^OR(100,+ORID,0)),U,11)
- +9 IF ORGRP'=IPGRP
- SET ORY=1
- QUIT
- +10 NEW SCH,IDX,SCHVAL
- SET (SCH,SCHVAL)=""
- +11 IF $DATA(^OR(100,+ORID,4.5,"ID","SCHEDULE"))
- SET SCH=$ORDER(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
- +12 IF SCH=""
- SET ORY=1
- QUIT
- +13 SET IDX=0
- FOR
- SET IDX=$ORDER(^OR(100,+ORID,4.5,SCH,IDX))
- if 'IDX
- QUIT
- Begin DoDot:1
- +14 SET SCHVAL=$GET(^OR(100,+ORID,4.5,SCH,IDX))
- +15 if '$LENGTH(SCHVAL)
- QUIT
- +16 DO VALSCH^ORWDPS33(.ORY,SCHVAL,"I")
- +17 IF ORY=0
- QUIT
- End DoDot:1
- +18 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