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

ORWDXQ.m

Go to the documentation of this file. 
  1. ORWDXQ ; SLC/KCM - Utilities for Quick Orders ; JUN 18, 2024@14:35
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,245,610**;Dec 17, 1997;Build 11
  1.  ;
  1. DLGNAME(VAL,INAME)      ; Return display name for a dialog (DELETE??)
  1.  N IEN S IEN=$O(^ORD(101.41,"B",INAME,0))
  1.  S VAL=$P($G(^ORD(101.41,IEN,5)),U,4)
  1.  Q
  1. DLGSAVE(VAL,CRC,DNAME,DGRP,RSP)    ; Return IEN of new or existing quick order
  1.  N ROOT,NM,IEN
  1.  S ROOT="ORWDQ "_CRC,VAL=0,IEN=+$O(^ORD(101.41,"B",ROOT,0))
  1.  I IEN=0 D SAVENEW(.VAL,ROOT,DNAME,DGRP,.RSP) I 1
  1.  E  I $$MATCH(IEN,DGRP,.RSP) S VAL=IEN I 1
  1.  E  D
  1.  . D UPDQNAME^ORCMEDT8(IEN)
  1.  . S ROOT=$$ENSURNEW^ORCMEDT8(ROOT)
  1.  . D SAVENEW(.VAL,ROOT,DNAME,DGRP,.RSP)
  1.  Q
  1. OLDELSE E  D  ; this creates other entries if CRC matches...
  1.  . S NM=ROOT
  1.  . F  S NM=$O(^ORD(101.41,"B",NM)) Q:$E(NM,1,$L(ROOT))'=ROOT  D
  1.  . . S IEN=0 F  S IEN=$O(^ORD(101.41,"B",ROOT,0)) Q:IEN'>0  D  Q:VAL
  1.  . . . I $$MATCH(IEN,DGRP,RSP) S VAL=IEN
  1.  . . I 'VAL D                         ; new entry by same CRC (rare!)
  1.  . . . F I=1:1 I '$D(^ORD(101.41,"B",ROOT_" "_I)) Q
  1.  . . . D SAVENEW(VAL,ROOT_" "_I,DNAME,DGRP,RSP)
  1.  Q
  1. MATCH(IEN,DGRP,RSP)     ; Called by DLGSAVE
  1.  ; Return true if the responses passed in match dialog
  1.  I $P(^ORD(101.41,IEN,0),U,5)'=DGRP Q 0  ; display group must match
  1.  N TST,RSLT,DLG,INST,VAL,I,J,L
  1.  S RSLT=1 M TST=RSP
  1.  S I=0 F  S I=$O(^ORD(101.41,IEN,6,I)) Q:'I  D  Q:'RSLT
  1.  . S DLG=$P(^ORD(101.41,IEN,6,I,0),U,2),INST=$P(^(0),U,3)
  1.  . S VAL="ORDIALOG(""WP"","_DLG_","_INST_")"
  1.  . I $D(^ORD(101.41,IEN,6,I,1)) S VAL=^(1)
  1.  . I '$D(TST(DLG,INST)) S RSLT=0 Q
  1.  . I TST(DLG,INST)'=VAL S RSLT=0 Q
  1.  . I $D(^ORD(101.41,IEN,6,I,2))>1 D  Q:'RSLT
  1.  . . N A,B,JMAX
  1.  . . S (J,L)=0 F  S L=$O(^ORD(101.41,IEN,6,I,2,L)) Q:'L  S J=J+1,A(J)=^(L,0)
  1.  . . S JMAX=J
  1.  . . S (J,L)=0 F  S L=$O(TST("WP",DLG,INST,L)) Q:'L  S J=J+1,B(J)=TST("WP",DLG,INST,L,0)
  1.  . . I JMAX'=J S RSLT=0 Q
  1.  . . S J=0 F  S J=$O(A(J)) Q:'J  S:A(J)'=$G(B(J)) RSLT=0  Q:'RSLT  K A(J),B(J)
  1.  . . I ($D(A)>1)!($D(B)>1) S RSLT=0
  1.  . . K TST("WP",DLG,INST)
  1.  . K TST(DLG,INST)
  1.  I $D(TST)>1 S RSLT=0
  1.  Q RSLT
  1. SAVENEW(ORQDLG,INM,DTX,DG,ORDIALOG)   ; Called by DLGSAVE
  1.  ; save the entries in ORDIALOG as a new quick order
  1.  ; INM=.01 name, DTX=display text, DGR=display group
  1.  S ORQDLG=0,ORDIALOG=$$DEFDLG(DG) Q:'ORDIALOG
  1.  D GETDLG1^ORCD(ORDIALOG)
  1.  N FDA,FDAIEN,DIERR,ORDG
  1.  S FDA(101.41,"+1,",.01)=INM
  1.  S FDA(101.41,"+1,",2)=DTX
  1.  S FDA(101.41,"+1,",4)="Q"
  1.  S FDA(101.41,"+1,",5)=DG
  1.  D UPDATE^DIE("","FDA","FDAIEN")
  1.  S ORQDLG=FDAIEN(1)
  1.  D SAVE^ORCMEDT1
  1.  Q
  1. DEFDLG(DG)    ; Return IEN of default dialog for display group
  1.  N DLG,DAD S DLG=+$P($G(^ORD(100.98,DG,0)),U,4)
  1.  I 'DLG S DAD=$O(^ORD(100.98,"AD",DG,0)) I DAD S DLG=$$DEFDLG(DAD)
  1.  Q DLG
  1. GETQLST(LST,DGRP,PRE)        ; Return quick list for a display group
  1.  N LVW,ILST,I,X0
  1.  S PRE=$G(PRE),ILST=0
  1.  D QV4DG^ORWUL(.LVW,DGRP) S LVW=+LVW Q:'LVW
  1.  S I=0 F  S I=$O(^ORD(101.44,LVW,10,I)) Q:'I  D
  1.  . S X0=$G(^ORD(101.44,LVW,10,I,0))
  1.  . I $P($G(^ORD(101.41,+X0,0)),U,3)]"" Q  ; quick order is disabled
  1.  . I DGRP="IV RX",$$ORDINFCHK^ORWUL(+X0) Q  ;Orderable item check for Infusion & Clinic Infusion in Pharmacy.
  1.  . S ILST=ILST+1,LST(ILST)=PRE_X0
  1.  Q
  1.  ;N DNAM,DLG,I,ILST,X
  1.  ;S ILST=0,X="ORWDQ "_$S(+DGRP:$P(^ORD(100.98,DGRP,0),U,3),1:DGRP),PRE=$G(PRE)
  1.  ;D GETLST^XPAR(.TMP,"ALL",X,"N")
  1.  ;S I=0 F  S I=$O(TMP(I)) Q:'I  S DLG=+TMP(I) I +DLG D
  1.  ;. S DNAM=$$GET^XPAR(DUZ_";VA(200,","ORWDQ DISPLAY NAME",DLG,"I")
  1.  ;. I '$L(DNAM) S DNAM=$P(^ORD(101.41,DLG,0),U,2)
  1.  ;. I $P($G(^ORD(101.41,DLG,0)),U,3)]"" Q  ; quick order is disabled
  1.  ;. S ILST=ILST+1,LST(ILST)=PRE_DLG_U_DNAM
  1.  ;Q
  1. PUTQLST(VAL,DG,QLST)  ; Save quick list
  1.  N PNM
  1.  S PNM="ORWDQ USR"_DUZ_" "_$P(^ORD(100.98,DG,0),U,3)
  1.  D QVSAVE^ORWUL(.VAL,PNM,.QLST)
  1.  D EN^XPAR(DUZ_";VA(200,","ORWDQ QUICK VIEW","`"_DG,PNM)
  1.  Q
  1.  ;N PNM,USER,I,DLG,QNM,CUR
  1.  ;S PNM="ORWDQ "_$P(^ORD(100.98,DG,0),U,3),USER=DUZ_";VA(200,"
  1.  ;D NDEL^XPAR(USER,PNM) ; remove all instances for this quick list
  1.  ;S I=0 F  S I=$O(QLST(I)) Q:'I  D ADD^XPAR(USER,PNM,I,"`"_+QLST(I))
  1.  ;S I=0 F  S I=$O(QLST(I)) Q:'I  D
  1.  ;. S DLG=+QLST(I),QNM=$P(QLST(I),U,2)
  1.  ;. S CUR=$$GET^XPAR(USER,"ORWDQ DISPLAY NAME",DLG,"I")
  1.  ;. I QNM=CUR Q
  1.  ;. I CUR="",(QNM=$P($G(^ORD(101.41,DLG,0)),U,2)) Q
  1.  ;. D EN^XPAR(USER,"ORWDQ DISPLAY NAME","`"_DLG,QNM)
  1.  ;Q
  1. GETQNAM(VAL,CRC)    ; Return current quick name
  1.  N ROOT S ROOT="ORWDQ "_CRC,VAL=""
  1.  I '$D(^ORD(101.41,"B",ROOT)) Q
  1.  S DLG=$O(^ORD(101.41,"B",ROOT,0))
  1.  ; S VAL=$$GET^XPAR(DUZ_";VA(200,","ORWDQ DISPLAY NAME",DLG,"I")
  1.  I '$L(VAL) S VAL=$P($G(^ORD(101.41,DLG,0)),U,2)
  1.  Q
  1. PUTQNAM(VAL,DLG,QNAM)   ; Save display name for a quick order dialog
  1.  ; see if DLG used QNAM as display text (quit if so)
  1.  ; otherwise save in ORWDQ DISPLAY NAME
  1.  Q