BQITAXCK ;GDIT/HS/ALA-Taxonomy check routine
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
EN(LIST) ;EP - Taxonomy Checks
N DIR,FOUND,HIVIEN,I,LINE,QFL,Y,TAX,DFLAG
S FOUND=0
I $G(FLAG)="" W @IOF
;
S QFL=0
; Loop through the Taxonomies
S ALR=""
F S ALR=$O(LIST(ALR)) Q:ALR="" D Q:QFL
. I $D(LIST(ALR))=1 W !!,$P(^BQI(90507.8,ALR,0),U,1)_" exists",! I $Y>20,$$QUIT() S QFL=1 Q
. I $D(LIST(ALR))>1 W !,"The following taxonomies have no entries for "_$P(^BQI(90507.8,ALR,0),U,1)_": " D
.. S TAX=""
.. F S TAX=$O(LIST(ALR,TAX)) Q:TAX="" D Q:QFL
... ; Check if there are no codes defined for this taxonomy
... I $Y>20,$$QUIT() S QFL=1 Q
... W !,?10,TAX
;
I QFL Q
I $$QUIT("End of taxonomy check. Enter RETURN to continue or '^' to exit")
Q
;
IT(TAX,FOUND,QFL,TEXT) ;
I FOUND=0 D
. W !,"The following taxonomies are missing or have no entries:",!
. S FOUND=1
. Q
I $Y>20,$$QUIT() S QFL=1 Q
W !,?5,TAX,?40,TEXT
Q
;
QUIT(PROMPT) ;
N QFL
S PROMPT=$G(PROMPT,"")
S QFL=$$PAUSE(PROMPT) S:QFL=0 QFL=""
W @IOF
Q QFL
;
PAUSE(PROMPT) ;EP - For screen displays pause and allow user to stop
; Returns a 1 if the user elected to stop
I IOST'["C-" Q 0
N DIR,DTOUT,DUOUT
I $G(PROMPT)]"" S DIR("A")=PROMPT
S DIR(0)="E" D ^DIR
Q $D(DTOUT)!$D(DUOUT)
;
CA ; EP
NEW ALR,TCT
S ALR=0
F S ALR=$O(^BQI(90507.8,ALR)) Q:'ALR D
. S TX=0,TCT=0
. F S TX=$O(^BQI(90507.8,ALR,12,TX)) Q:'TX D S LIST(ALR)=TCT
.. S LNC=$P(^BQI(90507.8,ALR,12,TX,0),U,1),TAX=$P(^(0),U,2)
.. S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
.. D BLD^BQITUTL(TAX,.TREF,"L")
.. I '$D(@TREF),'$$ENTRS(TAX) S LIST(ALR,TAX)="" Q
.. S TCT=TCT+1
K @TREF
Q
;
ENTRS(TAX) ;EP
S IEN=$O(^ATXLAB("B",TAX,"")) I IEN="" S DFLAG=1 Q 0
I $O(^ATXLAB(IEN,21,"B",""))="" Q 0
Q 1
BQITAXCK ;GDIT/HS/ALA-Taxonomy check routine
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
EN(LIST) ;EP - Taxonomy Checks
+1 NEW DIR,FOUND,HIVIEN,I,LINE,QFL,Y,TAX,DFLAG
+2 SET FOUND=0
+3 IF $GET(FLAG)=""
WRITE @IOF
+4 ;
+5 SET QFL=0
+6 ; Loop through the Taxonomies
+7 SET ALR=""
+8 FOR
SET ALR=$ORDER(LIST(ALR))
IF ALR=""
QUIT
Begin DoDot:1
+9 IF $DATA(LIST(ALR))=1
WRITE !!,$PIECE(^BQI(90507.8,ALR,0),U,1)_" exists",!
IF $Y>20
IF $$QUIT()
SET QFL=1
QUIT
+10 IF $DATA(LIST(ALR))>1
WRITE !,"The following taxonomies have no entries for "_$PIECE(^BQI(90507.8,ALR,0),U,1)_": "
Begin DoDot:2
+11 SET TAX=""
+12 FOR
SET TAX=$ORDER(LIST(ALR,TAX))
IF TAX=""
QUIT
Begin DoDot:3
+13 ; Check if there are no codes defined for this taxonomy
+14 IF $Y>20
IF $$QUIT()
SET QFL=1
QUIT
+15 WRITE !,?10,TAX
End DoDot:3
IF QFL
QUIT
End DoDot:2
End DoDot:1
IF QFL
QUIT
+16 ;
+17 IF QFL
QUIT
+18 IF $$QUIT("End of taxonomy check. Enter RETURN to continue or '^' to exit")
+19 QUIT
+20 ;
IT(TAX,FOUND,QFL,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>20
IF $$QUIT()
SET QFL=1
QUIT
+6 WRITE !,?5,TAX,?40,TEXT
+7 QUIT
+8 ;
QUIT(PROMPT) ;
+1 NEW QFL
+2 SET PROMPT=$GET(PROMPT,"")
+3 SET QFL=$$PAUSE(PROMPT)
IF QFL=0
SET QFL=""
+4 WRITE @IOF
+5 QUIT QFL
+6 ;
PAUSE(PROMPT) ;EP - For screen displays pause and allow user to stop
+1 ; Returns a 1 if the user elected to stop
+2 IF IOST'["C-"
QUIT 0
+3 NEW DIR,DTOUT,DUOUT
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT $DATA(DTOUT)!$DATA(DUOUT)
+7 ;
CA ; EP
+1 NEW ALR,TCT
+2 SET ALR=0
+3 FOR
SET ALR=$ORDER(^BQI(90507.8,ALR))
IF 'ALR
QUIT
Begin DoDot:1
+4 SET TX=0
SET TCT=0
+5 FOR
SET TX=$ORDER(^BQI(90507.8,ALR,12,TX))
IF 'TX
QUIT
Begin DoDot:2
+6 SET LNC=$PIECE(^BQI(90507.8,ALR,12,TX,0),U,1)
SET TAX=$PIECE(^(0),U,2)
+7 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+8 DO BLD^BQITUTL(TAX,.TREF,"L")
+9 IF '$DATA(@TREF)
IF '$$ENTRS(TAX)
SET LIST(ALR,TAX)=""
QUIT
+10 SET TCT=TCT+1
End DoDot:2
SET LIST(ALR)=TCT
End DoDot:1
+11 KILL @TREF
+12 QUIT
+13 ;
ENTRS(TAX) ;EP
+1 SET IEN=$ORDER(^ATXLAB("B",TAX,""))
IF IEN=""
SET DFLAG=1
QUIT 0
+2 IF $ORDER(^ATXLAB(IEN,21,"B",""))=""
QUIT 0
+3 QUIT 1
