- 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 Mar 13, 2025@21:27:52 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