- PXRMV1ID ; SLC/PJH - Build selectable code lists ;10/25/1999
- ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000
- ;
- ;Implementation utility
- ;----------------------
- START ;Lock entire taxonomy file
- I $$LOCK D
- .D BMES^XPDUTL("Generating selectable codes from taxonomy file")
- .K ^TMP("PXRM",$J)
- .N TAXIND
- .S TAXIND=0
- .F S TAXIND=$O(^PXD(811.2,TAXIND)) Q:'TAXIND D
- ..;Remove any existing entries
- ..D DEL(TAXIND)
- ..;Build new list of selectable codes
- ..D BCL(TAXIND)
- .D BMES^XPDUTL("Generation completed")
- D UNLOCK
- Q
- ;
- ;Build the list of codes for one taxonomy
- ;----------------------------------------
- BCL(TAXIND) ;
- N CODELIST,IC,FINDING,FILE,HIGH,LOW,NCE,TEMP
- ;
- ;Setup file names for indirection, these will hold the taxonomy lists.
- N ICD9IEN,ICPTIEN
- S ICD9IEN="^TMP(""PXRM"",$J,""ICD9IEN"")"
- S ICPTIEN="^TMP(""PXRM"",$J,""ICPTIEN"")"
- ;
- S NCE=0
- F FILE=80,81 D
- .S IC=0
- .F S IC=$O(^PXD(811.2,TAXIND,FILE,IC)) Q:+IC=0 D
- ..S TEMP=$G(^PXD(811.2,TAXIND,FILE,IC,0))
- ..;Append the taxonomy and finding information to CODELIST.
- ..S NCE=NCE+1
- ..S CODELIST(NCE)=TEMP_U_FILE
- ;CODELIST is LOW_U_HIGH_U_FILE
- ;Go through the standard coded list and get the file IEN for each entry.
- F IC=1:1:NCE D
- .S LOW=$P(CODELIST(IC),U,1)
- .S HIGH=$P(CODELIST(IC),U,2)
- .S FILE=$P(CODELIST(IC),U,3)
- .I FILE=80 D ICD9(LOW,HIGH) Q
- .I FILE=81 D ICPT(LOW,HIGH) Q
- ;
- ;Store the results.
- D STORE(TAXIND)
- K ^TMP("PXRM",$J,"ICD9IEN")
- K ^TMP("PXRM",$J,"ICPTIEN")
- Q
- ;
- ;=======================================================================
- DEL(TAXIND) ;Delete existing entry
- K ^PXD(811.2,TAXIND,"SDX")
- K ^PXD(811.2,TAXIND,"SPR")
- Q
- ;
- ;Build the list of internal entries for ICD9 (File 80)
- ;-----------------------------------------------------
- ICD9(LOW,HIGH) ;
- N END,IEN,IND
- S IND=LOW_" "
- S END=HIGH_" "
- F Q:(IND]END)!(+IND>+END)!(IND="") D
- .S IEN=$O(^ICD9("BA",IND,""))
- .I (+IEN>0),$$CODE^PXRMVAL($TR(IND," "),80) D
- ..S ^TMP("PXRM",$J,"ICD9IEN",IND)=IEN
- .S IND=$O(^ICD9("BA",IND))
- Q
- ;
- ;Build the list of internal entries for ICPT (File 81)
- ;-----------------------------------------------------
- ICPT(LOW,HIGH) ;
- N IEN,IND
- S IND=LOW
- F Q:(IND]HIGH)!(+IND>+HIGH)!(IND="") D
- .S IEN=$O(^ICPT("B",IND,""))
- .I (+IEN>0),$$CODE^PXRMVAL($TR(IND," "),81) D
- ..S ^TMP("PXRM",$J,"ICPTIEN",IND)=IEN
- .S IND=$O(^ICPT("B",IND))
- Q
- ;
- ;Lock the taxonomy file
- LOCK() N IND,LOCK
- S LOCK=0
- F IND=1:1:30 Q:LOCK D
- .L +^PXD(811.2):1
- .S LOCK=$T
- ;If we can't get lock generate an error and quit.
- I 'LOCK D Q 0
- .D BMES^XPDUTL("Could not get lock for taxonomy file ")
- Q 1
- ;
- ;Store selectable codes in taxonomy
- ;----------------------------------
- STORE(TAXIND) ;
- K ^TMP("PXRMV1ID",$J)
- N FDA,FDAIEN,FITEM,I2N,IEN,IND,MSG,NAME,SEQ,SUB,TEMP
- ;
- S NAME=$P(^PXD(811.2,TAXIND,0),U)
- ;
- S FDAIEN(1)=TAXIND
- ;
- S SUB="",IND=1,SEQ=0
- F S SUB=$O(^TMP("PXRM",$J,"ICD9IEN",SUB)) Q:SUB="" D
- .S IEN=^TMP("PXRM",$J,"ICD9IEN",SUB)
- .S IND=IND+1,SEQ=SEQ+1
- .S I2N="+"_IND_","_FDAIEN(1)_","
- .S ^TMP("PXRMV1ID",$J,811.23102,I2N,.01)=IEN
- .;S ^TMP("PXRMV1ID",$J,811.23102,I2N,.01)=SEQ
- .;S ^TMP("PXRMV1ID",$J,811.23102,I2N,1)=IEN
- .;S ^TMP("PXRMV1ID",$J,811.23102,I2N,3)=1
- ;
- S SEQ=0
- F S SUB=$O(^TMP("PXRM",$J,"ICPTIEN",SUB)) Q:SUB="" D
- .S IEN=^TMP("PXRM",$J,"ICPTIEN",SUB)
- .S IND=IND+1,SEQ=SEQ+1
- .S I2N="+"_IND_","_FDAIEN(1)_","
- .S ^TMP("PXRMV1ID",$J,811.23104,I2N,.01)=IEN
- .;S ^TMP("PXRMV1ID",$J,811.23104,I2N,.01)=SEQ
- .;S ^TMP("PXRMV1ID",$J,811.23104,I2N,1)=IEN
- .;S ^TMP("PXRMV1ID",$J,811.23104,I2N,3)=1
- ;
- ;None found
- I IND=1 Q
- ;
- S TEMP="^TMP(""PXRMV1ID"","_$J_")"
- D UPDATE^DIE("",TEMP,"FDAIEN","MSG")
- I $D(MSG) D ERR
- K ^TMP("PXRMV1ID",$J)
- Q
- ;
- ;Unlock the taxonomy
- ;-------------------
- UNLOCK L -^PXD(811.2)
- Q
- ;
- ;Error Handler
- ;-------------
- ERR N ERROR,IC,REF
- S ERROR(1)="Unable to build selectable codes for taxonomy : "
- S ERROR(2)=NAME
- S ERROR(3)="Error in UPDATE^DIE, needs further investigation"
- ;Move MSG into ERROR
- S REF="MSG"
- F IC=4:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
- ;Screen message
- D BMES^XPDUTL(.ERROR)
- ;Mail Message
- D ERR^PXRMV1IE(.ERROR)
- Q
- PXRMV1ID ; SLC/PJH - Build selectable code lists ;10/25/1999
- +1 ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000
- +2 ;
- +3 ;Implementation utility
- +4 ;----------------------
- START ;Lock entire taxonomy file
- +1 IF $$LOCK
- Begin DoDot:1
- +2 DO BMES^XPDUTL("Generating selectable codes from taxonomy file")
- +3 KILL ^TMP("PXRM",$JOB)
- +4 NEW TAXIND
- +5 SET TAXIND=0
- +6 FOR
- SET TAXIND=$ORDER(^PXD(811.2,TAXIND))
- IF 'TAXIND
- QUIT
- Begin DoDot:2
- +7 ;Remove any existing entries
- +8 DO DEL(TAXIND)
- +9 ;Build new list of selectable codes
- +10 DO BCL(TAXIND)
- End DoDot:2
- +11 DO BMES^XPDUTL("Generation completed")
- End DoDot:1
- +12 DO UNLOCK
- +13 QUIT
- +14 ;
- +15 ;Build the list of codes for one taxonomy
- +16 ;----------------------------------------
- BCL(TAXIND) ;
- +1 NEW CODELIST,IC,FINDING,FILE,HIGH,LOW,NCE,TEMP
- +2 ;
- +3 ;Setup file names for indirection, these will hold the taxonomy lists.
- +4 NEW ICD9IEN,ICPTIEN
- +5 SET ICD9IEN="^TMP(""PXRM"",$J,""ICD9IEN"")"
- +6 SET ICPTIEN="^TMP(""PXRM"",$J,""ICPTIEN"")"
- +7 ;
- +8 SET NCE=0
- +9 FOR FILE=80,81
- Begin DoDot:1
- +10 SET IC=0
- +11 FOR
- SET IC=$ORDER(^PXD(811.2,TAXIND,FILE,IC))
- IF +IC=0
- QUIT
- Begin DoDot:2
- +12 SET TEMP=$GET(^PXD(811.2,TAXIND,FILE,IC,0))
- +13 ;Append the taxonomy and finding information to CODELIST.
- +14 SET NCE=NCE+1
- +15 SET CODELIST(NCE)=TEMP_U_FILE
- End DoDot:2
- End DoDot:1
- +16 ;CODELIST is LOW_U_HIGH_U_FILE
- +17 ;Go through the standard coded list and get the file IEN for each entry.
- +18 FOR IC=1:1:NCE
- Begin DoDot:1
- +19 SET LOW=$PIECE(CODELIST(IC),U,1)
- +20 SET HIGH=$PIECE(CODELIST(IC),U,2)
- +21 SET FILE=$PIECE(CODELIST(IC),U,3)
- +22 IF FILE=80
- DO ICD9(LOW,HIGH)
- QUIT
- +23 IF FILE=81
- DO ICPT(LOW,HIGH)
- QUIT
- End DoDot:1
- +24 ;
- +25 ;Store the results.
- +26 DO STORE(TAXIND)
- +27 KILL ^TMP("PXRM",$JOB,"ICD9IEN")
- +28 KILL ^TMP("PXRM",$JOB,"ICPTIEN")
- +29 QUIT
- +30 ;
- +31 ;=======================================================================
- DEL(TAXIND) ;Delete existing entry
- +1 KILL ^PXD(811.2,TAXIND,"SDX")
- +2 KILL ^PXD(811.2,TAXIND,"SPR")
- +3 QUIT
- +4 ;
- +5 ;Build the list of internal entries for ICD9 (File 80)
- +6 ;-----------------------------------------------------
- ICD9(LOW,HIGH) ;
- +1 NEW END,IEN,IND
- +2 SET IND=LOW_" "
- +3 SET END=HIGH_" "
- +4 FOR
- IF (IND]END)!(+IND>+END)!(IND="")
- QUIT
- Begin DoDot:1
- +5 SET IEN=$ORDER(^ICD9("BA",IND,""))
- +6 IF (+IEN>0)
- IF $$CODE^PXRMVAL($TRANSLATE(IND," "),80)
- Begin DoDot:2
- +7 SET ^TMP("PXRM",$JOB,"ICD9IEN",IND)=IEN
- End DoDot:2
- +8 SET IND=$ORDER(^ICD9("BA",IND))
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;Build the list of internal entries for ICPT (File 81)
- +12 ;-----------------------------------------------------
- ICPT(LOW,HIGH) ;
- +1 NEW IEN,IND
- +2 SET IND=LOW
- +3 FOR
- IF (IND]HIGH)!(+IND>+HIGH)!(IND="")
- QUIT
- Begin DoDot:1
- +4 SET IEN=$ORDER(^ICPT("B",IND,""))
- +5 IF (+IEN>0)
- IF $$CODE^PXRMVAL($TRANSLATE(IND," "),81)
- Begin DoDot:2
- +6 SET ^TMP("PXRM",$JOB,"ICPTIEN",IND)=IEN
- End DoDot:2
- +7 SET IND=$ORDER(^ICPT("B",IND))
- End DoDot:1
- +8 QUIT
- +9 ;
- +10 ;Lock the taxonomy file
- LOCK() NEW IND,LOCK
- +1 SET LOCK=0
- +2 FOR IND=1:1:30
- IF LOCK
- QUIT
- Begin DoDot:1
- +3 LOCK +^PXD(811.2):1
- +4 SET LOCK=$TEST
- End DoDot:1
- +5 ;If we can't get lock generate an error and quit.
- +6 IF 'LOCK
- Begin DoDot:1
- +7 DO BMES^XPDUTL("Could not get lock for taxonomy file ")
- End DoDot:1
- QUIT 0
- +8 QUIT 1
- +9 ;
- +10 ;Store selectable codes in taxonomy
- +11 ;----------------------------------
- STORE(TAXIND) ;
- +1 KILL ^TMP("PXRMV1ID",$JOB)
- +2 NEW FDA,FDAIEN,FITEM,I2N,IEN,IND,MSG,NAME,SEQ,SUB,TEMP
- +3 ;
- +4 SET NAME=$PIECE(^PXD(811.2,TAXIND,0),U)
- +5 ;
- +6 SET FDAIEN(1)=TAXIND
- +7 ;
- +8 SET SUB=""
- SET IND=1
- SET SEQ=0
- +9 FOR
- SET SUB=$ORDER(^TMP("PXRM",$JOB,"ICD9IEN",SUB))
- IF SUB=""
- QUIT
- Begin DoDot:1
- +10 SET IEN=^TMP("PXRM",$JOB,"ICD9IEN",SUB)
- +11 SET IND=IND+1
- SET SEQ=SEQ+1
- +12 SET I2N="+"_IND_","_FDAIEN(1)_","
- +13 SET ^TMP("PXRMV1ID",$JOB,811.23102,I2N,.01)=IEN
- +14 ;S ^TMP("PXRMV1ID",$J,811.23102,I2N,.01)=SEQ
- +15 ;S ^TMP("PXRMV1ID",$J,811.23102,I2N,1)=IEN
- +16 ;S ^TMP("PXRMV1ID",$J,811.23102,I2N,3)=1
- End DoDot:1
- +17 ;
- +18 SET SEQ=0
- +19 FOR
- SET SUB=$ORDER(^TMP("PXRM",$JOB,"ICPTIEN",SUB))
- IF SUB=""
- QUIT
- Begin DoDot:1
- +20 SET IEN=^TMP("PXRM",$JOB,"ICPTIEN",SUB)
- +21 SET IND=IND+1
- SET SEQ=SEQ+1
- +22 SET I2N="+"_IND_","_FDAIEN(1)_","
- +23 SET ^TMP("PXRMV1ID",$JOB,811.23104,I2N,.01)=IEN
- +24 ;S ^TMP("PXRMV1ID",$J,811.23104,I2N,.01)=SEQ
- +25 ;S ^TMP("PXRMV1ID",$J,811.23104,I2N,1)=IEN
- +26 ;S ^TMP("PXRMV1ID",$J,811.23104,I2N,3)=1
- End DoDot:1
- +27 ;
- +28 ;None found
- +29 IF IND=1
- QUIT
- +30 ;
- +31 SET TEMP="^TMP(""PXRMV1ID"","_$JOB_")"
- +32 DO UPDATE^DIE("",TEMP,"FDAIEN","MSG")
- +33 IF $DATA(MSG)
- DO ERR
- +34 KILL ^TMP("PXRMV1ID",$JOB)
- +35 QUIT
- +36 ;
- +37 ;Unlock the taxonomy
- +38 ;-------------------
- UNLOCK LOCK -^PXD(811.2)
- +1 QUIT
- +2 ;
- +3 ;Error Handler
- +4 ;-------------
- ERR NEW ERROR,IC,REF
- +1 SET ERROR(1)="Unable to build selectable codes for taxonomy : "
- +2 SET ERROR(2)=NAME
- +3 SET ERROR(3)="Error in UPDATE^DIE, needs further investigation"
- +4 ;Move MSG into ERROR
- +5 SET REF="MSG"
- +6 FOR IC=4:1
- SET REF=$QUERY(@REF)
- IF REF=""
- QUIT
- SET ERROR(IC)=REF_"="_@REF
- +7 ;Screen message
- +8 DO BMES^XPDUTL(.ERROR)
- +9 ;Mail Message
- +10 DO ERR^PXRMV1IE(.ERROR)
- +11 QUIT
