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

LRWRKLS1.m

Go to the documentation of this file. 
  1. LRWRKLS1 ;DALOI/CJS/DRH - LRWRKLST, CONT. ; 13-Oct-2017 14:04 ; MKK
  1.  ;;5.2;LAB SERVICE;**1003,1004,121,153,185,268,1018,1025,1027,1041**;NOV 01, 1997;Build 23
  1.  ;
  1. LST1 ;from LRWRKLST
  1.  D CHKPAGE
  1.  Q:$G(LRSTOP)=1
  1.  S LRDX=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRCE=$S($D(^(.1)):^(.1),1:""),LRACC=$S($D(^(.2)):^(.2),1:"")
  1.  Q:'$D(^LR(+LRDX,0))#2
  1.  ;
  1.  S LRDPF=$P(^LR(+LRDX,0),U,2),DFN=$P(^(0),U,3)
  1.  D PT^LRX
  1.  ;
  1.  S (LRDLA,LRDLC,LRACO)=""
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) D
  1.  . N LRY
  1.  . S LRY=^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRACO=$P(LRY,U,6)
  1.  . S LRDLC=$$FMTE^XLFDT($P(LRY,"^"),"5MZ")
  1.  . S LRDLA=$$FMTE^XLFDT($P(LRY,"^",3),"5MZ")
  1.  S LRDTO=$$FMTE^XLFDT($P(LRDX,"^",4),"5MZ")
  1.  ;
  1.  W ! D DASH^LRX
  1.  ;
  1.  S LN=$G(LN)+1
  1.  D CHKPAGE
  1.  Q:$G(LRSTOP)
  1.  ;
  1.  W !,"ACCESSION: ",LRACC,?40,"PATIENT: ",PNM
  1.  ;W !,"  ORDER #: ",LRCE,?41,"SSN/ID: ",SSN,!
  1.  ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
  1.  W !,"  ORDER #: ",LRCE,?43,"HRCN: ",HRCN,!
  1.  ;----- END IHS MODIFICATIONS - NOTE- COULD NOT COPY DIRECT FROM IHS RTN
  1.  S X=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
  1.  W:X'="" ?6,"UID: ",X
  1.  W ?44,"DOB: ",$$FMTE^XLFDT(DOB,"5MZ")
  1.  W !," LOCATION: ",$E($P(LRDX,"^",7),1,19)
  1.  ; W:$L(LRDTO) ?35,"DATE ORDERED: ",LRDTO,!
  1.  ; ----- BEGIN IHS LR*5.2*1025 MODIFICATION
  1.  ; I $D(LRCE)>0 D                                            ; Does Order exist
  1.  I +$G(LRCE)>0 D                            ; Does Order exist -- LR*5.2*1027
  1.  . NEW DTTORD,FMDTORD,LRORDIEN
  1.  . S FMDTORD=+$O(^LRO(69,"C",LRCE,""))                     ; Date Ordred
  1.  . I FMDTORD<1 Q                                           ; If null, skip
  1.  . S LRORDIEN=+$O(^LRO(69,"C",LRCE,FMDTORD,""))            ; LRAN of Order
  1.  . I LRORDIEN<1 Q                                          ; If null, skip
  1.  . S DTTORD=+$P($G(^LRO(69,FMDTORD,1,LRORDIEN,0)),"^",5)   ; Date/Time of Order
  1.  . I $D(DTTORD)<1 Q                                        ; If null, skip
  1.  . ;
  1.  . W ?40,"ORDERED: ",$$FMTE^XLFDT(DTTORD,"5MZ"),!
  1.  ; ----- END IHS LR*5.2*1025 MODIFICATION
  1.  W:$P(LRDX,U,6) "    IDENTITY: ",$P(LRDX,U,6)
  1.  W:$L(LRDLC) ?38,"COLLECTED: ",LRDLC
  1.  ;
  1.  S (LRPRAC,LRX)=$P(LRDX,"^",8)
  1.  I LRPRAC S LRX=$$GET1^DIQ(200,LRPRAC_",",.01)
  1.  I LRX="" S LRX=$S($L(LRPRAC):LRPRAC,1:"UNKNOWN")
  1.  W !," PROVIDER: ",LRX
  1.  W:$L(LRDLA) ?36,"LAB ARRIVAL: ",LRDLA
  1.  S LN=$G(LN)+6
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1041
  1.  W !," ACCESSION PERSON: ",$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,"LOG-IN PERSON")
  1.  S LN=$G(LN)+1
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1041
  1.  ;
  1.  N PRAC,PR
  1.  D PRAC^LR7OMERG(LRAA,LRAD,LRAN,.PRAC)
  1.  S PR=0
  1.  F  S PR=$O(PRAC(PR)) Q:PR<1  W !?11,$$GET1^DIQ(200,PR_",",.01) S LN=LN+1
  1.  ;
  1.  D CHKPAGE
  1.  Q:$G(LRSTOP)=1
  1.  ;
  1.  ;
  1.  D LEDI
  1.  ;
  1.  ; Find and print order comments from file #69 
  1.  S X1=+$P(LRDX,U,4),X2=+$P(LRDX,U,5)
  1.  I $D(^LRO(69,X1,1,X2,6)) D
  1.  . W !,"  Order Comment:" S LN=LN+1
  1.  . S I=0
  1.  . F  S I=$O(^LRO(69,X1,1,X2,6,I)) Q:I<1  W !?11,^(I,0) S LN=LN+1 D CHKPAGE Q:$G(LRSTOP)
  1.  ;
  1.  ;
  1. TSTCOM ; Display test comments
  1.  ;
  1.  N LRI,LRX,LRY
  1.  ;
  1.  Q:$G(LRSTOP)
  1.  ;
  1.  ; Check for canceled test and print test and cancel reason
  1.  S LRI=0
  1.  F  S LRI=$O(^LRO(69,X1,1,X2,2,LRI)) Q:LRI<1  D
  1.  . S LRX=$G(^LRO(69,X1,1,X2,2,LRI,0))
  1.  . I '$P(LRX,"^",11) Q
  1.  . W !,"  CANCELED TEST: ",$P($G(^LAB(60,+LRX,0),"UNKNOWN"),"^")
  1.  . W " "_$E($P($G(^LAB(62.05,+$P(LRX,"^",2),0),"ROUTINE"),"^"),1,15)
  1.  . W " by: "_$$GET1^DIQ(200,+$P(LRX,"^",11)_",",.01)
  1.  . S LN=LN+1,LRI(2)=0
  1.  . F  S LRI(2)=$O(^LRO(69,X1,1,X2,2,LRI,1.1,LRI(2))) Q:LRI(2)<1  D  Q:$G(LRSTOP)
  1.  . . S LRY=$G(^LRO(69,X1,1,X2,2,LRI,1.1,LRI(2),0))
  1.  . . W !?3,": "_LRY
  1.  . . S LN=LN+1 D CHKPAGE
  1.  ;
  1.  I $L(LRACO) W !,"  Accession Comment: ",LRACO S LN=LN+1
  1.  ;
  1.  I $L($P(LRDX,U,6,7))>1 W ! S LN=LN+1
  1.  Q
  1.  ;
  1.  ;
  1. CHKPAGE ;
  1.  ; Check if task and user wants to stop task.
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD D  Q
  1.  . S (LRSTOP,ZTSTOP)=1
  1.  . W !!,"*** Report requested to stop by TaskMan ***"
  1.  . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
  1.  ;
  1.  Q:$G(LRSTOP)!($D(ZTQUEUED))!($E(IOST,1,2)'="C-")
  1.  Q:$G(LN)<(IOSL-2)
  1.  K DIR
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I $D(DIRUT) S (LREND,LRSTOP)=1
  1.  S LN=1
  1.  W !
  1.  Q
  1.  ;
  1.  ;
  1. LEDI ; print LEDI information
  1.  ;
  1.  N LRIENS,LRUID,LRX,LRY
  1.  ;
  1.  S LRY=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),LRIENS=LRAN_","_LRAD_","_LRAA_","
  1.  ;
  1.  S LRX=$$GET1^DIQ(68.02,LRIENS,16.1),LRUID=$P(LRY,"^",5)
  1.  I $L(LRX)!($L(LRUID)) D
  1.  . W !!
  1.  . I $L(LRX) W $J($$GET1^DID(68.02,16.2,"","LABEL")_": ",17),$E(LRX,1,20)
  1.  . I $L(LRUID) W ?40,$$GET1^DID(68.02,16.4,"","LABEL"),": ",LRUID
  1.  . S LN=LN+2
  1.  ;
  1.  S LRX=$$GET1^DIQ(68.02,LRIENS,16.2)
  1.  I $L(LRX) D
  1.  . W !,$J($$GET1^DID(68.02,16.1,"","LABEL")_": ",17),$E(LRX,1,20)
  1.  . S LN=LN+1
  1.  ;
  1.  Q