ATX50P71 ; IHS/OHPRD/LAB - POST INIT PATCH 6 [ 09/07/04 12:03 PM ]
;;5.1;TAXONOMY;**7**;FEB 04, 1997
;
;
LAB ;EP
S ATXPNSP=""
F ATXPNSP="ACD","ABM","ACHS","ACPT","ADE","AICD","AMH","AMQQ","APCD","APCH","APCL","APCP","APMF","AQAC","AQAJ","AQAO","AQAQ","ATS","ATX","AUPN","BAT","BCH","BCM","BDW","BGP","BI","BMC","BQC","BUD","BW","CIMY","CIMB","CIMG" D SET
S ATXTEXT="TAX" F ATXX=1:1 S ATXDATA=$P($T(@ATXTEXT+ATXX),";;",2) Q:ATXDATA="" D
.S ATXDA=$O(^ATXLAB("B",$P(ATXDATA,"|"),0))
.Q:ATXDA=""
.S $P(^ATXLAB(ATXDA,0),U,4)="n" W !,$P(ATXDATA,"|") ;SET NO DELETE
.S $P(^ATXLAB(ATXDA,0),U,22)=$P(ATXDATA,"|",2) ;set read only
.;set packages in multiple
.K DIC,DA,DR
.S ATXP=$P(ATXDATA,"|",3)
.F ATXN=1:1 S ATXPP=$P(ATXP,"*",ATXN) Q:ATXPP="" D
..S ATXPI=$O(^DIC(9.4,"C",ATXPP,0))
..Q:ATXPI="" ;NO PACKAGE
..S X="`"_ATXPI,DIC="^ATXLAB("_ATXDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002228,4101,0),U,2),DA(1)=ATXDA
..D ^DIC
..I Y=-1 W !,"updating package multiple for ",ATXPP," entry ",$P(^ATXLAB(ATXDA,0),U)," failed"
..K DIC,DA,Y,X
.Q
D SETTAXF
Q
SETTAXF ;
S X=0 F S X=$O(^ATXLAB(X)) Q:X'=+X D
.Q:$P(^ATXLAB(X,0),U,9)]""
.S $P(^ATXLAB(X,0),U,9)=60
.Q
Q
SET ;
S X=0 F S X=$O(^ATXLAB(X)) Q:X'=+X D
.S Y=$P(^ATXLAB(X,0),U)
.S L=$L(ATXPNSP)
.I $E(Y,1,L)=ATXPNSP S $P(^ATXLAB(X,0),U,4)="n" W !,Y
.Q
Q
;
TAX ;
;;APCH FECAL OCCULT BLOOD|0|APCH
;;APCH HCT/HGB TESTS|0|APCH
;;APCP PAP SMEAR LAB TESTS|0|APCP
;;APCP PAP SMEAR TESTS|0|APCP
;;APCP PSA TESTS TAX|0|APCP
;;AQAJ CREATININE CLEARANCE|0|AQAJ
;;BDR ALBUMIN TAX|0|BDR
;;BDR BICARBONATE TAX|0|BDR
;;BDR CALCIUM TAX|0|BDR
;;BDR CHOLESTEROL TAX|0|BDR
;;BDR HDL TAX|0|BDR
;;BDR HEMOGLOBIN TAX|0|BDR
;;BDR PHOSPHATES TAX|0|BDR
;;BDW PAP SMEAR LAB TESTS|0|BDW
;;BDW PSA TESTS TAX|0|BDW
;;BGP CD4 TAX|0|BGP
;;BGP CHLAMYDIA TESTS TAX|0|BGP
;;BGP GPRA ESTIMATED GFR TAX|0|BGP*APCH
;;BGP GPRA FOB TESTS|0|BGP
;;BGP HIV TEST TAX|0|BGP
;;BGP HIV VIRAL LOAD TAX|0|BGP
;;BGP PAP SMEAR TAX|0|BGP
;;BUD PAP SMEAR TAX|0|BUD
;;CIMG GPRA FOB TESTS|0|
;;CIMG GPRA PSA TESTS|0|
;;DM AUDIT 2 HR GTT TAX|0|APCL*BDM
;;DM AUDIT FASTING GLUCOSE TESTS|0|APCL*BDM
;;DM AUDIT 75GM 2HR GLUCOSE|0|APCL*BDM
;;DM AUDIT ALT TAX|0|APCL*BDM
;;DM AUDIT AST TAX|0|APCL*BDM
;;DM AUDIT CHOLESTEROL TAX|0|APCL*BDM*BGP
;;DM AUDIT CREATININE TAX|0|APCL*BDM*BGP
;;DM AUDIT GLUCOSE TESTS TAX|0|APCL*BDM
;;DM AUDIT HDL TAX|0|APCL*BDM*BGP
;;DM AUDIT HGB A1C TAX|0|APCL*BDM*BGP
;;DM AUDIT LDL CHOLESTEROL TAX|0|APCL*BDM*BGP
;;DM AUDIT LIPID PROFILE TAX|0|APCL*BDM*BGP
;;DM AUDIT MICROALBUMINURIA TAX|0|APCL*BDM*BGP
;;DM AUDIT PAP SMEAR TAX|0|APCL*BDM
;;DM AUDIT TRIGLYCERIDE TAX|0|APCL*BDM*BGP
;;DM AUDIT URINALYSIS TAX|0|APCL*BDM
;;DM AUDIT URINE PROTEIN TAX|0|APCL*BDM*BGP
;;
;;
;;
ATX50P71 ; IHS/OHPRD/LAB - POST INIT PATCH 6 [ 09/07/04 12:03 PM ]
+1 ;;5.1;TAXONOMY;**7**;FEB 04, 1997
+2 ;
+3 ;
LAB ;EP
+1 SET ATXPNSP=""
+2 FOR ATXPNSP="ACD","ABM","ACHS","ACPT","ADE","AICD","AMH","AMQQ","APCD","APCH","APCL","APCP","APMF","AQAC","AQAJ","AQAO","AQAQ","ATS","ATX","AUPN","BAT","BCH","BCM","BDW","BGP","BI","BMC","BQC","BUD","BW","CIMY","CIMB","CIMG"
DO SET
+3 SET ATXTEXT="TAX"
FOR ATXX=1:1
SET ATXDATA=$PIECE($TEXT(@ATXTEXT+ATXX),";;",2)
IF ATXDATA=""
QUIT
Begin DoDot:1
+4 SET ATXDA=$ORDER(^ATXLAB("B",$PIECE(ATXDATA,"|"),0))
+5 IF ATXDA=""
QUIT
+6 ;SET NO DELETE
SET $PIECE(^ATXLAB(ATXDA,0),U,4)="n"
WRITE !,$PIECE(ATXDATA,"|")
+7 ;set read only
SET $PIECE(^ATXLAB(ATXDA,0),U,22)=$PIECE(ATXDATA,"|",2)
+8 ;set packages in multiple
+9 KILL DIC,DA,DR
+10 SET ATXP=$PIECE(ATXDATA,"|",3)
+11 FOR ATXN=1:1
SET ATXPP=$PIECE(ATXP,"*",ATXN)
IF ATXPP=""
QUIT
Begin DoDot:2
+12 SET ATXPI=$ORDER(^DIC(9.4,"C",ATXPP,0))
+13 ;NO PACKAGE
IF ATXPI=""
QUIT
+14 SET X="`"_ATXPI
SET DIC="^ATXLAB("_ATXDA_",41,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9002228,4101,0),U,2)
SET DA(1)=ATXDA
+15 DO ^DIC
+16 IF Y=-1
WRITE !,"updating package multiple for ",ATXPP," entry ",$PIECE(^ATXLAB(ATXDA,0),U)," failed"
+17 KILL DIC,DA,Y,X
End DoDot:2
+18 QUIT
End DoDot:1
+19 DO SETTAXF
+20 QUIT
SETTAXF ;
+1 SET X=0
FOR
SET X=$ORDER(^ATXLAB(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 IF $PIECE(^ATXLAB(X,0),U,9)]""
QUIT
+3 SET $PIECE(^ATXLAB(X,0),U,9)=60
+4 QUIT
End DoDot:1
+5 QUIT
SET ;
+1 SET X=0
FOR
SET X=$ORDER(^ATXLAB(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET Y=$PIECE(^ATXLAB(X,0),U)
+3 SET L=$LENGTH(ATXPNSP)
+4 IF $EXTRACT(Y,1,L)=ATXPNSP
SET $PIECE(^ATXLAB(X,0),U,4)="n"
WRITE !,Y
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
TAX ;
+1 ;;APCH FECAL OCCULT BLOOD|0|APCH
+2 ;;APCH HCT/HGB TESTS|0|APCH
+3 ;;APCP PAP SMEAR LAB TESTS|0|APCP
+4 ;;APCP PAP SMEAR TESTS|0|APCP
+5 ;;APCP PSA TESTS TAX|0|APCP
+6 ;;AQAJ CREATININE CLEARANCE|0|AQAJ
+7 ;;BDR ALBUMIN TAX|0|BDR
+8 ;;BDR BICARBONATE TAX|0|BDR
+9 ;;BDR CALCIUM TAX|0|BDR
+10 ;;BDR CHOLESTEROL TAX|0|BDR
+11 ;;BDR HDL TAX|0|BDR
+12 ;;BDR HEMOGLOBIN TAX|0|BDR
+13 ;;BDR PHOSPHATES TAX|0|BDR
+14 ;;BDW PAP SMEAR LAB TESTS|0|BDW
+15 ;;BDW PSA TESTS TAX|0|BDW
+16 ;;BGP CD4 TAX|0|BGP
+17 ;;BGP CHLAMYDIA TESTS TAX|0|BGP
+18 ;;BGP GPRA ESTIMATED GFR TAX|0|BGP*APCH
+19 ;;BGP GPRA FOB TESTS|0|BGP
+20 ;;BGP HIV TEST TAX|0|BGP
+21 ;;BGP HIV VIRAL LOAD TAX|0|BGP
+22 ;;BGP PAP SMEAR TAX|0|BGP
+23 ;;BUD PAP SMEAR TAX|0|BUD
+24 ;;CIMG GPRA FOB TESTS|0|
+25 ;;CIMG GPRA PSA TESTS|0|
+26 ;;DM AUDIT 2 HR GTT TAX|0|APCL*BDM
+27 ;;DM AUDIT FASTING GLUCOSE TESTS|0|APCL*BDM
+28 ;;DM AUDIT 75GM 2HR GLUCOSE|0|APCL*BDM
+29 ;;DM AUDIT ALT TAX|0|APCL*BDM
+30 ;;DM AUDIT AST TAX|0|APCL*BDM
+31 ;;DM AUDIT CHOLESTEROL TAX|0|APCL*BDM*BGP
+32 ;;DM AUDIT CREATININE TAX|0|APCL*BDM*BGP
+33 ;;DM AUDIT GLUCOSE TESTS TAX|0|APCL*BDM
+34 ;;DM AUDIT HDL TAX|0|APCL*BDM*BGP
+35 ;;DM AUDIT HGB A1C TAX|0|APCL*BDM*BGP
+36 ;;DM AUDIT LDL CHOLESTEROL TAX|0|APCL*BDM*BGP
+37 ;;DM AUDIT LIPID PROFILE TAX|0|APCL*BDM*BGP
+38 ;;DM AUDIT MICROALBUMINURIA TAX|0|APCL*BDM*BGP
+39 ;;DM AUDIT PAP SMEAR TAX|0|APCL*BDM
+40 ;;DM AUDIT TRIGLYCERIDE TAX|0|APCL*BDM*BGP
+41 ;;DM AUDIT URINALYSIS TAX|0|APCL*BDM
+42 ;;DM AUDIT URINE PROTEIN TAX|0|APCL*BDM*BGP
+43 ;;
+44 ;;
+45 ;;
