BKMVC1.m

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