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