Index: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM2.m
===================================================================
--- WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM2.m	(revision 623)
@@ -1,210 +1,188 @@
-ORWDXM2	; SLC/KCM - Quick Orders ;04/25/2007
-	;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,132,158,187,195,215,243**;Dec 17, 1997;Build 242
-	;
-ADMTIME(ORDLOC,PATLOC,ENCLOC,DELAY,ISIMO)	;
-	N ADMLOC,INST,SCHLOC,SCHTYPE
-	S ADMLOC=+$P($G(ORDIALOG("B","ADMINISTRATION TIMES")),U,2)
-	I ADMLOC>0,ORDLOC>0,PATLOC'=ORDLOC D  Q
-	.S INST=0 F  S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0  D
-	..S ORDIALOG(ADMLOC,INST)=""
-	I ADMLOC>0,$S(ENCLOC'=PATLOC:1,ISIMO:1,DELAY:1,1:0) D  Q
-	.S INST=0 F  S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0  D
-	..S ORDIALOG(ADMLOC,INST)=""
-	S SCHLOC=+$P($G(ORDIALOG("B","SCHEDULE TYPE")),U,2) Q:SCHLOC'>0
-	S INST=0 F  S INST=$O(ORDIALOG(SCHLOC,INST)) Q:+INST'>0  D
-	.S SCHTYP=$G(ORDIALOG(SCHLOC,INST)) Q:SCHTYP=""
-	.I $S(SCHTYP="P":1,SCHTYP="O":1,SCHTYP="OC":1,1:0),ADMLOC>0 S ORDIALOG(ADMLOC,INST)=""
-	Q
-	;
-CLRRCL(OK)	     ; clear ORECALL
-	S OK=1
-	K ^TMP("ORECALL",$J),^TMP("ORWDXMQ",$J)
-	Q
-VERTXT	; set verify text for order
-	N SEQ,DA,X,PROMPT,MULT,CHILD,INST,TITLE,TEMP,ILST,SPACES
-	N ISADMIN
-	S ILST=0,$P(SPACES," ",31)=""
-	S SEQ=0 F  S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0  D
-	. S DA=0 F  S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA  D
-	. . S X0=$G(^ORD(101.41,+ORDIALOG,10,DA,0))
-	. . S ISADMIN=$S(+OREVENT>0:0,ISIMO=1:0,$P($G(^ORD(101.41,$P(X0,U,2),0)),U)="OR GTX ADMIN TIMES":1,1:0)
-	. . I ISADMIN=1,ORDLOC>0,ORDLOC'=PATLOC Q
-	. . I $P(X0,U,9)["*",ISADMIN=0 Q
-	. . S PROMPT=$P(X0,U,2),MULT=$P(X0,U,7),CHILD=$P(X0,U,11) I CHILD,ISADMIN=0 Q
-	. . Q:'PROMPT  S INST=$O(ORDIALOG(PROMPT,0)) Q:'INST  ; no values
-	. . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
-	. . I $E(ORDIALOG(PROMPT,0))="W" D
-	. . . N IWP,WP,CNT
-	. . . S IWP=0,CNT=0
-	. . . F  S IWP=$O(^TMP("ORWORD",$J,PROMPT,INST,IWP)) Q:'IWP  D
-	. . . . S CNT=CNT+1,WP(CNT)=^TMP("ORWORD",$J,PROMPT,INST,IWP,0)
-	. . . I CNT=1 S ILST=ILST+1,LST(ILST)=$J(TITLE,30)_WP(1)
-	. . . I CNT>1 D 
-	. . . . S ILST=ILST+1,LST(ILST)=TITLE,IWP=0
-	. . . . F  S IWP=$O(WP(IWP)) Q:'IWP  S ILST=ILST+1,LST(ILST)=WP(IWP)
-	. . E  D
-	. . . S TEMP=$$ITEM^ORCDLG(PROMPT,INST) I TEMP="" Q
-	. . . S ILST=ILST+1,LST(ILST)=$J(TITLE,30)
-	. . . ;S LST(ILST)=LST(ILST)_$$ITEM^ORCDLG(PROMPT,INST)
-	. . . S LST(ILST)=LST(ILST)_TEMP
-	. . Q:'MULT  Q:'$O(ORDIALOG(PROMPT,INST))  ; done
-	. . F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0  S ILST=ILST+1,LST(ILST)=SPACES_$$ITEM^ORCDLG(PROMPT,INST)
-	D DISPLAY^ORWDBA3  ;for display of Billing Aware data from orig order
-	Q
-RA	; setup environment for radiology
-	; -- get imaging types based on display group of quick order and
-	;    setup list of imaging locations based on imaging type
-	N ORY,ITYPE,IFN,CNT,ORIMLOC,PROMPT
-	S ORDIV=$$DIV^ORCDRA1,ITYPE=$P($G(^ORD(100.98,+ORDG,0)),U,3)
-	S ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0))
-	D EN4^RAO7PC1(ITYPE,"ORY")
-	S (IFN,CNT)=0 F  S IFN=$O(ORY(IFN)) Q:IFN'>0  D
-	. S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN
-	I '$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC
-	E  S ORIMLOC=CNT_"^1"
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX IMAGING LOCATION",0))
-	I $G(ORIMLOC) M ORDIALOG(PROMPT,"LIST")=ORIMLOC
-	Q
-LR	; setup environment for lab
-	; -- setup ORTIME, ORIMTIME & ORTEST arrays
-	;    setup ORMAX, ORDG, & ORCOLLCT variables
-	N PROMPT,INST,EDITONLY
-	D GETIMES^ORCDLR1  ; sets up ORTIME and ORIMTIME arrays
-	S ORMAX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q")
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),INST=1
-	D LRTEST           ; sets up ORTEST array and ORDG
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))
-	I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1
-	E  S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1
-	I ORCOLLCT="I" D
-	. S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
-	. D LRICTMOK
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ADMIN SCHEDULE",0))
-	I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1)
-	Q
-LRTEST	; -- Setup ORTEST() array of ordering parameters (copied from ORCDLR)
-	N OI,TST,DG
-	S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI
-	I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
-	S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB"
-	S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG
-	Q
-LRRQCM()	       ; return true if lab test has required comments
-	I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 1 ; edit via WP
-	N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM,OI,TST
-	S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN")
-	S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 0
-	I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
-	S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0))
-	S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6)
-	S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19)
-	Q REQDCOMM
-LRASMP()	      ; return true to ask collection sample (from ASKSAMP^ORCDLR)
-	N DEFSAMP,SAMP0
-	S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0))
-	I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) Q 0
-	I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask
-	I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask
-	I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice
-	Q 1
-LRICTMOK	       ;
-	Q:'$D(ORDIALOG(PROMPT,1))
-	N ORY
-	D VALDT^ORWU(.ORY,ORDIALOG(PROMPT,1))
-	I +$$VALID^LR7OV4(DUZ(2),ORY)=0 S ORDIALOG(PROMPT,1)=""
-	Q
-DO	; setup environment for diet order
-	; partially copied from EN^ORCDFH
-	I ORCAT'="I" D  Q
-	. S ORQUIT=1
-	. S LST(0)="8^0"
-	. S LST(.5)="This type of diet may be entered for inpatients only."
-	D EN^FHWOR8(+ORVP,.ORPARAM)          ; set FH ordering parameters
-	S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
-	N PROMPT,OI                          ; set NPO flag if NPO diet
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
-	S OI=+$G(ORDIALOG(PROMPT,1))
-	S ORNPO=($P($G(^ORD(101.43,OI,0)),U)="NPO")
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
-	S X=$G(ORDIALOG(PROMPT,1)) I $L(X) D CNV^ORCDFH1 S ORDIALOG(PROMPT,1)=$G(X)
-	Q
-EL	; setup environment for early/late tray
-	D EN^FHWOR8(+ORVP,.ORPARAM)          ; set FH ordering parameters
-	S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
-	D EN2^ORCDFH                         ; setup ORTIME array
-	N PROMPT                             ; set ORMEAL,ORTRAY
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX MEAL",0))
-	I $D(ORDIALOG(PROMPT,1)) S ORMEAL=ORDIALOG(PROMPT,1)
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
-	I $D(ORDIALOG(PROMPT,1)) S ORTRAY=ORDIALOG(PROMPT,1)
-	Q
-UD	; setup environment for unit dose med
-	I $G(ORWP94) G PS^ORWDPS3  ; if patch 94 installed
-	;
-	D AUTHMED Q:$G(ORQUIT)  ; checks authorized to write meds
-	N PROMPT,OI
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
-	I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV(1) Q:$G(ORQUIT)
-	D INSTR^ORCDPS(OI)      ; sets up instructions, routes, etc.
-	D CHOICES^ORCDPS("U")   ; gets list of dispense drugs       
-	Q
-IV	; setup environment for IV fluid
-	D AUTHMED Q:$G(ORQUIT)  ; checks authorized to write meds
-	; sets up list of volumes if only one solution
-	; otherwise, let the dialog go interactive
-	N PROMPT,INST,CNT,OI
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
-	S (CNT,INST)=0
-	F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  D  Q:$G(ORQUIT)
-	. S CNT=CNT+1
-	. S OI=ORDIALOG(PROMPT,INST) D MEDACTV(3) ; check active solutions
-	I CNT=1 S INST=1 D VOLUME^ORCDPSIV
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ADDITIVE",0))
-	S INST=0
-	F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  D  Q:$G(ORQUIT)
-	. S OI=ORDIALOG(PROMPT,INST) D MEDACTV(4) ; check active additives
-	Q
-OP	; setup environment for outpatient pharmacy
-	I $G(ORWP94) G PS^ORWDPS3  ; if patch 94 installed
-	;
-	D AUTHMED Q:$G(ORQUIT)       ; checks authorized to write meds
-	N PROMPT,INST,CNT,OI
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),OI=0
-	I $D(ORDIALOG(PROMPT,1)) S OI=$G(ORDIALOG(PROMPT,1)) D MEDACTV(2) Q:$G(ORQUIT)
-	D:+OI INSTR^ORCDPS(OI)           ; sets up instructions, routes, etc.
-	D CHOICES^ORCDPS("O")        ; gets list of dispense drugs      
-	; get defaults for drug, refills if only one dispense drug
-	S PROMPT=$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
-	S (CNT,INST)=0
-	F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  S CNT=CNT+1
-	I CNT=1 D
-	. S ORDRUG=+$G(ORDIALOG(PROMPT,1)),ORCOMPLX=0
-	. S OREFILLS=$P($G(ORDIALOG(PROMPT,"LIST","D",ORDRUG)),U,3)
-	. S:'$L(OREFILLS) OREFILLS=11
-	E  S ORCOMPLX=1,OREFILLS=11  ; force interactive on complex order
-	S ORCOPAY=1                  ; ask SC if can't determine copay
-	I $G(ORDRUG),$L($T(ASKSC^ORCDPS)) S ORCOPAY=$$ASKSC^ORCDPS
-	Q
-AUTHMED	; sets ORQUIT if not authorized to write meds
-	N NOAUTH,NAME
-	D AUTH^ORWDPS32(.NOAUTH,ORNP)
-	I +NOAUTH D
-	. S ORQUIT=1
-	. S LST(0)="8^0"
-	. S NAME=$P($G(^VA(200,+ORNP,20)),U,2)
-	. I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1)
-	. S LST(.5)=NAME_" is not authorized to write med orders."
-	Q
-MEDACTV(USAGE)	; sets ORQUIT if the orderable item is not active for a med
-	Q:'$G(OI)  S USAGE=+$G(USAGE)
-	I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D  Q
-	. S ORQUIT=1,LST(0)="8^0"
-	. S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
-	I USAGE,'$P($G(^ORD(101.43,OI,"PS")),U,USAGE) D  Q
-	. S ORQUIT=1,LST(0)="8^0"
-	. S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" may not be ordered as an "_$S(USAGE=1:"inpatient medication",USAGE=2:"outpatient medication",USAGE=3:"IV solution",1:"IV additive")_" anymore."
-	Q
-SCHEDULD()	; Is patient scheduled for PREOP (Imaging)
-	I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date
-	E  Q 0
-	Q
+ORWDXM2 ; SLC/KCM - Quick Orders ;11/25/02  09:49
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,132,158,187,195,215**;Dec 17, 1997
+ ;
+CLRRCL(OK)      ; clear ORECALL
+ S OK=1
+ K ^TMP("ORECALL",$J),^TMP("ORWDXMQ",$J)
+ Q
+VERTXT ; set verify text for order
+ N SEQ,DA,X,PROMPT,MULT,CHILD,INST,TITLE,ILST,SPACES
+ S ILST=0,$P(SPACES," ",31)=""
+ S SEQ=0 F  S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0  D
+ . S DA=0 F  S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA  D
+ . . S X0=$G(^ORD(101.41,+ORDIALOG,10,DA,0))
+ . . Q:$P(X0,U,9)["*"  ; hidden prompt
+ . . S PROMPT=$P(X0,U,2),MULT=$P(X0,U,7),CHILD=$P(X0,U,11) Q:CHILD
+ . . Q:'PROMPT  S INST=$O(ORDIALOG(PROMPT,0)) Q:'INST  ; no values
+ . . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
+ . . I $E(ORDIALOG(PROMPT,0))="W" D
+ . . . N IWP,WP,CNT
+ . . . S IWP=0,CNT=0
+ . . . F  S IWP=$O(^TMP("ORWORD",$J,PROMPT,INST,IWP)) Q:'IWP  D
+ . . . . S CNT=CNT+1,WP(CNT)=^TMP("ORWORD",$J,PROMPT,INST,IWP,0)
+ . . . I CNT=1 S ILST=ILST+1,LST(ILST)=$J(TITLE,30)_WP(1)
+ . . . I CNT>1 D 
+ . . . . S ILST=ILST+1,LST(ILST)=TITLE,IWP=0
+ . . . . F  S IWP=$O(WP(IWP)) Q:'IWP  S ILST=ILST+1,LST(ILST)=WP(IWP)
+ . . E  D
+ . . . S ILST=ILST+1,LST(ILST)=$J(TITLE,30)
+ . . . S LST(ILST)=LST(ILST)_$$ITEM^ORCDLG(PROMPT,INST)
+ . . Q:'MULT  Q:'$O(ORDIALOG(PROMPT,INST))  ; done
+ . . F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0  S ILST=ILST+1,LST(ILST)=SPACES_$$ITEM^ORCDLG(PROMPT,INST)
+ D DISPLAY^ORWDBA3  ;for display of Billing Aware data from orig order
+ Q
+RA ; setup environment for radiology
+ ; -- get imaging types based on display group of quick order and
+ ;    setup list of imaging locations based on imaging type
+ N ORY,ITYPE,IFN,CNT,ORIMLOC,PROMPT
+ S ORDIV=$$DIV^ORCDRA1,ITYPE=$P($G(^ORD(100.98,+ORDG,0)),U,3)
+ S ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0))
+ D EN4^RAO7PC1(ITYPE,"ORY")
+ S (IFN,CNT)=0 F  S IFN=$O(ORY(IFN)) Q:IFN'>0  D
+ . S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN
+ I '$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC
+ E  S ORIMLOC=CNT_"^1"
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX IMAGING LOCATION",0))
+ I $G(ORIMLOC) M ORDIALOG(PROMPT,"LIST")=ORIMLOC
+ Q
+LR ; setup environment for lab
+ ; -- setup ORTIME, ORIMTIME & ORTEST arrays
+ ;    setup ORMAX, ORDG, & ORCOLLCT variables
+ N PROMPT,INST,EDITONLY
+ D GETIMES^ORCDLR1  ; sets up ORTIME and ORIMTIME arrays
+ S ORMAX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q")
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),INST=1
+ D LRTEST           ; sets up ORTEST array and ORDG
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX COLLECTION TYPE",0))
+ I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1
+ E  S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1
+ I ORCOLLCT="I" D
+ . S PROMPT=$O(^ORD(101.41,"AB","OR GTX START DATE/TIME",0))
+ . D LRICTMOK
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ADMIN SCHEDULE",0))
+ I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1)
+ Q
+LRTEST ; -- Setup ORTEST() array of ordering parameters (copied from ORCDLR)
+ N OI,TST,DG
+ S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI
+ I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
+ S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB"
+ S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG
+ Q
+LRRQCM()        ; return true if lab test has required comments
+ I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 1 ; edit via WP
+ N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM,OI,TST
+ S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN")
+ S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 0
+ I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
+ S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0))
+ S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6)
+ S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19)
+ Q REQDCOMM
+LRASMP()       ; return true to ask collection sample (from ASKSAMP^ORCDLR)
+ N DEFSAMP,SAMP0
+ S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0))
+ I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) Q 0
+ I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask
+ I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask
+ I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice
+ Q 1
+LRICTMOK        ;
+ Q:'$D(ORDIALOG(PROMPT,1))
+ N ORY
+ D VALDT^ORWU(.ORY,ORDIALOG(PROMPT,1))
+ I +$$VALID^LR7OV4(DUZ(2),ORY)=0 S ORDIALOG(PROMPT,1)=""
+ Q
+DO ; setup environment for diet order
+ ; partially copied from EN^ORCDFH
+ I ORCAT'="I" D  Q
+ . S ORQUIT=1
+ . S LST(0)="8^0"
+ . S LST(.5)="This type of diet may be entered for inpatients only."
+ D EN^FHWOR8(+ORVP,.ORPARAM)          ; set FH ordering parameters
+ S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
+ N PROMPT,OI                          ; set NPO flag if NPO diet
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+ S OI=+$G(ORDIALOG(PROMPT,1))
+ S ORNPO=($P($G(^ORD(101.43,OI,0)),U)="NPO")
+ Q
+EL ; setup environment for early/late tray
+ D EN^FHWOR8(+ORVP,.ORPARAM)          ; set FH ordering parameters
+ S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
+ D EN2^ORCDFH                         ; setup ORTIME array
+ N PROMPT                             ; set ORMEAL,ORTRAY
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX MEAL",0))
+ I $D(ORDIALOG(PROMPT,1)) S ORMEAL=ORDIALOG(PROMPT,1)
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+ I $D(ORDIALOG(PROMPT,1)) S ORTRAY=ORDIALOG(PROMPT,1)
+ Q
+UD ; setup environment for unit dose med
+ I $G(ORWP94) G PS^ORWDPS3  ; if patch 94 installed
+ ;
+ D AUTHMED Q:$G(ORQUIT)  ; checks authorized to write meds
+ N PROMPT,OI
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+ I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV(1) Q:$G(ORQUIT)
+ D INSTR^ORCDPS(OI)      ; sets up instructions, routes, etc.
+ D CHOICES^ORCDPS("U")   ; gets list of dispense drugs       
+ Q
+IV ; setup environment for IV fluid
+ D AUTHMED Q:$G(ORQUIT)  ; checks authorized to write meds
+ ; sets up list of volumes if only one solution
+ ; otherwise, let the dialog go interactive
+ N PROMPT,INST,CNT,OI
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
+ S (CNT,INST)=0
+ F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  D  Q:$G(ORQUIT)
+ . S CNT=CNT+1
+ . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(3) ; check active solutions
+ I CNT=1 S INST=1 D VOLUME^ORCDPSIV
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ADDITIVE",0))
+ S INST=0
+ F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  D  Q:$G(ORQUIT)
+ . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(4) ; check active additives
+ Q
+OP ; setup environment for outpatient pharmacy
+ I $G(ORWP94) G PS^ORWDPS3  ; if patch 94 installed
+ ;
+ D AUTHMED Q:$G(ORQUIT)       ; checks authorized to write meds
+ N PROMPT,INST,CNT,OI
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),OI=0
+ I $D(ORDIALOG(PROMPT,1)) S OI=$G(ORDIALOG(PROMPT,1)) D MEDACTV(2) Q:$G(ORQUIT)
+ D:+OI INSTR^ORCDPS(OI)           ; sets up instructions, routes, etc.
+ D CHOICES^ORCDPS("O")        ; gets list of dispense drugs      
+ ; get defaults for drug, refills if only one dispense drug
+ S PROMPT=$O(^ORD(101.41,"AB","OR GTX DISPENSE DRUG",0))
+ S (CNT,INST)=0
+ F  S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST  S CNT=CNT+1
+ I CNT=1 D
+ . S ORDRUG=+$G(ORDIALOG(PROMPT,1)),ORCOMPLX=0
+ . S OREFILLS=$P($G(ORDIALOG(PROMPT,"LIST","D",ORDRUG)),U,3)
+ . S:'$L(OREFILLS) OREFILLS=11
+ E  S ORCOMPLX=1,OREFILLS=11  ; force interactive on complex order
+ S ORCOPAY=1                  ; ask SC if can't determine copay
+ I $G(ORDRUG),$L($T(ASKSC^ORCDPS)) S ORCOPAY=$$ASKSC^ORCDPS
+ Q
+AUTHMED ; sets ORQUIT if not authorized to write meds
+ N NOAUTH,NAME
+ D AUTH^ORWDPS32(.NOAUTH,ORNP)
+ I +NOAUTH D
+ . S ORQUIT=1
+ . S LST(0)="8^0"
+ . S NAME=$P($G(^VA(200,+ORNP,20)),U,2)
+ . I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1)
+ . S LST(.5)=NAME_" is not authorized to write med orders."
+ Q
+MEDACTV(USAGE) ; sets ORQUIT if the orderable item is not active for a med
+ Q:'$G(OI)  S USAGE=+$G(USAGE)
+ I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D  Q
+ . S ORQUIT=1,LST(0)="8^0"
+ . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
+ I USAGE,'$P($G(^ORD(101.43,OI,"PS")),U,USAGE) D  Q
+ . S ORQUIT=1,LST(0)="8^0"
+ . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" may not be ordered as an "_$S(USAGE=1:"inpatient medication",USAGE=2:"outpatient medication",USAGE=3:"IV solution",1:"IV additive")_" anymore."
+ Q
+SCHEDULD() ; Is patient scheduled for PREOP (Imaging)
+ I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date
+ E  Q 0
+ Q
