- ORWDXM ; SLC/KCM/JLI - Order Dialogs, Menus;10:42 AM 3/29/02 10:47AM 4/3/2002 11AM 4/5/2002 4:30PM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,132**;Dec 17, 1997
- ;
- ; 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))
- . 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
-
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXM 6358 printed Jan 18, 2025@03:37:07 Page 2
- ORWDXM ; SLC/KCM/JLI - Order Dialogs, Menus;10:42 AM 3/29/02 10:47AM 4/3/2002 11AM 4/5/2002 4:30PM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,132**;Dec 17, 1997
- +2 ;
- +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 SET TYP=$PIECE(X0,U,4)
- SET FID=+$PIECE(X5,U,5)
- SET AUT=$PIECE(X5,U,8)
- +16 IF '$LENGTH(X)
- SET X=$PIECE($GET(^ORD(101.41,IEN,0)),U,2)
- +17 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
- +18 SET $PIECE(LST(0),U,2)=NUMCOL
- +19 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
- +5