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

LRORD.m

Go to the documentation of this file.
  1. LRORD ;DALOI/CJS - LAZY ACCESSION LOGGING ;05/29/12 10:25
  1. ;;5.2;LAB SERVICE;**100,121,153,286,350**;Sep 27, 1994;Build 230
  1. ;
  1. EN ;;
  1. I $D(^LAB(69.9,1,"RO")),+$H'=+^("RO") W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),!," Are you sure you want to continue"
  1. I $T S %=2 D YN^DICN W:%=0 !,"If you continue to accession, you may block accessions from yesterday from",!,"rolling over." G LRORD:%=0 I %'=1 W !,"OK, try later." Q
  1. EN1 ;;from LROR4
  1. D EN^LRPARAM
  1. K ^TMP("LRSTIK",$J),DIC,LRURG,LRSAME,LRCOM,LRNATURE,LRTCOM
  1. S LRORDTIM="" S:'$D(LRORDR) LRORDR="" D DT^LRX
  1. I $D(LRADDTST) Q:LRADDTST=""
  1. S LRFIRST=1,LRODT=DT,U="^",LRECT=0,LROUTINE=$P(^LAB(69.9,1,3),U,2)
  1. S:$G(LRORDRR)="R" LRECT=1,LRFIRST=0
  1. I '$G(LRECT),LRORDR="" W !!,"WANT TO ENTER COLLECTION TIMES? Y//" D % S LRECT='(%["N") G KILL:$E(%)="^"
  1. I LRORDR="LC" W !!," Ordering for ROUTINE LAB COLLECT ONLY",$C(7),! S LRLWC="LC",LRLLOC=".",LREND=0 D NEXTCOL^LROW5 G KILL:LREND
  1. I LRORDR="SP" W !!," Ordering for SEND PATIENT ONLY",$C(7),! S LRLWC="SP"
  1. I LRORDR="WC" W !!,"Ordering for WARD COLLECT & DELIVER ONLY",$C(7),! S LRLWC="WC"
  1. I LRORDR="I" D ^LRORDIM G KILL:'$D(LRCDT)
  1. L5 I LRORDR]"",LRORDR'="LC",LRORDR'="I" S %DT="AET",%DT("A")=$S(LRORDR="WC":"COLLECTION",LRORDR="SP":"PATIENT VISIT",1:"")_" DATE: "
  1. I $T D DATE^LRWU G KILL:Y<1 S LRORDTIM=$P(Y,".",2),LRODT=$P(Y,".",1),X1=Y,X2=DT D ^%DTC IF X>370 W !,"Can't order more than 12 months ahead!!" G L5
  1. I $D(LRODT),$P(LRODT,".")?7N,'+$E($P(LRODT,"."),6,7) W !!?7,$C(7),"Please enter a date, ie. 4/1/90",!! G L5
  1. I $D(LRODT),$P(LRODT,".")<DT W !,$C(7),"Cannot order in the Past.",! G L5
  1. I $D(LRFLOG) S Y=LRFLOG G G0:LRFLOG>0
  1. S DIC="^LAB(62.6,",DIC(0)="AEQMZ"
  1. S DIC("S")=$S($D(LRLABKY):"I '(LRORDR=""LC""&'$P(^(0),U,4))",1:"I '(LRORDR=""LC""&'$P(^(0),U,4))&'$P(^(0),U,3)")
  1. D ^DIC K DIC G KILL:$D(DUOUT)!$D(DTOUT),G1:Y<1 S LRFLOG=Y
  1. G0 S $P(LRFLOG,U,3)=$P(^LAB(62.2,+$P(^LAB(62.6,+LRFLOG,0),U,2),0),U,2)
  1. S LRFLOG(0)=^LAB(62.6,+LRFLOG,0)
  1. S (LRWP,I)=0
  1. F S I=$O(^LAB(62.6,+Y,1,I)) Q:I<1 D
  1. . S Y(0)=$G(^LAB(62.6,+Y,1,I,0)),LRWP=LRWP+1
  1. . S ^TMP("LRSTIK",$J,$S($P(LRFLOG(0),"^",5):I,1:LRWP))=Y(0)
  1. . ; Lookup by number user enters.
  1. . S ^TMP("LRSTIK",$J,"B",LRWP)=$S($P(LRFLOG(0),"^",5):I,1:LRWP)
  1. . ; Lookup by test - used by LEDI (LRORDB) when user creates list "on-the-fly"
  1. . S ^TMP("LRSTIK",$J,"C",+Y(0),$S($P(LRFLOG(0),"^",5):I,1:LRWP))=""
  1. I LRWP>40 S LRFIRST=0 ; Don't automatically display "long" test lists.
  1. G G5
  1. G1 S LRWP=0 W !,"Select one or more tests from which you will be generating your entries."
  1. GET D Q15^LRORD2
  1. D ^DIC K DIC("S") G:Y<1 G5
  1. S LRWP=LRWP+1,LRY=Y
  1. S ^TMP("LRSTIK",$J,LRWP)=$P(LRY,U,1,2)
  1. ; "B" Used to lookup by number user enters.
  1. S ^TMP("LRSTIK",$J,"B",LRWP)=LRWP
  1. ; "C" Used by LEDI (LRORDB)
  1. S ^TMP("LRSTIK",$J,"C",+LRY,LRWP)=""
  1. S LRTSTS=+^TMP("LRSTIK",$J,LRWP) D GS^LRORD3
  1. S:+LRSAMP=-1&(LRSPEC=-1) LRWP=LRWP-1
  1. G GET:+LRSAMP=-1&(LRSPEC=-1)
  1. S ^TMP("LRSTIK",$J,LRWP)=^TMP("LRSTIK",$J,LRWP)_U_LRSAMP_U_U_LRSPEC
  1. G GET
  1. ;
  1. G5 G KILL:LRWP<1
  1. S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""
  1. S LRURG="",LRAD=DT,LRWPD=LRWP\2+(LRWP#2) D ^LRORD1
  1. KILL D ^LRORDK,HOME^%ZIS Q
  1. % R %:DTIME Q:%=""!(%["N")!(%["Y")!($E(%)="^") W !,"Answer 'Y' or 'N': " G %
  1. EN01 ;LAB COLLECT ORDER ENTRY
  1. ORDER S %=2 W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G ORDER
  1. S LRORDR="LC",LRLWCURG=$S($P(^LAB(69.9,1,3),U,2)'="":$P(^(3),U,2),1:9) G LRORD
  1. EN02 ;SEND PATIENT ORDER ENTRY
  1. SENDPAT S %=2 W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G SENDPAT
  1. S LRORDR="SP" G LRORD
  1. IMMCOL ;IMMEDIATE LAB COLLECTION
  1. I '$P($G(^LAB(69.9,1,7,DUZ(2),0)),U,6) W !!?5," This option is not available at the time ",!!,$C(7) Q
  1. S LRORDR="I" K LRODT G LRORD
  1. ;
  1. EN03 ;WARD COLLECT ORDER ENTRY
  1. WARDCOL ;
  1. S %=2
  1. W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G WARDCOL
  1. S LRORDR="WC" D LRORD
  1. Q
  1. ;
  1. ;
  1. LEDI ; Laboratory Electronic Data Exchange
  1. ; This entry point is used to select patients from ^LRT(67, file
  1. ; Routine LRDPAREF controls patient selection, patients must already
  1. ; exist in ^DPT in order to be selected.
  1. D ^LRPARAM
  1. I $G(LREND) D ^LRORDK Q
  1. N CONTROL,LA7,LA7SCFG,LA7X,LA7Y,LR64,LR696,LRLABLIO,LRRSTAT,LRRSITE,LRSD,LRTSN
  1. S LRREFBAR=$$BAR^LA7SBCR
  1. I LRREFBAR<0 D ^LRORDK Q
  1. S LRRSTAT="I"
  1. S LRRSTAT(0)=$$FIND1^DIC(64.061,"","OMX","Specimen in process","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
  1. D SITE^LA7SBCR2(.LRRSITE,"Scan Remote Site Barcode (SM)",LRREFBAR)
  1. I LRRSITE("ERROR") D Q
  1. . W !!,$C(7),"ERROR -- ",$P(LRRSITE("ERROR"),"^",2),!
  1. . D ^LRORDK
  1. ;
  1. ; Handle inter-divisional manifests
  1. I DUZ(2)=$P(LRRSITE("HSITE"),"^"),$$KSP^XUPARAM("INST")=$P(LRRSITE("RPSITE"),"^") D INTERDIV^LA7SMA(.LRRSITE),^LRORDK Q
  1. ;
  1. ; Get shipping manifest ID manual input
  1. I $G(LRRSITE("SMID"))="" D
  1. . F D SMID^LRORDB Q:LREND!($G(LRRSITE("SMID"))'="")
  1. I $G(LREND) D ^LRORDK Q
  1. ;
  1. ; LRORDRR="R" variable indicates host accessioning of remote orders
  1. S LRORDRR="R",LRORDR="" K LRODT
  1. D LRORD,^LRORDK
  1. Q
  1. ;
  1. ;
  1. ; LRORDRR =TYPE OF ORDER, LRECT =ASK COLECTION TIME
  1. ; LRFLOG =ACCESSION TEST GROUP, IF DEFINED ON ENTRY, PRESELECTS GROUP
  1. ;
  1. QUIZ W !,"The order copy is automatically sent to the CLOSEST PRINTER,"
  1. W !,"if a closest printer is defined for the device you are using."
  1. W !,"Otherwise, you will be prompted with ORDER COPY DEVICE.",!
  1. Q