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

ORCHTAB.m

Go to the documentation of this file.
  1. ORCHTAB ;SLC/MKB-Build Chart tab listings ;05:58 PM 23 Aug 2000
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,68,94**;Dec 17, 1997
  1. EN ; -- rebuild ORTAB listing
  1. N CONTEXT,DEFCXT,LCNT,NUM,ORTITLE,ORCAPTN,ORMENU,ORACTNS,ORCHANGE,Z,ORMAX,ORRM
  1. S CONTEXT=$S($P($G(^TMP("OR",$J,ORTAB,0)),U,4):"",1:$P($G(^(0)),U,3))
  1. S (LCNT,NUM)=0,ORMAX=40 K ^TMP("OR",$J,ORTAB)
  1. D EN^ORCHTAB1 ; rebuild ORTAB via CONTEXT
  1. I 'LCNT S LCNT=1,^TMP("OR",$J,ORTAB,1,0)=" "_$$PAD("No data available.",40)_"|"
  1. S ^TMP("OR",$J,ORTAB,0)=LCNT_U_NUM_U_CONTEXT_U_$G(DEFCXT),^("TITLE")=$G(ORTITLE),^("RM")=$S($G(ORRM):ORRM,1:240)
  1. I $D(ORCHANGE) S Z=$O(^ORD(101,"B",ORCHANGE,0)) S:Z ^TMP("OR",$J,ORTAB,"CHANGE")=Z_";ORD(101,"
  1. I $D(ORACTNS),NUM S Z=$O(^ORD(101,"B",ORACTNS,0)) S:Z ^TMP("OR",$J,ORTAB,"#")=Z_"^1:"_NUM
  1. I $D(ORMENU) S Z=$O(^ORD(101,"B",ORMENU,0)) S:Z ^TMP("OR",$J,ORTAB,"MENU")=Z_";ORD(101,"
  1. I $D(ORCAPTN) M ^TMP("OR",$J,ORTAB,"CAPTION")=ORCAPTN
  1. Q
  1. ;
  1. SUBHDR(X) ; -- add subheader X to listing
  1. S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=" "_$$PAD(X,40)_"|"
  1. D SETVIDEO(LCNT,6,$L(X),IOUON,IOUOFF)
  1. S ^TMP("OR",$J,ORTAB,"HDR",X)=LCNT
  1. Q
  1. ;
  1. ADD ; -- add item to listing
  1. N FIRST,LINES,I
  1. S LCNT=LCNT+1,NUM=NUM+1,FIRST=LCNT,LINES=+$G(ORTX)
  1. S:+$G(DATA)>LINES LINES=+DATA
  1. S ^TMP("OR",$J,ORTAB,"IDX",NUM)=ID_U_FIRST_U_LINES_U_$G(ORIFN)
  1. S ^TMP("OR",$J,ORTAB,LCNT,0)=$$PAD(NUM,5)_$$PAD($G(ORTX(1)),40)_"| "_$G(DATA(1))
  1. F I=2:1:LINES S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=" "_$$PAD($G(ORTX(I)),40)_"| "_$G(DATA(I))
  1. D:$L(ID) SETVIDEO(FIRST,1,5,IOINHI,IOINORM) ; hilite selectable items
  1. K ORTX
  1. Q
  1. ;
  1. LINE ; -- add line X with DATA to listing
  1. S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=" "_$$PAD(X,40)_"| "_$G(DATA)
  1. Q
  1. ;
  1. BLANK ; -- add blank line
  1. S LCNT=LCNT+1,^TMP("OR",$J,ORTAB,LCNT,0)=$$REPEAT^XLFSTR(" ",45)_"|"
  1. Q
  1. ;
  1. SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
  1. S ^TMP("OR",$J,ORTAB,"VIDEO",LINE,COL,WIDTH)=ON
  1. S ^TMP("OR",$J,ORTAB,"VIDEO",LINE,COL+WIDTH,0)=OFF
  1. Q
  1. ;
  1. PAD(X,WIDTH) ; -- returns X padded with spaces to total WIDTH
  1. N Y S Y=X_$$REPEAT^XLFSTR(" ",WIDTH-$L(X))
  1. Q Y
  1. ;
  1. DATE(X) ;
  1. N D,Y S D=$P(X,".") I D="" Q ""
  1. I 'D Q $E($$FTDATE^ORCD(D),1,8) ; free text date
  1. S Y=$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  1. Q Y
  1. ;
  1. DATETIME(X,LF) ;
  1. N D,T,Y,YR,TM I X="" Q ""
  1. I X'>0 S X=$$FTDT(X) Q:X'?7N.1".".6N X ;free text date/time
  1. S D=$P(X,"."),T=$P(X,".",2) I D="" Q ""
  1. S Y=$E(D,4,5)_"/"_$E(D,6,7),YR=1700+$E(D,1,3),TM=""
  1. I T S:$L(T)<4 T=T_$E("0000",1,4-$L(T)) S TM=$E(T,1,2)_":"_$E(T,3,4)
  1. I '$G(LF) S Y=Y_"/"_$E(YR,3,4)_$S(T:" "_TM,1:"") ;not Order Long Format
  1. E S Y=Y_$S(X'<($$NOW^XLFDT-10000):" "_TM,LF=1:" "_YR,1:"/"_$E(YR,3,4))
  1. Q Y
  1. ;
  1. FTDT(X) ; -- Return free text date for use in Tab displays
  1. N Y,%DT S X=$$UP^XLFSTR(X)
  1. Q:"NOW"[X "NOW" I X?1"NOW+"1.N.E Q X
  1. I "NOON"[X Q "NOON"
  1. I $E("MIDNIGHT",1,$L(X))[X Q "MIDNIGHT"
  1. I (X="AM")!(X="NEXT")!(X="CLOSEST") Q X
  1. I X="NEXTA" Q "NEXT"
  1. I $E(X)="T" D Q Y
  1. . N X1,X2 S X1=$P(X,"@"),X2=$P(X,"@",2)
  1. . S Y=$S(X1="T":"TODAY",1:X1)_" "_X2
  1. S %DT="TX" D ^%DT
  1. Q Y
  1. ;
  1. LNAMEF(X) ; -- Returns user X name as LNAME,F
  1. N LN,FN,Y S X=$P($G(^VA(200,+X,0)),U) Q:X="" "UNKNOWN"
  1. S LN=$P(X,","),FN=$P(X,",",2) S:$E(FN)=" " FN=$E(FN,2,99)
  1. S Y=$E(LN,1,8)_","_$E(FN)
  1. Q Y
  1. ;
  1. TXT ; -- Add text in X to ORTX() up to ORMAX width
  1. N I,Y S:'$G(ORTX) ORTX=1,ORTX(1)="" S Y=$L(ORTX(ORTX))
  1. I $L(ORTX(ORTX)_" "_X)'>ORMAX S ORTX(ORTX)=ORTX(ORTX)_$S(Y:" ",1:"")_X Q
  1. F I=1:1:$L(X," ") S:$L(ORTX(ORTX)_" "_$P(X," ",I))>ORMAX ORTX=ORTX+1,Y=0 S ORTX(ORTX)=$G(ORTX(ORTX))_$S(Y:" ",1:"")_$P(X," ",I),Y=1
  1. Q
  1. ;
  1. ACCESS() ; -- Does user have menu tree access to CPRS?
  1. I '$L($T(ACCESS^XQCHK)) Q 1 ;Can't check - allow access
  1. N OROK,ORTYP,OROPT S OROK=0
  1. F ORTYP="WARD CLERK","NURSE","CLINICIAN" D Q:OROK
  1. . S OROPT=+$$FIND1^DIC(19,"","QX","OR OE/RR MENU "_ORTYP) Q:OROPT'>0
  1. . S:$$ACCESS^XQCHK(DUZ,OROPT)>0 OROK=1
  1. Q OROK