LRWU8A ;DALOI/TCK - TOOL TO FIX ORGANISM SUBFILE & DATA-PART 2 ;06/18/12 13:32
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;-----------------------------------------------------------
ASK() ; Run analyze/repair query.
;
N Y,DIRUT,DTOUT,DUOUT,FIX
;
K DIR,Y
S FIX=0
;
W !,"This process will check the Organism Sub-field (#63.3) of"
W !,"the LAB DATA file (#63) looking for possible discrepancies"
W !,"in the Data Dictionary. Once the process has completed, a"
W !,"MailMan message will be sent to the user that started this"
W !,"process and any other user selected."
W !!
W !,"The two modes in which this process can be run are ANALYZE"
W !,"and REPAIR. If the ANALYZE option is chosen, the process will"
W !,"only look for the discrepancies and report the findings via"
W !,"a MailMan message. If the ANALYZE/REPAIR option is chosen the"
W !,"process will ANALYZE and REPAIR any discrepancies found that"
W !,"can be fixed programmatically and list all those that could"
W !,"not be fixed but need attention."
W !!
;
S DIR("A")="Do you want to continue with this process",DIR("B")="N"
S DIR(0)="Y",DIR("B")="NO"
D ^DIR
I 'Y Q FIX
;
K DIR,Y
;
S DIR(0)="NAO^1:3",DIR("B")=3
S DIR("A",1)="Select the action you wish to take:"
S DIR("A",2)=""
S DIR("A",3)="1. Analyze and Report. "
S DIR("A",4)="2. Analyze, Repair and Report. "
S DIR("A",5)="3. Quit - No Action."
S DIR("A",6)=""
S DIR("A")="Enter a number 1 thru 3: "
S DIR("?")="Select a number from 1 thru 3 or press <Return> to exit"
;
D ^DIR
I Y=1 S FIX=1
I Y=2 S FIX=2
I Y=3!(Y=-1) S FIX=0 Q FIX
;
K DIR,Y
S DIR("A")="Are you sure you want to proceed",DIR("B")="N"
S DIR(0)="Y",DIR("B")="NO"
;
D ^DIR
I 'Y S FIX=0
;-----
Q FIX
;-----------------------------------------------------------
SEND ; Send the report/email to all recipients selected.
;
N DSH,ERROR,FLDN,HDR,INTERP,LN,LRSITE,MSG,NFLD,NFX,NINT
N NKEY,NSCR,NUM,OKEY,SCRN,SP,TMP,TOTAL,XMDUZ,XMSUB,DIFROM,XMINSTR
;
S (XMSUB,XMDUZ,MSG,LN,ERROR,NUM)=""
S LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
;
S XMINSTR("ADDR FLAGS")="R"
S XMSUB="LAB DATA file (#63) Microbiology Antibiotic Fields Cleanup"
S $P(SP," ",80)="",$P(DSH,"-",80)=""
;
; Not all errors were auto-repaired
I '+$G(FIX)!(+$G(FIX)&($D(^TMP("LR",$J,"S6")))) D
.S MSG($$LN)="Contact the National Service Desk to request assistance from the Clin 4"
.S MSG($$LN)="Product Support team in resolving the following errors identified in the"
.S MSG($$LN)="VistA Laboratory package:"
.S MSG($$LN)=""
;
S MSG($$LN)="The LAB DATA file (#63) cleanup process has completed."
S MSG($$LN)=""
S TMP="Tool run in ANALYZE"_$S(FIX:"/REPAIR",1:"")_" MODE for: "
S MSG($$LN)=TMP_$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_")."
S MSG($$LN)=""
S TMP="This process checked the Organism Sub-field (#63.3) of the "
S MSG($$LN)=TMP_"LAB DATA file (#63)"
S TMP="to locate potential Data Dictionary discrepancies related to "
S MSG($$LN)=TMP_"the definition and"
S MSG($$LN)="setup of fields for reporting antibiotic sensitivities."
S MSG($$LN)=""
S MSG($$LN)="The following report lists any discrepancies found:"
S MSG($$LN)=$TR(SP," ","-")
S MSG($$LN)=""
I '$D(^TMP("LR",$J)) D Q
.S MSG($$LN)="*** NO DISCREPANCIES WERE FOUND IN FILE (#63). ***"
.D SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
F TYP="S1","S2","S3","S4","S5","S6" D
.D BLDARY(TYP)
.I '$D(ARY(TYP)) Q
.S MSG($$LN)=HDR
.S MSG($$LN)=$TR(SP," ","-")
.I TYP="S1" D
..I 'FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S TMP=TMP_$E("CURRENT INPUT"_SP,1,30)_"PROPOSED INPUT"
...S MSG($$LN)=TMP
..I FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S TMP=TMP_$E("FORMER INPUT"_SP,1,30)_"NEW INPUT"
...S MSG($$LN)=TMP
..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)
..S TMP=TMP_$E("TRANSFORM"_SP,1,30)_"TRANSFORM"
..S MSG($$LN)=TMP
..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)
..S MSG($$LN)=TMP_$E(DSH,1,15)
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.OLDIT,.NEWIT,.IEN)
...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(OLDIT_SP,1,30)_$E(NEWIT_SP,1,15)
...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
..S MSG($$LN)=""
..S MSG($$LN)=""
.I TYP="S2" D
..I 'FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S TMP=TMP_$E("CURRENT"_SP,1,30)_"PROPOSED"
...S MSG($$LN)=TMP
..I FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S MSG($$LN)=TMP_$E("FORMER"_SP,1,30)_"NEW"
..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)_$E("HELP"_SP,1,30)_"HELP"
..S MSG($$LN)=TMP
..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)_$E(DSH,1,15)
..S MSG($$LN)=TMP
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.OHLP,.NHLP,.IEN)
...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(OHLP_SP,1,30)_$E(NHLP_SP,1,15)
...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
..S MSG($$LN)=""
..S MSG($$LN)=""
.I TYP="S3" D
..I 'FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S MSG($$LN)=TMP_$E("CURRENT"_SP,1,20)_"PROPOSED"
..I FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
...S MSG($$LN)=TMP_$E("FORMER"_SP,1,20)_"NEW"
..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)_$E("SET OF CODES"_SP,1,20)
..S TMP=TMP_"SET OF CODES"
..S MSG($$LN)=TMP
..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,18)_$E(SP,1,2)_$E(DSH,1,25)
..S MSG($$LN)=TMP
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.OKEY,.NKEY,.IEN)
...S MSG($$LN)=$E(ANTIB_SP,1,31)_" "_$E(OKEY_SP,1,18)_" "_$E(NKEY_SP,1,25)
...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,31)_" "_$S($L(OKEY)>18:$E(OKEY_SP,19,36),1:$E(SP,19,36))_" "_$E(NKEY,26,44)
...S MSG($$LN)=$E(SP,1,33)_$S($L(OKEY)>36:$E(OKEY_SP,37,54),1:$E(SP,37,54))_" "_$E(NKEY,45,53)
...I $L(OKEY)>54 D
....N LGOKEY,ADLOKEY,LLNOKEY,PADLOKEY
....S LGOKEY=$L(OKEY)-54,ADLOKEY=LGOKEY\18,LLNOKEY=LGOKEY/18
....S LLNOKEY=$S(LLNOKEY[".":1,1:0),PADLOKEY=0
....I ADLOKEY>=1 D
.....F PADLOKEY=1:1:ADLOKEY D
......S MSG($$LN)=$E(SP,1,33)_$E(OKEY_SP,(18*PADLOKEY)+37,(18*PADLOKEY)+54)
....I LLNOKEY D
.....S MSG($$LN)=$E(SP,1,33)_$E(OKEY_SP,(18*(ADLOKEY+1))+37,(18*(PADLOKEY+1))+54)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
..S MSG($$LN)=""
..S MSG($$LN)=""
.I TYP="S4" D
..S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)_$E("INTERP FIELD"_SP,1,30)
..S TMP=TMP_"SCREEN FIELD"
..S MSG($$LN)=TMP
..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)
..S TMP=TMP_$E($S('FIX:"NEEDED",1:"ADDED")_SP,1,30)
..S TMP=TMP_$S('FIX:"NEEDED",1:"ADDED")
..S MSG($$LN)=TMP
..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)_$E(DSH,1,15)
..S MSG($$LN)=TMP
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.INTERP,.SCRN,.IEN)
...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(INTERP_SP,1,30)_$E(SCRN_SP,1,15)
...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
..S MSG($$LN)=""
..S MSG($$LN)=""
.I TYP="S5" D
..I 'FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,28)
...S TMP=TMP_$E("NEW FIELD #"_SP,1,13)_$E("NEW INTERP"_SP,1,13)
...S MSG($$LN)=TMP_$E("NEW SCREEN"_SP,1,13)_$E("OCCURRENCES"_SP,1,11)
..I FIX D
...S TMP=$E("ANTIBIOTIC NAME"_SP,1,28)
...S TMP=TMP_$E("FIELD ADDED"_SP,1,13)_$E("INTERP ADDED"_SP,1,14)
...S MSG($$LN)=TMP_$E("SCRN ADDED"_SP,1,12)_$E("OCCURRENCES"_SP,1,11)
..S TMP=$E(" (FIELD NUMBER)"_SP,1,67)_"FOUND"
..S MSG($$LN)=TMP
..S TMP=$E(DSH,1,26)_$E(SP,1,2)_$E(DSH,1,11)_$E(SP,1,2)_$E(DSH,1,12)
..S MSG($$LN)=TMP_$E(SP,1,2)_$E(DSH,1,11)_$E(SP)_$E(DSH,1,11)
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.IEN,.NFLD,.NINT,.NSCR,.NFX)
...S TMP=$E(ANTIB_SP,1,28)_$E(NFLD_SP,1,13)_$E(NINT_SP,1,14)
...S MSG($$LN)=TMP_$E(NSCR_SP,1,13)_$E(NFX_SP,1,4)
...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
..I FIX D
...S MSG($$LN)=""
...S TMP=" Note: Due to the added antibiotics, updates may"
...S MSG($$LN)=TMP
...S TMP=" need to be made to input (edit) templates"
...S MSG($$LN)=TMP
...S TMP=" in the LAB DATA file that correspond to the"
...S MSG($$LN)=TMP
...S TMP=" old fields and update the new fields."
...S MSG($$LN)=TMP
..S MSG($$LN)=""
..S MSG($$LN)=""
.I TYP="S6" D
..S MSG($$LN)=$E("ANTIBIOTIC"_SP,1,33)_$E("FIELD NUMBER",1,20)
..S MSG($$LN)=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,20)
..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
...D GETDATA(TYP,CNT,.ANTIB,.FLDN)
...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(FLDN_SP,1,30)
...S TOTAL=CNT
..S MSG($$LN)=$TR(SP," ","-")
..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
.S MSG($$LN)=""
.S MSG($$LN)=""
K ARY
S MSG($$LN)=$TR(SP," ","*")
S MSG($$LN)="*** END OF REPORT ***"
D SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
;
Q
;-----------------------------------------------------------
LN() ; Increment the line couter.
;
S LN=LN+1
;
Q LN
;-----------------------------------------------------------
GETDATA(TYP,CNT,A1,A2,A3,A4,A5,A6) ; Set up variables for print.
;
N I,NUM
;
S NUM=$L(ARY(TYP,CNT),"|")
F I=1:1:NUM S @("A"_I)=$P(ARY(TYP,CNT),"|",I)
;
Q
;
;-----------------------------------------------------------
BLDARY(TYP) ; Build the array.
;
N ANTIB,IEN,MDE,NEWIT,NFLDN,NHLP,OFLN,OLDIT,OHLP,TMP
;
S (ANTIB,OLDIT)="",NEWIT="D ^LRMISR",CNT=0,IEN=""
I TYP="S1" S HDR="INCORRECT INPUT TRANSFORMS (IT)"
I TYP="S2" S HDR="INCORRECT HELP TEXT"
I TYP="S3" S HDR="INCORRECT SET OF CODES"
I TYP="S4" S HDR="MISSING INTERP and/or SCREEN"
I TYP="S5" D
. S HDR="BAD FIELD NUMBER and DEFINITION, LAB DATA "
. S HDR=HDR_$S('FIX:"NOT ",1:"")_"UPDATED"
I TYP="S6" S HDR="ANTIBIOTICS NEEDING MANUAL REVIEW/UPDATE"
I 'FIX S HDR="ANALYZE - "_HDR
I FIX S HDR="ANALYZE/REPAIR - "_HDR
F S IEN=$O(^TMP("LR",$J,TYP,IEN)) Q:IEN="" D
.I FIX,TYP="S5" D
..S TMP=$P($G(^TMP("LR",$J,TYP,IEN)),U),ANTIB=$P(^DD(63.3,TMP,0),U)
.E S ANTIB=$P(^DD(63.3,IEN,0),U)
.I TYP="S1" D
..S CNT=CNT+1
..S OLDIT=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
..S NEWIT=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
..S ARY(TYP,CNT)=ANTIB_"|"_OLDIT_"|"_NEWIT_"|"_IEN
.I TYP="S2" D
..S CNT=CNT+1
..S OHLP=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
..S NHLP=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
..S ARY(TYP,CNT)=ANTIB_"|"_OHLP_"|"_NHLP_"|"_IEN
.I TYP="S3" D
..S CNT=CNT+1
..S OKEY=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
..S NKEY=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
..S ARY(TYP,CNT)=ANTIB_"|"_OKEY_"|"_NKEY_"|"_IEN
.I TYP="S4" D
..S CNT=CNT+1
..S INTERP=$P($G(^TMP("LR",$J,TYP,IEN)),U)
..S SCRN=$P($G(^TMP("LR",$J,TYP,IEN)),U,2)
..S ARY(TYP,CNT)=ANTIB_"|"_INTERP_"|"_SCRN_"|"_IEN
.I TYP="S5" D
..S CNT=CNT+1
..S OFLN=IEN
..I 'FIX S (NFLDN,NINT,NSCR)="TBD"
..I FIX D
...S NFLDN=$P($G(^TMP("LR",$J,TYP,IEN)),U)
...S NINT=$P($G(^TMP("LR",$J,TYP,IEN)),U,2)
...S NSCR=$P($G(^TMP("LR",$J,TYP,IEN)),U,3)
..S NFX=$P($G(^TMP("LR",$J,TYP,IEN)),U,4)
..S ARY(TYP,CNT)=ANTIB_"|"_IEN_"|"_NFLDN_"|"_NINT_"|"_NSCR_"|"_NFX
.I TYP="S6" D
..S CNT=CNT+1
..S ARY(TYP,CNT)=ANTIB_"|"_IEN
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWU8A 11537 printed Sep 23, 2025@19:59:02 Page 2
LRWU8A ;DALOI/TCK - TOOL TO FIX ORGANISM SUBFILE & DATA-PART 2 ;06/18/12 13:32
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;-----------------------------------------------------------
ASK() ; Run analyze/repair query.
+1 ;
+2 NEW Y,DIRUT,DTOUT,DUOUT,FIX
+3 ;
+4 KILL DIR,Y
+5 SET FIX=0
+6 ;
+7 WRITE !,"This process will check the Organism Sub-field (#63.3) of"
+8 WRITE !,"the LAB DATA file (#63) looking for possible discrepancies"
+9 WRITE !,"in the Data Dictionary. Once the process has completed, a"
+10 WRITE !,"MailMan message will be sent to the user that started this"
+11 WRITE !,"process and any other user selected."
+12 WRITE !!
+13 WRITE !,"The two modes in which this process can be run are ANALYZE"
+14 WRITE !,"and REPAIR. If the ANALYZE option is chosen, the process will"
+15 WRITE !,"only look for the discrepancies and report the findings via"
+16 WRITE !,"a MailMan message. If the ANALYZE/REPAIR option is chosen the"
+17 WRITE !,"process will ANALYZE and REPAIR any discrepancies found that"
+18 WRITE !,"can be fixed programmatically and list all those that could"
+19 WRITE !,"not be fixed but need attention."
+20 WRITE !!
+21 ;
+22 SET DIR("A")="Do you want to continue with this process"
SET DIR("B")="N"
+23 SET DIR(0)="Y"
SET DIR("B")="NO"
+24 DO ^DIR
+25 IF 'Y
QUIT FIX
+26 ;
+27 KILL DIR,Y
+28 ;
+29 SET DIR(0)="NAO^1:3"
SET DIR("B")=3
+30 SET DIR("A",1)="Select the action you wish to take:"
+31 SET DIR("A",2)=""
+32 SET DIR("A",3)="1. Analyze and Report. "
+33 SET DIR("A",4)="2. Analyze, Repair and Report. "
+34 SET DIR("A",5)="3. Quit - No Action."
+35 SET DIR("A",6)=""
+36 SET DIR("A")="Enter a number 1 thru 3: "
+37 SET DIR("?")="Select a number from 1 thru 3 or press <Return> to exit"
+38 ;
+39 DO ^DIR
+40 IF Y=1
SET FIX=1
+41 IF Y=2
SET FIX=2
+42 IF Y=3!(Y=-1)
SET FIX=0
QUIT FIX
+43 ;
+44 KILL DIR,Y
+45 SET DIR("A")="Are you sure you want to proceed"
SET DIR("B")="N"
+46 SET DIR(0)="Y"
SET DIR("B")="NO"
+47 ;
+48 DO ^DIR
+49 IF 'Y
SET FIX=0
+50 ;-----
+51 QUIT FIX
+52 ;-----------------------------------------------------------
SEND ; Send the report/email to all recipients selected.
+1 ;
+2 NEW DSH,ERROR,FLDN,HDR,INTERP,LN,LRSITE,MSG,NFLD,NFX,NINT
+3 NEW NKEY,NSCR,NUM,OKEY,SCRN,SP,TMP,TOTAL,XMDUZ,XMSUB,DIFROM,XMINSTR
+4 ;
+5 SET (XMSUB,XMDUZ,MSG,LN,ERROR,NUM)=""
+6 SET LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
+7 ;
+8 SET XMINSTR("ADDR FLAGS")="R"
+9 SET XMSUB="LAB DATA file (#63) Microbiology Antibiotic Fields Cleanup"
+10 SET $PIECE(SP," ",80)=""
SET $PIECE(DSH,"-",80)=""
+11 ;
+12 ; Not all errors were auto-repaired
+13 IF '+$GET(FIX)!(+$GET(FIX)&($DATA(^TMP("LR",$JOB,"S6"))))
Begin DoDot:1
+14 SET MSG($$LN)="Contact the National Service Desk to request assistance from the Clin 4"
+15 SET MSG($$LN)="Product Support team in resolving the following errors identified in the"
+16 SET MSG($$LN)="VistA Laboratory package:"
+17 SET MSG($$LN)=""
End DoDot:1
+18 ;
+19 SET MSG($$LN)="The LAB DATA file (#63) cleanup process has completed."
+20 SET MSG($$LN)=""
+21 SET TMP="Tool run in ANALYZE"_$SELECT(FIX:"/REPAIR",1:"")_" MODE for: "
+22 SET MSG($$LN)=TMP_$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_")."
+23 SET MSG($$LN)=""
+24 SET TMP="This process checked the Organism Sub-field (#63.3) of the "
+25 SET MSG($$LN)=TMP_"LAB DATA file (#63)"
+26 SET TMP="to locate potential Data Dictionary discrepancies related to "
+27 SET MSG($$LN)=TMP_"the definition and"
+28 SET MSG($$LN)="setup of fields for reporting antibiotic sensitivities."
+29 SET MSG($$LN)=""
+30 SET MSG($$LN)="The following report lists any discrepancies found:"
+31 SET MSG($$LN)=$TR(SP," ","-")
+32 SET MSG($$LN)=""
+33 IF '$DATA(^TMP("LR",$JOB))
Begin DoDot:1
+34 SET MSG($$LN)="*** NO DISCREPANCIES WERE FOUND IN FILE (#63). ***"
+35 DO SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
End DoDot:1
QUIT
+36 FOR TYP="S1","S2","S3","S4","S5","S6"
Begin DoDot:1
+37 DO BLDARY(TYP)
+38 IF '$DATA(ARY(TYP))
QUIT
+39 SET MSG($$LN)=HDR
+40 SET MSG($$LN)=$TR(SP," ","-")
+41 IF TYP="S1"
Begin DoDot:2
+42 IF 'FIX
Begin DoDot:3
+43 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+44 SET TMP=TMP_$EXTRACT("CURRENT INPUT"_SP,1,30)_"PROPOSED INPUT"
+45 SET MSG($$LN)=TMP
End DoDot:3
+46 IF FIX
Begin DoDot:3
+47 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+48 SET TMP=TMP_$EXTRACT("FORMER INPUT"_SP,1,30)_"NEW INPUT"
+49 SET MSG($$LN)=TMP
End DoDot:3
+50 SET TMP=$EXTRACT(" (FIELD NUMBER)"_SP,1,33)
+51 SET TMP=TMP_$EXTRACT("TRANSFORM"_SP,1,30)_"TRANSFORM"
+52 SET MSG($$LN)=TMP
+53 SET TMP=$EXTRACT(DSH,1,31)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,28)_$EXTRACT(SP,1,2)
+54 SET MSG($$LN)=TMP_$E(DSH,1,15)
+55 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+56 DO GETDATA(TYP,CNT,.ANTIB,.OLDIT,.NEWIT,.IEN)
+57 SET MSG($$LN)=$E(ANTIB_SP,1,33)_$EXTRACT(OLDIT_SP,1,30)_$EXTRACT(NEWIT_SP,1,15)
+58 SET MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
+59 SET TOTAL=CNT
End DoDot:3
+60 SET MSG($$LN)=$TR(SP," ","-")
+61 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
+62 SET MSG($$LN)=""
+63 SET MSG($$LN)=""
End DoDot:2
+64 IF TYP="S2"
Begin DoDot:2
+65 IF 'FIX
Begin DoDot:3
+66 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+67 SET TMP=TMP_$EXTRACT("CURRENT"_SP,1,30)_"PROPOSED"
+68 SET MSG($$LN)=TMP
End DoDot:3
+69 IF FIX
Begin DoDot:3
+70 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+71 SET MSG($$LN)=TMP_$E("FORMER"_SP,1,30)_"NEW"
End DoDot:3
+72 SET TMP=$EXTRACT(" (FIELD NUMBER)"_SP,1,33)_$EXTRACT("HELP"_SP,1,30)_"HELP"
+73 SET MSG($$LN)=TMP
+74 SET TMP=$EXTRACT(DSH,1,31)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,28)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,15)
+75 SET MSG($$LN)=TMP
+76 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+77 DO GETDATA(TYP,CNT,.ANTIB,.OHLP,.NHLP,.IEN)
+78 SET MSG($$LN)=$E(ANTIB_SP,1,33)_$EXTRACT(OHLP_SP,1,30)_$EXTRACT(NHLP_SP,1,15)
+79 SET MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
+80 SET TOTAL=CNT
End DoDot:3
+81 SET MSG($$LN)=$TR(SP," ","-")
+82 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
+83 SET MSG($$LN)=""
+84 SET MSG($$LN)=""
End DoDot:2
+85 IF TYP="S3"
Begin DoDot:2
+86 IF 'FIX
Begin DoDot:3
+87 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+88 SET MSG($$LN)=TMP_$E("CURRENT"_SP,1,20)_"PROPOSED"
End DoDot:3
+89 IF FIX
Begin DoDot:3
+90 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)
+91 SET MSG($$LN)=TMP_$E("FORMER"_SP,1,20)_"NEW"
End DoDot:3
+92 SET TMP=$EXTRACT(" (FIELD NUMBER)"_SP,1,33)_$EXTRACT("SET OF CODES"_SP,1,20)
+93 SET TMP=TMP_"SET OF CODES"
+94 SET MSG($$LN)=TMP
+95 SET TMP=$EXTRACT(DSH,1,31)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,18)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,25)
+96 SET MSG($$LN)=TMP
+97 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+98 DO GETDATA(TYP,CNT,.ANTIB,.OKEY,.NKEY,.IEN)
+99 SET MSG($$LN)=$E(ANTIB_SP,1,31)_" "_$EXTRACT(OKEY_SP,1,18)_" "_$EXTRACT(NKEY_SP,1,25)
+100 SET MSG($$LN)=$E(" ("_IEN_")"_SP,1,31)_" "_$SELECT($LENGTH(OKEY)>18:$EXTRACT(OKEY_SP,19,36),1:$EXTRACT(SP,19,36))_" "_$EXTRACT(NKEY,26,44)
+101 SET MSG($$LN)=$E(SP,1,33)_$SELECT($LENGTH(OKEY)>36:$EXTRACT(OKEY_SP,37,54),1:$EXTRACT(SP,37,54))_" "_$EXTRACT(NKEY,45,53)
+102 IF $LENGTH(OKEY)>54
Begin DoDot:4
+103 NEW LGOKEY,ADLOKEY,LLNOKEY,PADLOKEY
+104 SET LGOKEY=$LENGTH(OKEY)-54
SET ADLOKEY=LGOKEY\18
SET LLNOKEY=LGOKEY/18
+105 SET LLNOKEY=$SELECT(LLNOKEY[".":1,1:0)
SET PADLOKEY=0
+106 IF ADLOKEY>=1
Begin DoDot:5
+107 FOR PADLOKEY=1:1:ADLOKEY
Begin DoDot:6
+108 SET MSG($$LN)=$E(SP,1,33)_$EXTRACT(OKEY_SP,(18*PADLOKEY)+37,(18*PADLOKEY)+54)
End DoDot:6
End DoDot:5
+109 IF LLNOKEY
Begin DoDot:5
+110 SET MSG($$LN)=$E(SP,1,33)_$EXTRACT(OKEY_SP,(18*(ADLOKEY+1))+37,(18*(PADLOKEY+1))+54)
End DoDot:5
End DoDot:4
+111 SET TOTAL=CNT
End DoDot:3
+112 SET MSG($$LN)=$TR(SP," ","-")
+113 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
+114 SET MSG($$LN)=""
+115 SET MSG($$LN)=""
End DoDot:2
+116 IF TYP="S4"
Begin DoDot:2
+117 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,33)_$EXTRACT("INTERP FIELD"_SP,1,30)
+118 SET TMP=TMP_"SCREEN FIELD"
+119 SET MSG($$LN)=TMP
+120 SET TMP=$EXTRACT(" (FIELD NUMBER)"_SP,1,33)
+121 SET TMP=TMP_$EXTRACT($SELECT('FIX:"NEEDED",1:"ADDED")_SP,1,30)
+122 SET TMP=TMP_$SELECT('FIX:"NEEDED",1:"ADDED")
+123 SET MSG($$LN)=TMP
+124 SET TMP=$EXTRACT(DSH,1,31)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,28)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,15)
+125 SET MSG($$LN)=TMP
+126 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+127 DO GETDATA(TYP,CNT,.ANTIB,.INTERP,.SCRN,.IEN)
+128 SET MSG($$LN)=$E(ANTIB_SP,1,33)_$EXTRACT(INTERP_SP,1,30)_$EXTRACT(SCRN_SP,1,15)
+129 SET MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
+130 SET TOTAL=CNT
End DoDot:3
+131 SET MSG($$LN)=$TR(SP," ","-")
+132 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
+133 SET MSG($$LN)=""
+134 SET MSG($$LN)=""
End DoDot:2
+135 IF TYP="S5"
Begin DoDot:2
+136 IF 'FIX
Begin DoDot:3
+137 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,28)
+138 SET TMP=TMP_$EXTRACT("NEW FIELD #"_SP,1,13)_$EXTRACT("NEW INTERP"_SP,1,13)
+139 SET MSG($$LN)=TMP_$E("NEW SCREEN"_SP,1,13)_$EXTRACT("OCCURRENCES"_SP,1,11)
End DoDot:3
+140 IF FIX
Begin DoDot:3
+141 SET TMP=$EXTRACT("ANTIBIOTIC NAME"_SP,1,28)
+142 SET TMP=TMP_$EXTRACT("FIELD ADDED"_SP,1,13)_$EXTRACT("INTERP ADDED"_SP,1,14)
+143 SET MSG($$LN)=TMP_$E("SCRN ADDED"_SP,1,12)_$EXTRACT("OCCURRENCES"_SP,1,11)
End DoDot:3
+144 SET TMP=$EXTRACT(" (FIELD NUMBER)"_SP,1,67)_"FOUND"
+145 SET MSG($$LN)=TMP
+146 SET TMP=$EXTRACT(DSH,1,26)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,11)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,12)
+147 SET MSG($$LN)=TMP_$E(SP,1,2)_$EXTRACT(DSH,1,11)_$EXTRACT(SP)_$EXTRACT(DSH,1,11)
+148 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+149 DO GETDATA(TYP,CNT,.ANTIB,.IEN,.NFLD,.NINT,.NSCR,.NFX)
+150 SET TMP=$EXTRACT(ANTIB_SP,1,28)_$EXTRACT(NFLD_SP,1,13)_$EXTRACT(NINT_SP,1,14)
+151 SET MSG($$LN)=TMP_$E(NSCR_SP,1,13)_$EXTRACT(NFX_SP,1,4)
+152 SET MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
+153 SET TOTAL=CNT
End DoDot:3
+154 SET MSG($$LN)=$TR(SP," ","-")
+155 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
+156 IF FIX
Begin DoDot:3
+157 SET MSG($$LN)=""
+158 SET TMP=" Note: Due to the added antibiotics, updates may"
+159 SET MSG($$LN)=TMP
+160 SET TMP=" need to be made to input (edit) templates"
+161 SET MSG($$LN)=TMP
+162 SET TMP=" in the LAB DATA file that correspond to the"
+163 SET MSG($$LN)=TMP
+164 SET TMP=" old fields and update the new fields."
+165 SET MSG($$LN)=TMP
End DoDot:3
+166 SET MSG($$LN)=""
+167 SET MSG($$LN)=""
End DoDot:2
+168 IF TYP="S6"
Begin DoDot:2
+169 SET MSG($$LN)=$E("ANTIBIOTIC"_SP,1,33)_$EXTRACT("FIELD NUMBER",1,20)
+170 SET MSG($$LN)=$E(DSH,1,31)_$EXTRACT(SP,1,2)_$EXTRACT(DSH,1,20)
+171 SET CNT=""
FOR
SET CNT=$ORDER(ARY(TYP,CNT))
if CNT=""
QUIT
Begin DoDot:3
+172 DO GETDATA(TYP,CNT,.ANTIB,.FLDN)
+173 SET MSG($$LN)=$E(ANTIB_SP,1,33)_$EXTRACT(FLDN_SP,1,30)
+174 SET TOTAL=CNT
End DoDot:3
+175 SET MSG($$LN)=$TR(SP," ","-")
+176 SET MSG($$LN)=$E("TOTAL: "_SP,1,7)_$EXTRACT(TOTAL_SP,1,10)
End DoDot:2
+177 SET MSG($$LN)=""
+178 SET MSG($$LN)=""
End DoDot:1
+179 KILL ARY
+180 SET MSG($$LN)=$TR(SP," ","*")
+181 SET MSG($$LN)="*** END OF REPORT ***"
+182 DO SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
+183 ;
+184 QUIT
+185 ;-----------------------------------------------------------
LN() ; Increment the line couter.
+1 ;
+2 SET LN=LN+1
+3 ;
+4 QUIT LN
+5 ;-----------------------------------------------------------
GETDATA(TYP,CNT,A1,A2,A3,A4,A5,A6) ; Set up variables for print.
+1 ;
+2 NEW I,NUM
+3 ;
+4 SET NUM=$LENGTH(ARY(TYP,CNT),"|")
+5 FOR I=1:1:NUM
SET @("A"_I)=$PIECE(ARY(TYP,CNT),"|",I)
+6 ;
+7 QUIT
+8 ;
+9 ;-----------------------------------------------------------
BLDARY(TYP) ; Build the array.
+1 ;
+2 NEW ANTIB,IEN,MDE,NEWIT,NFLDN,NHLP,OFLN,OLDIT,OHLP,TMP
+3 ;
+4 SET (ANTIB,OLDIT)=""
SET NEWIT="D ^LRMISR"
SET CNT=0
SET IEN=""
+5 IF TYP="S1"
SET HDR="INCORRECT INPUT TRANSFORMS (IT)"
+6 IF TYP="S2"
SET HDR="INCORRECT HELP TEXT"
+7 IF TYP="S3"
SET HDR="INCORRECT SET OF CODES"
+8 IF TYP="S4"
SET HDR="MISSING INTERP and/or SCREEN"
+9 IF TYP="S5"
Begin DoDot:1
+10 SET HDR="BAD FIELD NUMBER and DEFINITION, LAB DATA "
+11 SET HDR=HDR_$SELECT('FIX:"NOT ",1:"")_"UPDATED"
End DoDot:1
+12 IF TYP="S6"
SET HDR="ANTIBIOTICS NEEDING MANUAL REVIEW/UPDATE"
+13 IF 'FIX
SET HDR="ANALYZE - "_HDR
+14 IF FIX
SET HDR="ANALYZE/REPAIR - "_HDR
+15 FOR
SET IEN=$ORDER(^TMP("LR",$JOB,TYP,IEN))
if IEN=""
QUIT
Begin DoDot:1
+16 IF FIX
IF TYP="S5"
Begin DoDot:2
+17 SET TMP=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U)
SET ANTIB=$PIECE(^DD(63.3,TMP,0),U)
End DoDot:2
+18 IF '$TEST
SET ANTIB=$PIECE(^DD(63.3,IEN,0),U)
+19 IF TYP="S1"
Begin DoDot:2
+20 SET CNT=CNT+1
+21 SET OLDIT=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|")
+22 SET NEWIT=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|",2)
+23 SET ARY(TYP,CNT)=ANTIB_"|"_OLDIT_"|"_NEWIT_"|"_IEN
End DoDot:2
+24 IF TYP="S2"
Begin DoDot:2
+25 SET CNT=CNT+1
+26 SET OHLP=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|")
+27 SET NHLP=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|",2)
+28 SET ARY(TYP,CNT)=ANTIB_"|"_OHLP_"|"_NHLP_"|"_IEN
End DoDot:2
+29 IF TYP="S3"
Begin DoDot:2
+30 SET CNT=CNT+1
+31 SET OKEY=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|")
+32 SET NKEY=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),"|",2)
+33 SET ARY(TYP,CNT)=ANTIB_"|"_OKEY_"|"_NKEY_"|"_IEN
End DoDot:2
+34 IF TYP="S4"
Begin DoDot:2
+35 SET CNT=CNT+1
+36 SET INTERP=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U)
+37 SET SCRN=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U,2)
+38 SET ARY(TYP,CNT)=ANTIB_"|"_INTERP_"|"_SCRN_"|"_IEN
End DoDot:2
+39 IF TYP="S5"
Begin DoDot:2
+40 SET CNT=CNT+1
+41 SET OFLN=IEN
+42 IF 'FIX
SET (NFLDN,NINT,NSCR)="TBD"
+43 IF FIX
Begin DoDot:3
+44 SET NFLDN=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U)
+45 SET NINT=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U,2)
+46 SET NSCR=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U,3)
End DoDot:3
+47 SET NFX=$PIECE($GET(^TMP("LR",$JOB,TYP,IEN)),U,4)
+48 SET ARY(TYP,CNT)=ANTIB_"|"_IEN_"|"_NFLDN_"|"_NINT_"|"_NSCR_"|"_NFX
End DoDot:2
+49 IF TYP="S6"
Begin DoDot:2
+50 SET CNT=CNT+1
+51 SET ARY(TYP,CNT)=ANTIB_"|"_IEN
End DoDot:2
End DoDot:1
+52 ;
+53 QUIT
