BLRCHGER ; IHS/OIT/MKK - CHANGE PROVIDER AND/OR LOCATION ERROR ROUTINES; 07/22/2005 8:05 AM ]
;;5.2;LR;**1022**;September 20, 2007
;
; These subroutines were pulled from the BLRCHGPL routine because it
; became too large.
;
; Failure -- Display arrays and set END Flag
BADSTUFF(LABEL) ; EP
NEW MID,IMNOTE
; Setup NOTE string
S MID=(IOM\2)-10
S IMNOTE=$TR($J("",IOM)," ","*")
S $E(IMNOTE,MID,MID+15)=" IMPORTANT NOTE "
;
W !,IMNOTE,!
W !,"Filing Failed at LABEL:",LABEL,!!
W ?5,"LRDFN:",$G(LRDFN)
W ?20," LRSS:",$G(LRSS)
W ?35," LRAA:",$G(LRAA)
W ?50,"LRIDT:",$G(LRIDT)
W !
W ?5," LRAD:",$G(LRAD)
W ?20," LRAN:",$G(LRAN)
W !
W ?5," ON:",$G(ON)
W ?20,"LRODT:",$G(LRODT)
W ?35," LRSN:",$G(LRSN)
W !
;
D ARRYDUMP("ERRS")
D ARRYDUMP("FDA")
W !
W !,IMNOTE,!!
W "Program will now end",!!
D BLRGPGR^BLRGMENU()
S LREND=1 ; Set END flag
;
Q
;
; "Dump" the array -- written because SAC does not
; allow use of Z routines. I wanted to use ZW.
ARRYDUMP(ARRY) ; EP
NEW STR1
;
S STR1=$Q(@ARRY@(""))
W !,?5,ARRY,!
W ?10,STR1,"=",@STR1,!
F S STR1=$Q(@STR1) Q:STR1="" D
. W ?10,STR1,"=",@STR1,!
Q
;
; Routine to display issue with IHS LAB TRANSACTION file not
; having the Accession Number being edited. This should
; NEVER happen, but it will if users are trying to edit an
; order that is older than the retention days for the BLRTXLOG
; file. This is NOT a fatal error.
BADJUJU(LABEL,BADACS,BADON) ; EP
K STR
S STR(1)=""
S STR(2)=$TR($J("",65)," ","*")
S STR(3)=""
S STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
S STR(5)=""
S STR(6)=$$CJ^XLFSTR(LABEL_" -- IHS LAB TRANSACTION LOG PROBLEM",65)
S STR(7)=""
S STR(8)=$$CJ^XLFSTR(">>> ACCESSION:"_BADACS_" ORDER #:"_BADON_" <<<",65)
S STR(9)=""
S STR(10)=$$CJ^XLFSTR("Transaction NOT found.",65)
S STR(11)=""
S STR(12)=$G(STR(2))
S STR(13)=""
D BMES^XPDUTL(.STR)
D BLRGPGR^BLRGMENU()
Q
BLRCHGER ; IHS/OIT/MKK - CHANGE PROVIDER AND/OR LOCATION ERROR ROUTINES; 07/22/2005 8:05 AM ]
+1 ;;5.2;LR;**1022**;September 20, 2007
+2 ;
+3 ; These subroutines were pulled from the BLRCHGPL routine because it
+4 ; became too large.
+5 ;
+6 ; Failure -- Display arrays and set END Flag
BADSTUFF(LABEL) ; EP
+1 NEW MID,IMNOTE
+2 ; Setup NOTE string
+3 SET MID=(IOM\2)-10
+4 SET IMNOTE=$TRANSLATE($JUSTIFY("",IOM)," ","*")
+5 SET $EXTRACT(IMNOTE,MID,MID+15)=" IMPORTANT NOTE "
+6 ;
+7 WRITE !,IMNOTE,!
+8 WRITE !,"Filing Failed at LABEL:",LABEL,!!
+9 WRITE ?5,"LRDFN:",$GET(LRDFN)
+10 WRITE ?20," LRSS:",$GET(LRSS)
+11 WRITE ?35," LRAA:",$GET(LRAA)
+12 WRITE ?50,"LRIDT:",$GET(LRIDT)
+13 WRITE !
+14 WRITE ?5," LRAD:",$GET(LRAD)
+15 WRITE ?20," LRAN:",$GET(LRAN)
+16 WRITE !
+17 WRITE ?5," ON:",$GET(ON)
+18 WRITE ?20,"LRODT:",$GET(LRODT)
+19 WRITE ?35," LRSN:",$GET(LRSN)
+20 WRITE !
+21 ;
+22 DO ARRYDUMP("ERRS")
+23 DO ARRYDUMP("FDA")
+24 WRITE !
+25 WRITE !,IMNOTE,!!
+26 WRITE "Program will now end",!!
+27 DO BLRGPGR^BLRGMENU()
+28 ; Set END flag
SET LREND=1
+29 ;
+30 QUIT
+31 ;
+32 ; "Dump" the array -- written because SAC does not
+33 ; allow use of Z routines. I wanted to use ZW.
ARRYDUMP(ARRY) ; EP
+1 NEW STR1
+2 ;
+3 SET STR1=$QUERY(@ARRY@(""))
+4 WRITE !,?5,ARRY,!
+5 WRITE ?10,STR1,"=",@STR1,!
+6 FOR
SET STR1=$QUERY(@STR1)
IF STR1=""
QUIT
Begin DoDot:1
+7 WRITE ?10,STR1,"=",@STR1,!
End DoDot:1
+8 QUIT
+9 ;
+10 ; Routine to display issue with IHS LAB TRANSACTION file not
+11 ; having the Accession Number being edited. This should
+12 ; NEVER happen, but it will if users are trying to edit an
+13 ; order that is older than the retention days for the BLRTXLOG
+14 ; file. This is NOT a fatal error.
BADJUJU(LABEL,BADACS,BADON) ; EP
+1 KILL STR
+2 SET STR(1)=""
+3 SET STR(2)=$TRANSLATE($JUSTIFY("",65)," ","*")
+4 SET STR(3)=""
+5 SET STR(4)=$$CJ^XLFSTR("Site: "_$$LOC^XBFUNC,65)
+6 SET STR(5)=""
+7 SET STR(6)=$$CJ^XLFSTR(LABEL_" -- IHS LAB TRANSACTION LOG PROBLEM",65)
+8 SET STR(7)=""
+9 SET STR(8)=$$CJ^XLFSTR(">>> ACCESSION:"_BADACS_" ORDER #:"_BADON_" <<<",65)
+10 SET STR(9)=""
+11 SET STR(10)=$$CJ^XLFSTR("Transaction NOT found.",65)
+12 SET STR(11)=""
+13 SET STR(12)=$GET(STR(2))
+14 SET STR(13)=""
+15 DO BMES^XPDUTL(.STR)
+16 DO BLRGPGR^BLRGMENU()
+17 QUIT
