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