- BKMIXX5 ;PRXM/HC/KJH - BKMV UTILITY PROGRAM; [ 7/15/2005 1:28 PM ] ; 16 Jul 2005 8:34 PM
- ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
- ; Generic Taxonomy Utilities
- ; Utility for building list of referenced IENs from a Taxonomy.
- Q
- ;
- BLDTAX(TAX,TARGET) ; PEP
- ;
- D BLD^BQITUTL(TAX,TARGET)
- Q
- ;
- I $$PATCH^XPDUTL("ATX*5.1*11") D BLDTAX^ATXAPI(TAX,TARGET) Q
- ;
- ; Takes a taxonomy name and builds an array that can then be used
- ; to scan various V-File cross-references to see which records
- ; match an entry in the Taxonomy.
- ;
- ; Currently supported Taxonomies are as follows:
- ; (where FILE is field #.15 in the TAXONOMY file #9002226)
- ; ICD9 Diagnoses via ICD9 codes (^ICD9 - FILE 80)
- ; ICD9 Procedures via ICD9 codes (^ICD0 - FILE 80.1)
- ; CPT Procedures via CPT codes (^ICPT - FILE 81)
- ; Medications via NDC codes (^PSDRUG - FILE 2)
- ; Medications via MED IEN (^PSDRUG - FILE 50)
- ; Laboratory tests via LOINC codes (^LAB(60) - FILE 95.3)
- ; Patient Education Topics by name (^AUTTEDT - FILE 9999999.09)
- ; NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
- ; Immunizations via HL7/CVX codes (^AUTTIMM - FILE 9999999.14)
- ; Health Factors by Name (^AUTTHF - FILE 9999999.64)
- ; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
- ; Laboratory tests via LAB IEN (^LAB(60) - FILE 60)
- ;
- ; Input:
- ; TAX = Name of Taxonomy from ATXAX or ATXLAB file.
- ; (required)
- ; TARGET = Closed array reference where the output will be stored.
- ; (required)
- ; This can be a local variable or global reference.
- ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
- ;
- ; Output:
- ; An array in the local or global TARGET of the form:
- ; @TARGET@(IEN)=NAME (.01 field)
- ;
- ; NOTE: Kill the output array before calling the function unless
- ; you intend to group several Taxonomies of the same type.
- ;
- N FILEREF,TAXIEN,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME
- I TARGET=""!(TAX="") Q
- S TAXIEN=$O(^ATXAX("B",TAX,0)),TAXREF="^ATXAX"
- I TAXIEN="" S TAXIEN=$O(^ATXLAB("B",TAX,0)),TAXREF="^ATXLAB"
- I TAXIEN="" Q
- I TAXREF="^ATXAX" S FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")
- I TAXREF="^ATXLAB" S FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
- ; The following file references from Taxonomy are supported:
- I $F(",80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,",","_FILEREF_",")=0 Q
- S ENTRY=0
- F S ENTRY=$O(@TAXREF@(TAXIEN,21,ENTRY)) Q:'ENTRY D
- .S VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
- .S VAL=$P(VALUE,U,1),END=$P(VALUE,U,2)
- .; LAB entries use the IEN and only specify one value.
- .I FILEREF=60 D Q
- ..S NAME=$P($G(^LAB(60,VAL,0)),U,1),@TARGET@(VAL)=NAME
- .; MED entries use the IEN and only specify one value.
- .I FILEREF=50 D Q
- ..S NAME=$P($G(^PSDRUG(VAL,0)),U,1),@TARGET@(VAL)=NAME
- .; Otherwise, treat all items as ranges (even if there is only one entry).
- .I END="" S END=VAL
- .D
- ..I FILEREF=95.3 D Q
- ...; The LOINC x-ref in LAB does not use the check digit (piece 2).
- ...S VAL=$P(VAL,"-"),END=$P(END,"-")
- ...S FILE="^LAB(60)",INDEX="AF"
- ..I FILEREF=2 S FILE="^PSDRUG",INDEX="D" Q
- ..I FILEREF=9999999.09 S FILE="^AUTTEDT",INDEX="B" Q
- ..I FILEREF=9999999.14 S FILE="^AUTTIMM",INDEX="C" Q
- ..I FILEREF=9999999.64 S FILE="^AUTTHF",INDEX="B" Q
- ..; CPT, ICD9, and ICD0 require a SPACE be added to the code.
- ..; Some Taxonomy entries already have the space included.
- ..S:$E(VAL,$L(VAL))'=" " VAL=VAL_" "
- ..S:$E(END,$L(END))'=" " END=END_" "
- ..I FILEREF=80 S FILE="^ICD9",INDEX="BA" Q
- ..I FILEREF=80.1 S FILE="^ICD0",INDEX="BA" Q
- ..I FILEREF=81 S FILE="^ICPT",INDEX="BA" Q
- .; Backup one entry so loop can find all the entries in the range.
- .S VAL=$O(@FILE@(INDEX,VAL),-1)
- .F S VAL=$O(@FILE@(INDEX,VAL)) Q:VAL="" Q:$$CHECK(VAL,END) D
- ..S IEN=""
- ..F S IEN=$O(@FILE@(INDEX,VAL,IEN)) Q:IEN="" D
- ...S NAME=$P($G(@FILE@(IEN,0)),U,1)
- ...S @TARGET@(IEN)=NAME
- Q
- ;
- CHECK(V,E) ;
- N Z
- I V=E Q 0
- S Z(V)=""
- S Z(E)=""
- I $O(Z(""))=E Q 1
- Q 0
- ;
- BLDTAX1(TAX,TARGET) ;EP
- ;
- ; Takes a list of partial Patient Education topic names and
- ; builds an array that can then be used to scan a V-File
- ; cross-reference to see which records match an entry in the
- ; list.
- ;
- ; This tag only supports Patient Education:
- ; (where FILE is field #.15 in the TAXONOMY file #9002226)
- ; Patient Education Topic Codes (^AUTTEDT - FILE 9999999.09)
- ;
- ; Input:
- ; TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
- ; (required)
- ;
- ; Example: "CD-,-CD,AOD-,-AOD"
- ; Example: "*BGP HIV/AIDS DXS"
- ;
- ; Returns items where the MNEMONIC field for the Patient
- ; Education entry contains one of the listed values.
- ;
- ; Second example shows an ICD taxonomy name.
- ; If used, will search for any Patient Education entry
- ; containing one of the values in that Taxonomy.
- ;
- ; TARGET : Closed array reference where the output will be stored.
- ; This can be a local variable or global reference.
- ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
- ;
- ; Output:
- ; An array in the local or global TARGET of the form:
- ; @TARGET@(IEN)=NAME (.01 field)
- ;
- ; NOTE: Kill the output array before calling the function unless
- ; you intend to group several Taxonomies of the same type.
- ;
- N VAL,IEN,NAME,MNEMONIC,TAX1,I,ICDIEN,FLG
- F I=1:1:$L(TAX,",") S TAX1=$P(TAX,",",I) I $E(TAX1)="*" D BLDTAX($E(TAX1,2,$L(TAX1)),"ICDIEN")
- S VAL=""
- F S VAL=$O(^AUTTEDT("B",VAL)) Q:VAL="" D
- .S IEN=""
- .F S IEN=$O(^AUTTEDT("B",VAL,IEN)) Q:IEN="" D
- ..S NAME=$$GET1^DIQ(9999999.09,IEN,.01,"I"),MNEMONIC=$$GET1^DIQ(9999999.09,IEN,1,"I"),FLG=0
- ..F I=1:1:$L(TAX,",") S TAX1=$P(TAX,",",I) I $E(TAX1)'="*",MNEMONIC[TAX1 S @TARGET@(IEN)=NAME_U_MNEMONIC,FLG=1 Q
- ..I FLG=1 Q
- ..S I=""
- ..;If an ICD is used as the MNEMONIC it will be formatted as "ICD-abbreviation".
- ..;For example, if the ICD is "042." and the patient education is 'alcohol or drugs' then the MNEMONIC would be "042.-AOD".
- ..F S I=$O(ICDIEN(I)) Q:I="" S TAX1=ICDIEN(I)_"-" I MNEMONIC[TAX1 S @TARGET@(IEN)=NAME_U_MNEMONIC,FLG=1 Q
- ..I FLG=1 Q
- ..Q
- .Q
- Q
- ;
- ICD(IEN,TXIEN,TYPE) ; EP - Utility wrapper for calling $$ICD^ATXCHK
- ; TYPE can be 9 (ICD), 0 (PRC), or 1 (CPT)
- ; $$ICD^ATXCHK only checks ranges ("AA" x-ref). (ex. 200.80-200.288)
- ; Also need to check individual entries ("B" x-ref). (ex. 042.)
- N ITEM
- I $G(IEN)=""!($G(TXIEN)="")!($G(TYPE)="") Q 0
- ; Check ranges first (most entries are setup as ranges)
- I $$PATCH^XPDUTL("ATX*5.1*11") I $$ICD^ATXAPI(IEN,TXIEN,TYPE)=1 Q 1
- ;
- I $$ICD^ATXCHK(IEN,TXIEN,TYPE)=1 Q 1
- ; Check individual entries (currently only a few, but potentially more could be defined)
- S ITEM=$S(TYPE=9:$P($G(^ICD9(IEN,0)),U),TYPE=0:$P($G(^ICD0(IEN,0)),U),TYPE=1:$P($G(^ICPT(IEN,0)),U),1:"")
- I ITEM="" Q 0
- ; Under certain conditions, item will have a space at the end.
- I $D(^ATXAX(TXIEN,21,"B",ITEM)) Q 1
- I $D(^ATXAX(TXIEN,21,"B",ITEM_" ")) Q 1
- Q 0
- ;
- STAT(STATUS) ; Check presence on HIV registry and status = STATUS
- ;
- N DFN,BKMDFN,HIVREG,BKMNODE,BKMIEN
- ; Variable Y contains the 'DFN' (IEN for file 2 in global ^DPT) from the FileMan Screen call.
- S DFN=Y
- Q:'+$G(DFN) 0
- S (BKMIEN,BKMDFN)=$O(^BKM(90451,"B",DFN,0)) Q:'+BKMDFN 0
- I '$D(^BKM(90451,BKMDFN)) Q 0
- S HIVREG=1
- I '$D(^BKM(90451,BKMDFN,1,HIVREG)) Q 0
- S BKMNODE=$G(^BKM(90451,BKMDFN,1,HIVREG,0))
- I STATUS]"" Q:$P(BKMNODE,U,7)'=STATUS 0
- Q 1
- BKMIXX5 ;PRXM/HC/KJH - BKMV UTILITY PROGRAM; [ 7/15/2005 1:28 PM ] ; 16 Jul 2005 8:34 PM
- +1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
- +2 ; Generic Taxonomy Utilities
- +3 ; Utility for building list of referenced IENs from a Taxonomy.
- +4 QUIT
- +5 ;
- BLDTAX(TAX,TARGET) ; PEP
- +1 ;
- +2 DO BLD^BQITUTL(TAX,TARGET)
- +3 QUIT
- +4 ;
- +5 IF $$PATCH^XPDUTL("ATX*5.1*11")
- DO BLDTAX^ATXAPI(TAX,TARGET)
- QUIT
- +6 ;
- +7 ; Takes a taxonomy name and builds an array that can then be used
- +8 ; to scan various V-File cross-references to see which records
- +9 ; match an entry in the Taxonomy.
- +10 ;
- +11 ; Currently supported Taxonomies are as follows:
- +12 ; (where FILE is field #.15 in the TAXONOMY file #9002226)
- +13 ; ICD9 Diagnoses via ICD9 codes (^ICD9 - FILE 80)
- +14 ; ICD9 Procedures via ICD9 codes (^ICD0 - FILE 80.1)
- +15 ; CPT Procedures via CPT codes (^ICPT - FILE 81)
- +16 ; Medications via NDC codes (^PSDRUG - FILE 2)
- +17 ; Medications via MED IEN (^PSDRUG - FILE 50)
- +18 ; Laboratory tests via LOINC codes (^LAB(60) - FILE 95.3)
- +19 ; Patient Education Topics by name (^AUTTEDT - FILE 9999999.09)
- +20 ; NOTE: Use BLDTAX1 below if providing a list of partial Patient Education Topic Codes to match.
- +21 ; Immunizations via HL7/CVX codes (^AUTTIMM - FILE 9999999.14)
- +22 ; Health Factors by Name (^AUTTHF - FILE 9999999.64)
- +23 ; (where FILE is field #.09 in the LAB TAXONOMY file #9002228)
- +24 ; Laboratory tests via LAB IEN (^LAB(60) - FILE 60)
- +25 ;
- +26 ; Input:
- +27 ; TAX = Name of Taxonomy from ATXAX or ATXLAB file.
- +28 ; (required)
- +29 ; TARGET = Closed array reference where the output will be stored.
- +30 ; (required)
- +31 ; This can be a local variable or global reference.
- +32 ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
- +33 ;
- +34 ; Output:
- +35 ; An array in the local or global TARGET of the form:
- +36 ; @TARGET@(IEN)=NAME (.01 field)
- +37 ;
- +38 ; NOTE: Kill the output array before calling the function unless
- +39 ; you intend to group several Taxonomies of the same type.
- +40 ;
- +41 NEW FILEREF,TAXIEN,TAXREF,ENTRY,VALUE,VAL,END,FILE,INDEX,IEN,NAME
- +42 IF TARGET=""!(TAX="")
- QUIT
- +43 SET TAXIEN=$ORDER(^ATXAX("B",TAX,0))
- SET TAXREF="^ATXAX"
- +44 IF TAXIEN=""
- SET TAXIEN=$ORDER(^ATXLAB("B",TAX,0))
- SET TAXREF="^ATXLAB"
- +45 IF TAXIEN=""
- QUIT
- +46 IF TAXREF="^ATXAX"
- SET FILEREF=$$GET1^DIQ(9002226,TAXIEN,.15,"I")
- +47 IF TAXREF="^ATXLAB"
- SET FILEREF=$$GET1^DIQ(9002228,TAXIEN,.09,"I")
- +48 ; The following file references from Taxonomy are supported:
- +49 IF $FIND(",80,80.1,81,2,50,95.3,9999999.09,9999999.14,9999999.64,60,",","_FILEREF_",")=0
- QUIT
- +50 SET ENTRY=0
- +51 FOR
- SET ENTRY=$ORDER(@TAXREF@(TAXIEN,21,ENTRY))
- IF 'ENTRY
- QUIT
- Begin DoDot:1
- +52 SET VALUE=@TAXREF@(TAXIEN,21,ENTRY,0)
- +53 SET VAL=$PIECE(VALUE,U,1)
- SET END=$PIECE(VALUE,U,2)
- +54 ; LAB entries use the IEN and only specify one value.
- +55 IF FILEREF=60
- Begin DoDot:2
- +56 SET NAME=$PIECE($GET(^LAB(60,VAL,0)),U,1)
- SET @TARGET@(VAL)=NAME
- End DoDot:2
- QUIT
- +57 ; MED entries use the IEN and only specify one value.
- +58 IF FILEREF=50
- Begin DoDot:2
- +59 SET NAME=$PIECE($GET(^PSDRUG(VAL,0)),U,1)
- SET @TARGET@(VAL)=NAME
- End DoDot:2
- QUIT
- +60 ; Otherwise, treat all items as ranges (even if there is only one entry).
- +61 IF END=""
- SET END=VAL
- +62 Begin DoDot:2
- +63 IF FILEREF=95.3
- Begin DoDot:3
- +64 ; The LOINC x-ref in LAB does not use the check digit (piece 2).
- +65 SET VAL=$PIECE(VAL,"-")
- SET END=$PIECE(END,"-")
- +66 SET FILE="^LAB(60)"
- SET INDEX="AF"
- End DoDot:3
- QUIT
- +67 IF FILEREF=2
- SET FILE="^PSDRUG"
- SET INDEX="D"
- QUIT
- +68 IF FILEREF=9999999.09
- SET FILE="^AUTTEDT"
- SET INDEX="B"
- QUIT
- +69 IF FILEREF=9999999.14
- SET FILE="^AUTTIMM"
- SET INDEX="C"
- QUIT
- +70 IF FILEREF=9999999.64
- SET FILE="^AUTTHF"
- SET INDEX="B"
- QUIT
- +71 ; CPT, ICD9, and ICD0 require a SPACE be added to the code.
- +72 ; Some Taxonomy entries already have the space included.
- +73 IF $EXTRACT(VAL,$LENGTH(VAL))'=" "
- SET VAL=VAL_" "
- +74 IF $EXTRACT(END,$LENGTH(END))'=" "
- SET END=END_" "
- +75 IF FILEREF=80
- SET FILE="^ICD9"
- SET INDEX="BA"
- QUIT
- +76 IF FILEREF=80.1
- SET FILE="^ICD0"
- SET INDEX="BA"
- QUIT
- +77 IF FILEREF=81
- SET FILE="^ICPT"
- SET INDEX="BA"
- QUIT
- End DoDot:2
- +78 ; Backup one entry so loop can find all the entries in the range.
- +79 SET VAL=$ORDER(@FILE@(INDEX,VAL),-1)
- +80 FOR
- SET VAL=$ORDER(@FILE@(INDEX,VAL))
- IF VAL=""
- QUIT
- IF $$CHECK(VAL,END)
- QUIT
- Begin DoDot:2
- +81 SET IEN=""
- +82 FOR
- SET IEN=$ORDER(@FILE@(INDEX,VAL,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +83 SET NAME=$PIECE($GET(@FILE@(IEN,0)),U,1)
- +84 SET @TARGET@(IEN)=NAME
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +85 QUIT
- +86 ;
- CHECK(V,E) ;
- +1 NEW Z
- +2 IF V=E
- QUIT 0
- +3 SET Z(V)=""
- +4 SET Z(E)=""
- +5 IF $ORDER(Z(""))=E
- QUIT 1
- +6 QUIT 0
- +7 ;
- BLDTAX1(TAX,TARGET) ;EP
- +1 ;
- +2 ; Takes a list of partial Patient Education topic names and
- +3 ; builds an array that can then be used to scan a V-File
- +4 ; cross-reference to see which records match an entry in the
- +5 ; list.
- +6 ;
- +7 ; This tag only supports Patient Education:
- +8 ; (where FILE is field #.15 in the TAXONOMY file #9002226)
- +9 ; Patient Education Topic Codes (^AUTTEDT - FILE 9999999.09)
- +10 ;
- +11 ; Input:
- +12 ; TAX = PATIENT EDUCATION TOPIC CODE LIST to search for
- +13 ; (required)
- +14 ;
- +15 ; Example: "CD-,-CD,AOD-,-AOD"
- +16 ; Example: "*BGP HIV/AIDS DXS"
- +17 ;
- +18 ; Returns items where the MNEMONIC field for the Patient
- +19 ; Education entry contains one of the listed values.
- +20 ;
- +21 ; Second example shows an ICD taxonomy name.
- +22 ; If used, will search for any Patient Education entry
- +23 ; containing one of the values in that Taxonomy.
- +24 ;
- +25 ; TARGET : Closed array reference where the output will be stored.
- +26 ; This can be a local variable or global reference.
- +27 ; (Ex. TARGET="ARRAY" or TARGET="^TMP($J)"
- +28 ;
- +29 ; Output:
- +30 ; An array in the local or global TARGET of the form:
- +31 ; @TARGET@(IEN)=NAME (.01 field)
- +32 ;
- +33 ; NOTE: Kill the output array before calling the function unless
- +34 ; you intend to group several Taxonomies of the same type.
- +35 ;
- +36 NEW VAL,IEN,NAME,MNEMONIC,TAX1,I,ICDIEN,FLG
- +37 FOR I=1:1:$LENGTH(TAX,",")
- SET TAX1=$PIECE(TAX,",",I)
- IF $EXTRACT(TAX1)="*"
- DO BLDTAX($EXTRACT(TAX1,2,$LENGTH(TAX1)),"ICDIEN")
- +38 SET VAL=""
- +39 FOR
- SET VAL=$ORDER(^AUTTEDT("B",VAL))
- IF VAL=""
- QUIT
- Begin DoDot:1
- +40 SET IEN=""
- +41 FOR
- SET IEN=$ORDER(^AUTTEDT("B",VAL,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +42 SET NAME=$$GET1^DIQ(9999999.09,IEN,.01,"I")
- SET MNEMONIC=$$GET1^DIQ(9999999.09,IEN,1,"I")
- SET FLG=0
- +43 FOR I=1:1:$LENGTH(TAX,",")
- SET TAX1=$PIECE(TAX,",",I)
- IF $EXTRACT(TAX1)'="*"
- IF MNEMONIC[TAX1
- SET @TARGET@(IEN)=NAME_U_MNEMONIC
- SET FLG=1
- QUIT
- +44 IF FLG=1
- QUIT
- +45 SET I=""
- +46 ;If an ICD is used as the MNEMONIC it will be formatted as "ICD-abbreviation".
- +47 ;For example, if the ICD is "042." and the patient education is 'alcohol or drugs' then the MNEMONIC would be "042.-AOD".
- +48 FOR
- SET I=$ORDER(ICDIEN(I))
- IF I=""
- QUIT
- SET TAX1=ICDIEN(I)_"-"
- IF MNEMONIC[TAX1
- SET @TARGET@(IEN)=NAME_U_MNEMONIC
- SET FLG=1
- QUIT
- +49 IF FLG=1
- QUIT
- +50 QUIT
- End DoDot:2
- +51 QUIT
- End DoDot:1
- +52 QUIT
- +53 ;
- ICD(IEN,TXIEN,TYPE) ; EP - Utility wrapper for calling $$ICD^ATXCHK
- +1 ; TYPE can be 9 (ICD), 0 (PRC), or 1 (CPT)
- +2 ; $$ICD^ATXCHK only checks ranges ("AA" x-ref). (ex. 200.80-200.288)
- +3 ; Also need to check individual entries ("B" x-ref). (ex. 042.)
- +4 NEW ITEM
- +5 IF $GET(IEN)=""!($GET(TXIEN)="")!($GET(TYPE)="")
- QUIT 0
- +6 ; Check ranges first (most entries are setup as ranges)
- +7 IF $$PATCH^XPDUTL("ATX*5.1*11")
- IF $$ICD^ATXAPI(IEN,TXIEN,TYPE)=1
- QUIT 1
- +8 ;
- +9 IF $$ICD^ATXCHK(IEN,TXIEN,TYPE)=1
- QUIT 1
- +10 ; Check individual entries (currently only a few, but potentially more could be defined)
- +11 SET ITEM=$SELECT(TYPE=9:$PIECE($GET(^ICD9(IEN,0)),U),TYPE=0:$PIECE($GET(^ICD0(IEN,0)),U),TYPE=1:$PIECE($GET(^ICPT(IEN,0)),U),1:"")
- +12 IF ITEM=""
- QUIT 0
- +13 ; Under certain conditions, item will have a space at the end.
- +14 IF $DATA(^ATXAX(TXIEN,21,"B",ITEM))
- QUIT 1
- +15 IF $DATA(^ATXAX(TXIEN,21,"B",ITEM_" "))
- QUIT 1
- +16 QUIT 0
- +17 ;
- STAT(STATUS) ; Check presence on HIV registry and status = STATUS
- +1 ;
- +2 NEW DFN,BKMDFN,HIVREG,BKMNODE,BKMIEN
- +3 ; Variable Y contains the 'DFN' (IEN for file 2 in global ^DPT) from the FileMan Screen call.
- +4 SET DFN=Y
- +5 IF '+$GET(DFN)
- QUIT 0
- +6 SET (BKMIEN,BKMDFN)=$ORDER(^BKM(90451,"B",DFN,0))
- IF '+BKMDFN
- QUIT 0
- +7 IF '$DATA(^BKM(90451,BKMDFN))
- QUIT 0
- +8 SET HIVREG=1
- +9 IF '$DATA(^BKM(90451,BKMDFN,1,HIVREG))
- QUIT 0
- +10 SET BKMNODE=$GET(^BKM(90451,BKMDFN,1,HIVREG,0))
- +11 IF STATUS]""
- IF $PIECE(BKMNODE,U,7)'=STATUS
- QUIT 0
- +12 QUIT 1
