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

BLRSGNS3.m

Go to the documentation of this file. 
  1. BLRSGNS3 ; IHS/MSC/MKK - Delete Order even though in SiGN or SYmptom Process (Continued) ; 02-Nov-2015 13:45 ; MKK
  1.  ;;5.2;LR;**1035,1037**;NOV 1, 1997;Build 4
  1.  ;
  1.  ; Code moved from BLRSGNSP becuase BLRSGNSP became too large
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. ERRMSG(MSG,ERRFRTN) ; EP - Errors occurred during FILE^DIE call
  1.  NEW LRCNT,LRMTXT,MESSAGE,NOWDTIME,ORDERNUM,TAB,WOTARR1,WOTARR2,WOTVAR
  1.  NEW IENS     ; IHS/MSC/MKK - LR*5.2*1037
  1.  ;
  1.  S TAB=$J("",10)
  1.  ;
  1.  S MSG=$G(MSG,"FileMan Error")    ; IHS/MSC/MKK - LR*5.2*1037 - Make sure MSG variable exists
  1.  S ERRFRTN=$G(ERRFRTN,"BLRSGNSP") ; Set "ERRor From RouTiNe" Variable
  1.  ;
  1.  S MESSAGE="FileMan DBS call failed in routine "_ERRFRTN_"."
  1.  ;
  1.  S LRMTXT(1)=MSG_" Issue in routine "_ERRFRTN_"."
  1.  S LRMTXT(2)=" "
  1.  S LRMTXT(3)="The following debugging information is provided to assist"
  1.  S LRMTXT(4)="support staff in resolving issue during accessioning."
  1.  ;
  1.  S LRMTXT(5)=" "
  1.  S LRCNT=5
  1.  ;
  1.  S LRCNT=LRCNT+1,LRMTXT(LRCNT)="     DUZ="_$G(DUZ)
  1.  S LRCNT=LRCNT+1,LRMTXT(LRCNT)="     DUZ(2)="_$G(DUZ(2))
  1.  S LRCNT=LRCNT+1,LRMTXT(LRCNT)=" "
  1.  ;
  1.  ; Store Arrays
  1.  F WOTARR1="ERRS","FDA","FDAIEN","LR68","LRAA","LRAD","LRAN","LRDFN","LRDIE","LRSS","LRTSTS","LRUNQ","LRWLC","XQY","XQY0" D
  1.  . S X=$G(@WOTARR1)
  1.  . Q:X=""     ; IHS/MSC/MKK - LR*5.2*1037 - Don't do anything if the variable doesn't exist
  1.  . ;
  1.  . I X'="" S LRCNT=LRCNT+1,LRMTXT(LRCNT)=WOTARR1_"="_X
  1.  . S WOTARR2=WOTARR1
  1.  . F  S WOTARR2=$Q(@WOTARR2) Q:WOTARR2=""  S LRCNT=LRCNT+1,LRMTXT(LRCNT)=WOTARR2_"="_@WOTARR2
  1.  ;
  1.  ; Create ORDERNUM variable, if possible.
  1.  S IENS=+$G(LRORT)_","_+$G(LRSP)_","_+$G(LRODT)_","   ; IHS/MSC/MKK - LR*5.2*1037
  1.  S ORDERNUM=$$GET1^DIQ(69.01,$P(IENS,",",2,3),"ORDER #")
  1.  ;
  1.  ; Store variables
  1.  F WOTVAR="DFN","IENS","LRORD","LRODT","LRSP","ORDERNUM","PROBSTR","SNOMED","DESCPROB","ICDCODE","ICDDESC" D
  1.  . Q:$G(@WOTARR1)=""    ; IHS/MSC/MKK - LR*5.2*1037 - Don't do anything if the variable doesn't exist
  1.  . ;
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_WOTVAR_"="_$G(@WOTVAR)
  1.  ;
  1.  F WOTVAR="LRASTEST","LRNEWTST","ORIGPN","ORIGSN","ORIGICDP","ORIGICDI" D
  1.  . Q:$G(@WOTARR1)=""    ; IHS/MSC/MKK - LR*5.2*1037 - Don't do anything if the variable doesn't exist
  1.  . ;
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_WOTVAR_"="_$G(@WOTVAR)
  1.  ;
  1.  I $L($G(INDIC)) S WOTVAR="INDIC",LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_WOTVAR_"="_$G(@WOTVAR)
  1.  ;
  1.  ; Store the $STACK as well
  1.  S CONTXT=$STACK(-1)
  1.  F LOOP=0:1:CONTXT  D
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_"$STACK("_LOOP_",1,CONTEXT LEVEL)="_LOOP
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_"$STACK("_LOOP_",2,CONTEXT TYPE)="_$STACK(LOOP)
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_"$STACK("_LOOP_",3,CURRENT PLACE)="_$STACK(LOOP,"PLACE")
  1.  . S LRCNT=LRCNT+1,LRMTXT(LRCNT)=TAB_"$STACK("_LOOP_",4,CURRENT SOURCE)="_$STACK(LOOP,"MCODE")
  1.  ;
  1.  ; D SENDMAIL^BLRUTIL3(.MESSAGE,.LRMTXT,ERRFRTN,1)    ; Deliberately commented out.  Do Not send MailMan message.
  1.  ;
  1.  ; Store messages for 30 days
  1.  S NOWDTIME=$$HTFM^XLFDT($H)
  1.  I +$P($G(^XTMP(ERRFRTN,0)),"^")'>(+NOWDTIME) D
  1.  . K ^XTMP(ERRFRTN)
  1.  . K ^XTMP("BLRSGNSP")
  1.  . S ^XTMP(ERRFRTN,0)=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^Temporary Informational Message Storage"
  1.  . S ^XTMP("BLRSGNSP")=$$HTFM^XLFDT(+$H+30)_"^"_$$DT^XLFDT_"^'D' Index for Temporary Informational Message Storage"
  1.  ;
  1.  M ^XTMP(ERRFRTN,NOWDTIME,MSG)=LRMTXT
  1.  ; S ^XTMP("BLRSGNSP","D",ORDERNUM,NOWDTIME,ERRFRTN)=""
  1.  S:+$G(ORDERNUM) ^XTMP("BLRSGNSP","D",ORDERNUM,NOWDTIME,ERRFRTN)=""  ; IHS/MSC/MKK - LR*5.2*1037
  1.  Q
  1.  ;
  1. FIXIT ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ORDERN,U,XPARSYS,XQXFLG)
  1.  ;
  1.  K ^XTMP("BLRSGNSP")
  1.  S ERRFRTN="BLRSGN"
  1.  F  S ERRFRTN=$O(^XTMP(ERRFRTN))  Q:ERRFRTN=""!($E(ERRFRTN,1,6)'="BLRSGN")  D
  1.  . W "ERRFRTN=",ERRFRTN,!
  1.  . S ORDERNUM=0
  1.  . F  S ORDERNUM=$O(^XTMP(ERRFRTN,"D",ORDERNUM))  Q:ORDERNUM<1  D
  1.  .. S NOWDTIME=0
  1.  .. F  S NOWDTIME=$O(^XTMP(ERRFRTN,"D",ORDERNUM,NOWDTIME))  Q:NOWDTIME<1  D
  1.  ... S ^XTMP("BLRSGNSP","D",ORDERNUM,NOWDTIME,ERRFRTN)=""
  1.  ;
  1.  Q
  1.  ;
  1. OERRSTSC(ODT,SN) ; EP - Change OERR Status from PENDING to DISCOUNTINUED for entire test
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,ODT,SN,U,XPARSYS,XQXFLG)
  1.  S CONTROL="OC"
  1.  D NEW^LR7OB1(ODT,SN,CONTROL,,,1)
  1.  Q
  1.  ;
  1. OERRSTSO(LRODT,LRSN,LROT) ; EP - Change OERR Status from PENDING to DISCOUNTINUED for specific test(s)
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRODT,LROT,LRSN,U,XPARSYS,XQXFLG)
  1.  S LROTIEN=LROT_","_LRSN_","_LRODT
  1.  S ORIFN=$$GET1^DIQ(69.03,LROTIEN,6)
  1.  S F60IEN=$$GET1^DIQ(69.03,.01,LROTIEN,"I")
  1.  S II(F60IEN)="",LRSTATUS=1
  1.  D NEW^LR7OB1(LRODT,LRSN,"OC",,.II,LRSTATUS)
  1.  Q