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 Apr 09, 2024@21:27:14 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
