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

LR541PST.m

Go to the documentation of this file. 
  1. LR541PST ;HPS/DSK - LR*5.2*541 PATCH POST INSTALL ROUTINE ;Nov 12, 2020@15:02
  1.  ;;5.2;LAB SERVICE;**541**;Sep 27, 1994;Build 7
  1.  ;
  1.  ;Reference to:      Supported by:
  1.  ;-----------------  --------------
  1.  ;STATUS^ORCSAVE2    IA #5903
  1.  ;^OR(100            IA #3582
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  ; 1. Scan all Microbiology accession areas starting in 2019.
  1.  ; 2. If any test at ^LRO(68,LRAA,1,LRAD,1,LRAN,4,test,0) has a complete date/time,
  1.  ;    retrieve file 69 order number. Quit if no complete tests.
  1.  ; 3. In file 69, find CPRS order number for the test. Quit if referral patient and
  1.  ;    no order number.
  1.  ; 4. Check status in file 100. Quit if not active.
  1.  ; 5. Check status in file 63. (Due to unreported issue in which file 68 status
  1.  ;    might be complete but file 63 status is preliminary.)
  1.  ; 6. If any accession area for the test is preliminary or not present in file 63, quit.
  1.  ; 7. If not ordered as a component of a panel, call STATUS^ORCSAVE2 to update CPRS status
  1.  ;    to complete.
  1.  ; 8. If ordered as a component of a panel, check all panel components to determine
  1.  ;    if any are not complete in file 68.
  1.  ; 9. For all complete component statuses in file 68, check file 63 statuses.
  1.  ;10. If all are complete in file 68 and not preliminary in file 63, call STATUS^ORCSAVE2
  1.  ;    to update CPRS order number to complete.  
  1.  ;This routine is not deleted after install since it is tasked. A future
  1.  ;patch will delete the routine.
  1.  ;
  1.  N LRDUZ
  1.  S ZTRTN="START^LR541PST"
  1.  S ZTDESC="LR*5.2*541 Post-Install Routine"
  1.  S ZTIO="",ZTDTH=$H
  1.  S LRDUZ=DUZ
  1.  S ZTSAVE("LRDUZ")=""
  1.  D ^%ZTLOAD
  1.  W !!,"LR*5.2*541 Post-Install Routine has been tasked - TASK NUMBER: ",$G(ZTSK)
  1.  W !!,"You as well as members of the LMI MailMan Group will receive"
  1.  W !,"a MailMan message when the search completes.",!
  1.  Q
  1.  ;
  1. START ;
  1.  N LRAREA,LRDATE,LRACN,LRNUM,LRDFN,LRIDT,LREX,LREXSTR,LRSUB,LREXEC
  1.  S ^XTMP("LR 541 POST INSTALL",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*541 POST INSTALL"
  1.  S ^XTMP("LR 541 POST INSTALL",1)="ORDERS (#100) file order numbers updated to complete status"
  1.  ;kill in case re-started for some reason
  1.  K ^TMP("LR541 OR NO UPDATE",$J),^TMP("LR541 OR CHECKED",$J)
  1.  ;Find file 63 subscript for prelim/final status of all Microbiology edit codes
  1.  S LREX=0,LREXSTR=""
  1.  F  S LREX=$O(^LAB(62.07,LREX)) Q:'LREX  D
  1.  . S LREXSTR=$G(^LAB(62.07,LREX,.1))
  1.  . S LRSUB=$S(LREXSTR["11.5":1,LREXSTR["23":11,LREXSTR["19":8,LREXSTR["15":5,LREXSTR["34":16,1:"")
  1.  . Q:LRSUB=""
  1.  . S LREXEC(LREX)=LRSUB
  1.  S (LRAREA,LRNUM)=0
  1.  F  S LRAREA=$O(^LRO(68,LRAREA)) Q:'LRAREA  I $P($G(^LRO(68,LRAREA,0)),"^",2)="MI" D
  1.  . ;start search in 2019
  1.  . S LRDATE=3180000
  1.  . F  S LRDATE=$O(^LRO(68,LRAREA,1,LRDATE)) Q:'LRDATE  D
  1.  . . S LRACN=0
  1.  . . F  S LRACN=$O(^LRO(68,LRAREA,1,LRDATE,1,LRACN)) Q:'LRACN  D
  1.  . . . ;check to see if this accession was already checked
  1.  . . . ;as a test within a profile
  1.  . . . Q:$D(^TMP("LR541 TRACE",$J,LRAREA,LRDATE,LRACN))
  1.  . . . S LRDFN=$P($G(^LRO(68,LRAREA,1,LRDATE,1,LRACN,0)),"^")
  1.  . . . ;If a referral patient, quit. Referrals not stored in CPRS.
  1.  . . . Q:$P($G(^LR(+LRDFN,0)),"^",2)'=2
  1.  . . . S LRIDT=$P(^LRO(68,LRAREA,1,LRDATE,1,LRACN,3),"^",5)
  1.  . . . D LRTST
  1.  D XTMP,MAIL
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. LRTST ;
  1.  N LRTST,LRSTR,LRPEND,LRSUB,LRORD,LRPANEL,LRODATE,LROSN
  1.  N LRXDFN,LRXIDT,LRXTEST
  1.  S LRTST=0
  1.  F  S LRTST=$O(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST)) Q:'LRTST  D
  1.  . S LRSTR=$G(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0))
  1.  . ;Accession still pending
  1.  . Q:$P(LRSTR,"^",5)=""
  1.  . ;Accession merged or not performed
  1.  . ;Not evaluating merged/not performed because root cause of issue
  1.  . ;exists in result verification logic - not merging/not performed logic.
  1.  . Q:$P(LRSTR,"^",6)'=""
  1.  . S LRPEND=$$CHK63(LRDFN,LRIDT,LRTST)
  1.  . Q:LRPEND
  1.  . S LRPANEL=$P(^LRO(68,LRAREA,1,LRDATE,1,LRACN,4,LRTST,0),"^",9)
  1.  . S LRORD=$G(^LRO(68,LRAREA,1,LRDATE,1,LRACN,.1))
  1.  . Q:LRORD=""
  1.  . S (LRODATE,LROSN)=0
  1.  . F  S LRODATE=$O(^LRO(69,"C",LRORD,LRODATE)) Q:'LRODATE  D
  1.  . . F  S LROSN=$O(^LRO(69,"C",LRORD,LRODATE,LROSN)) Q:'LROSN  D LRO69
  1.  Q
  1.  ;
  1. CHK63(LRXDFN,LRXIDT,LRXTEST) ;
  1.  ;Because the test in file 68 might be complete, but the status
  1.  ;in file 63 could be preliminary, check statuses in file 63.
  1.  N LRXEX,LRXSUB
  1.  S LRXEX=$P(^LAB(60,LRXTEST,0),"^",14)
  1.  ;This is not a Micro test, so don't check further for prelim/final.
  1.  I LRXEX="" Q 0
  1.  I '$G(LREXEC(LRXEX)) Q 0
  1.  S LRXSUB=LREXEC(LRXEX)
  1.  ;This test has not yet been resulted, so is pending.
  1.  I '$D(^LR(LRXDFN,"MI",LRXIDT,LRXSUB)) Q 1
  1.  I $P($G(^LR(LRXDFN,"MI",LRXIDT,LRXSUB)),"^",2)'="F" Q 1
  1.  Q 0
  1.  ;
  1. LRO69 ;analyze CPRS order number
  1.  N LROTST,LRNTST,LROCPRS
  1.  S LROTST=0
  1.  F  S LROTST=$O(^LRO(69,LRODATE,1,LROSN,2,LROTST)) Q:'LROTST  D
  1.  . S LRNTST=$P(^LRO(69,LRODATE,1,LROSN,2,LROTST,0),"^")
  1.  . ;Quit if test in file 69 does not correspond to the test
  1.  . ;or panel being evaluated in file 68.
  1.  . I LRNTST'=LRTST,LRNTST'=LRPANEL Q
  1.  . S LROCPRS=$P(^LRO(69,LRODATE,1,LROSN,2,LROTST,0),"^",7)
  1.  . ;CPRS order number will be null for referral orders
  1.  . ;(already checked for referral, but adding line below as a safeguard.)
  1.  . Q:LROCPRS=""
  1.  . ;Order might have been checked if a panel was ordered.
  1.  . Q:$D(^TMP("LR541 OR CHECKED",$J,LROCPRS))
  1.  . Q:$D(^TMP("LR541 OR NO UPDATE",$J,LROCPRS))
  1.  . ;only check orders with active status
  1.  . I $P($G(^OR(100,LROCPRS,3)),"^",3)'=6 Q
  1.  . ;Update status - this test is not a panel since test number
  1.  . ;equals panel number
  1.  . I LRTST=LRPANEL D UPDATE Q
  1.  . ;check all accessions for test components of a panel
  1.  . N LRXTST,LRXAA,LRXAD,LRXAN,LRXSTR,LRX68STR,LRXIDTZ
  1.  . S LRXTST=0
  1.  . F  S LRXTST=$O(^LRO(69,LRODATE,1,LROSN,2,LRXTST)) Q:'LRXTST  D
  1.  . . S LRXSTR=$G(^LRO(69,LRODATE,1,LROSN,2,LRXTST,0))
  1.  . . Q:$P(LRXSTR,"^",7)'=LROCPRS
  1.  . . S LRXAD=$P(LRXSTR,"^",3)
  1.  . . ;Accession fields might be null for profile tests.
  1.  . . Q:LRXAD=""
  1.  . . S LRXAA=$P(LRXSTR,"^",4),LRXAN=$P(LRXSTR,"^",5)
  1.  . . I LRXAA=""!(LRXAN="") Q
  1.  . . S LRNTST=$P(^LRO(69,LRODATE,1,LROSN,2,LRXTST,0),"^")
  1.  . . ;cross check file 68 test status
  1.  . . S LRX68STR=$G(^LRO(68,LRXAA,1,LRXAD,1,LRXAN,4,LRNTST,0))
  1.  . . Q:LRX68STR=""
  1.  . . ;This CPRS order is not yet final or was marked not performed or merged
  1.  . . I $P(LRX68STR,"^",5)=""!($P(LRX68STR,"^",6)'="") S ^TMP("LR541 OR NO UPDATE",$J,LROCPRS)=""
  1.  . . S LRXIDTZ=$P(^LRO(68,LRXAA,1,LRXAD,1,LRXAN,3),"^",5)
  1.  . . S LRPEND=$$CHK63(LRDFN,LRXIDTZ,LRNTST)
  1.  . . ;A test is pending on this order, so don't update to complete.
  1.  . . I LRPEND S ^TMP("LR541 OR NO UPDATE",$J,LROCPRS)=""
  1.  . ;set trace of orders checked
  1.  . S ^TMP("LR541 OR CHECKED",$J,LROCPRS)=""
  1.  . Q:$D(^TMP("LR541 OR NO UPDATE",$J,LROCPRS))
  1.  . ;all component tests are complete, so update status on order
  1.  . D UPDATE
  1.  Q
  1.  ;
  1. UPDATE ;update status to "complete" and set trace file
  1.  D STATUS^ORCSAVE2(LROCPRS,2)
  1.  S ^XTMP("LR 541 POST INSTALL",LROCPRS)=LRODATE_"^"_LROSN
  1.  S LRNUM=LRNUM+1
  1.  Q
  1.  ;
  1. XTMP ;Generate MailMan message and keep in ^XTMP for 60 days
  1.  S ^XTMP("LR 541 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^LR*5.2*541 POST INSTALL"
  1.  I $O(^XTMP("LR 541 POST INSTALL",1))="" D  Q
  1.  . S ^XTMP("LR 541 MAILMAN MESSAGE",2)=" "
  1.  . S ^XTMP("LR 541 MAILMAN MESSAGE",3)="LR*5.2*541 post-install routine found no occurrences"
  1.  . S ^XTMP("LR 541 MAILMAN MESSAGE",4)="related to the issue for ServiceNow ticket INC13797003."
  1.  . ;Set an entry in the detail ^XTMP("LR 541 POST INSTALL" if needed for future reference
  1.  . S ^XTMP("LR 541 POST INSTALL",1)="No issues found."
  1.  ;
  1.  ;Issues were found
  1.  S ^XTMP("LR 541 MAILMAN MESSAGE",1)=" "
  1.  S ^XTMP("LR 541 MAILMAN MESSAGE",2)="The post install for LR*5.2*541 corrected the CPRS order status"
  1.  S ^XTMP("LR 541 MAILMAN MESSAGE",3)="of "_LRNUM_" orders. The global ^XTMP(""LR 541 POST INSTALL"") contains"
  1.  S ^XTMP("LR 541 MAILMAN MESSAGE",4)="the specific order numbers."
  1.  K ^TMP("LR541 OR NO UPDATE",$J),^TMP("LR541 OR CHECKED",$J)
  1.  Q
  1.  ;
  1. MAIL ;
  1.  N LRMY,LRMSUB,LRMTEXT,LRMFROM,LRMIN
  1.  S LRMIN("FROM")="LR*5.2*541 Post-Install"
  1.  S LRMY(LRDUZ)=""
  1.  S LRMY("G.LMI")=""
  1.  S LRMSUB="LR*5.2*541 Post-Install"
  1.  S LRMTEXT="^XTMP(""LR 541 MAILMAN MESSAGE"")"
  1.  D SENDMSG^XMXAPI(DUZ,LRMSUB,LRMTEXT,.LRMY,.LRMIN,"","")
  1.  Q