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

LAKDIFF.m

Go to the documentation of this file. 
  1. LAKDIFF ;DALOI/RWF - KEYBOARD DIFFERENTIAL COUNTER ;8/16/90  10:38
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**13,52**;Sep 27, 1994
  1.  ;
  1.  ; Cross link by id = accession
  1.  ;
  1. LA1 ;
  1.  I '$D(LRPARAM) D ^LRPARAM
  1.  ;
  1.  D HOME^%ZIS
  1.  ;
  1.  S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)),U="^"
  1.  I TSK<1 D  Q
  1.  . W !,"Unable to find entry in AUTO INSTRUMENT file using ",LANM," as PROGRAM NAME"
  1.  . D QUIT
  1.  ;
  1.  W !!?20,"KEYPAD DIFF ENTRY",!!
  1.  ;
  1.  S LREND=0,LRTOP=$P(^LAB(69.9,1,1),U,1)
  1.  D ^LASET
  1.  I 'TSK D  Q
  1.  . W $C(7),!!,"AUTO INSTRUMENT file is incompletly defined for the Keypad Diff."
  1.  . D QUIT
  1.  ;
  1.  I LALCT="N" D  Q
  1.  . W $C(7),!!,"Field LOAD CHEM TESTS is configured incorrectly in AUTO INSTRUMENT File"
  1.  . W !,"Set it to either 'TC ARRAY' or 'TMP GLOBAL'."
  1.  . D QUIT
  1.  ;
  1.  K ^LA("LOCK",TSK)
  1.  ;
  1.  S DTIME=$$DTIME^XUP(DUZ)
  1.  S DT=$$DT^XLFDT
  1.  ;
  1.  D DISPLAY
  1.  I LREND D QUIT Q
  1.  ;
  1.  ; Select accession date to use
  1.  S LRAA=+$G(WL)
  1.  I LRAA<1 D QUIT Q
  1.  D ADATE^LRWU
  1.  I LREND D QUIT Q
  1.  ;
  1.  ; Get last accession used on this date if any
  1.  S LRAN=+$P($G(^LRO(68,LRAA,1,LRAD,2)),"^",4)
  1.  ;
  1.  I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV
  1.  I LREND D QUIT Q
  1.  ;
  1.  D INT
  1.  ;
  1.  ; Setup screen and keyboard
  1.  S LAXGF=1 D PREP^XGF
  1.  ;
  1.  ; Set read terminator to <CR>. Otherwise problems in scroll&roll sections.
  1.  D INITKB^XGF($C(13))
  1.  ;
  1.  ; Turn on echo, cursor, keypad in numeric mode
  1.  X ^%ZOSF("EON") W IOCUON_IOKPNM
  1.  ;
  1.  ; Get code to erase entire display
  1.  S X="IOEDALL" D ENDR^%ZISS
  1.  ;
  1.  F  D LA2 Q:LREND
  1.  D QUIT
  1.  ;
  1.  Q
  1.  ;
  1. LA2 ;
  1.  N CUP,FLAG,I,ID,IDE,LADFN,LADT,LAOK,TRAY,TV,X,Y
  1.  ;
  1.  S RMK=""
  1.  F  D WLN Q:LREND!(LAOK)
  1.  I LREND Q
  1.  S FLAG=0
  1.  ;
  1.  ; Save value of LRDFN, call to LAGEN sets it to 0
  1.  S LADFN=LRDFN
  1.  S (ID,LOG)=LRAN,IDE=0,LADT=LRAD
  1.  S TRAY=1,CUP=""
  1.  ;Can be changed by the cross-link code
  1.  X LAGEN
  1.  I 'ISQN D  Q
  1.  . W !!,$C(7),"Unable to create entry in LAH global",!
  1.  ;
  1.  S LRDFN=LADFN
  1.  ;
  1.  D ^LAKDIFF1
  1.  I 'FLAG D ^LAKDIFF2
  1.  I FLAG Q
  1.  ;
  1.  S I=0
  1.  F  S I=$O(TV(I)) Q:I<1  S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
  1.  I $L($G(RMK)) D RMK^LASET
  1.  ;
  1.  D ^LAKDIFF3
  1.  Q
  1.  ;
  1. WLN ; Select accession/patient to work with
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S LAOK=0
  1.  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN))
  1.  I LRAN'>0 S LRAN="^"
  1.  S DIR(0)="NO^1:9999999:0^K:'$D(^LRO(68,LRAA,1,LRAD,1,X,0)) X"
  1.  S DIR("A")="Accession Number",DIR("B")=LRAN
  1.  S DIR("?")="Enter a valid accession number to enter DIFF results on."
  1.  D ^DIR
  1.  I $D(DIRUT) S LREND=1 Q
  1.  S LRAN=Y
  1.  ;
  1.  S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRACC=$S($D(^(.2)):^(.2),1:"")
  1.  S LRODT=$S($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
  1.  S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
  1.  ;
  1.  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
  1.  D PT^LRX
  1.  ;
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  ;
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Patient name: "_PNM_"  SSN: "_SSN_"  Acc: "_LRACC
  1.  S DIR("A")="Is this the correct patient"
  1.  S DIR("B")="YES"
  1.  D ^DIR
  1.  ;
  1.  I $D(DIRUT) S LREND=1 Q
  1.  I Y=1 S LAOK=1
  1.  Q
  1.  ;
  1. INT ;
  1.  N I1,I2,I3,I4,LAI,LAJ,X
  1.  ;
  1.  K KEY
  1.  ;
  1.  I LALCT="T" D
  1.  . M ^TMP("LA",$J)=TC
  1.  . K TC
  1.  ;
  1.  S LAI=0
  1.  F  S LAI=$O(^TMP("LA",$J,LAI)) Q:LAI'>0  D
  1.  . S LAJ=$S(LAI<30:"W",1:"R")
  1.  . S I3=^(LAI,3),I4=^(4),X=^(0)
  1.  . ;
  1.  . I $D(KEY(LAJ,I4)) D  Q
  1.  . . W $C(7),!!,">> The same KEY (",I4,") is set for more than one TEST<<",!!,$C(7)
  1.  . ;
  1.  . S I1=$P(^LAB(60,X,.1),U,1),I2=+^(.2)
  1.  . S ^TMP("LA",$J,LAI,.1)=I1,^(.2)=I2
  1.  . S ^TMP($J,LAJ,LAI)=I4,KEY(LAJ,I4)=""
  1.  . I I3=2 S ^TMP($J,"NC",LAI)=""
  1.  Q
  1.  ;
  1. DISPLAY ; Ask user if display should be updated on each key press
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,LAXPAR,X,Y
  1.  ;
  1.  ; Get stored value from parameter tool
  1.  S X=$$GET^XPAR("USR","LA KDIFF DISPLAY UPDATE",1,"E")
  1.  ;
  1.  I $L(X) S DIR("B")=X
  1.  E  S DIR("B")="YES"
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Update display on each key press"
  1.  D ^DIR
  1.  I $D(DIRUT) S LREND=1 Q
  1.  ;
  1.  S LAUPDATE=Y
  1.  ; Save parameter for future use
  1.  D EN^XPAR("USR","LA KDIFF DISPLAY UPDATE",1,Y,.LAXPAR)
  1.  Q
  1.  ;
  1. QUIT ;
  1.  ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  ;
  1.  I $G(LAXGF) D
  1.  . D CLEAN^XGF
  1.  . D KILL^%ZISS
  1.  ;
  1.  S LREND=0
  1.  I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D
  1.  . K ^XTMP("LRCAP",LRCSQ,DUZ)
  1.  . K LRCSQ
  1.  ;
  1.  I $D(LRCSQ),$G(LRAA),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
  1.  ;
  1.  D STOP^LRCAPV
  1.  D ^LRGVK
  1.  ;
  1.  K %,ACK,ASK,BASE,C,CENUM,CHK,CNT,CODE,CONT,CUP,DA,DATYP,DFN,DONE,DPF,ECHOALL,ER,FLAG,HDR,HOME,HRD,I,I1,I3,I4,ID,IDE,IDENT,IDT,IN,ISQN,J,K,KEY,L,LAGEN,LACT,LALCT,LANM,LAUPDATE,LAXGF,LINE
  1.  K LINK,LOG,LRAA,LRACC,LRAD,LRAN,LRDFN,LRDPF,LRDY,LREND,LRIDT,LRIO,LRLL,LRODT,LROVER,LRPGM,LRSET,LRSN,LRSUBS,LRTIME,LRTOP,LRTST,LWL,M,METH,NAK,NC,NOW,OUT,PNM,Q,RMK,RT,SS
  1.  K SSN,STORE,T,T1,T2,TC,TEMP,TOTAL,TOUT,TP,TQ,TRAP,TRAY,TRY,TSK,TV,TY,TYPE,V,WDT,WL,X,Y,YY,Z,ZTSK
  1.  ;
  1.  K ^TMP($J),^TMP("LA",$J),^TMP("LR",$J)
  1.  Q
  1.  ;
  1. TRAP ; Error Trap
  1.  D ^LABERR
  1.  S T=TSK D SET^LAB
  1.  G @("LA2^"_LANM)