BKMVC1 ;PRXM/HC/BWF - BKMV Taxonomy Check; [ 1/12/2005 7:16 PM ] ; 26 Apr 2005 11:18 AM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;;Modified by William McCrary, 3/11/05.
; Taxonomy Check routine
Q
;
EN ;EP - Taxonomy Checks
N DIR,FOUND,HIVIEN,I,LINE,QUIT,Y,BKMVTAX,TAX
S FOUND=0
I $G(FLAG)="" W @IOF
S HIVIEN=$$HIVIEN^BKMIXX3()
I HIVIEN="" D Q
. I $$QUIT("There is no HMS register defined.")
. Q
;
I '$D(^BKM(90450,HIVIEN,11,"B",DUZ)) D Q
. I $$QUIT("You are not a valid HMS user.")
. Q
;
S QUIT=0
; Loop through the Taxonomies as stored in routine BKMVTAX4.
K BKMVTAX
F EP="DX","ED","IZ","M","P","S","T","O" D
. F I=1:1 S Y=$P($T(@(EP_"+"_I_"^BKMVTAX4")),";;",2) Q:Y="" S BKMVTAX(Y)=""
. Q
S TAX=""
F S TAX=$O(BKMVTAX(TAX)) Q:TAX="" D Q:QUIT
. N IEN,TAXTYPE
. S TAXTYPE="",IEN=""
. ; Check if this taxonomy is not defined in either ^ATXAX or ^ATXLAB
. I $D(^ATXAX("B",TAX)) S TAXTYPE="RX",IEN=$O(^ATXAX("B",TAX,""))
. I $D(^ATXLAB("B",TAX)) S TAXTYPE="LAB",IEN=$O(^ATXLAB("B",TAX,""))
. I TAXTYPE="" D IT(TAX,.FOUND,.QUIT,"Missing") Q
. ; Check that IEN was valued to avoid a SUBSCRIPT error - should never happen
. I IEN="" Q
. ; Check if there are no codes defined for this taxonomy
. I TAXTYPE="RX",$O(^ATXAX(IEN,21,"B",""))="" D IT(TAX,.FOUND,.QUIT,"No Entries") Q
. I TAXTYPE="LAB",$O(^ATXLAB(IEN,21,"B",""))="" D IT(TAX,.FOUND,.QUIT,"No Entries") Q
. Q
;
I QUIT Q
I FOUND=0,$G(DFLAG)="" W !!!,"All taxonomies are present",!,$$QUIT()
I FOUND=1,$$QUIT("End of taxonomy check. Enter RETURN to continue or '^' to exit")
;I $$QUIT()
Q
;
IT(TAX,FOUND,QUIT,TEXT) ;
I FOUND=0 D
. W !,"The following taxonomies are missing or have no entries:",!
. S FOUND=1
. Q
I $Y>22,$$QUIT() S QUIT=1 Q
W !,?5,TAX,?40,TEXT
Q
;
QUIT(PROMPT) ;
N QUIT
S PROMPT=$G(PROMPT,"")
;I $G(PROMPT)'="" W !,PROMPT
S QUIT=$$PAUSE^BKMIXX3(PROMPT) S:QUIT=0 QUIT=""
W @IOF
Q QUIT
BKMVC1 ;PRXM/HC/BWF - BKMV Taxonomy Check; [ 1/12/2005 7:16 PM ] ; 26 Apr 2005 11:18 AM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;;Modified by William McCrary, 3/11/05.
+3 ; Taxonomy Check routine
+4 QUIT
+5 ;
EN ;EP - Taxonomy Checks
+1 NEW DIR,FOUND,HIVIEN,I,LINE,QUIT,Y,BKMVTAX,TAX
+2 SET FOUND=0
+3 IF $GET(FLAG)=""
WRITE @IOF
+4 SET HIVIEN=$$HIVIEN^BKMIXX3()
+5 IF HIVIEN=""
Begin DoDot:1
+6 IF $$QUIT("There is no HMS register defined.")
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 IF '$DATA(^BKM(90450,HIVIEN,11,"B",DUZ))
Begin DoDot:1
+10 IF $$QUIT("You are not a valid HMS user.")
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 SET QUIT=0
+14 ; Loop through the Taxonomies as stored in routine BKMVTAX4.
+15 KILL BKMVTAX
+16 FOR EP="DX","ED","IZ","M","P","S","T","O"
Begin DoDot:1
+17 FOR I=1:1
SET Y=$PIECE($TEXT(@(EP_"+"_I_"^BKMVTAX4")),";;",2)
IF Y=""
QUIT
SET BKMVTAX(Y)=""
+18 QUIT
End DoDot:1
+19 SET TAX=""
+20 FOR
SET TAX=$ORDER(BKMVTAX(TAX))
IF TAX=""
QUIT
Begin DoDot:1
+21 NEW IEN,TAXTYPE
+22 SET TAXTYPE=""
SET IEN=""
+23 ; Check if this taxonomy is not defined in either ^ATXAX or ^ATXLAB
+24 IF $DATA(^ATXAX("B",TAX))
SET TAXTYPE="RX"
SET IEN=$ORDER(^ATXAX("B",TAX,""))
+25 IF $DATA(^ATXLAB("B",TAX))
SET TAXTYPE="LAB"
SET IEN=$ORDER(^ATXLAB("B",TAX,""))
+26 IF TAXTYPE=""
DO IT(TAX,.FOUND,.QUIT,"Missing")
QUIT
+27 ; Check that IEN was valued to avoid a SUBSCRIPT error - should never happen
+28 IF IEN=""
QUIT
+29 ; Check if there are no codes defined for this taxonomy
+30 IF TAXTYPE="RX"
IF $ORDER(^ATXAX(IEN,21,"B",""))=""
DO IT(TAX,.FOUND,.QUIT,"No Entries")
QUIT
+31 IF TAXTYPE="LAB"
IF $ORDER(^ATXLAB(IEN,21,"B",""))=""
DO IT(TAX,.FOUND,.QUIT,"No Entries")
QUIT
+32 QUIT
End DoDot:1
IF QUIT
QUIT
+33 ;
+34 IF QUIT
QUIT
+35 IF FOUND=0
IF $GET(DFLAG)=""
WRITE !!!,"All taxonomies are present",!,$$QUIT()
+36 IF FOUND=1
IF $$QUIT("End of taxonomy check. Enter RETURN to continue or '^' to exit")
+37 ;I $$QUIT()
+38 QUIT
+39 ;
IT(TAX,FOUND,QUIT,TEXT) ;
+1 IF FOUND=0
Begin DoDot:1
+2 WRITE !,"The following taxonomies are missing or have no entries:",!
+3 SET FOUND=1
+4 QUIT
End DoDot:1
+5 IF $Y>22
IF $$QUIT()
SET QUIT=1
QUIT
+6 WRITE !,?5,TAX,?40,TEXT
+7 QUIT
+8 ;
QUIT(PROMPT) ;
+1 NEW QUIT
+2 SET PROMPT=$GET(PROMPT,"")
+3 ;I $G(PROMPT)'="" W !,PROMPT
+4 SET QUIT=$$PAUSE^BKMIXX3(PROMPT)
IF QUIT=0
SET QUIT=""
+5 WRITE @IOF
+6 QUIT QUIT
