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

ORY244.m

Go to the documentation of this file. 
  1. ORY244 ;SLC/JEH -- post-install for OR*3*244 ;12/14/2005
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**244**;Dec 17, 1997;Build 1
  1.  ; Variables used: 
  1.  ; DATE = the date 2nd part of the sub script of LRO(69,DATE
  1.  ; LORSN = the multiple counter of 69 or 4th part  to get to each LAB ORDER
  1.  ; LABDFN = DFN of LR file
  1.  ; TSTCNT = the sub multiple / counter of the lab test or the 6th part of the 69 sub script   
  1.  ; OERRDFN = DFN of OR(100 
  1.  ; LRSUB = sub of LAB(60, the lab test in LR
  1.  ; L60DFN = DFN of Lab test performed
  1.  ; TSTCNT = 6th part of sub script of LOR(69, pts to LAB TEST( LAB(60, and corresponding OR DFN
  1.  ; TSTTYP= CH MI AP, from the order file OR(100
  1.  ; PANEL=1 Indicates from a panel test versies single test PANEL="" 
  1.  ; CNT244 = Number of Abnormal results modified
  1.  ;
  1.  ;
  1. POST ; -- Postinit corrects the abnormal flag and resuslts set in the OR(100, file
  1.  N DATE,LOCATION,PTNAME,LABDFN,LORSN,LRSUB,TSTCNT,PANEL,TSTTYP,LRIVDAT,LSTEST,LABPNUM,TEST
  1.  N L60DFN,RCNT,LRRESULT,LV60TST,OERRDFN,OR0,ORESULTS,CNT244,DAT60LV1,DAT60LV2,DAT69LV1,DAT69LV2
  1.  S LOCATION="",PTNAME="",LABDFN="",PANEL="",CNT244=0,TEST=""
  1.  K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
  1.  S ^TMP("ORFIX",$J,0)=0
  1.  ;
  1. PTR69 ; -- Loop thru Lab order file 69 to find ptr to Order file (OR 100) and Lab Data file (LR
  1.  N ORMSG,ZTSK
  1.  S ORMSG(1)=""
  1.  S ORMSG(2)="STARTING reinstatement of missing abnormal results in the ORDER file #100"
  1.  S ORMSG(3)=""
  1.  D MES^XPDUTL(.ORMSG)
  1.  ;W !,"STARTING reinstatement of missing abnormal results in the ORDER file #100"
  1.  S DATE=3050815 ; PROBLEM START WITH LR*5.2*340 given to test sites Aug 15
  1.  F  S DATE=$O(^LRO(69,DATE)) Q:DATE'?7N!(DATE>3051231)  D  ;69 loop
  1.  . ;
  1.  . S LORSN=0
  1.  . F  S LORSN=$O(^LRO(69,DATE,1,LORSN)) Q:LORSN'>0  D    ;loop within LR order to get multi test
  1.  . . ;
  1.  . . S DAT69LV1=$G(^LRO(69,DATE,1,LORSN,0)) Q:DAT69LV1=""
  1.  . . S LABDFN=$P(^LRO(69,DATE,1,LORSN,0),"^",1)  ;get LR DFN
  1.  . . I LABDFN="" Q   ;No LR not need to process v2
  1.  . . ;
  1.  . . S TSTCNT=0
  1.  . . F  S TSTCNT=$O(^LRO(69,DATE,1,LORSN,2,TSTCNT)) Q:TSTCNT=""!(TSTCNT]"@")  D  ;loop thru test 
  1.  . . . ;
  1.  . . . W "."
  1.  . . . S DAT69LV2=$G(^LRO(69,DATE,1,LORSN,2,TSTCNT,0)) Q:DAT69LV2=""
  1.  . . . S OERRDFN=$P(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",7)  ;get DFN of OR(100
  1.  . . . I OERRDFN="" Q   ;No OR(100 no need to process v2
  1.  . . . S L60DFN=+$P(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",1)  ;get DFN of 60 lab test performed
  1.  . . . I L60DFN="" Q   ;No lab test no need to process v2
  1.  . . . ; If test is a Panel of test or a single test?
  1.  . . . S DAT60LV1=$G(^LAB(60,L60DFN,0)) Q:DAT60LV1=""
  1.  . . . S LSTEST=L60DFN
  1.  . . . S PANEL=""
  1.  . . . S PANEL=$G(^LAB(60,L60DFN,2,1,0)) ;if there, equal to 1st test in panel test.
  1.  . . . I PANEL'="" S PANEL=L60DFN
  1.  . . . ; OR100FU GET INFO FROM OR(100
  1.  . . . I $G(^OR(100,OERRDFN,7))="" Q  ;No results no need to process
  1.  . . . I $P(^OR(100,OERRDFN,7),"^",2)=1 Q  ;If abnomal results already, no need to process
  1.  . . . ;
  1.  . . . S LRIVDAT="",TSTTYP="",ORESULTS=""
  1.  . . . I $G(^OR(100,OERRDFN,4))="" Q   ;If no date time of type quit v3
  1.  . . . S LRIVDAT=$P(^OR(100,OERRDFN,4),";",5)
  1.  . . . S TSTTYP=$P(^OR(100,OERRDFN,4),";",4)
  1.  . . . ;If not one of the Lab test types processed by LR7OR1 then quit
  1.  . . . I TSTTYP'="CH" Q
  1.  . . . I LRIVDAT="" Q  ;No LR date no need to process v2
  1.  . . . I PANEL="" D NONPAN
  1.  . . . ;
  1.  . . . I PANEL'="" D PAN60 ; PROCESS A PANEL OF TEST FOR THSI ORDER.
  1.  ;
  1.  D MAIL
  1.  ;W !,"Up date of Order file is complete!"
  1.  ;W !,"Please check your Mail for a list of modified ORDER files"
  1.  N ORMSG,ZTSK
  1.  S ORMSG(1)=""
  1.  S ORMSG(2)="Up date of Order file is complete!"
  1.  S ORMSG(3)="Please check your Mail for a list of modified ORDER files"
  1.  S ORMSG(4)=""
  1.  D MES^XPDUTL(.ORMSG)
  1.  Q
  1.  ;
  1. NONPAN ;
  1.  S DAT60LV2=$G(^LAB(60,L60DFN,.2)) Q:DAT60LV2=""
  1.  S LRSUB=$P(^LAB(60,L60DFN,.2),"^",1)
  1.  I LRSUB="" Q   ; if not test skip v2
  1.  S LRRESULT=$G(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB)) Q:LRRESULT=""  ;If no results quit
  1.  S TEST=$P(LRRESULT,"^",2)
  1.  I (TEST["L")!(TEST["H") D  Q
  1.  . I $G(^LAB(60,L60DFN,.1))="" Q  ;If no test name quit v3
  1.  . S ORESULTS=$P(^LAB(60,L60DFN,.1),"^",1)_"="_$P(LRRESULT,"^",1)
  1.  . D ORUPDAT ;set ABNORMAL results in Order file
  1.  Q
  1.  ;
  1. PAN60 ;
  1.  S ORESULTS=""   ;Clear for the next order file
  1.  ; S DAT60LV1=$G(^LAB(60,LRSUB,0)) Q:DAT60LV1=""
  1.  ;
  1.  ; Lab(60 DFN in LOR(69 was a Panel of test.
  1.  ; If an abnormal test in the panel test loop thru the panel test to pull each individual test 
  1.  ; also loop Thru the LR from the start to pull the results to put with the test from LAB(60 
  1.  S LRSUB=""
  1.  ; Loop Thru LR file to pull individual test results when from a panel of test.
  1.  S RCNT=0
  1.  S LSTEST=""
  1.  S LABPNUM=0
  1.  F  S LABPNUM=$O(^LAB(60,PANEL,2,LABPNUM)) Q:LABPNUM=""!(LABPNUM]"@")  D
  1.  . S LV60TST=$G(^LAB(60,PANEL,2,LABPNUM,0)) Q:LV60TST=""
  1.  . S L60DFN=$P(LV60TST,"^",1)
  1.  . I L60DFN="" Q  ;If not test skip v3
  1.  . S LRSUB=$G(^LAB(60,L60DFN,.2))  ; If L60DFN not null but not valid quit v3
  1.  . I LRSUB="" Q  ; v3
  1.  . S LRSUB=$P(^LAB(60,L60DFN,.2),"^",1)
  1.  . S LRRESULT=$G(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB)) Q:LRRESULT=""  ;If no test quit
  1.  . S TEST=$P(LRRESULT,"^",2) Q:LRRESULT=""  ;If no results quit
  1.  . I (TEST["L")!(TEST["H") D  Q
  1.  . . S RCNT=RCNT+1
  1.  . . S DAT60LV1=$G(^LAB(60,L60DFN,0)) Q:DAT60LV1=""
  1.  . . S LSTEST=LRSUB
  1.  . . I $G(^LAB(60,L60DFN,.1))="" Q  ;If no test name quit v3
  1.  . . S $P(ORESULTS,",",RCNT)=$P(^LAB(60,L60DFN,.1),"^",1)_"="_$P(LRRESULT,"^",1)_" "
  1.  . . ; S LRSUB=LRSUB+1  ;Bump to the next LR test results
  1.  I ORESULTS'="" D ORUPDAT ;set ABNORMAL results in Order file
  1.  Q
  1.  ;
  1. ORUPDAT ; Update the OR(100, file Abnormal results
  1.  ;
  1.  S CNT244=CNT244+1
  1.  S ^TMP("ORFIX",$J,0)=CNT244
  1.  S PTNAME=""
  1.  S OR0=$G(^OR(100,OERRDFN,0))
  1.  S PTNAME=$$PTNM($P(OR0,U,2))
  1.  S ^TMP("ORFIX",$J,CNT244)="PATIENT NAME="_PTNAME
  1.  S ^TMP("ORFIX",$J,CNT244,0)=" ORER FILE DFN="_OERRDFN
  1.  S ^TMP("ORFIX",$J,CNT244,1)=" LAB DATA LRDFN="_LABDFN
  1.  I PANEL="" S ^TMP("ORFIX",$J,CNT244,2)=" LABORATORY TEST IEN="_LSTEST
  1.  I PANEL'="" S ^TMP("ORFIX",$J,CNT244,2)=" LABORATORY TEST(PANEL) IEN="_PANEL
  1.  S ^TMP("ORFIX",$J,CNT244,3)=" ABNORMAL TEST RESULTS: "_ORESULTS
  1.  S $P(^OR(100,OERRDFN,7),"^",2)=1
  1.  S $P(^OR(100,OERRDFN,7),"^",3)=ORESULTS
  1.  ;W !," ABNORMAL TEST RESULTS: ",ORESULTS
  1.  ;
  1.  ;S THISTEST=^OR(100,OERRDFN,7)
  1.  ;W !,"Before update ^OR(100,"_OERRDFN_",7)=",THISTEST
  1.  ;
  1.  ;S THISTEST=^OR(100,OERRDFN,7)
  1.  ;W !,"After update ^OR(100,"_OERRDFN_",7)=",THISTEST
  1.  ;W !
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. MAIL ;Send results of cleanup in a mail message to initiator
  1.  N I,XMSUB,XMTEXT,XMDUZ,XMY,DIFROM
  1.  S XMSUB="Patch OR*3*244 Clean up completed"
  1.  S XMDUZ="Patch OR*3*244 Clean up job"
  1.  S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
  1.  S XMTEXT="^TMP(""ORTXT"",$J,"
  1.  K ^TMP("ORTXT",$J)
  1.  ; set up header and count
  1.  S I=1
  1.  S ^TMP("ORTXT",$J,I)="The reinstatement of Abnormal results has completed.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="Below is a listing of Abnormal results taken from Lab test and added to the Order file.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U)_" orders had abnormal results added.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  I $G(^TMP("ORFIX",$J,0))=0 S ^TMP("ORTXT",$J,I)="No changes were made to your database.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  ; set up message text
  1.  S CNT244=0 F  S CNT244=$O(^TMP("ORFIX",$J,CNT244)) Q:CNT244=""  D
  1.  .S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244),I=I+1
  1.  .S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,0),I=I+1
  1.  .S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,1),I=I+1
  1.  .S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,2),I=I+1
  1.  .S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,3),I=I+1
  1.  .S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  D ^XMD ;send results
  1.  Q
  1.  ;
  1. PTNM(IEN) ;Return pt name or -1 if unable to determine
  1.  N DFN,VADM
  1.  I +IEN=0!(IEN'["DPT") Q -1
  1.  S DFN=+IEN
  1.  D ^VADPT
  1.  I $G(VADM(1))="" Q -1
  1.  Q $G(VADM(1))
  1.  ;