Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWNSS

ORWNSS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to ^SC("AE" supported by IA #4422
  1. ;
  1. NSSOK(ORY,ORX) ;Check availability for Non-standard schedule
  1. N VAL
  1. S VAL=$$PATCH^XPDUTL("PSJ*5.0*113")
  1. S ORY=VAL
  1. Q
  1. NSSMSG(ORY) ;Retrieve site message for None-Standard Schedule
  1. N ORSRV
  1. S ORY=""
  1. S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. S ORY=$$GET^XPAR("SRV.`"_+$G(ORSRV)_"^DIV^SYS","ORWIM NSS MESSAGE",1,"I")
  1. Q
  1. VALSCH(ORY,ORID) ;Validate a schedule for IM order; 1: valid, 0: invalid
  1. ;
  1. S ORY=0
  1. Q:'$D(^OR(100,+ORID,0))
  1. N IPGRP,ORGRP,DGRP,LOC,AIPM ;*327,362 - Add IV, clinic display groups
  1. S LOC=+$P($G(^OR(100,+ORID,0)),U,10),AIPM=$D(^SC("AE",1,LOC))
  1. S DGRP=$S($G(AIPM):"C RX",$G(^OR(100,+ORID,4))["V":"IV RX",1:"UD RX")
  1. S IPGRP=$O(^ORD(100.98,"B",DGRP,0))
  1. S ORGRP=$P($G(^OR(100,+ORID,0)),U,11)
  1. I ORGRP'=IPGRP S ORY=1 Q
  1. N SCH,IDX,SCHVAL S (SCH,SCHVAL)=""
  1. I $D(^OR(100,+ORID,4.5,"ID","SCHEDULE")) S SCH=$O(^OR(100,+ORID,4.5,"ID","SCHEDULE",0))
  1. I SCH="" S ORY=1 Q
  1. S IDX=0 F S IDX=$O(^OR(100,+ORID,4.5,SCH,IDX)) Q:'IDX D
  1. . S SCHVAL=$G(^OR(100,+ORID,4.5,SCH,IDX))
  1. . Q:'$L(SCHVAL)
  1. . D VALSCH^ORWDPS33(.ORY,SCHVAL,"I")
  1. . I ORY=0 Q
  1. Q
  1. QOSCH(ORY,QOID) ;Validate IM QO schedule
  1. ;QOID: Inpt Pharmacy QO
  1. S ORY=""
  1. N QOSCH,SCHID,SCHVAL,RST
  1. S SCHID=$O(^ORD(101.41,"B","OR GTX SCHEDULE",0))
  1. S (QOSCH,SCHVAL)="",RST=1
  1. I '$D(^ORD(101.41,+QOID,6,"D",SCHID)) S ORY="schedule is not defined." Q
  1. S QOSCH=$O(^ORD(101.41,+QOID,6,"D",SCHID,0))
  1. I 'QOSCH S ORY="schedule is not defined." Q
  1. N IDX S IDX=0
  1. F S IDX=$O(^ORD(101.41,+QOID,6,QOSCH,IDX)) Q:'IDX!('RST) D
  1. . S SCHVAL=^ORD(101.41,+QOID,6,QOSCH,IDX)
  1. . I $$UP^XLFSTR(SCHVAL)="OTHER" S ORY="OTHER" Q
  1. . D VALSCH^ORWDPS33(.RST,SCHVAL,"I")
  1. . I RST=0 S ORY="This quick order contains a non-standard administration schedule." Q
  1. Q
  1. CHKSCH(ORY,SCH) ;Validate schedule
  1. Q:SCH=""
  1. D VALSCH^ORWDPS33(.ORY,SCH,"I")
  1. Q