LRCAPPH3 ;DALOI/FHS/PC - CHECK CPT CODE AND FILE POINTERS ; 5/1/99
;;5.2;LAB SERVICE;**1031**;NOV 1, 1997
;
;;VA LR Patche(s): 263,291
;
;Called from LRCAPPH,LRCAPPH4
EN ;
K ^TMP("LRCAPPH",$J),LRSEP S LRSEP(1)="==================="
S LRSEP(2)="****************"
K %DT S %DT="",X="T+5" D ^%DT S LRPGDT=Y
S ^TMP("LRCAPPH",$J,0)=Y_U_$$NOW^XLFDT_U_"LAB CPT DATA CHECKER"
S ^TMP("LRCAPPH60",$J,0)=Y_U_$$NOW^XLFDT_U_"LAB 60 CPT DATA CHECKER"
K %DT S %DT="" S X="T-1" D ^%DT S LRINADT=$$FMTE^XLFDT(Y,1)
S LRINADTX=Y K %DT
AA ;Look for CPT processing errors
D
. N LRAAN,LRCE,LRTXT,LRX
. S LRAAN="^LRO(69,""AA"")"
. F S LRAAN=$Q(@LRAAN) Q:$QS(LRAAN,2)'="AA" D
. . S LRX=@LRAAN Q:'LRX S LRCE=$QS(LRAAN,3)
. . K LRTXT
. . S LRTXT="Lab Order Number "_LRCE_" "
. . I LRX<1 D
. . . S LRTXT(1)=LRTXT_" was rejected by the PCE API "
. . I LRX=2 D
. . . S LRTXT(1)=LRTXT_"has no Institution for the ordering location."
. . I LRX=3 D
. . . S LRTXT(1)=LRTXT_"Provider is InActive."
. . I LRX=4 D
. . . S LRTXT(1)=LRTXT_"Not Processed "
. . . S LRTXT(2)=" - No DEFAULT LAB OOS LOCATION defined."
. . I LRX=5 D
. . . S LRTXT(1)=LRTXT_"Ordering Location "
. . . S LRTXT(2)=" has no STOP CODE NUMBER defined."
. . I $D(LRTXT(1)) S LRTXT(10)=LRSEP(1) D MSGSET("LRCAPPH",.LRTXT)
LAM ;Look for inactive Codes and broken pointers.
;in ^LAM
N LRI,LRXDT,LRY,LRII
S LRI=0 F S LRI=$O(^LAM(LRI)) Q:LRI<1 D I '$D(ZTQUEUED) W:'(LRI#50) "."
. I '$G(LRACT) Q:'$O(^LAM(LRI,7,0))
. S LRII=0 F S LRII=$O(^LAM(LRI,4,LRII)) Q:LRII<1 D
. . I '$G(^LAM(LRI,4,LRII,0)) W:'$D(ZTQUEUED) !,"@@@@@@@@@@@",LRI,! D Q
. . . I '$L($P($G(^LAM(LRI,4,LRII,0)),U)) K ^LAM(LRI,4,LRII) Q
. . . N DR,DA,DIE,DIK
. . . S DA=LRII,DA(1)=LRI,DIK="^LAM("_LRI_",4," D ^DIK
. . K LRX S LRX=^LAM(LRI,4,LRII,0) D CK
LAB ;Look for inactive Codes in ^LAB
N LRJ,LRN,LRSPEC,LRBECPT,MSGTYPE,MSGFLAG,DEFAULT,HCPCS,Y
S LRJ=0 F S LRJ=$O(^LAB(60,LRJ)) Q:'LRJ D
. S MSGFLAG=0
. S X=^LAB(60,LRJ,0),LRN=$P(X,U,1)
. I ($P(X,U,4)'="CH")&($P(X,U,4)'="MI") Q
. S LRSPEC=0 F S LRSPEC=$O(^LAB(60,LRJ,1,LRSPEC)) Q:'LRSPEC D
. . K LRBECPT
. . D IACPT(LRJ,DT,LRSPEC)
. . Q:('$D(LRBECPT(LRJ)))
. . S X=$O(LRBECPT(LRJ,1,0)) Q:'X
. . S MSGTYPE="SPECIMEN ("_LRSPEC_") CPT"
. . D MSG2(MSGTYPE)
. S X=$G(^LAB(60,LRJ,1.1)) S DEFAULT=$P(X,U,1),HCPCS=$P(X,U,2)
. I HCPCS D
. . S MSGTYPE="HCPCS CPT"
. . S X=HCPCS,Y=$$CPT^ICPTCOD(X,,,) I '$P(Y,U,7) S X=$P(Y,U,2) D MSG2(MSGTYPE)
. I DEFAULT D
. . S MSGTYPE="DEFAULT CPT"
. . S X=DEFAULT,Y=$$CPT^ICPTCOD(X,,,) I '$P(Y,U,7) S X=$P(Y,U,2) D MSG2(MSGTYPE)
. I MSGFLAG D MSGSET("LRCAPPH60",.LRMSG)
Q
;
IACPT(LRBETST,LRBECDT,LRSPEC) ; Get inactive specimen CPT
N A,ARR,LRBEAX,LRBEIEN,LRBEAR60,X
S LRBEIEN=LRSPEC_","_LRBETST_",",(LRI,LRBECPT)=""
D GETS^DIQ(60.01,LRBEIEN,"96*","I","LRBEAR60")
S A="" F S A=$O(LRBEAR60(60.196,A)) Q:A="" D
. Q:$G(LRBEAR60(60.196,A,1,"I"))=""
. S ARR($G(LRBEAR60(60.196,A,1,"I")))=$G(LRBEAR60(60.196,A,.01,"I"))
S X=$O(ARR(LRBECDT),-1) I X D
.S LRBEAX=ARR(X)
.S LRBEAX=$$CPT^ICPTCOD(LRBEAX,LRBECDT)
.I '$P(LRBEAX,U,7) S LRBECPT(LRBETST,1,$P(LRBEAX,U,2))="SPECIMEN CPT"
Q
;
EN0 ;Entry point for scan 64, scan 60, and mail reports to G.LMI
;Called from LRCAPPH
D EN
D MAIL
D MAIL2
END ;Called from LRCAPPH4
I $E($G(IOST),1,2)="P-" W @IOF
K DA,DIC,DIE,DIK,DR,I
K LRACT,LRCMT,LRINADT,LRINADTX,LRI,LRII,LRMSG,LRN,LRPGDT,LRTST,LRSEP,LRX
K LRTXT,X,XMTEXT,XMSUB,Y
K ^TMP("LRCAPPH",$J),^TMP("LRCAPPH60",$J)
D ^%ZISC
Q
ACTIVE ;Print only WKLD CODES that have associated test assigned
;and do not have inactivation dates
S LRACT=1 D EN0
Q
CK ;
I '$G(LRACT) Q:$P(LRX,U,4)
K X,Y,DIC,LRMSG
F I=1:1:5 S LRX(I)=$P(LRX,U,I)
I LRX(2)="CPT" D Q
. S X=$P(LRX(1),";")
. S Y=$$CPT^ICPTCOD(X,,,) I $S('$P(Y,U,7):1,LRX(4):1,1:0) D
. . S ^TMP("LRCAPPH",$J,"ICPT",X)=""
. . S Y(0)=$P(Y,U,2,3)_"^^1"
. . D MSG
S DIC(0)="XOZ",X=+LRX(1),DIC=U_$P(LRX(1),";",2)
S:$E(LRX(2))="L" DIC("S")="I '$P($G(^(4)),U)"
D ^DIC
I Y<1 D MSG Q
I $G(LRX(4)) D MSG
Q
MSG ;
K LRMSG
S LRN=^LAM(LRI,0)
S LRCMT=$P($G(^TMP("LRCAPPH",$J,0)),U,4)+1
S LRMSG(LRCMT)=$P(LRN,U,2)_" ["_LRI_"] "_$P(LRN,U),LRCMT=LRCMT+1
I Y<1 D Q
. S LRMSG(LRCMT)="*** Has an invalid "_LRX(2)_" code of "_+X_" ."
. D TST
. I '$P(^LAM(LRI,4,LRII,0),U,4) S $P(^(0),U,4)=LRINADTX D
. . S LRCMT=LRCMT+1,LRMSG(LRCMT)="Inactivation date of "_LRINADT_" has been entered."
. S LRCMT=LRCMT+1,LRMSG(LRCMT)=LRSEP(1)
. D MSGSET("LRCAPPH",.LRMSG)
I $P($G(Y(0)),U,4) D
. N LRXDT
. S LRCMT=LRCMT+1,LRMSG(LRCMT)=$P(Y(0),U)_" "_$P(Y(0),U,2),LRCMT=LRCMT+1
. S LRMSG(LRCMT)="Is an inactive "_LRX(2)_" code."
. D TST
. S:'$P(^LAM(LRI,4,LRII,0),U,4) $P(^(0),U,4)=LRINADTX
. S LRXDT=$P(^LAM(LRI,4,LRII,0),U,4)
. S LRCMT=LRCMT+1,LRMSG(LRCMT)="Inactivation date of "_$$FMTE^XLFDT(LRXDT,1)_" has been entered."
. S LRCMT=LRCMT+1,LRMSG(LRCMT)=LRSEP(2)
. D MSGSET("LRCAPPH",.LRMSG)
Q
MAIL ;Send message to G.LMI local mail group
Q:'$O(^TMP("LRCAPPH",$J,0))
N DUZ,XMDUZ,XMSUB,XMTEXT
S LRCMT=$G(LRCMT)+1
S ^TMP("LRCAPPH",$J,LRCMT,0)="Listing of all offending codes:"
S LRCMT=$G(LRCMT)+1,^TMP("LRCAPPH",$J,LRCMT,0)=""
S LRC="^TMP(""LRCAPPH"",$J,""A"")" F S LRC=$Q(@LRC) Q:$QS(LRC,2)'=$J D
. S LRCMT=LRCMT+1,^TMP("LRCAPPH",$J,LRCMT,0)=" "_$QS(LRC,3)_" "_$QS(LRC,4)
S XMSUB=" NIGHTLY WKLD CODE CHECK REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
S XMY("G.LMI")="",XMTEXT="^TMP(""LRCAPPH"","_$J_","
D ^XMD
Q
TST ;
Q:'$O(^LAM(LRI,7,0))
K LRT N X
S LRCMT=$G(LRCMT)+1 S LRMSG(LRCMT)="Associated Tests"
S LRT=0 F S LRT=$O(^LAM(LRI,7,LRT)) Q:LRT<1 S LRTST=$G(^(LRT,0)) D
. S X=+LRTST
. S LRTST="^"_$P(LRTST,";",2)_$P(LRTST,";")_",0)",LRCMT=LRCMT+1
. S LRMSG(LRCMT)=" "_$P(@LRTST,U)_" {"_X_"}"
Q
MSGSET(SUB,TXT) ;SUB=subscript - TXT = array containing the message
N I ;
S LRCMT=$P($G(^TMP(SUB,$J,0)),U,4)
S I=0 F S I=$O(TXT(I)) Q:I<1 D
. S LRCMT=LRCMT+1,^TMP(SUB,$J,LRCMT,0)=TXT(I)
S $P(^TMP(SUB,$J,0),U,4)=LRCMT
Q
;
MSG2(MSGTYPE) ;
I 'MSGFLAG D
. K LRMSG
. S LRCMT=$P($G(^TMP("LRCAPPH",$J,0)),U,4)+1,LRMSG(LRCMT)=" "
. S LRCMT=LRCMT+1,LRMSG(LRCMT)=$P(LRN,U,1)_" ["_LRJ_"]"
S LRCMT=LRCMT+1
S LRMSG(LRCMT)="*** Has an inactive "_MSGTYPE_" Code of "_X_".",MSGFLAG=1
Q
;
MAIL2 ;Send message to G.LMI local mail group
N DUZ,XMDUZ,XMSUB,XMTEXT
Q:'$O(^TMP("LRCAPPH60",$J,0))
S LRCMT=$G(LRCMT)+1,^TMP("LRCAPPH60",$J,LRCMT,0)=" "
S XMSUB="NIGHTLY FILE #60 CPT CODE CHECK REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
S XMY("G.LMI")="",XMTEXT="^TMP(""LRCAPPH60"","_$J_","
D ^XMD
Q
LRCAPPH3 ;DALOI/FHS/PC - CHECK CPT CODE AND FILE POINTERS ; 5/1/99
+1 ;;5.2;LAB SERVICE;**1031**;NOV 1, 1997
+2 ;
+3 ;;VA LR Patche(s): 263,291
+4 ;
+5 ;Called from LRCAPPH,LRCAPPH4
EN ;
+1 KILL ^TMP("LRCAPPH",$JOB),LRSEP
SET LRSEP(1)="==================="
+2 SET LRSEP(2)="****************"
+3 KILL %DT
SET %DT=""
SET X="T+5"
DO ^%DT
SET LRPGDT=Y
+4 SET ^TMP("LRCAPPH",$JOB,0)=Y_U_$$NOW^XLFDT_U_"LAB CPT DATA CHECKER"
+5 SET ^TMP("LRCAPPH60",$JOB,0)=Y_U_$$NOW^XLFDT_U_"LAB 60 CPT DATA CHECKER"
+6 KILL %DT
SET %DT=""
SET X="T-1"
DO ^%DT
SET LRINADT=$$FMTE^XLFDT(Y,1)
+7 SET LRINADTX=Y
KILL %DT
AA ;Look for CPT processing errors
+1 Begin DoDot:1
+2 NEW LRAAN,LRCE,LRTXT,LRX
+3 SET LRAAN="^LRO(69,""AA"")"
+4 FOR
SET LRAAN=$QUERY(@LRAAN)
IF $QSUBSCRIPT(LRAAN,2)'="AA"
QUIT
Begin DoDot:2
+5 SET LRX=@LRAAN
IF 'LRX
QUIT
SET LRCE=$QSUBSCRIPT(LRAAN,3)
+6 KILL LRTXT
+7 SET LRTXT="Lab Order Number "_LRCE_" "
+8 IF LRX<1
Begin DoDot:3
+9 SET LRTXT(1)=LRTXT_" was rejected by the PCE API "
End DoDot:3
+10 IF LRX=2
Begin DoDot:3
+11 SET LRTXT(1)=LRTXT_"has no Institution for the ordering location."
End DoDot:3
+12 IF LRX=3
Begin DoDot:3
+13 SET LRTXT(1)=LRTXT_"Provider is InActive."
End DoDot:3
+14 IF LRX=4
Begin DoDot:3
+15 SET LRTXT(1)=LRTXT_"Not Processed "
+16 SET LRTXT(2)=" - No DEFAULT LAB OOS LOCATION defined."
End DoDot:3
+17 IF LRX=5
Begin DoDot:3
+18 SET LRTXT(1)=LRTXT_"Ordering Location "
+19 SET LRTXT(2)=" has no STOP CODE NUMBER defined."
End DoDot:3
+20 IF $DATA(LRTXT(1))
SET LRTXT(10)=LRSEP(1)
DO MSGSET("LRCAPPH",.LRTXT)
End DoDot:2
End DoDot:1
LAM ;Look for inactive Codes and broken pointers.
+1 ;in ^LAM
+2 NEW LRI,LRXDT,LRY,LRII
+3 SET LRI=0
FOR
SET LRI=$ORDER(^LAM(LRI))
IF LRI<1
QUIT
Begin DoDot:1
+4 IF '$GET(LRACT)
IF '$ORDER(^LAM(LRI,7,0))
QUIT
+5 SET LRII=0
FOR
SET LRII=$ORDER(^LAM(LRI,4,LRII))
IF LRII<1
QUIT
Begin DoDot:2
+6 IF '$GET(^LAM(LRI,4,LRII,0))
IF '$DATA(ZTQUEUED)
WRITE !,"@@@@@@@@@@@",LRI,!
Begin DoDot:3
+7 IF '$LENGTH($PIECE($GET(^LAM(LRI,4,LRII,0)),U))
KILL ^LAM(LRI,4,LRII)
QUIT
+8 NEW DR,DA,DIE,DIK
+9 SET DA=LRII
SET DA(1)=LRI
SET DIK="^LAM("_LRI_",4,"
DO ^DIK
End DoDot:3
QUIT
+10 KILL LRX
SET LRX=^LAM(LRI,4,LRII,0)
DO CK
End DoDot:2
End DoDot:1
IF '$DATA(ZTQUEUED)
IF '(LRI#50)
WRITE "."
LAB ;Look for inactive Codes in ^LAB
+1 NEW LRJ,LRN,LRSPEC,LRBECPT,MSGTYPE,MSGFLAG,DEFAULT,HCPCS,Y
+2 SET LRJ=0
FOR
SET LRJ=$ORDER(^LAB(60,LRJ))
IF 'LRJ
QUIT
Begin DoDot:1
+3 SET MSGFLAG=0
+4 SET X=^LAB(60,LRJ,0)
SET LRN=$PIECE(X,U,1)
+5 IF ($PIECE(X,U,4)'="CH")&($PIECE(X,U,4)'="MI")
QUIT
+6 SET LRSPEC=0
FOR
SET LRSPEC=$ORDER(^LAB(60,LRJ,1,LRSPEC))
IF 'LRSPEC
QUIT
Begin DoDot:2
+7 KILL LRBECPT
+8 DO IACPT(LRJ,DT,LRSPEC)
+9 IF ('$DATA(LRBECPT(LRJ)))
QUIT
+10 SET X=$ORDER(LRBECPT(LRJ,1,0))
IF 'X
QUIT
+11 SET MSGTYPE="SPECIMEN ("_LRSPEC_") CPT"
+12 DO MSG2(MSGTYPE)
End DoDot:2
+13 SET X=$GET(^LAB(60,LRJ,1.1))
SET DEFAULT=$PIECE(X,U,1)
SET HCPCS=$PIECE(X,U,2)
+14 IF HCPCS
Begin DoDot:2
+15 SET MSGTYPE="HCPCS CPT"
+16 SET X=HCPCS
SET Y=$$CPT^ICPTCOD(X,,,)
IF '$PIECE(Y,U,7)
SET X=$PIECE(Y,U,2)
DO MSG2(MSGTYPE)
End DoDot:2
+17 IF DEFAULT
Begin DoDot:2
+18 SET MSGTYPE="DEFAULT CPT"
+19 SET X=DEFAULT
SET Y=$$CPT^ICPTCOD(X,,,)
IF '$PIECE(Y,U,7)
SET X=$PIECE(Y,U,2)
DO MSG2(MSGTYPE)
End DoDot:2
+20 IF MSGFLAG
DO MSGSET("LRCAPPH60",.LRMSG)
End DoDot:1
+21 QUIT
+22 ;
IACPT(LRBETST,LRBECDT,LRSPEC) ; Get inactive specimen CPT
+1 NEW A,ARR,LRBEAX,LRBEIEN,LRBEAR60,X
+2 SET LRBEIEN=LRSPEC_","_LRBETST_","
SET (LRI,LRBECPT)=""
+3 DO GETS^DIQ(60.01,LRBEIEN,"96*","I","LRBEAR60")
+4 SET A=""
FOR
SET A=$ORDER(LRBEAR60(60.196,A))
IF A=""
QUIT
Begin DoDot:1
+5 IF $GET(LRBEAR60(60.196,A,1,"I"))=""
QUIT
+6 SET ARR($GET(LRBEAR60(60.196,A,1,"I")))=$GET(LRBEAR60(60.196,A,.01,"I"))
End DoDot:1
+7 SET X=$ORDER(ARR(LRBECDT),-1)
IF X
Begin DoDot:1
+8 SET LRBEAX=ARR(X)
+9 SET LRBEAX=$$CPT^ICPTCOD(LRBEAX,LRBECDT)
+10 IF '$PIECE(LRBEAX,U,7)
SET LRBECPT(LRBETST,1,$PIECE(LRBEAX,U,2))="SPECIMEN CPT"
End DoDot:1
+11 QUIT
+12 ;
EN0 ;Entry point for scan 64, scan 60, and mail reports to G.LMI
+1 ;Called from LRCAPPH
+2 DO EN
+3 DO MAIL
+4 DO MAIL2
END ;Called from LRCAPPH4
+1 IF $EXTRACT($GET(IOST),1,2)="P-"
WRITE @IOF
+2 KILL DA,DIC,DIE,DIK,DR,I
+3 KILL LRACT,LRCMT,LRINADT,LRINADTX,LRI,LRII,LRMSG,LRN,LRPGDT,LRTST,LRSEP,LRX
+4 KILL LRTXT,X,XMTEXT,XMSUB,Y
+5 KILL ^TMP("LRCAPPH",$JOB),^TMP("LRCAPPH60",$JOB)
+6 DO ^%ZISC
+7 QUIT
ACTIVE ;Print only WKLD CODES that have associated test assigned
+1 ;and do not have inactivation dates
+2 SET LRACT=1
DO EN0
+3 QUIT
CK ;
+1 IF '$GET(LRACT)
IF $PIECE(LRX,U,4)
QUIT
+2 KILL X,Y,DIC,LRMSG
+3 FOR I=1:1:5
SET LRX(I)=$PIECE(LRX,U,I)
+4 IF LRX(2)="CPT"
Begin DoDot:1
+5 SET X=$PIECE(LRX(1),";")
+6 SET Y=$$CPT^ICPTCOD(X,,,)
IF $SELECT('$PIECE(Y,U,7):1,LRX(4):1,1:0)
Begin DoDot:2
+7 SET ^TMP("LRCAPPH",$JOB,"ICPT",X)=""
+8 SET Y(0)=$PIECE(Y,U,2,3)_"^^1"
+9 DO MSG
End DoDot:2
End DoDot:1
QUIT
+10 SET DIC(0)="XOZ"
SET X=+LRX(1)
SET DIC=U_$PIECE(LRX(1),";",2)
+11 IF $EXTRACT(LRX(2))="L"
SET DIC("S")="I '$P($G(^(4)),U)"
+12 DO ^DIC
+13 IF Y<1
DO MSG
QUIT
+14 IF $GET(LRX(4))
DO MSG
+15 QUIT
MSG ;
+1 KILL LRMSG
+2 SET LRN=^LAM(LRI,0)
+3 SET LRCMT=$PIECE($GET(^TMP("LRCAPPH",$JOB,0)),U,4)+1
+4 SET LRMSG(LRCMT)=$PIECE(LRN,U,2)_" ["_LRI_"] "_$PIECE(LRN,U)
SET LRCMT=LRCMT+1
+5 IF Y<1
Begin DoDot:1
+6 SET LRMSG(LRCMT)="*** Has an invalid "_LRX(2)_" code of "_+X_" ."
+7 DO TST
+8 IF '$PIECE(^LAM(LRI,4,LRII,0),U,4)
SET $PIECE(^(0),U,4)=LRINADTX
Begin DoDot:2
+9 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)="Inactivation date of "_LRINADT_" has been entered."
End DoDot:2
+10 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)=LRSEP(1)
+11 DO MSGSET("LRCAPPH",.LRMSG)
End DoDot:1
QUIT
+12 IF $PIECE($GET(Y(0)),U,4)
Begin DoDot:1
+13 NEW LRXDT
+14 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)=$PIECE(Y(0),U)_" "_$PIECE(Y(0),U,2)
SET LRCMT=LRCMT+1
+15 SET LRMSG(LRCMT)="Is an inactive "_LRX(2)_" code."
+16 DO TST
+17 IF '$PIECE(^LAM(LRI,4,LRII,0),U,4)
SET $PIECE(^(0),U,4)=LRINADTX
+18 SET LRXDT=$PIECE(^LAM(LRI,4,LRII,0),U,4)
+19 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)="Inactivation date of "_$$FMTE^XLFDT(LRXDT,1)_" has been entered."
+20 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)=LRSEP(2)
+21 DO MSGSET("LRCAPPH",.LRMSG)
End DoDot:1
+22 QUIT
MAIL ;Send message to G.LMI local mail group
+1 IF '$ORDER(^TMP("LRCAPPH",$JOB,0))
QUIT
+2 NEW DUZ,XMDUZ,XMSUB,XMTEXT
+3 SET LRCMT=$GET(LRCMT)+1
+4 SET ^TMP("LRCAPPH",$JOB,LRCMT,0)="Listing of all offending codes:"
+5 SET LRCMT=$GET(LRCMT)+1
SET ^TMP("LRCAPPH",$JOB,LRCMT,0)=""
+6 SET LRC="^TMP(""LRCAPPH"",$J,""A"")"
FOR
SET LRC=$QUERY(@LRC)
IF $QSUBSCRIPT(LRC,2)'=$JOB
QUIT
Begin DoDot:1
+7 SET LRCMT=LRCMT+1
SET ^TMP("LRCAPPH",$JOB,LRCMT,0)=" "_$QSUBSCRIPT(LRC,3)_" "_$QSUBSCRIPT(LRC,4)
End DoDot:1
+8 SET XMSUB=" NIGHTLY WKLD CODE CHECK REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
+9 SET XMY("G.LMI")=""
SET XMTEXT="^TMP(""LRCAPPH"","_$JOB_","
+10 DO ^XMD
+11 QUIT
TST ;
+1 IF '$ORDER(^LAM(LRI,7,0))
QUIT
+2 KILL LRT
NEW X
+3 SET LRCMT=$GET(LRCMT)+1
SET LRMSG(LRCMT)="Associated Tests"
+4 SET LRT=0
FOR
SET LRT=$ORDER(^LAM(LRI,7,LRT))
IF LRT<1
QUIT
SET LRTST=$GET(^(LRT,0))
Begin DoDot:1
+5 SET X=+LRTST
+6 SET LRTST="^"_$PIECE(LRTST,";",2)_$PIECE(LRTST,";")_",0)"
SET LRCMT=LRCMT+1
+7 SET LRMSG(LRCMT)=" "_$PIECE(@LRTST,U)_" {"_X_"}"
End DoDot:1
+8 QUIT
MSGSET(SUB,TXT) ;SUB=subscript - TXT = array containing the message
+1 ;
NEW I
+2 SET LRCMT=$PIECE($GET(^TMP(SUB,$JOB,0)),U,4)
+3 SET I=0
FOR
SET I=$ORDER(TXT(I))
IF I<1
QUIT
Begin DoDot:1
+4 SET LRCMT=LRCMT+1
SET ^TMP(SUB,$JOB,LRCMT,0)=TXT(I)
End DoDot:1
+5 SET $PIECE(^TMP(SUB,$JOB,0),U,4)=LRCMT
+6 QUIT
+7 ;
MSG2(MSGTYPE) ;
+1 IF 'MSGFLAG
Begin DoDot:1
+2 KILL LRMSG
+3 SET LRCMT=$PIECE($GET(^TMP("LRCAPPH",$JOB,0)),U,4)+1
SET LRMSG(LRCMT)=" "
+4 SET LRCMT=LRCMT+1
SET LRMSG(LRCMT)=$PIECE(LRN,U,1)_" ["_LRJ_"]"
End DoDot:1
+5 SET LRCMT=LRCMT+1
+6 SET LRMSG(LRCMT)="*** Has an inactive "_MSGTYPE_" Code of "_X_"."
SET MSGFLAG=1
+7 QUIT
+8 ;
MAIL2 ;Send message to G.LMI local mail group
+1 NEW DUZ,XMDUZ,XMSUB,XMTEXT
+2 IF '$ORDER(^TMP("LRCAPPH60",$JOB,0))
QUIT
+3 SET LRCMT=$GET(LRCMT)+1
SET ^TMP("LRCAPPH60",$JOB,LRCMT,0)=" "
+4 SET XMSUB="NIGHTLY FILE #60 CPT CODE CHECK REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
+5 SET XMY("G.LMI")=""
SET XMTEXT="^TMP(""LRCAPPH60"","_$JOB_","
+6 DO ^XMD
+7 QUIT
