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

ORCDLR.m

Go to the documentation of this file.
  1. ORCDLR ;SLC/MKB-Utility functions for LR dialogs ;11/22/06
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,49,61,71,79,175,243,327**;Dec 17, 1997;Build 9
  1. TEST ; -- Setup ORTEST() array of ordering parameters
  1. N OI,TST,WRD,I,DG
  1. S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI
  1. I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
  1. S WRD="GenWardInstructions" I $O(ORTEST(WRD,0)) D W !
  1. . W ! S I=0 F S I=$O(ORTEST(WRD,I)) Q:I'>0 W !,ORTEST(WRD,I,0)
  1. S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB"
  1. S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG
  1. Q
  1. ;
  1. CKTYP ; -- ck type of test [Exit Action]
  1. N X,Y S X=$G(ORDIALOG(PROMPT,INST)) Q:'X
  1. S Y=$P($G(^ORD(101.43,+X,"LR")),U,7)
  1. I (Y="O")!(Y="N") W $C(7),!,"This test may not be ordered anymore. Please select another test." S ORQUIT=1 D WAIT Q
  1. Q
  1. ;
  1. WAIT ; -- Wait for user
  1. N X W !,"Press <return> to continue ..." R X:DTIME
  1. Q
  1. ;
  1. SHOWMAX ; -- Setup max days allowed for cont orders
  1. K ^TMP($J,"ORCDLR SHOWMAX")
  1. D ZERO^PSS51P1(+ORSCH,,,,"ORCDLR SHOWMAX")
  1. I $S('$G(ORSCH):1,"CD"'[$P($G(^TMP($J,"ORCDLR SHOWMAX",+ORSCH,5)),U):1,1:0) K ORDIALOG(PROMPT,INST) Q ;just in case
  1. ;I $S('$G(ORSCH):1,"CD"'[$P($G(^PS(51.1,+ORSCH,0)),U,5):1,1:0) K ORDIALOG(PROMPT,INST) Q ;just in case
  1. N Y,OK S ORSMAX=$G(^TMP($J,"ORCDLR SHOWMAX",+ORSCH,2.5)),ORSTMS=$G(^TMP($J,"ORCDLR SHOWMAX",+ORSCH,2)) ;DJE/VM *327 ORSTMS was not being filled.
  1. ;N Y,OK S ORSMAX=$G(^TMP($J,"ORCDLR SHOWMAX",+ORSCH,2.5)),ORSTMS=$P($G(^(0)),U,3)
  1. ;N Y,OK S ORSMAX=$P($G(^PS(51.1,ORSCH,0)),U,7),ORSTMS=$P($G(^(0)),U,3)
  1. S ORSMAX=$S('$G(ORSMAX):ORMAX,$G(ORTYPE)="Z":ORSMAX,ORMAX<ORSMAX:ORMAX,1:ORSMAX),ORSTMS=$S(ORSMAX&ORSTMS:ORSMAX*1440\ORSTMS,1:"") ;set max days, times
  1. I FIRST,$G(ORTYPE)="Q" S Y=$G(ORDIALOG(PROMPT,INST)) I $L(Y) S OK=$$CKMAX(Y) Q:OK K ORDIALOG(PROMPT,INST) ;Q if valid, else fall thru and prompt
  1. W !!,"Maximum number of days for continuous orders is "_ORSMAX_"; enter a duration",!,"as either a number of days (3) or Xnumber of times (X3).",!
  1. K ^TMP($J,"ORCDLR SHOWMAX")
  1. Q
  1. ;
  1. CKMAX(X) ; -- Ck duration X against max allowed
  1. N Y S Y=1
  1. I +X=X S Y=$S(X<0:"0^Cannot order in the past.",'ORSMAX:1,X'>ORSMAX:1,1:"0^Cannot order more than "_ORSMAX_" days in advance.") G CKQ
  1. I (X'?1"X"1.N),(X'?1"x"1.N) S Y="0^Enter either a number of days or X_number of times." G CKQ
  1. I ORSTMS,+$E(X,2,9)>ORSTMS S Y="0^Cannot order more than "_ORSTMS_" time* s." G CKQ
  1. I 'ORSTMS,+$E(X,2,9)>ORSMAX S Y="0^Cannot order for more than "_ORSMAX_" days." G CKQ ; day of week schedule
  1. S Y=1
  1. CKQ Q Y
  1. ;
  1. SAMPLE() ; -- Get default sample from Test for INST
  1. N X,Y I $L($G(LRFSAMP)) Q LRFSAMP
  1. I (ORCOLLCT="LC")!(ORCOLLCT="I") S X=$G(ORTEST("Lab CollSamp")) G SAMPQ
  1. S X=$G(ORTEST("Unique CollSamp")) G:X SAMPQ
  1. S X=$G(ORTEST("Default CollSamp"))
  1. SAMPQ S Y=+$G(ORTEST("CollSamp",+X))
  1. Q Y
  1. ;
  1. ENSAMP ; -- Get list of samples to pick from
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) N I,CNT,X,Y S (I,CNT)=0
  1. F S I=$O(ORTEST("CollSamp",I)) Q:I'>0 S X=$G(ORTEST("CollSamp",I)) D
  1. . S Y=$P(X,U,1,2)_" "_$$GET1^DIQ(61,+$P(X,U,3)_",",.01)_" "_$P(X,U,4)
  1. . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=Y
  1. . S ORDIALOG(PROMPT,"LIST","B",$P(X,U,2))=+X
  1. S:CNT ORDIALOG(PROMPT,"LIST")=CNT_$S($$SECTION'="MI":"^1",1:"")
  1. Q
  1. ;
  1. ASKSAMP() ; -- Ask for Collection Sample?
  1. N X,Y,DIR,DEFSAMP,SAMP0
  1. S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0))
  1. I $G(ORTYPE)="Z",DEFSAMP Q 1
  1. I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) W !!,"Lab will collect "_$P(SAMP0,U)_" "_$P(SAMP0,U,3)_".",! Q 0
  1. I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask
  1. I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask
  1. I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice
  1. S DIR(0)="YA",DIR("A")="Is "_$P(SAMP0,U)_" "_$P(SAMP0,U,3)_" the correct sample to collect? ",DIR("B")="Yes"
  1. D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q 0
  1. D:'Y LIST^ORCD
  1. Q 'Y
  1. ;
  1. SECTION() ; -- Returns Lab section of Orderable Item
  1. N PTR,X
  1. S PTR=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
  1. S X=$P($G(^ORD(101.43,+$G(ORDIALOG(PTR,1)),"LR")),U,6)
  1. Q X
  1. ;
  1. SHOWCOMM(SAMP) ; -- Show comments for sample
  1. Q:'$G(SAMP) Q:'$G(ORTEST) N ORCOMM,I
  1. D SCOM^LR7OR3(+ORTEST,SAMP,.ORCOMM)
  1. S I=0 F S I=$O(ORCOMM(I)) Q:I'>0 W !,ORCOMM(I,0)
  1. Q
  1. ;
  1. SPECIMEN() ; -- Get default specimen from Sample for INST
  1. N X,Y I $L($G(LRFSPEC)) S Y=LRFSPEC
  1. E S X=$$VAL^ORCD("COLLECTION SAMPLE"),Y=+$P($G(^LAB(62,+X,0)),U,2)
  1. Q Y
  1. ;
  1. SPECHELP ; -- Xecutable help for Specimen prompt
  1. I '$D(^LAB(61,"E")) D P^ORCDLGH Q
  1. W !,"Choose from: "
  1. N SP,I,DONE,CNT S (CNT,DONE)=0,SP=""
  1. F S SP=$O(^LAB(61,"E",SP)) Q:SP="" S I=+$O(^(SP,0)) I I D
  1. . S CNT=CNT+1 I CNT>(IOSL-2) S CNT=0 I '$$MORE^ORCD S DONE=1 Q
  1. . W !," "_$P($G(^LAB(61,I,0)),U)
  1. Q
  1. ;
  1. URGENCY ; -- Get list of urgencies to pick from
  1. Q:$D(ORDIALOG(PROMPT,"LIST")) N I,J,X
  1. I $G(ORTEST("Default Urgency")) S ORDIALOG(PROMPT,"LIST")="1^1",ORDIALOG(PROMPT,"LIST",1)=ORTEST("Default Urgency") Q ; Forced Urgency
  1. I '$D(ORTEST("Urgencies")) S ORDIALOG(PROMPT,"LIST")="0^1" Q
  1. S (I,J)=0 F S I=$O(ORTEST("Urgencies",I)) Q:I'>0 D
  1. . S X=ORTEST("Urgencies",I) I $G(ORCOLLCT)="LC",'$P($G(^LAB(62.05,+X,0)),U,2) Q ; Lab cannot collect
  1. . S J=J+1,ORDIALOG(PROMPT,"LIST",J)=X,ORDIALOG(PROMPT,"LIST","B",$P(X,U,2))=+X
  1. S ORDIALOG(PROMPT,"LIST")=J_"^1"
  1. Q
  1. ;
  1. ASKURG() ; -- Ask urgency prompt?
  1. I $G(ORTEST("Default Urgency")) Q 0 ; Forced Urgency
  1. I FIRST,$G(ORL) Q $$GET^XPAR("ALL^"_ORL,"LR ASK URGENCY")
  1. Q (+$G(ORDIALOG(PROMPT,"LIST"))>1)
  1. ;
  1. REQDCOMM() ; -- Process required comments
  1. I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 0 ;edit as WP
  1. N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM
  1. S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN")
  1. S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0))
  1. S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6)
  1. S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19) Q:'REQDCOMM 1
  1. I $G(ORTYPE)="Z",$P($G(^LAB(62.07,+REQDCOMM,0)),U)'="ORDER COMMENT" Q 1
  1. X:$D(^LAB(62.07,REQDCOMM,.1)) ^(.1)
  1. S (CNT,I)=0 K REQDCOMM
  1. F S I=$O(LRTCOM(LRTEST(1),I)) Q:I'>0 S CNT=CNT+1,REQDCOMM(CNT,0)=LRTCOM(LRTEST(1),I)
  1. S:$L($G(LRCCOM)) CNT=CNT+1,REQDCOMM(CNT,0)=LRCCOM
  1. I CNT S REQDCOMM(0)="^^"_CNT_U_CNT_U_DT_U_U,ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"",$J,"_PROMPT_","_INST_")" M ^TMP("ORWORD",$J,PROMPT,INST)=REQDCOMM
  1. RQ Q 1
  1. ;
  1. XHELP(PTR) ; -- Xecutable help
  1. I $D(ORDIALOG(PTR,"LIST")),X="?"!$P(ORDIALOG(PTR,"LIST"),U,2) D LIST^ORCD Q
  1. D P^ORCDLGH ; ??-help
  1. Q
  1. ;
  1. CHANGED(FLD) ; -- Kill dependent values when FLD changes
  1. N PROMPTS,P,NAME,PTR K ORCOLLCT
  1. S PROMPTS="COLLECTION SAMPLE^SPECIMEN^WORD PROCESSING 1^START DATE/TIME"
  1. S:FLD="OI" PROMPTS="COLLECTION TYPE^"_PROMPTS_"^LAB URGENCY"
  1. F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P),PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) I PTR K ORDIALOG(PTR,ORI),ORDIALOG(PTR,"LIST")
  1. Q
  1. ;
  1. LB(ORDER) ; -- Returns 1 or 0, if "LB #" is already in text
  1. N I,Y S I=0,Y=0
  1. F S I=$O(^OR(100,+ORDER,1,I)) Q:I'>0 I $G(^(I,0))["LB #" S Y=1 Q
  1. Q Y
  1. ;
  1. DATE(X) ; Free text input to FM time
  1. N %DT,Y
  1. D ^%DT
  1. Q Y
  1. ;
  1. XSCH ; -- xecutable help for schedule prompt
  1. N X,IFN,CNT,Z,DONE
  1. K ^TMP($J,"ORSCLR XSCH")
  1. D AP^PSS51P1("LR",,,,"ORSCLR XSCH")
  1. W !!,"Choose from:" S CNT=1
  1. S X="" F S X=$O(^TMP($J,"ORSCLR XSCH","APLR",X)) Q:X="" S IFN=0 D Q:$G(DONE)
  1. .;S X="" F S X=$O(^PS(51.1,"APLR",X)) Q:X="" S IFN=0 D Q:$G(DONE)
  1. . F S IFN=$O(^TMP($J,"ORSCLR XSCH","APLR",X,IFN)) Q:IFN'>0 D Q:$G(DONE)
  1. . .;F S IFN=$O(^PS(51.1,"APLR",X,IFN)) Q:IFN'>0 D Q:$G(DONE)
  1. .. W !," "_X S CNT=CNT+1 Q:CNT'>(IOSL-5) S CNT=0
  1. .. W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
  1. W !
  1. K ^TMP($J,"ORSCLR XSCH")
  1. Q
  1. ;
  1. MULT(ORIFN,CTYPE,CDATE) ;check multiple orders from VALID^ORCDLR1
  1. N KID,OREVENT,ORSTRT,OK,X,Y,%DT
  1. I '$D(CTYPE) S CTYPE=$$VALUE^ORCSAVE2(ORIFN,"COLLECT")
  1. Q:"SPWC"[CTYPE 0 ; only check LC and I
  1. I '$D(CDATE) S CDATE=$$VALUE^ORCSAVE2(ORIFN,"START")
  1. D AM^ORCSAVE2:CDATE="AM",NEXT^ORCSAVE2:CDATE="NEXT" ; returns X
  1. S %DT="T" S:'$D(X) X=CDATE D ^%DT I Y<1 Q 0
  1. D SCHEDULE^ORCSEND1(ORIFN,"LR",.ORSTRT,Y) Q:ORSTRT'>1 0 ; get all starts
  1. S KID=0,OK=1 F S KID=$O(ORSTRT(KID)) Q:'KID!('OK) D
  1. . I CTYPE="LC" S OK=$$LABCOLL^ORCDLR1(KID) Q
  1. . S OK=$$IMMCOLL^ORCDLR1(KID)
  1. I OK Q 0
  1. Q "1^One or more of the multiple orders will be changed to Ward Collect"