ORWDXM ; SLC/KCM/JLI - Order Dialogs, Menus;31-Dec-2012 10:33;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,132,1007,1013**;Dec 17, 1997;Build 47
;Modified - IHS/MSC/PLS - 01/25/2011 - Line MENU+15
; LST(0)=name^# cols^path switch^^^ Key Variables (pieces 6-20)
; LST(n)=col^row^type^ien^formid^autoaccept^display text^mnemonic
; ^displayonly
N ILST,I,COL,ROW,IEN,TYP,FID,AUT,MNE,DON,X,X0,X5,NUMCOL
S X0=$G(^ORD(101.41,DLG,0)),X5=$G(^(5)),ILST=0,NUMCOL=1
;S COL=$P(X5,U) S:'COL COL=80 S COL=80\COL
S LST(0)=$P(X0,U,2)_U_NUMCOL_U_$P(X5,U,3)
S $P(LST(0),U,6)=$$KEYVAR^ORWDXM3(DLG) ; key vars start at 6th piece
S I=0 F S I=$O(^ORD(101.41,DLG,10,I)) Q:'I D
. S X=$G(^ORD(101.41,DLG,10,I,0))
. S ROW=$P(X,U),COL=$P(ROW,".",2),ROW=$P(ROW,".",1)
. I COL>NUMCOL S NUMCOL=COL
. S IEN=+$P(X,U,2),MNE=$P(X,U,3),DON=$P(X,U,5),X=$P(X,U,4)
. S X0=$G(^ORD(101.41,IEN,0)),X5=$G(^(5))
. I $E(X0,1,2)="PS",$T(QUICK^APSPMULT)]"",$P($G(^ORD(100.98,+$P(X0,U,5),0)),U,3)'["NV RX" Q:'$$QUICK^APSPMULT(IEN) ;IHS/MSC/JDS - 01/25/2011 - screen drugs
. S TYP=$P(X0,U,4),FID=+$P(X5,U,5),AUT=$P(X5,U,8)
. I '$L(X) S X=$P($G(^ORD(101.41,IEN,0)),U,2)
. S ILST=ILST+1,LST(ILST)=COL_U_ROW_U_TYP_U_IEN_U_FID_U_AUT_U_X_U_MNE_U_DON
S $P(LST(0),U,2)=NUMCOL
Q
PROMPTS(LST,DLG) ; Return prompting info for generic dialog
; LST(n)=ID^REQ^HID^PROMPT^TYPE^DOMAIN^DEFAULT^IDFLT^HELP^XREF^SCR
N I,X,ILST,SEQ,REQ,HID,ITM,IDX,PRMT,HLP,DFLT,IDFLT,TYP,DOM,ID,WP,SCR
S ILST=0
S SEQ=0 F S SEQ=$O(^ORD(101.41,DLG,10,"B",SEQ)) Q:'SEQ D
. S I=0 F S I=$O(^ORD(101.41,DLG,10,"B",SEQ,I)) Q:'I D
. . S X=$G(^ORD(101.41,DLG,10,I,0))
. . S ITM=$P(X,U,2),REQ=+$P(X,U,6),IDX=$P(X,U,10),PRMT=$P(X,U,14)
. . I '$L(PRMT) S PRMT=$P(X,U,4)
. . S HLP=$P($G(^ORD(101.41,DLG,10,I,1)),U,1)
. . S HID=$E($G(^ORD(101.41,DLG,10,I,3)),1,3)="I 0"
. . S SCR="" I $L($G(^ORD(101.41,DLG,10,I,4))) S SCR=DLG_":"_I
. . S X=$G(^ORD(101.41,ITM,0)) I '$L(PRMT) S PRMT=$P(X,U,2)
. . S X=$G(^ORD(101.41,ITM,1)),TYP=$P(X,U),DOM=$P(X,U,2),ID=$P(X,U,3)
. . S X=$G(^ORD(101.41,DLG,10,I,7)) D XDFLT(X,TYP,DOM,.IDFLT,.DFLT)
. . I '$L(ID) S ID="ID"_ITM
. . S ILST=ILST+1
. . S LST(ILST)="~"_ID_U_REQ_U_HID_U_PRMT_U_TYP_U_DOM_U_DFLT_U_IDFLT_U_HLP_U_IDX_U_SCR
. . ; loop here to append any default word processing
. . S WP=0 F S WP=$O(^ORD(101.41,DLG,10,I,8,WP)) Q:'WP D
. . . S ILST=ILST+1,LST(ILST)="t"_$G(^ORD(101.41,DLG,10,I,8,WP,0))
Q
XDFLT(CODE,TYPE,DOMAIN,IVAL,EVAL) ; return internal, external default values
S (IVAL,EVAL)="" Q:'$L(CODE)
; set err trap here?
N ID,REQ,HID,PRMT,TYP,DOM,DFLT,IDFLT,HLP,Y ; to protect PROMPTS
X CODE
S IVAL=$G(Y),EVAL=IVAL
I TYPE="D",IVAL S EVAL=$$FMTE^XLFDT(IVAL)
I TYPE="P",IVAL,DOMAIN S EVAL=$$GET1^DIQ(+DOMAIN,IVAL_",",.01)
I TYPE="S",$L(IVAL) S EVAL=$P($P(DOMAIN,IVAL_":",2),";",1)
I TYPE="Y",$L(IVAL) S EVAL=$S(IVAL=1:"YES",1:"NO")
Q
DLGNAME(VAL,DLG) ; Return name(s) of dialog & base dialog given IEN
; VAL=InternalName^DisplayName^BaseDialogIEN^BaseDialogName
N INT,EXT,BIEN,BNAM
S INT=$P($G(^ORD(101.41,DLG,0)),U),EXT=$P($G(^(0)),U,2)
S BNAM=INT,BIEN=DLG
I $P(^ORD(101.41,DLG,0),U,4)="Q" D
. N DGRP S DGRP=$P($G(^ORD(101.41,DLG,0)),U,5) Q:'DGRP
. S BIEN=$$DEFDLG^ORWDXQ(DGRP),BNAM=$P(^ORD(101.41,BIEN,0),U)
S VAL=INT_U_EXT_U_BIEN_U_BNAM
Q
FORMID(VAL,DLG) ; Return the FormID for a dialog
S VAL=+$P($G(^ORD(101.41,DLG,5)),U,5) Q:VAL
I $P($G(^ORD(101.41,DLG,0)),U,4)="Q" D
. N DGRP S DGRP=$P($G(^ORD(101.41,DLG,0)),U,5) Q:'DGRP
. S DLG=$$DEFDLG^ORWDXQ(DGRP) Q:'DLG
. S VAL=+$P($G(^ORD(101.41,DLG,5)),U,5)
I 'VAL,$P($G(^ORD(101.41,DLG,0)),U,7)=$O(^DIC(9.4,"C","OR",0)) D
. S VAL=152 ; use generic "on the fly" form
Q
MSTYLE(VAL) ; Return the menu style for the system
S VAL=+$$GET^XPAR("SYS","ORWDXM ORDER MENU STYLE",1,"I")
Q
LOADSET(LST,DLG) ; Return the contents of an order set
; LST(0): SetDisplayText^Key Variables
; LST(n): DlgIEN^DlgType^DisplayText^OrderableItemIENs(OIIEN;OIIEN;..)
N SEQ,DA,ITM,TYP,ILST,X,OIENS,PKGINFO
S LST(0)=$P(^ORD(101.41,DLG,0),U,2)_U_$$KEYVAR^ORWDXM3(DLG),ILST=0
S SEQ="" F S SEQ=$O(^ORD(101.41,DLG,10,"B",SEQ)) Q:SEQ="" D
. S DA=0 F S DA=$O(^ORD(101.41,DLG,10,"B",SEQ,DA)) Q:'DA D
. . S X=$G(^ORD(101.41,DLG,10,DA,0)),ITM=$P(X,U,2),X=$P(X,U,4)
. . Q:'ITM Q:'$D(^ORD(101.41,+ITM,0))
. . S (OIENS,PKGINFO)=""
. . S TYP=$P(^ORD(101.41,ITM,0),U,4)
. . S OIENS=$$OIIFN(+ITM)
. . S PKGINFO=$$PKGINF(+ITM)
. . I '$L(X) S X=$P($G(^ORD(101.41,ITM,5)),U,4)
. . I '$L(X) S X=$P($G(^ORD(101.41,ITM,0)),U,2)
. . I '$L(X) S X="Display Name Missing"
. . S ILST=ILST+1,LST(ILST)=ITM_U_TYP_U_X_U_OIENS_U_PKGINFO
Q
PKGINF(DLG) ; Get Package based on the DLG ID
N PKGID,PKGNM
S PKGID="",PKGNM=""
S:$D(^ORD(101.41,DLG,0)) PKGID=$P(^(0),U,7)
I PKGID D
. S:$D(^DIC(9.4,PKGID,0)) PKGNM=$P(^(0),U,2)
Q PKGNM
OIIFN(DLG) ; Get Orderable Item IENs based on the DLG
N OIDX,OINODE,OINUM,OIIENS,OI0
S (OIIENS,OINODE,OIIENS)=""
S OINUM=0
S OIDX=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
S:$D(^ORD(101.41,DLG,6,"D",OIDX)) OINODE=$O(^(OIDX,0))
S:OINODE OINUM=$P(^ORD(101.41,DLG,6,OINODE,0),U,3)
I OINUM F OI0=1:1:OINUM S OIIENS=OIIENS_^(OI0)_";"
Q OIIENS
AUTOACK(REC,ORVP,ORNP,ORL,ORIT) ; Place a quick order without verify step
N ORDG,ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG
N ORDIALOG,ORIFN,ORLEAD,ORTRAIL
S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
S DGRP=$P($G(^ORD(101.41,ORIT,0)),U,5) Q:'DGRP
S ORDIALOG=$$DEFDLG^ORWDXQ(DGRP)
I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) S ORCAT="O" ; temp
I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) S ORCAT="I" ; temp
D GETDLG1^ORCD(ORDIALOG)
D GETORDER^ORCD("^ORD(101.41,"_ORIT_",6)")
; check required fields?
D EN^ORCSAVE
S REC="" I ORIFN D GETBYIFN^ORWORR(.REC,ORIFN)
Q
ALLRSP(QUIK) ; Return 1 if quick order has values for all responses
N ALLOK,DLG,ITM,PRMT
S ALLOK=1,DLG=+$$DEFDLG^ORWDXQ(+$P($G(^ORD(101.41,QUIK,0)),U,5))
S ITM=0 F S ITM=$O(^ORD(101.41,DLG,10,ITM)) Q:'ITM D Q:'ALLOK
. Q:$P($G(^ORD(101.41,DLG,10,ITM,0)),U,8)=1
. S PRMT=$P(^ORD(101.41,DLG,10,ITM,0),U,2)
. I '$$HASRSP(QUIK,PRMT) S ALLOK=0
Q ALLOK
HASRSP(QUIK,PRMT) ; Return 1 if quick order has response for prompt
N FND,RSP S FND=0
S RSP=0 F S RSP=$O(^ORD(101.41,QUIK,6,RSP)) Q:'RSP D Q:FND
. I $P(^ORD(101.41,QUIK,6,RSP,0),U,2)=PRMT S FND=1
Q FND
ORWDXM ; SLC/KCM/JLI - Order Dialogs, Menus;31-Dec-2012 10:33;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,132,1007,1013**;Dec 17, 1997;Build 47
+2 ;Modified - IHS/MSC/PLS - 01/25/2011 - Line MENU+15
+1 ; LST(0)=name^# cols^path switch^^^ Key Variables (pieces 6-20)
+2 ; LST(n)=col^row^type^ien^formid^autoaccept^display text^mnemonic
+3 ; ^displayonly
+4 NEW ILST,I,COL,ROW,IEN,TYP,FID,AUT,MNE,DON,X,X0,X5,NUMCOL
+5 SET X0=$GET(^ORD(101.41,DLG,0))
SET X5=$GET(^(5))
SET ILST=0
SET NUMCOL=1
+6 ;S COL=$P(X5,U) S:'COL COL=80 S COL=80\COL
+7 SET LST(0)=$PIECE(X0,U,2)_U_NUMCOL_U_$PIECE(X5,U,3)
+8 ; key vars start at 6th piece
SET $PIECE(LST(0),U,6)=$$KEYVAR^ORWDXM3(DLG)
+9 SET I=0
FOR
SET I=$ORDER(^ORD(101.41,DLG,10,I))
IF 'I
QUIT
Begin DoDot:1
+10 SET X=$GET(^ORD(101.41,DLG,10,I,0))
+11 SET ROW=$PIECE(X,U)
SET COL=$PIECE(ROW,".",2)
SET ROW=$PIECE(ROW,".",1)
+12 IF COL>NUMCOL
SET NUMCOL=COL
+13 SET IEN=+$PIECE(X,U,2)
SET MNE=$PIECE(X,U,3)
SET DON=$PIECE(X,U,5)
SET X=$PIECE(X,U,4)
+14 SET X0=$GET(^ORD(101.41,IEN,0))
SET X5=$GET(^(5))
+15 ;IHS/MSC/JDS - 01/25/2011 - screen drugs
IF $EXTRACT(X0,1,2)="PS"
IF $TEXT(QUICK^APSPMULT)]""
IF $PIECE($GET(^ORD(100.98,+$PIECE(X0,U,5),0)),U,3)'["NV RX"
IF '$$QUICK^APSPMULT(IEN)
QUIT
+16 SET TYP=$PIECE(X0,U,4)
SET FID=+$PIECE(X5,U,5)
SET AUT=$PIECE(X5,U,8)
+17 IF '$LENGTH(X)
SET X=$PIECE($GET(^ORD(101.41,IEN,0)),U,2)
+18 SET ILST=ILST+1
SET LST(ILST)=COL_U_ROW_U_TYP_U_IEN_U_FID_U_AUT_U_X_U_MNE_U_DON
End DoDot:1
+19 SET $PIECE(LST(0),U,2)=NUMCOL
+20 QUIT
PROMPTS(LST,DLG) ; Return prompting info for generic dialog
+1 ; LST(n)=ID^REQ^HID^PROMPT^TYPE^DOMAIN^DEFAULT^IDFLT^HELP^XREF^SCR
+2 NEW I,X,ILST,SEQ,REQ,HID,ITM,IDX,PRMT,HLP,DFLT,IDFLT,TYP,DOM,ID,WP,SCR
+3 SET ILST=0
+4 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(101.41,DLG,10,"B",SEQ))
IF 'SEQ
QUIT
Begin DoDot:1
+5 SET I=0
FOR
SET I=$ORDER(^ORD(101.41,DLG,10,"B",SEQ,I))
IF 'I
QUIT
Begin DoDot:2
+6 SET X=$GET(^ORD(101.41,DLG,10,I,0))
+7 SET ITM=$PIECE(X,U,2)
SET REQ=+$PIECE(X,U,6)
SET IDX=$PIECE(X,U,10)
SET PRMT=$PIECE(X,U,14)
+8 IF '$LENGTH(PRMT)
SET PRMT=$PIECE(X,U,4)
+9 SET HLP=$PIECE($GET(^ORD(101.41,DLG,10,I,1)),U,1)
+10 SET HID=$EXTRACT($GET(^ORD(101.41,DLG,10,I,3)),1,3)="I 0"
+11 SET SCR=""
IF $LENGTH($GET(^ORD(101.41,DLG,10,I,4)))
SET SCR=DLG_":"_I
+12 SET X=$GET(^ORD(101.41,ITM,0))
IF '$LENGTH(PRMT)
SET PRMT=$PIECE(X,U,2)
+13 SET X=$GET(^ORD(101.41,ITM,1))
SET TYP=$PIECE(X,U)
SET DOM=$PIECE(X,U,2)
SET ID=$PIECE(X,U,3)
+14 SET X=$GET(^ORD(101.41,DLG,10,I,7))
DO XDFLT(X,TYP,DOM,.IDFLT,.DFLT)
+15 IF '$LENGTH(ID)
SET ID="ID"_ITM
+16 SET ILST=ILST+1
+17 SET LST(ILST)="~"_ID_U_REQ_U_HID_U_PRMT_U_TYP_U_DOM_U_DFLT_U_IDFLT_U_HLP_U_IDX_U_SCR
+18 ; loop here to append any default word processing
+19 SET WP=0
FOR
SET WP=$ORDER(^ORD(101.41,DLG,10,I,8,WP))
IF 'WP
QUIT
Begin DoDot:3
+20 SET ILST=ILST+1
SET LST(ILST)="t"_$GET(^ORD(101.41,DLG,10,I,8,WP,0))
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
XDFLT(CODE,TYPE,DOMAIN,IVAL,EVAL) ; return internal, external default values
+1 SET (IVAL,EVAL)=""
IF '$LENGTH(CODE)
QUIT
+2 ; set err trap here?
+3 ; to protect PROMPTS
NEW ID,REQ,HID,PRMT,TYP,DOM,DFLT,IDFLT,HLP,Y
+4 XECUTE CODE
+5 SET IVAL=$GET(Y)
SET EVAL=IVAL
+6 IF TYPE="D"
IF IVAL
SET EVAL=$$FMTE^XLFDT(IVAL)
+7 IF TYPE="P"
IF IVAL
IF DOMAIN
SET EVAL=$$GET1^DIQ(+DOMAIN,IVAL_",",.01)
+8 IF TYPE="S"
IF $LENGTH(IVAL)
SET EVAL=$PIECE($PIECE(DOMAIN,IVAL_":",2),";",1)
+9 IF TYPE="Y"
IF $LENGTH(IVAL)
SET EVAL=$SELECT(IVAL=1:"YES",1:"NO")
+10 QUIT
DLGNAME(VAL,DLG) ; Return name(s) of dialog & base dialog given IEN
+1 ; VAL=InternalName^DisplayName^BaseDialogIEN^BaseDialogName
+2 NEW INT,EXT,BIEN,BNAM
+3 SET INT=$PIECE($GET(^ORD(101.41,DLG,0)),U)
SET EXT=$PIECE($GET(^(0)),U,2)
+4 SET BNAM=INT
SET BIEN=DLG
+5 IF $PIECE(^ORD(101.41,DLG,0),U,4)="Q"
Begin DoDot:1
+6 NEW DGRP
SET DGRP=$PIECE($GET(^ORD(101.41,DLG,0)),U,5)
IF 'DGRP
QUIT
+7 SET BIEN=$$DEFDLG^ORWDXQ(DGRP)
SET BNAM=$PIECE(^ORD(101.41,BIEN,0),U)
End DoDot:1
+8 SET VAL=INT_U_EXT_U_BIEN_U_BNAM
+9 QUIT
FORMID(VAL,DLG) ; Return the FormID for a dialog
+1 SET VAL=+$PIECE($GET(^ORD(101.41,DLG,5)),U,5)
IF VAL
QUIT
+2 IF $PIECE($GET(^ORD(101.41,DLG,0)),U,4)="Q"
Begin DoDot:1
+3 NEW DGRP
SET DGRP=$PIECE($GET(^ORD(101.41,DLG,0)),U,5)
IF 'DGRP
QUIT
+4 SET DLG=$$DEFDLG^ORWDXQ(DGRP)
IF 'DLG
QUIT
+5 SET VAL=+$PIECE($GET(^ORD(101.41,DLG,5)),U,5)
End DoDot:1
+6 IF 'VAL
IF $PIECE($GET(^ORD(101.41,DLG,0)),U,7)=$ORDER(^DIC(9.4,"C","OR",0))
Begin DoDot:1
+7 ; use generic "on the fly" form
SET VAL=152
End DoDot:1
+8 QUIT
MSTYLE(VAL) ; Return the menu style for the system
+1 SET VAL=+$$GET^XPAR("SYS","ORWDXM ORDER MENU STYLE",1,"I")
+2 QUIT
LOADSET(LST,DLG) ; Return the contents of an order set
+1 ; LST(0): SetDisplayText^Key Variables
+2 ; LST(n): DlgIEN^DlgType^DisplayText^OrderableItemIENs(OIIEN;OIIEN;..)
+3 NEW SEQ,DA,ITM,TYP,ILST,X,OIENS,PKGINFO
+4 SET LST(0)=$PIECE(^ORD(101.41,DLG,0),U,2)_U_$$KEYVAR^ORWDXM3(DLG)
SET ILST=0
+5 SET SEQ=""
FOR
SET SEQ=$ORDER(^ORD(101.41,DLG,10,"B",SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+6 SET DA=0
FOR
SET DA=$ORDER(^ORD(101.41,DLG,10,"B",SEQ,DA))
IF 'DA
QUIT
Begin DoDot:2
+7 SET X=$GET(^ORD(101.41,DLG,10,DA,0))
SET ITM=$PIECE(X,U,2)
SET X=$PIECE(X,U,4)
+8 IF 'ITM
QUIT
IF '$DATA(^ORD(101.41,+ITM,0))
QUIT
+9 SET (OIENS,PKGINFO)=""
+10 SET TYP=$PIECE(^ORD(101.41,ITM,0),U,4)
+11 SET OIENS=$$OIIFN(+ITM)
+12 SET PKGINFO=$$PKGINF(+ITM)
+13 IF '$LENGTH(X)
SET X=$PIECE($GET(^ORD(101.41,ITM,5)),U,4)
+14 IF '$LENGTH(X)
SET X=$PIECE($GET(^ORD(101.41,ITM,0)),U,2)
+15 IF '$LENGTH(X)
SET X="Display Name Missing"
+16 SET ILST=ILST+1
SET LST(ILST)=ITM_U_TYP_U_X_U_OIENS_U_PKGINFO
End DoDot:2
End DoDot:1
+17 QUIT
PKGINF(DLG) ; Get Package based on the DLG ID
+1 NEW PKGID,PKGNM
+2 SET PKGID=""
SET PKGNM=""
+3 IF $DATA(^ORD(101.41,DLG,0))
SET PKGID=$PIECE(^(0),U,7)
+4 IF PKGID
Begin DoDot:1
+5 IF $DATA(^DIC(9.4,PKGID,0))
SET PKGNM=$PIECE(^(0),U,2)
End DoDot:1
+6 QUIT PKGNM
OIIFN(DLG) ; Get Orderable Item IENs based on the DLG
+1 NEW OIDX,OINODE,OINUM,OIIENS,OI0
+2 SET (OIIENS,OINODE,OIIENS)=""
+3 SET OINUM=0
+4 SET OIDX=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+5 IF $DATA(^ORD(101.41,DLG,6,"D",OIDX))
SET OINODE=$ORDER(^(OIDX,0))
+6 IF OINODE
SET OINUM=$PIECE(^ORD(101.41,DLG,6,OINODE,0),U,3)
+7 IF OINUM
FOR OI0=1:1:OINUM
SET OIIENS=OIIENS_^(OI0)_";"
+8 QUIT OIIENS
AUTOACK(REC,ORVP,ORNP,ORL,ORIT) ; Place a quick order without verify step
+1 NEW ORDG,ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG
+2 NEW ORDIALOG,ORIFN,ORLEAD,ORTRAIL
+3 SET ORVP=ORVP_";DPT("
SET ORL(2)=ORL_";SC("
SET ORL=ORL(2)
+4 SET DGRP=$PIECE($GET(^ORD(101.41,ORIT,0)),U,5)
IF 'DGRP
QUIT
+5 SET ORDIALOG=$$DEFDLG^ORWDXQ(DGRP)
+6 ; temp
IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSO OERR",0))
SET ORCAT="O"
+7 ; temp
IF ORDIALOG=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
SET ORCAT="I"
+8 DO GETDLG1^ORCD(ORDIALOG)
+9 DO GETORDER^ORCD("^ORD(101.41,"_ORIT_",6)")
+10 ; check required fields?
+11 DO EN^ORCSAVE
+12 SET REC=""
IF ORIFN
DO GETBYIFN^ORWORR(.REC,ORIFN)
+13 QUIT
ALLRSP(QUIK) ; Return 1 if quick order has values for all responses
+1 NEW ALLOK,DLG,ITM,PRMT
+2 SET ALLOK=1
SET DLG=+$$DEFDLG^ORWDXQ(+$PIECE($GET(^ORD(101.41,QUIK,0)),U,5))
+3 SET ITM=0
FOR
SET ITM=$ORDER(^ORD(101.41,DLG,10,ITM))
IF 'ITM
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^ORD(101.41,DLG,10,ITM,0)),U,8)=1
QUIT
+5 SET PRMT=$PIECE(^ORD(101.41,DLG,10,ITM,0),U,2)
+6 IF '$$HASRSP(QUIK,PRMT)
SET ALLOK=0
End DoDot:1
IF 'ALLOK
QUIT
+7 QUIT ALLOK
HASRSP(QUIK,PRMT) ; Return 1 if quick order has response for prompt
+1 NEW FND,RSP
SET FND=0
+2 SET RSP=0
FOR
SET RSP=$ORDER(^ORD(101.41,QUIK,6,RSP))
IF 'RSP
QUIT
Begin DoDot:1
+3 IF $PIECE(^ORD(101.41,QUIK,6,RSP,0),U,2)=PRMT
SET FND=1
End DoDot:1
IF FND
QUIT
+4 QUIT FND
