Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRWU8A

LRWU8A.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;-----------------------------------------------------------
  1. ASK() ; Run analyze/repair query.
  1. ;
  1. N Y,DIRUT,DTOUT,DUOUT,FIX
  1. ;
  1. K DIR,Y
  1. S FIX=0
  1. ;
  1. W !,"This process will check the Organism Sub-field (#63.3) of"
  1. W !,"the LAB DATA file (#63) looking for possible discrepancies"
  1. W !,"in the Data Dictionary. Once the process has completed, a"
  1. W !,"MailMan message will be sent to the user that started this"
  1. W !,"process and any other user selected."
  1. W !!
  1. W !,"The two modes in which this process can be run are ANALYZE"
  1. W !,"and REPAIR. If the ANALYZE option is chosen, the process will"
  1. W !,"only look for the discrepancies and report the findings via"
  1. W !,"a MailMan message. If the ANALYZE/REPAIR option is chosen the"
  1. W !,"process will ANALYZE and REPAIR any discrepancies found that"
  1. W !,"can be fixed programmatically and list all those that could"
  1. W !,"not be fixed but need attention."
  1. W !!
  1. ;
  1. S DIR("A")="Do you want to continue with this process",DIR("B")="N"
  1. S DIR(0)="Y",DIR("B")="NO"
  1. D ^DIR
  1. I 'Y Q FIX
  1. ;
  1. K DIR,Y
  1. ;
  1. S DIR(0)="NAO^1:3",DIR("B")=3
  1. S DIR("A",1)="Select the action you wish to take:"
  1. S DIR("A",2)=""
  1. S DIR("A",3)="1. Analyze and Report. "
  1. S DIR("A",4)="2. Analyze, Repair and Report. "
  1. S DIR("A",5)="3. Quit - No Action."
  1. S DIR("A",6)=""
  1. S DIR("A")="Enter a number 1 thru 3: "
  1. S DIR("?")="Select a number from 1 thru 3 or press <Return> to exit"
  1. ;
  1. D ^DIR
  1. I Y=1 S FIX=1
  1. I Y=2 S FIX=2
  1. I Y=3!(Y=-1) S FIX=0 Q FIX
  1. ;
  1. K DIR,Y
  1. S DIR("A")="Are you sure you want to proceed",DIR("B")="N"
  1. S DIR(0)="Y",DIR("B")="NO"
  1. ;
  1. D ^DIR
  1. I 'Y S FIX=0
  1. ;-----
  1. Q FIX
  1. ;-----------------------------------------------------------
  1. SEND ; Send the report/email to all recipients selected.
  1. ;
  1. N DSH,ERROR,FLDN,HDR,INTERP,LN,LRSITE,MSG,NFLD,NFX,NINT
  1. N NKEY,NSCR,NUM,OKEY,SCRN,SP,TMP,TOTAL,XMDUZ,XMSUB,DIFROM,XMINSTR
  1. ;
  1. S (XMSUB,XMDUZ,MSG,LN,ERROR,NUM)=""
  1. S LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1. ;
  1. S XMINSTR("ADDR FLAGS")="R"
  1. S XMSUB="LAB DATA file (#63) Microbiology Antibiotic Fields Cleanup"
  1. S $P(SP," ",80)="",$P(DSH,"-",80)=""
  1. ;
  1. ; Not all errors were auto-repaired
  1. I '+$G(FIX)!(+$G(FIX)&($D(^TMP("LR",$J,"S6")))) D
  1. .S MSG($$LN)="Contact the National Service Desk to request assistance from the Clin 4"
  1. .S MSG($$LN)="Product Support team in resolving the following errors identified in the"
  1. .S MSG($$LN)="VistA Laboratory package:"
  1. .S MSG($$LN)=""
  1. ;
  1. S MSG($$LN)="The LAB DATA file (#63) cleanup process has completed."
  1. S MSG($$LN)=""
  1. S TMP="Tool run in ANALYZE"_$S(FIX:"/REPAIR",1:"")_" MODE for: "
  1. S MSG($$LN)=TMP_$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_")."
  1. S MSG($$LN)=""
  1. S TMP="This process checked the Organism Sub-field (#63.3) of the "
  1. S MSG($$LN)=TMP_"LAB DATA file (#63)"
  1. S TMP="to locate potential Data Dictionary discrepancies related to "
  1. S MSG($$LN)=TMP_"the definition and"
  1. S MSG($$LN)="setup of fields for reporting antibiotic sensitivities."
  1. S MSG($$LN)=""
  1. S MSG($$LN)="The following report lists any discrepancies found:"
  1. S MSG($$LN)=$TR(SP," ","-")
  1. S MSG($$LN)=""
  1. I '$D(^TMP("LR",$J)) D Q
  1. .S MSG($$LN)="*** NO DISCREPANCIES WERE FOUND IN FILE (#63). ***"
  1. .D SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
  1. F TYP="S1","S2","S3","S4","S5","S6" D
  1. .D BLDARY(TYP)
  1. .I '$D(ARY(TYP)) Q
  1. .S MSG($$LN)=HDR
  1. .S MSG($$LN)=$TR(SP," ","-")
  1. .I TYP="S1" D
  1. ..I 'FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S TMP=TMP_$E("CURRENT INPUT"_SP,1,30)_"PROPOSED INPUT"
  1. ...S MSG($$LN)=TMP
  1. ..I FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S TMP=TMP_$E("FORMER INPUT"_SP,1,30)_"NEW INPUT"
  1. ...S MSG($$LN)=TMP
  1. ..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)
  1. ..S TMP=TMP_$E("TRANSFORM"_SP,1,30)_"TRANSFORM"
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)
  1. ..S MSG($$LN)=TMP_$E(DSH,1,15)
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.OLDIT,.NEWIT,.IEN)
  1. ...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(OLDIT_SP,1,30)_$E(NEWIT_SP,1,15)
  1. ...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. ..S MSG($$LN)=""
  1. ..S MSG($$LN)=""
  1. .I TYP="S2" D
  1. ..I 'FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S TMP=TMP_$E("CURRENT"_SP,1,30)_"PROPOSED"
  1. ...S MSG($$LN)=TMP
  1. ..I FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S MSG($$LN)=TMP_$E("FORMER"_SP,1,30)_"NEW"
  1. ..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)_$E("HELP"_SP,1,30)_"HELP"
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)_$E(DSH,1,15)
  1. ..S MSG($$LN)=TMP
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.OHLP,.NHLP,.IEN)
  1. ...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(OHLP_SP,1,30)_$E(NHLP_SP,1,15)
  1. ...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. ..S MSG($$LN)=""
  1. ..S MSG($$LN)=""
  1. .I TYP="S3" D
  1. ..I 'FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S MSG($$LN)=TMP_$E("CURRENT"_SP,1,20)_"PROPOSED"
  1. ..I FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)
  1. ...S MSG($$LN)=TMP_$E("FORMER"_SP,1,20)_"NEW"
  1. ..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)_$E("SET OF CODES"_SP,1,20)
  1. ..S TMP=TMP_"SET OF CODES"
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,18)_$E(SP,1,2)_$E(DSH,1,25)
  1. ..S MSG($$LN)=TMP
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.OKEY,.NKEY,.IEN)
  1. ...S MSG($$LN)=$E(ANTIB_SP,1,31)_" "_$E(OKEY_SP,1,18)_" "_$E(NKEY_SP,1,25)
  1. ...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)
  1. ...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)
  1. ...I $L(OKEY)>54 D
  1. ....N LGOKEY,ADLOKEY,LLNOKEY,PADLOKEY
  1. ....S LGOKEY=$L(OKEY)-54,ADLOKEY=LGOKEY\18,LLNOKEY=LGOKEY/18
  1. ....S LLNOKEY=$S(LLNOKEY[".":1,1:0),PADLOKEY=0
  1. ....I ADLOKEY>=1 D
  1. .....F PADLOKEY=1:1:ADLOKEY D
  1. ......S MSG($$LN)=$E(SP,1,33)_$E(OKEY_SP,(18*PADLOKEY)+37,(18*PADLOKEY)+54)
  1. ....I LLNOKEY D
  1. .....S MSG($$LN)=$E(SP,1,33)_$E(OKEY_SP,(18*(ADLOKEY+1))+37,(18*(PADLOKEY+1))+54)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. ..S MSG($$LN)=""
  1. ..S MSG($$LN)=""
  1. .I TYP="S4" D
  1. ..S TMP=$E("ANTIBIOTIC NAME"_SP,1,33)_$E("INTERP FIELD"_SP,1,30)
  1. ..S TMP=TMP_"SCREEN FIELD"
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(" (FIELD NUMBER)"_SP,1,33)
  1. ..S TMP=TMP_$E($S('FIX:"NEEDED",1:"ADDED")_SP,1,30)
  1. ..S TMP=TMP_$S('FIX:"NEEDED",1:"ADDED")
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,28)_$E(SP,1,2)_$E(DSH,1,15)
  1. ..S MSG($$LN)=TMP
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.INTERP,.SCRN,.IEN)
  1. ...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(INTERP_SP,1,30)_$E(SCRN_SP,1,15)
  1. ...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. ..S MSG($$LN)=""
  1. ..S MSG($$LN)=""
  1. .I TYP="S5" D
  1. ..I 'FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,28)
  1. ...S TMP=TMP_$E("NEW FIELD #"_SP,1,13)_$E("NEW INTERP"_SP,1,13)
  1. ...S MSG($$LN)=TMP_$E("NEW SCREEN"_SP,1,13)_$E("OCCURRENCES"_SP,1,11)
  1. ..I FIX D
  1. ...S TMP=$E("ANTIBIOTIC NAME"_SP,1,28)
  1. ...S TMP=TMP_$E("FIELD ADDED"_SP,1,13)_$E("INTERP ADDED"_SP,1,14)
  1. ...S MSG($$LN)=TMP_$E("SCRN ADDED"_SP,1,12)_$E("OCCURRENCES"_SP,1,11)
  1. ..S TMP=$E(" (FIELD NUMBER)"_SP,1,67)_"FOUND"
  1. ..S MSG($$LN)=TMP
  1. ..S TMP=$E(DSH,1,26)_$E(SP,1,2)_$E(DSH,1,11)_$E(SP,1,2)_$E(DSH,1,12)
  1. ..S MSG($$LN)=TMP_$E(SP,1,2)_$E(DSH,1,11)_$E(SP)_$E(DSH,1,11)
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.IEN,.NFLD,.NINT,.NSCR,.NFX)
  1. ...S TMP=$E(ANTIB_SP,1,28)_$E(NFLD_SP,1,13)_$E(NINT_SP,1,14)
  1. ...S MSG($$LN)=TMP_$E(NSCR_SP,1,13)_$E(NFX_SP,1,4)
  1. ...S MSG($$LN)=$E(" ("_IEN_")"_SP,1,20)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. ..I FIX D
  1. ...S MSG($$LN)=""
  1. ...S TMP=" Note: Due to the added antibiotics, updates may"
  1. ...S MSG($$LN)=TMP
  1. ...S TMP=" need to be made to input (edit) templates"
  1. ...S MSG($$LN)=TMP
  1. ...S TMP=" in the LAB DATA file that correspond to the"
  1. ...S MSG($$LN)=TMP
  1. ...S TMP=" old fields and update the new fields."
  1. ...S MSG($$LN)=TMP
  1. ..S MSG($$LN)=""
  1. ..S MSG($$LN)=""
  1. .I TYP="S6" D
  1. ..S MSG($$LN)=$E("ANTIBIOTIC"_SP,1,33)_$E("FIELD NUMBER",1,20)
  1. ..S MSG($$LN)=$E(DSH,1,31)_$E(SP,1,2)_$E(DSH,1,20)
  1. ..S CNT="" F S CNT=$O(ARY(TYP,CNT)) Q:CNT="" D
  1. ...D GETDATA(TYP,CNT,.ANTIB,.FLDN)
  1. ...S MSG($$LN)=$E(ANTIB_SP,1,33)_$E(FLDN_SP,1,30)
  1. ...S TOTAL=CNT
  1. ..S MSG($$LN)=$TR(SP," ","-")
  1. ..S MSG($$LN)=$E("TOTAL: "_SP,1,7)_$E(TOTAL_SP,1,10)
  1. .S MSG($$LN)=""
  1. .S MSG($$LN)=""
  1. K ARY
  1. S MSG($$LN)=$TR(SP," ","*")
  1. S MSG($$LN)="*** END OF REPORT ***"
  1. D SENDMSG^XMXAPI(DUZ,XMSUB,"MSG",.XMY,.XMINSTR)
  1. ;
  1. Q
  1. ;-----------------------------------------------------------
  1. LN() ; Increment the line couter.
  1. ;
  1. S LN=LN+1
  1. ;
  1. Q LN
  1. ;-----------------------------------------------------------
  1. GETDATA(TYP,CNT,A1,A2,A3,A4,A5,A6) ; Set up variables for print.
  1. ;
  1. N I,NUM
  1. ;
  1. S NUM=$L(ARY(TYP,CNT),"|")
  1. F I=1:1:NUM S @("A"_I)=$P(ARY(TYP,CNT),"|",I)
  1. ;
  1. Q
  1. ;
  1. ;-----------------------------------------------------------
  1. BLDARY(TYP) ; Build the array.
  1. ;
  1. N ANTIB,IEN,MDE,NEWIT,NFLDN,NHLP,OFLN,OLDIT,OHLP,TMP
  1. ;
  1. S (ANTIB,OLDIT)="",NEWIT="D ^LRMISR",CNT=0,IEN=""
  1. I TYP="S1" S HDR="INCORRECT INPUT TRANSFORMS (IT)"
  1. I TYP="S2" S HDR="INCORRECT HELP TEXT"
  1. I TYP="S3" S HDR="INCORRECT SET OF CODES"
  1. I TYP="S4" S HDR="MISSING INTERP and/or SCREEN"
  1. I TYP="S5" D
  1. . S HDR="BAD FIELD NUMBER and DEFINITION, LAB DATA "
  1. . S HDR=HDR_$S('FIX:"NOT ",1:"")_"UPDATED"
  1. I TYP="S6" S HDR="ANTIBIOTICS NEEDING MANUAL REVIEW/UPDATE"
  1. I 'FIX S HDR="ANALYZE - "_HDR
  1. I FIX S HDR="ANALYZE/REPAIR - "_HDR
  1. F S IEN=$O(^TMP("LR",$J,TYP,IEN)) Q:IEN="" D
  1. .I FIX,TYP="S5" D
  1. ..S TMP=$P($G(^TMP("LR",$J,TYP,IEN)),U),ANTIB=$P(^DD(63.3,TMP,0),U)
  1. .E S ANTIB=$P(^DD(63.3,IEN,0),U)
  1. .I TYP="S1" D
  1. ..S CNT=CNT+1
  1. ..S OLDIT=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
  1. ..S NEWIT=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_OLDIT_"|"_NEWIT_"|"_IEN
  1. .I TYP="S2" D
  1. ..S CNT=CNT+1
  1. ..S OHLP=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
  1. ..S NHLP=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_OHLP_"|"_NHLP_"|"_IEN
  1. .I TYP="S3" D
  1. ..S CNT=CNT+1
  1. ..S OKEY=$P($G(^TMP("LR",$J,TYP,IEN)),"|")
  1. ..S NKEY=$P($G(^TMP("LR",$J,TYP,IEN)),"|",2)
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_OKEY_"|"_NKEY_"|"_IEN
  1. .I TYP="S4" D
  1. ..S CNT=CNT+1
  1. ..S INTERP=$P($G(^TMP("LR",$J,TYP,IEN)),U)
  1. ..S SCRN=$P($G(^TMP("LR",$J,TYP,IEN)),U,2)
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_INTERP_"|"_SCRN_"|"_IEN
  1. .I TYP="S5" D
  1. ..S CNT=CNT+1
  1. ..S OFLN=IEN
  1. ..I 'FIX S (NFLDN,NINT,NSCR)="TBD"
  1. ..I FIX D
  1. ...S NFLDN=$P($G(^TMP("LR",$J,TYP,IEN)),U)
  1. ...S NINT=$P($G(^TMP("LR",$J,TYP,IEN)),U,2)
  1. ...S NSCR=$P($G(^TMP("LR",$J,TYP,IEN)),U,3)
  1. ..S NFX=$P($G(^TMP("LR",$J,TYP,IEN)),U,4)
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_IEN_"|"_NFLDN_"|"_NINT_"|"_NSCR_"|"_NFX
  1. .I TYP="S6" D
  1. ..S CNT=CNT+1
  1. ..S ARY(TYP,CNT)=ANTIB_"|"_IEN
  1. ;
  1. Q