- 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
