- LR163 ;DALISC/FHS - LR*5.2*163 PATCH ENVIRONMENT CHECK ROUTINE
- ;;5.2;LAB SERVICE;**163**;Sep 27, 1994
- EN0 ;
- Q:'$G(XPDENV)
- L +^LRO(69,"AA"):15 I '$T D BMES^XPDUTL($$CJ^XLFSTR(" Unable to successfully lock the ^LRO(69,AA) global. ",80)) S XPQUIT=2
- I '$D(^LAM(0))#2 D BMES^XPDUTL($$CJ^XLFSTR("There is no WKLD CODE file.",80)) S XPQUIT=2
- I $$VERSION^XPDUTL("ICPT")'="6.0" D BMES^XPDUTL($$CJ^XLFSTR("You must install ICPT V6.0 Package first.",80)) S XPQUIT=2
- I '$O(^LAM(0)) D BMES^XPDUTL($$CJ^XLFSTR("There is no data in your WKLD CODE file.",80)) S XPDQUIT=2
- I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device in not defined.",80)) S XPDQUIT=2
- I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Please Log in to set local DUZ... variables.",80)) S XPDQUIT=2
- I '$D(^VA(200,$G(DUZ),0))#2 D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system.",80)) S XPDQUIT=2
- I +$G(^LAM("VR"))'>5.1 D BMES^XPDUTL($$CJ^XLFSTR("You must have LAB V5.2 or greater Installed.",80)) S XPDQUIT=2
- I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Install environment check FAILED.",80)) L -^LRO(69,"AA")
- I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Environment Check is Ok ---",80))
- Q
- PRE ;LR*5.2*163 AFTER USER COMMITS ROUTINE KIDS INSTALL"
- ENPRE ;
- Q:'$D(XPDNM)
- ;Cleanup broken X-Ref
- N I,N
- S I=0 F S I=$O(^LAM(I)) Q:I<1 D
- . Q:'$D(^LAM(I,"7","B","LRDATA"))
- . S N=0 F S N=$O(^LAM(I,7,"B","LRDATA",N)) Q:N<1 D
- . . K ^LAM(I,7,"B","LRDATA",N),^LAM(I,7,N,0)
- . . I $P(^LAM(I,7,0),U,4) S $P(^LAM(I,7,0),U,4)=$P(^LAM(I,7,0),U,4)-1
- I $D(^LAB(64.81,0))#2 S X=$P(^(0),U,1,2) K ^LAB(64.81) S ^LAB(64.81,0)=X
- S:$D(^LAM(0))#2 $P(^LAM(0),U,3)=2225 D
- . D BMES^XPDUTL($$CJ^XLFSTR("Removing 'Reserve 2 field (#8) in WKLD CODE file (#64).",80))
- . D BMES^XPDUTL($$CJ^XLFSTR("The field will be renamed 'PRICE'.",80))
- . N DA,DIK
- . S DA=8,DIK="^DD(64," D ^DIK
- D BMES^XPDUTL($$CJ^XLFSTR("Removing 'Reserve 2 field (#8) in WKLD CODE SUFFIX file (#64.2).",80))
- D BMES^XPDUTL($$CJ^XLFSTR("The field will be renamed 'PRICE'.",80)) D
- . N DA,DIK
- . S DA=8,DIK="^DD(64.2," D ^DIK
- D BMES^XPDUTL($$CJ^XLFSTR("Removing existing CPT codes for WKLD CODE file.",80))
- W ! S I=0 F S I=$O(^LAM(I)) Q:I<1 D
- . I '$D(^LAM(I,0))#2 K ^LAM(I) Q
- . S:'$P(^LAM(I,0),U,7) $P(^(0),U,7)=38 K:$D(^LAM(I,4)) ^LAM(I,4) W:'(I#50) "."
- K ^LAM("AD")
- D SPCK
- D BMES^XPDUTL($$CJ^XLFSTR("** Pre Install Step Complete **",80))
- Q
- PURG ;
- K DIK,DA S DIK="^LAB(64.81,",DA=LRIEN,DA(1)=64.81 D ^DIK K DIK
- Q
- SPCK K ^XTMP("LR","SPELL ERR")
- S ^XTMP("LR","SPELL ERR")="LR*5.2*163 Spelling errors"
- D BMES^XPDUTL($$CJ^XLFSTR("Correcting Duplicates or Spelling Errors",80))
- D BMES^XPDUTL($$CJ^XLFSTR("Names that begin with 'X*' have codes that are incorrect.",80))
- K CK S CK="" F I=1:1 S LN=$T(SPELL+I) Q:$P(LN,";;",2)="STOP" S CK(I)=LN
- S I=0 F S I=$O(CK(I)) Q:I<1 D BMES^XPDUTL($$CJ^XLFSTR($P(CK(I),";",3)_" "_$P(CK(I),";",4),80))
- K DIC S DIC=64,DIC(0)="XNZM"
- S II=0 F S II=$O(CK(II)) Q:II<1 D
- . S X=$P(CK(II),";",3)_".0000",NM=$P(CK(II),";",4) D ^DIC
- . I Y<1 D BMES^XPDUTL($$CJ^XLFSTR("*** Unable to find WKLD Code [ "_X_" ] in your file #64 ****",80)) Q
- . ;W !,Y W:Y>1 !,Y(0)
- . S LNX=$P(Y,U,2) I LNX'=NM S CK=1 D FILE
- D BMES^XPDUTL($$CJ^XLFSTR("Spelling updates completed.",80))
- Q
- SPELL ;
- ;;97485;X*Hepatitis C RNA;
- ;;STOP
- FILE ;
- N LRROOT,DA
- D BMES^XPDUTL($$CJ^XLFSTR("Correcting Spelling of entry "_+Y_" from "_LNX_" to "_NM,80))
- S DA=+Y,LRROOT(64,DA_",",.01)=NM
- D FILE^DIE("","LRROOT",^XTMP("LR","SPELL ERR"))
- Q
- POST ;LR*5.2*163 POST INSTALL ROUTINE KIDS INSTALL"
- ENPOS ;
- S:$D(^LAM(0))#2 $P(^(0),U,3)=99999 S $P(^LAB(69.9,1,"VSIT"),U)=1
- D BMES^XPDUTL($$CJ^XLFSTR("LABORATORY SITE FILE (#69.9) field PCE/VSIT ON (#615)",80))
- D BMES^XPDUTL($$CJ^XLFSTR("is set to transmit CPT codes ONLY - No stop code transmission.",80))
- I '$O(^LAB(64.81,0)) W $C(7) D BMES^XPDUTL($$CJ^XLFSTR("No data in file # 64.81 - No linking done.",80)) G MSG
- D BMES^XPDUTL($$CJ^XLFSTR("** Starting CPT to NLT linking - Standby **",80))
- CPT ;
- S LRACTDT="MARCH 1, 1997" W !
- K DIE S LRIEN=0,DIE="^LAM(" F S LRIEN=$O(^LAB(64.81,LRIEN)) Q:LRIEN<1 I $D(^(LRIEN,0))#2 S DATA=^(0) D I '$P(^LAB(64.81,LRIEN,0),U,9) D PURG
- . S LRNLT=$P(DATA,U,2),LRCPT=$P(DATA,U,3),LRRNAME=$P(DATA,U,8)
- . Q:'LRNLT!('LRCPT)
- . W:'(LRIEN#50) "." D LK
- I '$O(^LAB(64.81,0)) D BMES^XPDUTL($$CJ^XLFSTR("Database Upgrade Completed Successfully",80)) G MSG
- D BMES^XPDUTL($$CJ^XLFSTR(" Database Upgrade is Incomplete - Use FM to print upgrade errors",80))
- D BMES^XPDUTL($$CJ^XLFSTR("stored in the LAB NLT/CPT CODES (#64.81) file.",80))
- MSG ;
- D BMES^XPDUTL($$CJ^XLFSTR("Checking File pointer integrity",80))
- D
- . S LRI=0 F S LRI=$O(^LAB(64.2,LRI)) Q:LRI<1 I $D(^(LRI,0)),'$D(^LAB(64.3,+$P(^(0),U,14),0)) D
- . . N DIE,DA,DR W "."
- . . S DR="11///1",DA=LRI,DIE="^LAB(64.2," D ^DIE
- D
- . S LRI=0 F S LRI=$O(^LAM(LRI)) Q:LRI<1 I $D(^(LRI,0)),'$D(^LAB(64.3,+$P(^(0),U,14),0)) D
- . . N DIE,DA,DR W "*"
- . . S DR="12///1",DA=LRI,DIE="^LAM(" D ^DIE
- D BMES^XPDUTL($$CJ^XLFSTR("Use 'Workload code list option [LRCAPD] for a full listing of",80))
- D BMES^XPDUTL($$CJ^XLFSTR("ALL NLT Codes used in Laboratory Test File (#60).",80))
- D BMES^XPDUTL($$CJ^XLFSTR("You can also use the [Edit or Print WKLD CODES] option for a listing",80))
- D BMES^XPDUTL($$CJ^XLFSTR("of linked CPT linked NLT codes.",80))
- L -^LAB(69,"AA")
- D BMES^XPDUTL($$CJ^XLFSTR("** Post install completed **",80))
- Q
- LK ;
- S LRCODE=0 F S LRCODE=+$O(^LAM("C",LRNLT_" ",LRCODE)) Q:LRCODE<1 D
- . K DA S TAG="*",DA=LRCODE I '$D(^LAM(DA,0))#2 D ERR Q
- . S TAG="|" I +$P(^LAM(DA,0),U,2)'[+LRNLT D ERR Q
- . K DR D ADD
- Q
- ADD ;
- Q:$D(^LAM(DA,4,"B",LRCPT))
- Q:'$P($G(^LAM(DA,0)),U,2) Q:$P(^(0),U,2)'[+LRNLT
- S DA(1)=4,DR="18///"_LRCPT_";",DR(1,64)="18///"_LRCPT,DR(2,64.018)=".01///"_LRCPT_";2///"_LRACTDT_";5///"_"CPT"
- W:$G(LRDBUG) "DA = ",DA_" " D ^DIE I $D(^LAM(DA,4,"B",LRCPT)) W:$G(LRDBUG) ". - " Q
- S TAG="/" D ERR
- Q
- ERR ;
- S:'$D(TAG) TAG="+" S $P(^LAB(64.81,LRIEN,0),U,9)=$P(^(0),U,9)_LRNLT_TAG
- W $C(7) D BMES^XPDUTL($$CJ^XLFSTR("Error Processing WKLD CODE "_LRNLT_" Logged in "_LRIEN,80)) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR163 6267 printed Jan 18, 2025@03:04:02 Page 2
- LR163 ;DALISC/FHS - LR*5.2*163 PATCH ENVIRONMENT CHECK ROUTINE
- +1 ;;5.2;LAB SERVICE;**163**;Sep 27, 1994
- EN0 ;
- +1 if '$GET(XPDENV)
- QUIT
- +2 LOCK +^LRO(69,"AA"):15
- IF '$TEST
- DO BMES^XPDUTL($$CJ^XLFSTR(" Unable to successfully lock the ^LRO(69,AA) global. ",80))
- SET XPQUIT=2
- +3 IF '$DATA(^LAM(0))#2
- DO BMES^XPDUTL($$CJ^XLFSTR("There is no WKLD CODE file.",80))
- SET XPQUIT=2
- +4 IF $$VERSION^XPDUTL("ICPT")'="6.0"
- DO BMES^XPDUTL($$CJ^XLFSTR("You must install ICPT V6.0 Package first.",80))
- SET XPQUIT=2
- +5 IF '$ORDER(^LAM(0))
- DO BMES^XPDUTL($$CJ^XLFSTR("There is no data in your WKLD CODE file.",80))
- SET XPDQUIT=2
- +6 IF $SELECT('$GET(IOM):1,'$GET(IOSL):1,$GET(U)'="^":1,1:0)
- DO BMES^XPDUTL($$CJ^XLFSTR("Terminal Device in not defined.",80))
- SET XPDQUIT=2
- +7 IF $SELECT('$GET(DUZ):1,$DATA(DUZ)[0:1,$DATA(DUZ(0))[0:1,1:0)
- DO BMES^XPDUTL($$CJ^XLFSTR("Please Log in to set local DUZ... variables.",80))
- SET XPDQUIT=2
- +8 IF '$DATA(^VA(200,$GET(DUZ),0))#2
- DO BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system.",80))
- SET XPDQUIT=2
- +9 IF +$GET(^LAM("VR"))'>5.1
- DO BMES^XPDUTL($$CJ^XLFSTR("You must have LAB V5.2 or greater Installed.",80))
- SET XPDQUIT=2
- +10 IF $GET(XPDQUIT)
- DO BMES^XPDUTL($$CJ^XLFSTR("Install environment check FAILED.",80))
- LOCK -^LRO(69,"AA")
- +11 IF '$GET(XPDQUIT)
- DO BMES^XPDUTL($$CJ^XLFSTR("Environment Check is Ok ---",80))
- +12 QUIT
- PRE ;LR*5.2*163 AFTER USER COMMITS ROUTINE KIDS INSTALL"
- ENPRE ;
- +1 if '$DATA(XPDNM)
- QUIT
- +2 ;Cleanup broken X-Ref
- +3 NEW I,N
- +4 SET I=0
- FOR
- SET I=$ORDER(^LAM(I))
- if I<1
- QUIT
- Begin DoDot:1
- +5 if '$DATA(^LAM(I,"7","B","LRDATA"))
- QUIT
- +6 SET N=0
- FOR
- SET N=$ORDER(^LAM(I,7,"B","LRDATA",N))
- if N<1
- QUIT
- Begin DoDot:2
- +7 KILL ^LAM(I,7,"B","LRDATA",N),^LAM(I,7,N,0)
- +8 IF $PIECE(^LAM(I,7,0),U,4)
- SET $PIECE(^LAM(I,7,0),U,4)=$PIECE(^LAM(I,7,0),U,4)-1
- End DoDot:2
- End DoDot:1
- +9 IF $DATA(^LAB(64.81,0))#2
- SET X=$PIECE(^(0),U,1,2)
- KILL ^LAB(64.81)
- SET ^LAB(64.81,0)=X
- +10 if $DATA(^LAM(0))#2
- SET $PIECE(^LAM(0),U,3)=2225
- Begin DoDot:1
- +11 DO BMES^XPDUTL($$CJ^XLFSTR("Removing 'Reserve 2 field (#8) in WKLD CODE file (#64).",80))
- +12 DO BMES^XPDUTL($$CJ^XLFSTR("The field will be renamed 'PRICE'.",80))
- +13 NEW DA,DIK
- +14 SET DA=8
- SET DIK="^DD(64,"
- DO ^DIK
- End DoDot:1
- +15 DO BMES^XPDUTL($$CJ^XLFSTR("Removing 'Reserve 2 field (#8) in WKLD CODE SUFFIX file (#64.2).",80))
- +16 DO BMES^XPDUTL($$CJ^XLFSTR("The field will be renamed 'PRICE'.",80))
- Begin DoDot:1
- +17 NEW DA,DIK
- +18 SET DA=8
- SET DIK="^DD(64.2,"
- DO ^DIK
- End DoDot:1
- +19 DO BMES^XPDUTL($$CJ^XLFSTR("Removing existing CPT codes for WKLD CODE file.",80))
- +20 WRITE !
- SET I=0
- FOR
- SET I=$ORDER(^LAM(I))
- if I<1
- QUIT
- Begin DoDot:1
- +21 IF '$DATA(^LAM(I,0))#2
- KILL ^LAM(I)
- QUIT
- +22 if '$PIECE(^LAM(I,0),U,7)
- SET $PIECE(^(0),U,7)=38
- if $DATA(^LAM(I,4))
- KILL ^LAM(I,4)
- if '(I#50)
- WRITE "."
- End DoDot:1
- +23 KILL ^LAM("AD")
- +24 DO SPCK
- +25 DO BMES^XPDUTL($$CJ^XLFSTR("** Pre Install Step Complete **",80))
- +26 QUIT
- PURG ;
- +1 KILL DIK,DA
- SET DIK="^LAB(64.81,"
- SET DA=LRIEN
- SET DA(1)=64.81
- DO ^DIK
- KILL DIK
- +2 QUIT
- SPCK KILL ^XTMP("LR","SPELL ERR")
- +1 SET ^XTMP("LR","SPELL ERR")="LR*5.2*163 Spelling errors"
- +2 DO BMES^XPDUTL($$CJ^XLFSTR("Correcting Duplicates or Spelling Errors",80))
- +3 DO BMES^XPDUTL($$CJ^XLFSTR("Names that begin with 'X*' have codes that are incorrect.",80))
- +4 KILL CK
- SET CK=""
- FOR I=1:1
- SET LN=$TEXT(SPELL+I)
- if $PIECE(LN,";;",2)="STOP"
- QUIT
- SET CK(I)=LN
- +5 SET I=0
- FOR
- SET I=$ORDER(CK(I))
- if I<1
- QUIT
- DO BMES^XPDUTL($$CJ^XLFSTR($PIECE(CK(I),";",3)_" "_$PIECE(CK(I),";",4),80))
- +6 KILL DIC
- SET DIC=64
- SET DIC(0)="XNZM"
- +7 SET II=0
- FOR
- SET II=$ORDER(CK(II))
- if II<1
- QUIT
- Begin DoDot:1
- +8 SET X=$PIECE(CK(II),";",3)_".0000"
- SET NM=$PIECE(CK(II),";",4)
- DO ^DIC
- +9 IF Y<1
- DO BMES^XPDUTL($$CJ^XLFSTR("*** Unable to find WKLD Code [ "_X_" ] in your file #64 ****",80))
- QUIT
- +10 ;W !,Y W:Y>1 !,Y(0)
- +11 SET LNX=$PIECE(Y,U,2)
- IF LNX'=NM
- SET CK=1
- DO FILE
- End DoDot:1
- +12 DO BMES^XPDUTL($$CJ^XLFSTR("Spelling updates completed.",80))
- +13 QUIT
- SPELL ;
- +1 ;;97485;X*Hepatitis C RNA;
- +2 ;;STOP
- FILE ;
- +1 NEW LRROOT,DA
- +2 DO BMES^XPDUTL($$CJ^XLFSTR("Correcting Spelling of entry "_+Y_" from "_LNX_" to "_NM,80))
- +3 SET DA=+Y
- SET LRROOT(64,DA_",",.01)=NM
- +4 DO FILE^DIE("","LRROOT",^XTMP("LR","SPELL ERR"))
- +5 QUIT
- POST ;LR*5.2*163 POST INSTALL ROUTINE KIDS INSTALL"
- ENPOS ;
- +1 if $DATA(^LAM(0))#2
- SET $PIECE(^(0),U,3)=99999
- SET $PIECE(^LAB(69.9,1,"VSIT"),U)=1
- +2 DO BMES^XPDUTL($$CJ^XLFSTR("LABORATORY SITE FILE (#69.9) field PCE/VSIT ON (#615)",80))
- +3 DO BMES^XPDUTL($$CJ^XLFSTR("is set to transmit CPT codes ONLY - No stop code transmission.",80))
- +4 IF '$ORDER(^LAB(64.81,0))
- WRITE $CHAR(7)
- DO BMES^XPDUTL($$CJ^XLFSTR("No data in file # 64.81 - No linking done.",80))
- GOTO MSG
- +5 DO BMES^XPDUTL($$CJ^XLFSTR("** Starting CPT to NLT linking - Standby **",80))
- CPT ;
- +1 SET LRACTDT="MARCH 1, 1997"
- WRITE !
- +2 KILL DIE
- SET LRIEN=0
- SET DIE="^LAM("
- FOR
- SET LRIEN=$ORDER(^LAB(64.81,LRIEN))
- if LRIEN<1
- QUIT
- IF $DATA(^(LRIEN,0))#2
- SET DATA=^(0)
- Begin DoDot:1
- +3 SET LRNLT=$PIECE(DATA,U,2)
- SET LRCPT=$PIECE(DATA,U,3)
- SET LRRNAME=$PIECE(DATA,U,8)
- +4 if 'LRNLT!('LRCPT)
- QUIT
- +5 if '(LRIEN#50)
- WRITE "."
- DO LK
- End DoDot:1
- IF '$PIECE(^LAB(64.81,LRIEN,0),U,9)
- DO PURG
- +6 IF '$ORDER(^LAB(64.81,0))
- DO BMES^XPDUTL($$CJ^XLFSTR("Database Upgrade Completed Successfully",80))
- GOTO MSG
- +7 DO BMES^XPDUTL($$CJ^XLFSTR(" Database Upgrade is Incomplete - Use FM to print upgrade errors",80))
- +8 DO BMES^XPDUTL($$CJ^XLFSTR("stored in the LAB NLT/CPT CODES (#64.81) file.",80))
- MSG ;
- +1 DO BMES^XPDUTL($$CJ^XLFSTR("Checking File pointer integrity",80))
- +2 Begin DoDot:1
- +3 SET LRI=0
- FOR
- SET LRI=$ORDER(^LAB(64.2,LRI))
- if LRI<1
- QUIT
- IF $DATA(^(LRI,0))
- IF '$DATA(^LAB(64.3,+$PIECE(^(0),U,14),0))
- Begin DoDot:2
- +4 NEW DIE,DA,DR
- WRITE "."
- +5 SET DR="11///1"
- SET DA=LRI
- SET DIE="^LAB(64.2,"
- DO ^DIE
- End DoDot:2
- End DoDot:1
- +6 Begin DoDot:1
- +7 SET LRI=0
- FOR
- SET LRI=$ORDER(^LAM(LRI))
- if LRI<1
- QUIT
- IF $DATA(^(LRI,0))
- IF '$DATA(^LAB(64.3,+$PIECE(^(0),U,14),0))
- Begin DoDot:2
- +8 NEW DIE,DA,DR
- WRITE "*"
- +9 SET DR="12///1"
- SET DA=LRI
- SET DIE="^LAM("
- DO ^DIE
- End DoDot:2
- End DoDot:1
- +10 DO BMES^XPDUTL($$CJ^XLFSTR("Use 'Workload code list option [LRCAPD] for a full listing of",80))
- +11 DO BMES^XPDUTL($$CJ^XLFSTR("ALL NLT Codes used in Laboratory Test File (#60).",80))
- +12 DO BMES^XPDUTL($$CJ^XLFSTR("You can also use the [Edit or Print WKLD CODES] option for a listing",80))
- +13 DO BMES^XPDUTL($$CJ^XLFSTR("of linked CPT linked NLT codes.",80))
- +14 LOCK -^LAB(69,"AA")
- +15 DO BMES^XPDUTL($$CJ^XLFSTR("** Post install completed **",80))
- +16 QUIT
- LK ;
- +1 SET LRCODE=0
- FOR
- SET LRCODE=+$ORDER(^LAM("C",LRNLT_" ",LRCODE))
- if LRCODE<1
- QUIT
- Begin DoDot:1
- +2 KILL DA
- SET TAG="*"
- SET DA=LRCODE
- IF '$DATA(^LAM(DA,0))#2
- DO ERR
- QUIT
- +3 SET TAG="|"
- IF +$PIECE(^LAM(DA,0),U,2)'[+LRNLT
- DO ERR
- QUIT
- +4 KILL DR
- DO ADD
- End DoDot:1
- +5 QUIT
- ADD ;
- +1 if $DATA(^LAM(DA,4,"B",LRCPT))
- QUIT
- +2 if '$PIECE($GET(^LAM(DA,0)),U,2)
- QUIT
- if $PIECE(^(0),U,2)'[+LRNLT
- QUIT
- +3 SET DA(1)=4
- SET DR="18///"_LRCPT_";"
- SET DR(1,64)="18///"_LRCPT
- SET DR(2,64.018)=".01///"_LRCPT_";2///"_LRACTDT_";5///"_"CPT"
- +4 if $GET(LRDBUG)
- WRITE "DA = ",DA_" "
- DO ^DIE
- IF $DATA(^LAM(DA,4,"B",LRCPT))
- if $GET(LRDBUG)
- WRITE ". - "
- QUIT
- +5 SET TAG="/"
- DO ERR
- +6 QUIT
- ERR ;
- +1 if '$DATA(TAG)
- SET TAG="+"
- SET $PIECE(^LAB(64.81,LRIEN,0),U,9)=$PIECE(^(0),U,9)_LRNLT_TAG
- +2 WRITE $CHAR(7)
- DO BMES^XPDUTL($$CJ^XLFSTR("Error Processing WKLD CODE "_LRNLT_" Logged in "_LRIEN,80))
- QUIT