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

ORCDVBEC.m

Go to the documentation of this file.
  1. ORCDVBEC ;SLC/MKB-Utility functions for VBECS dialogs ;2/11/08 11:04
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332**;Dec 17, 1997;Build 44
  1. ;
  1. ; External References:
  1. ; OEAPI^VBECA3 #4766
  1. ; RR^LR7OR1 #2503
  1. ; GCOM^LR7OR3 #2428
  1. ; $$SITE^VASITE #10112
  1. ; $$HL7TFM^XLFDT #10103
  1. ; $$UP^XLFSTR #10104
  1. ;
  1. PTR(X) ; -- Returns pointer to #101.41 of prompt OR GTX X
  1. Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
  1. ;
  1. EN ; -- entry action
  1. I '$L($T(OEAPI^VBECA3)) W $C(7),!!,"Blood Bank orders are not available yet!" H 2 S ORQUIT=1 Q
  1. N DIV,ORSTN,C,N,X S DIV=+$P($G(^SC(+$G(ORL),0)),U,15)
  1. S ORSTN=$P($$SITE^VASITE(DT,DIV),U,3)
  1. I $G(ORTYPE)'="Z" D OEAPI^VBECA3(.ORVB,+ORVP,ORSTN),PTINFO^ORCDVBC1
  1. I $G(OREVENT) S ORVB("SPECIMEN")="" ;assume no specimen if delayed
  1. S C=0 F S C=$O(ORVB(C)) Q:C<1 S N=0 F S N=$O(ORVB(C,"MSBOS",N)) Q:N<1 S X=$G(ORVB(C,"MSBOS",N)),ORMSBOS(C,$P(X,U))=$P(X,U,2) ;sort
  1. ;get initial state: ORCOMP/ORTEST = id^id^ ^id, ORTAS = 1 or 0:
  1. S (ORCOMP,ORTEST,ORTAS)="" I $D(OREDIT)!$G(OREWRITE) D
  1. . N P,I,X,X0 S P=$$PTR("ORDERABLE ITEM")
  1. . S I=0 F S I=$O(ORDIALOG(P,I)) Q:I<1 S X=+$G(ORDIALOG(P,I)) D
  1. .. S X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
  1. .. I $P(X0,U) S ORCOMP=ORCOMP_$S($L(ORCOMP):U,1:"")_X Q
  1. .. S ORTEST=ORTEST_$S($L(ORTEST):U,1:"")_X
  1. Q
  1. ;
  1. EX ; -- exit action
  1. K ORITM,ORCOMP,ORTEST,ORTAS,ORMSBOS,ORTIME,ORIMTIME,ORDIV,ORCOLLCT,ORVB,ORASK,ORSURG
  1. I $G(ORXL) S ORL=ORXL K ORXL
  1. Q
  1. ;
  1. XHELP ; -- display OI's in groups
  1. N INDEX,CNT,SCREEN,X,Y,SYN,Y0,D,Z,DONE
  1. S CNT=1,SCREEN=$G(ORDIALOG(PROMPT,"S"))
  1. F INDEX="S.VBC","S.VBT" D Q:$G(DONE)
  1. . W !!,$S(INDEX["C":"Choose from Blood Components:",1:"or Diagnostic Tests:")
  1. . S X="" F S X=$O(^ORD(101.43,INDEX,X)) Q:X="" S Y=0 D Q:$G(DONE)
  1. .. F S Y=$O(^ORD(101.43,INDEX,X,Y)) Q:Y'>0 S SYN=$G(^(Y)) I 'SYN D Q:$G(DONE)
  1. ... S Y0=$G(^ORD(101.43,Y,0)),D=INDEX X:$L(SCREEN) SCREEN Q:'$T
  1. ... W !," "_X ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
  1. ... 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. Q
  1. ;
  1. PSAOI ; -- set ORASK flags or show GenWrdInstructions for OI instance
  1. I $$DUP^ORCD(PROMPT,ORI) K DONE W $C(7),!,"This component or test has already been selected!",! Q
  1. N X0,NAME,ORT,ORWRD,WRD,I
  1. S ORASK=+$G(^ORD(101.43,+$G(Y),"VB")),X0=$G(^(0)) ;VBEC OI
  1. Q:ORASK Q:$G(ORESET)=+$G(Y) ;get ward instr for new tests
  1. S NAME=$P(X0,U,8),ORT=+$$TEST^ORCSEND2(NAME) ;corresponding Lab OI
  1. S ORT=+$P($G(^ORD(101.43,ORT,0)),U,2) ;#60 ien
  1. D GCOM^LR7OR3(ORT,.ORWRD) S WRD="GenWardInstructions"
  1. I $O(ORWRD(WRD,0)) W !! S I=0 F S I=$O(ORWRD(WRD,I)) Q:I'>0 W ORWRD(WRD,I,0),!
  1. Q
  1. ;
  1. MOD ; -- get allowable modifier values
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) N ORX,I,X
  1. D GETLST^XPAR(.ORX,"ALL","OR VBECS MODIFIERS","Q")
  1. S I=0 F S I=$O(ORX(I)) Q:I<1 D
  1. . S X=$P($G(ORX(I)),U,2) Q:'$L(X)
  1. . S ORDIALOG(PROMPT,"LIST",I)=X_U_X
  1. . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
  1. S:ORX ORDIALOG(PROMPT,"LIST")=ORX_"^1"
  1. Q
  1. ;
  1. PSAMT ; -- Post-Selection Action for Amount, to validate and format
  1. ; only allow numeric entry for now, until GUI can accept volume
  1. N X,X1,X2
  1. I +Y'=Y W !,$C(7),"Enter the number of units needed, from 1-99." K DONE Q
  1. S X=$$UP^XLFSTR(Y),X1=+X ;,X2=$$STRIP($P(X,X1,2))
  1. ;I X2="ML" S ORDIALOG(PROMPT,ORI)=X1_"ml" Q
  1. I (X1<1)!(X1>99) W !,$C(7),"Enter the number of units needed, from 1-99." K DONE Q ;!("UNITS"'[X2)
  1. S ORDIALOG(PROMPT,ORI)=X1 ;_" unit"_$S(X1>1:"s",1:"")
  1. Q
  1. ;
  1. SPCSTS ; -- set Specimen Status by component [Entry Action]
  1. I '$G(ORASK) K ORDIALOG(PROMPT,INST) Q ;not a component
  1. N OI,X S OI=+$G(ORDIALOG($$PTR("ORDERABLE ITEM"),INST))
  1. S X=+$P($G(^ORD(101.43,OI,0)),U,2)
  1. S ORDIALOG(PROMPT,INST)=$G(ORVB(X,"SPECIMEN"))_U_$G(ORVB("SPECIMEN"))
  1. Q
  1. ;
  1. EXOI ; -- setup dialog parameters for selected items
  1. N ORI,X,X0,TEST,COMP
  1. S (ORTAS,TEST,COMP)="" K ORASK
  1. S ORI=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI<1 D
  1. . S X=+$G(ORDIALOG(PROMPT,ORI)),X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
  1. . I $P(X0,U) S COMP=COMP_$S($L(COMP):U,1:"")_X Q
  1. . S TEST=TEST_$S($L(TEST):U,1:"")_X S:$P(X0,U,2)>1 ORTAS=1
  1. I ORTEST'=TEST S ORTEST=TEST K ORTEST("Lab CollSamp")
  1. I ORCOMP'=COMP S ORCOMP=COMP D CHANGED:'FIRST,COMP:COMP
  1. I ORCOMP,U[$G(ORVB("ABORH")),'ORTAS,$G(ORTYPE)'="Z" D ADDTAS
  1. Q
  1. ;
  1. COMP ; -- Handle component-specific tasks [from EXOI]
  1. ; Uses ORCOMP, ORVB(comp)
  1. Q:$G(ORTYPE)="Z" ;QO editor
  1. N ORP,ORI,ORT,ORTST,ORTMP,ORTDT,ORZ,ORHDR,OROOT,N
  1. F ORI=1:1:$L(ORCOMP,U) S ORC=$P(ORCOMP,U,ORI) D
  1. . S N=0 F S N=$O(ORVB(ORC,"TEST",N)) Q:N<1 S ORT=+$G(ORVB(ORC,"TEST",N)),ORTST(ORT)=""
  1. . I $G(ORVB(ORC,"SPECIMEN")),$P($G(ORVB("SPECIMEN")),U,2)="",'ORTAS D ADDTAS
  1. C1 S ORP=$$PTR("RESULTS"),(ORI,ORT)=0 F S ORT=+$O(ORTST(ORT)) Q:ORT<1 D
  1. . K ^TMP("LRRR",$J) D RR^LR7OR1(+ORVP,,,,,ORT,,1)
  1. . ;S ORTMP="^TMP(""LRRR"",$J,+ORVP)",ORTMP=$Q(@ORTMP)
  1. . ;Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_+ORVP)
  1. . S ORTMP=$$FIRST(+ORVP,ORT) Q:'$L(ORTMP)
  1. . S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
  1. . S ORI=ORI+1,ORDIALOG(ORP,ORI)=$P(ORZ,U,1,6)_U_ORTDT
  1. . W:'$G(ORHDR) !!,"RECENT LAB RESULTS:",!,"Test Result Units Range Collected Accession Sts"
  1. . W:'$G(ORHDR) !,"---- ------ ----- ----- --------- --------- ---"
  1. . W !,$$PAD^ORCHTAB($P(ORZ,U,15),8)_$J($P(ORZ,U,2),9)_" "_$$PAD^ORCHTAB($P(ORZ,U,3),3)_$$PAD^ORCHTAB($P(ORZ,U,4),11)_$$PAD^ORCHTAB($P(ORZ,U,5),10)_$$DATETIME^ORCHTAB(ORTDT)_" "_$$PAD^ORCHTAB($P(ORZ,U,16),15)_$P(ORZ,U,6)
  1. . S ORHDR=1,OROOT=$P(ORTMP,",",1,5)_",""N""" ;ck for comments
  1. . F S ORTMP=$Q(@ORTMP) Q:$P(ORTMP,",",1,6)'=OROOT W !," "_@ORTMP
  1. W:$G(ORHDR) ! K ^TMP("LRRR",$J)
  1. W !!,"NOTE: The nursing blood administration order must be entered separately."
  1. Q
  1. ;
  1. FIRST(DFN,TEST) ; -- returns array reference to first data node
  1. ; in ^TMP("LRRR",$J,DFN) for TEST
  1. N Y,IDT,DA S Y=""
  1. S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:IDT<1 D Q:Y
  1. . S DA=0 F S DA=$O(^TMP("LRRR",$J,DFN,"CH",IDT,DA)) Q:DA<1 I +$G(^(DA))=TEST S Y=1 Q
  1. I Y S Y=$NA(^TMP("LRRR",$J,DFN,"CH",IDT,DA))
  1. Q Y
  1. ;
  1. ADDTAS ; -- adds T&S to order, sets ORTAS=1
  1. ; Expects PROMPT=OI, ORTEST
  1. N ORI S ORI=$O(ORDIALOG(PROMPT,"?"),-1),ORI=ORI+1
  1. S ORDIALOG(PROMPT,ORI)=+$O(^ORD(101.43,"ID","1;99VBC",0))
  1. W !!,"Type & Screen added for new specimen."
  1. S ORTAS=1,ORTEST=$G(ORTEST)_$S($L($G(ORTEST)):U,1:"")_"1"
  1. Q
  1. ;
  1. CHANGED ; -- Kill dependent values when Component changes
  1. N PTR,I,J
  1. F I="FREE TEXT","RESULTS" S PTR=$$PTR(I) I PTR D
  1. . S J=0 F S J=$O(ORDIALOG(PTR,J)) Q:J<1 K ORDIALOG(PTR,J)
  1. . K ORDIALOG(PTR,"LIST")
  1. Q
  1. ;
  1. DTW ; -- Comp D/T Wanted to specimen exp d/t for TAS [DTW Exit Action]
  1. Q:'$G(ORVB("SPECIMEN")) Q:$G(ORTYPE)="Z"
  1. N X,Y,%DT,EXP,OK
  1. S X=$G(ORDIALOG(PROMPT,INST)),%DT="T" D ^%DT Q:Y<1
  1. S EXP=$$HL7TFM^XLFDT(+$G(ORVB("SPECIMEN"))),OK=1
  1. I EXP<Y D:'$G(ORTAS) ADDTAS S OK=0
  1. D UID(OK) ;[re]set Specimen UID
  1. Q
  1. ;
  1. UID(OK) ; -- [re]set the Specimen UID if DTW changes
  1. N SPCSTS,I,X
  1. S SPCSTS=$$PTR("SPECIMEN STATUS")
  1. S I=0 F S I=$O(ORDIALOG(SPCSTS,I)) Q:I<1 D
  1. . S X=$P(ORDIALOG(SPCSTS,I),U)_U_$S($G(OK):$G(ORVB("SPECIMEN")),1:"^")
  1. . S ORDIALOG(SPCSTS,I)=X
  1. Q
  1. ;
  1. REASON ; -- get allowable reasons
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) N ORX,I,X
  1. D GETLST^XPAR(.ORX,"ALL","OR VBECS REASON FOR REQUEST","Q")
  1. S I=0 F S I=$O(ORX(I)) Q:I<1 D
  1. . S X=$P($G(ORX(I)),U,2) Q:'$L(X)
  1. . S ORDIALOG(PROMPT,"LIST",I)=X_U_X
  1. . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
  1. S:ORX ORDIALOG(PROMPT,"LIST")=ORX ;_"^1"
  1. Q
  1. ;
  1. ENTYPE ; -- set up Coll Type
  1. I '$D(ORTEST("Lab CollSamp")) D
  1. . N I,V,T,LC S LC=1
  1. . F I=1:1:$L(ORTEST,U) S V=+$P(ORTEST,U,I) D Q:'LC ;no LC samp
  1. .. S T=$$LAB60(V) ;VBECS ID -> #60 ien
  1. .. I '$P($G(^LAB(60,T,0)),U,9) S LC=0 Q
  1. . S ORTEST("Lab CollSamp")=LC
  1. I '$D(ORTIME),'$D(ORIMTIME) D GETIMES^ORCDLR1
  1. Q
  1. ;
  1. LAB60(X) ; -- Return file 60 ien for VBECS OI ID
  1. N Y,I,NM
  1. S I=$O(^ORD(101.43,"ID",+X_";99VBC",0)),NM=$P($G(^ORD(101.43,+I,0)),U)_" - LAB"
  1. S Y=+$O(^LAB(60,"B",NM,0))
  1. Q Y
  1. ;
  1. ENSURG ; -- Get list of surgeries from ORVB("SURGERY")
  1. S:$P($G(^ORD(101.42,+$$VAL^ORCD("URGENCY"),0)),U,2)="P" REQD=1
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) K ORSURG
  1. N I,CNT,X S (I,CNT)=0
  1. F S I=$O(ORVB("SURGERY",I)) Q:I'>0 S X=$G(ORVB("SURGERY",I)) D
  1. . S ORSURG($P(X,U))=$P(X,U,2),X=$P(X,U) ;ORSURG(name)=NoBloodReqd
  1. . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_U_X
  1. . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=X
  1. S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
  1. Q
  1. ;
  1. CKMSBOS ; -- check if MSBOS limit exists, was exceeded [from PSA]
  1. Q:'$L($G(Y)) N OI,AMT,I,X,COMP,LIMIT
  1. I ORCOMP,$G(ORSURG($P(Y,U))) W !," >> No blood is required for this procedure!",! Q
  1. S OI=$$PTR("ORDERABLE ITEM"),AMT=$$PTR("AMOUNT")
  1. S I=0 F S I=$O(ORDIALOG(OI,I)) Q:I<1 D
  1. . S X=ORDIALOG(OI,I),COMP=+$P($G(^ORD(101.43,+X,0)),U,2)
  1. . S LIMIT=$G(ORMSBOS(COMP,$P(Y,U))) Q:LIMIT=""
  1. . Q:$G(ORDIALOG(AMT,I))'>LIMIT
  1. . W !," >> Requested #units of "_$P($G(^ORD(101.43,+X,0)),U)_" exceeds MSBOS limit of "_LIMIT_"!",!
  1. Q
  1. ;
  1. ENURG ; -- Get list of urgencies from #101.42, parameter
  1. Q:$G(ORDIALOG(PROMPT,"LIST")) N I,CNT,X S CNT=0
  1. S X="" F S X=$O(^ORD(101.42,"S.VBEC",X)) Q:X="" D
  1. . ;I X="STAT" Q:'$$GET^XPAR("ALL","OR VBECS STAT USER")
  1. . ;I X="STAT",'$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)) Q
  1. . S I=0 F S I=$O(^ORD(101.42,"S.VBEC",X,I)) Q:I<1 D
  1. .. S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=I_U_X
  1. .. S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR(X))=I
  1. S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
  1. Q
  1. ;
  1. ASKURG() ; -- ask unless PreOp, set default
  1. N Y S Y=1
  1. I FIRST,'$D(ORDIALOG(PROMPT,INST)),$G(ORTYPE)'="Z" D
  1. . I $$PREOP S ORDIALOG(PROMPT,INST)=+$O(^ORD(101.42,"C","P",0)),Y=0 Q
  1. . S ORDIALOG(PROMPT,INST)=9 ;default
  1. Q Y
  1. ;
  1. PREOP() ; -- Returns 1 or 0, if order is for pre-op
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="YAO",DIR("A")="Is this order for pre-op? "
  1. S DIR("?")="If YES, the urgency will be set to PRE-OP and a surgery name will be required"
  1. S DIR("B")="NO" D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
  1. Q +Y