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

LR7OGMC.m

Go to the documentation of this file. 
  1. LR7OGMC ;DALOI/STAFF- Interim report rpc memo chem ;July 29, 2019@10:00
  1.  ;;5.2;LAB SERVICE;**187,230,312,286,356,372,395,350,516,523,527**;Sep 27, 1994;Build 16
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; sets lab data into ^TMP("LR7OG",$J,"TP"
  1.  ; ^TMP("LR7OG",$J,"G")=dfn^pnm^lrdfn^age^sex^lrcw
  1.  ; ^TMP("LR7OG",$J,"TMP",LR Subscript)=ifn of test from 60
  1.  ; ^TMP("LR7OG",$J,"T",ifn 60)=^LAB(60,IFN,0)
  1.  ; ^TMP("LR7OG",$J,"TP",collect date/time)=zero node from data
  1.  ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder)=test#^name^printname^^printcode^dataname^result^flag^units^range^performing site
  1.  ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder,#)=interpretation
  1.  ; ^TMP("LR7OG",$J,"TP",collect date/time,"C",#)=comment
  1.  ; ALL = 1 when coming from INTERIMG^LR7OGM (Most Recent)
  1.  ;
  1.  ;
  1. CH(LRDFN,IDT,ALL,OUTCNT,FORMAT,DONE,SKIP) ; from LR7OGM
  1.  N ACC,AREA,ACDT,CDT,CHSUB,CMNT,GOTNP,INTP,LABSUB,LRAAT,LRAD,NUM,PNODE
  1.  N PORDER,SPEC,TCNT,TESTNUM,TESTSUB,UID,ZERO,LRORUT
  1.  ;
  1.  S GOTNP=0,ZERO=$G(^LR(LRDFN,"CH",IDT,0)),UID=$P($G(^("ORU")),"^")
  1.  I UID'="" S UID=$$CHECKUID^LRWU4(UID)
  1.  S AREA=$P(UID,"^",2),ACDT=$P(UID,"^",3),NUM=$P(UID,"^",4)
  1.  S CDT=+ZERO,LABSUB="CH",TCNT=0,SPEC=$P(ZERO,U,5)
  1.  ;
  1.  D GETNP ;Check for NP comments
  1.  ;LR*5.2*527: commenting out line below so that "not performed" ordered
  1.  ;            tests will display.
  1.  ;I FORMAT,GOTNP S SKIP=1 Q
  1.  I GOTNP,'$P(ZERO,U,3) D  Q
  1.  . N LRXQUIT
  1.  . S LRXQUIT=1
  1.  . D ACC:UID
  1.  . ;LR*5.2*527: The line below would not have been called in the 
  1.  . ;            pre-LR 527 version of this routine because GOTNP=1
  1.  . ;            and FORMAT=1.
  1.  . ;            Leaving it here commented out in case it is needed
  1.  . ;            in the future for some reason.
  1.  . ;I $O(^TMP("LR7OG",$J,"TP",CDT,0)) K:FORMAT ^TMP("LR7OG",$J,"TP",CDT) D CHKNP Q
  1.  . ;LR*5.2*527: adding logic to retrieve information for ordered tests
  1.  . ;            which have been marked "not performed".
  1.  . S LRORUT=0
  1.  . F  S LRORUT=$O(^LR(LRDFN,"CH",IDT,"ORUT",LRORUT)) Q:'LRORUT  D
  1.  . . S TESTNUM=$P($G(^LR(LRDFN,"CH",IDT,"ORUT",LRORUT,0)),U,13)
  1.  . . Q:'TESTNUM
  1.  . . I '("BO"[$P($G(^LAB(60,TESTNUM,0)),U,3)) Q
  1.  . . Q:'$D(^LAB(60,TESTNUM,.1))  S PNODE=^(.1)
  1.  . . ;Checking for existence of "ALL" as well as value in case this option is called
  1.  . . ;from an option which only selects certain tests and is not the CPRS Labs Tab
  1.  . . ;"Selected Tests by Date" report.
  1.  . . ;Selected tests will be in ^TMP("LR7OG" and TESTS(TESTNUM)
  1.  . . ;Setting flag to check whether at least this test was selected.
  1.  . . I $D(ALL),'$G(ALL),$D(^TMP("LR7OG",$J,"T",TESTNUM)),$D(TESTS(TESTNUM)) S LRXQUIT=0
  1.  . . ;Do not display this test if it was not selected.
  1.  . . I $D(ALL),'$G(ALL),'$D(^TMP("LR7OG",$J,"T",TESTNUM)),'$D(TESTS(TESTNUM)) Q
  1.  . . S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:1/1000000)
  1.  . . F  Q:'$D(^TMP("LR7OG",$J,"TP",CDT,PORDER))  Q:TESTNUM=+^(PORDER)  S PORDER=PORDER+1
  1.  . . I $D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q
  1.  . . S ^TMP("LR7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_"X"_U_$P(^(0),U,5)_U_"Test Not Performed"
  1.  . ;Quit if no "not performed" tests were selected
  1.  . I $D(ALL),'$G(ALL),LRXQUIT Q
  1.  . S ^TMP("LR7OG",$J,"TP",CDT)=ZERO
  1.  . D CMT
  1.  . I 'FORMAT D PRINT^LR7OGMP(.OUTCNT)
  1.  . I FORMAT D
  1.  . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^CH^"_(9999999-IDT)
  1.  . . S OUTCNT=OUTCNT+1,DONE=1
  1.  . . D GRID^LR7OGMG(.OUTCNT)
  1.  . K ^TMP("LR7OG",$J,"TP")
  1.  ;LR*5.2*527: end of added lines in this section
  1.  ;
  1.  D ACC:UID,VER
  1.  I '$O(^TMP("LR7OG",$J,"TP",CDT,0)) S SKIP=1 Q
  1.  ;LR*5.2*527: Line below not changed. But this logic doesn't seem
  1.  ;            to cause an output because the same sort of check was
  1.  ;            done previously in this section at GETNP.
  1.  I '$O(^LR(LRDFN,"CH",IDT,1)) D CHKNP
  1.  ;
  1.  ;LR 523 quit out when only calling for info only for LR7OGM
  1.  I FORMAT=4 Q
  1.  ;
  1.  I FORMAT D
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^CH^"_(9999999-IDT)
  1.  . S OUTCNT=OUTCNT+1,DONE=1
  1.  . ;LR*5.2*527: changing line below to not check for GOTNP
  1.  . ;I 'GOTNP D GRID^LR7OGMG(.OUTCNT)
  1.  . D GRID^LR7OGMG(.OUTCNT)
  1.  ;
  1.  I 'FORMAT D PRINT^LR7OGMP(.OUTCNT)
  1.  ;
  1.  K ^TMP("LR7OG",$J,"TP")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. ACC ;Check Accession
  1.  N ANODE,X0,LRODT,LRSN,LROD0,LROD1,X,STATUS,LROS
  1.  ;
  1.  K ^TMP("LR7OG",$J,"ACC")
  1.  ;
  1.  I '$D(^LRO(68,+AREA,1,+ACDT,1,+NUM)) Q
  1.  ;
  1.  S X0=$G(^LRO(68,+AREA,1,+ACDT,1,+NUM,0)),LRODT=$P(X0,"^",4),LRSN=$P(X0,"^",5),LROD0=$G(^LRO(69,+LRODT,1,LRSN,0)),LROD1=$G(^(1))
  1.  ;
  1.  S TESTNUM=0
  1.  F  S TESTNUM=$O(^LRO(68,+AREA,1,+ACDT,1,+NUM,4,TESTNUM)) Q:'TESTNUM  S ANODE=^(TESTNUM,0) D
  1.  . I $P(ANODE,U,6)'="*Not Performed" Q:$P(ANODE,U,5)  ;complete date
  1.  . ;LR*5.2*527: commenting out line below so that NP'd tests will display
  1.  . ;I FORMAT,$P(ANODE,U,6)="*Not Performed" Q  ;Don't show NP'd results on Most Recent Report
  1.  . I 'ALL,'$D(^TMP("LR7OG",$J,"T",TESTNUM)),'$D(TESTS(TESTNUM)) Q  ;Selected test not in accession
  1.  . ;LR*5.2*527: adding"*Not Performed" check so that NP'd tests will display
  1.  . ;            ^TMP("LR7OG",$J,"TP" will be set up below for NP'd tests.
  1.  . ;            ^TMP("LR7OG",$J,"TP" is set up at VER for other tests.
  1.  . I $P(ANODE,U,6)'="*Not Performed",TESTNUM'=$P(ANODE,"^",9),$P($G(^LRO(68,+AREA,1,+ACDT,1,+NUM,4,+$P(ANODE,"^",9),0)),"^",5) Q  ;complete date on parent
  1.  . S ^TMP("LR7OG",$J,"ACC",TESTNUM)=ANODE
  1.  ;
  1.  I '$O(^TMP("LR7OG",$J,"ACC",0)) Q
  1.  ;
  1.  S TESTNUM=0
  1.  F  S TESTNUM=$O(^TMP("LR7OG",$J,"ACC",TESTNUM)) Q:'TESTNUM  S ANODE=^(TESTNUM) D
  1.  . Q:'$D(^LAB(60,TESTNUM,.1))  S PNODE=^(.1) I '("BO"[$P($G(^(0)),U,3)) Q
  1.  . S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:1/1000000)
  1.  . F  Q:'$D(^TMP("LR7OG",$J,"TP",CDT,PORDER))  Q:TESTNUM=+^(PORDER)  S PORDER=PORDER+1
  1.  . I $D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q
  1.  . S LROS="Collected - Specimen In Lab"
  1.  . I LROD1'="" S X=$P(LROD1,U,4),LROS=$S(X="C":"Collected - Specimen In Lab",X="U":"Uncollected, cancelled",1:"On Collection List")
  1.  . S STATUS=$S($P(ANODE,"^",6)="*Not Performed":"Test Not Performed",1:LROS)
  1.  . S ^TMP("LR7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_"X"_U_$P(^(0),U,5)_U_STATUS
  1.  . S TCNT=TCNT+1
  1.  ;
  1.  K ^TMP("LR7OG",$J,"ACC")
  1.  I TCNT S ^TMP("LR7OG",$J,"TP",CDT)=ZERO
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. VER ; Check Verified Results
  1.  Q:'$P(ZERO,U,3)
  1.  ;
  1.  I ALL D
  1.  . S TESTSUB=1
  1.  . F  S TESTSUB=$O(^LR(LRDFN,"CH",IDT,TESTSUB)) Q:TESTSUB<1  S TESTNUM=$O(^LAB(60,"C","CH;"_TESTSUB_";1",0)) D CHSETUP
  1.  ;
  1.  I 'ALL D
  1.  . S TESTSUB=1
  1.  . F  S TESTSUB=$O(^TMP("LR7OG",$J,"TMP",TESTSUB)) Q:TESTSUB<1  S TESTNUM=+^(TESTSUB) D CHSETUP
  1.  ;
  1.  I TCNT D
  1.  . S ^TMP("LR7OG",$J,"TP",CDT)=ZERO,CMNT=0
  1.  . F  S CMNT=+$O(^LR(LRDFN,LABSUB,IDT,1,CMNT)) Q:CMNT<1  S ^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)=^(CMNT,0) S TCNT=TCNT+1
  1.  Q
  1.  ;
  1.  ;
  1. CHSETUP ; within scope of CH
  1.  ;
  1.  N LRX
  1.  I 'TESTNUM Q
  1.  Q:'$D(^LAB(60,TESTNUM,.1))  S PNODE=^(.1) I '("BO"[$P($G(^(0)),U,3)) Q
  1.  Q:'$D(^LR(LRDFN,LABSUB,IDT,TESTSUB))  Q:'$L($P(^(TESTSUB),U))
  1.  ;
  1.  S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:TESTSUB/1000000)
  1.  F  Q:'$D(^TMP("LR7OG",$J,"TP",CDT,PORDER))  Q:TESTNUM=+^(PORDER)  S PORDER=PORDER+1
  1.  ;
  1.  I $D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q
  1.  ;
  1.  S LRX=$$TSTRES^LRRPU(LRDFN,LABSUB,IDT,TESTSUB,TESTNUM)
  1.  S ^TMP("LR7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_$P(PNODE,U,3)_U_$P(^(0),U,5)_U_$P(LRX,U)_U_$P(LRX,U,2)_U_$P(LRX,U,5)_U_$$EN^LRLRRVF($P(LRX,U,3),$P(LRX,U,4))_U_$P(LRX,U,6)
  1.  ;
  1.  ; Save performing lab ien in list
  1.  I $P(LRX,U,6) S ^TMP("LRPLS",$J,$P(LRX,U,6))=""
  1.  ;
  1.  S TCNT=TCNT+1
  1.  I $D(^LAB(60,TESTNUM,1,SPEC,1,0)) D
  1.  . S INTP=0
  1.  . F  S INTP=+$O(^LAB(60,TESTNUM,1,SPEC,1,INTP)) Q:INTP<1  D
  1.  . . S ^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)=^(INTP,0)
  1.  . . S TCNT=TCNT+1
  1.  Q
  1.  ;
  1.  ;
  1. CMT ; Retrieve specimen comments
  1.  ;
  1.  S ^TMP("LR7OG",$J,"TP",CDT)=ZERO,CMNT=0
  1.  F  S CMNT=+$O(^LR(LRDFN,LABSUB,IDT,1,CMNT)) Q:CMNT<1  S ^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)=^(CMNT,0) S TCNT=TCNT+1
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHKNP ; Check for NP comments and no verified results.
  1.  ;
  1.  N LRCAN,X
  1.  S LRCAN=0
  1.  F  S LRCAN=+$O(^LR(LRDFN,"CH",IDT,1,LRCAN)) Q:LRCAN<1  S X=^(LRCAN,0) Q:(($E(X)="*")&(X["Not Performed:"))
  1.  ;
  1.  ; Print if cancel comment and no unverified results.
  1.  I LRCAN<1 Q
  1.  D CMT
  1.  D PRINT^LR7OGMP(.OUTCNT)
  1.  K ^TMP("LR7OG",$J,"TP")
  1.  Q
  1.  ;
  1.  ;
  1. GETNP ;Set NP flag (Not Performed)
  1.  N LRCAN,X,LRNPCNT
  1.  S LRCAN=0
  1.  F  S LRCAN=+$O(^LR(LRDFN,"CH",IDT,1,LRCAN)) Q:LRCAN<1  S X=^(LRCAN,0) Q:(($E(X)="*")&(X["Not Performed:"))
  1.  Q:LRCAN<1
  1.  ;LR*5.2*527: Commenting out line below so that not performed comments
  1.  ;            will display if test results are entered but not yet
  1.  ;            verified. The non-verified results will not display.
  1.  ;I $G(FORMAT) Q:$O(^LR(LRDFN,"CH",IDT,1))
  1.  S GOTNP=1
  1.  Q