BQITAXXU ;GDHSD/HS/ALA-Update Taxonomies for pointers ; 17 Dec 2015 4:08 PM
;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
;
;Repoint taxonomies in 90507.8
NEW ALRT,TXN,TAX,ATXN,TYP
S ALRT=0
F S ALRT=$O(^BQI(90507.8,ALRT)) Q:'ALRT D
. S TXN=0
. F S TXN=$O(^BQI(90507.8,ALRT,11,TXN)) Q:'TXN D
.. S TAX=$P(^BQI(90507.8,ALRT,11,TXN,0),U,1),TYP=$P(^(0),U,5)
.. I TYP'=5 D
... S ATXN=$O(^ATXAX("B",TAX,""))
... I ATXN'="" S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("
.. I TYP=5 D
... S ATXN=$O(^ATXLAB("B",TAX,""))
... I ATXN'="" S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXLAB(" Q
... S ATXN=$O(^ATXAX("B",TAX,""))
... S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("
;
;Repoint taxonomies in 90507
NEW RGN,TXN,TAX,VALUE,ATXN,GLO,RPN
S RGN=0
F S RGN=$O(^BQI(90507,RGN)) Q:'RGN D
. S TXN=0
. F S TXN=$O(^BQI(90507,RGN,10,TXN)) Q:'TXN D
.. S TAX=$P(^BQI(90507,RGN,10,TXN,0),U,1),VALUE=$P(^(0),U,2)
.. I VALUE["ATXAX" S ATXN=$O(^ATXAX("B",TAX,"")),GLO=";ATXAX("
.. I VALUE["ATXLAB" S ATXN=$O(^ATXLAB("B",TAX,"")),GLO=";ATXLAB("
.. I ATXN="" Q
.. S $P(^BQI(90507,RGN,10,TXN,0),U,2)=ATXN_GLO
. S RPN=0
. F S RPN=$O(^BQI(90507,RGN,20,RPN)) Q:'RPN D
.. S TXN=0
.. F S TXN=$O(^BQI(90507,RGN,20,RPN,10,TXN)) Q:'TXN D
... S TAX=$P(^BQI(90507,RGN,20,RPN,10,TXN,0),U,1),VALUE=$P(^(0),U,2)
... I VALUE["ATXAX" S ATXN=$O(^ATXAX("B",TAX,"")),GLO=";ATXAX("
... I VALUE["ATXLAB" S ATXN=$O(^ATXLAB("B",TAX,"")),GLO=";ATXLAB("
... I ATXN="" Q
... S $P(^BQI(90507,RGN,20,RPN,10,TXN,0),U,2)=ATXN_GLO
;
;Repoint taxonomies in 90508
NEW BQIDA,TXN,TAX,VALUE,ATXN,GLO
S BQIDA=1,TXN=0
F S TXN=$O(^BQI(90508,BQIDA,10,TXN)) Q:'TXN D
. S TAX=$P(^BQI(90508,BQIDA,10,TXN,0),U,1),TYP=$P(^(0),U,3)
. I TYP'=5 D
.. S ATXN=$O(^ATXAX("B",TAX,""))
.. I ATXN'="" S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("
. I TYP=5 D
.. S ATXN=$O(^ATXLAB("B",TAX,""))
.. I ATXN'="" S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXLAB(" Q
.. S ATXN=$O(^ATXAX("B",TAX,""))
.. S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("
;
LTAX ;EP Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,TAXX,ATXN
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
; Loop through the Taxonomies
D LDLAB(.LTAX)
F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
. I $D(^ATXLAB("B",X)) Q ; Skip pre-existing Lab taxonomies
. D ^DIC S DA=+Y
. I DA<1 Q
. S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
. S BQTXUP(9002228,DA_",",.05)=DUZ
. S BQTXUP(9002228,DA_",",.06)=DT
. S BQTXUP(9002228,DA_",",.09)=60
. D FILE^DIE("I","BQTXUP")
. S BQTXUP(9002228,DA_",",.08)="B"
. D FILE^DIE("E","BQTXUP")
;
F BJ=1:1 Q:'$D(LTAX(BJ)) S TAXX=LTAX(BJ) D
. S TXN=$O(^BQI(90508,BQIDA,10,"B",TAXX,"")) I TXN'="" Q
. NEW DA,DIC,DLAYGO,IENS
. S DA(1)=BQIDA,DIC(0)="L",DLAYGO=90508.03,DIC="^BQI(90508,"_DA(1)_",10,",X=TAXX
. D ^DIC
. S DA=+Y I DA=-1 Q
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90508.03,IENS,.03)=5,BQIUPD(90508.03,IENS,.04)="Y",BQIUPD(90508.03,IENS,.05)="T"
. D FILE^DIE("","BQIUPD","ERROR")
. S ATXN=$O(^ATXLAB("B",TAXX,""))
. I ATXN'="" S $P(^BQI(90508,DA(1),10,DA,0),U,2)=ATXN_";ATXLAB(" Q
K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
;
Q
;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
NEW I,TEXT
F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT="" S ARRAY(I)=TEXT
Q
;
LAB ;EP;LAB TESTS (SITE-POPULATED)
;;BQI MMR TITER TAX
;;BQI HEP A TITER TAX
;;BQI HEP B TITER TAX
;;BQI VARICELLA TITER TAX
BQITAXXU ;GDHSD/HS/ALA-Update Taxonomies for pointers ; 17 Dec 2015 4:08 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
+2 ;
+3 ;Repoint taxonomies in 90507.8
+4 NEW ALRT,TXN,TAX,ATXN,TYP
+5 SET ALRT=0
+6 FOR
SET ALRT=$ORDER(^BQI(90507.8,ALRT))
IF 'ALRT
QUIT
Begin DoDot:1
+7 SET TXN=0
+8 FOR
SET TXN=$ORDER(^BQI(90507.8,ALRT,11,TXN))
IF 'TXN
QUIT
Begin DoDot:2
+9 SET TAX=$PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,1)
SET TYP=$PIECE(^(0),U,5)
+10 IF TYP'=5
Begin DoDot:3
+11 SET ATXN=$ORDER(^ATXAX("B",TAX,""))
+12 IF ATXN'=""
SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("
End DoDot:3
+13 IF TYP=5
Begin DoDot:3
+14 SET ATXN=$ORDER(^ATXLAB("B",TAX,""))
+15 IF ATXN'=""
SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXLAB("
QUIT
+16 SET ATXN=$ORDER(^ATXAX("B",TAX,""))
+17 SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 ;Repoint taxonomies in 90507
+20 NEW RGN,TXN,TAX,VALUE,ATXN,GLO,RPN
+21 SET RGN=0
+22 FOR
SET RGN=$ORDER(^BQI(90507,RGN))
IF 'RGN
QUIT
Begin DoDot:1
+23 SET TXN=0
+24 FOR
SET TXN=$ORDER(^BQI(90507,RGN,10,TXN))
IF 'TXN
QUIT
Begin DoDot:2
+25 SET TAX=$PIECE(^BQI(90507,RGN,10,TXN,0),U,1)
SET VALUE=$PIECE(^(0),U,2)
+26 IF VALUE["ATXAX"
SET ATXN=$ORDER(^ATXAX("B",TAX,""))
SET GLO=";ATXAX("
+27 IF VALUE["ATXLAB"
SET ATXN=$ORDER(^ATXLAB("B",TAX,""))
SET GLO=";ATXLAB("
+28 IF ATXN=""
QUIT
+29 SET $PIECE(^BQI(90507,RGN,10,TXN,0),U,2)=ATXN_GLO
End DoDot:2
+30 SET RPN=0
+31 FOR
SET RPN=$ORDER(^BQI(90507,RGN,20,RPN))
IF 'RPN
QUIT
Begin DoDot:2
+32 SET TXN=0
+33 FOR
SET TXN=$ORDER(^BQI(90507,RGN,20,RPN,10,TXN))
IF 'TXN
QUIT
Begin DoDot:3
+34 SET TAX=$PIECE(^BQI(90507,RGN,20,RPN,10,TXN,0),U,1)
SET VALUE=$PIECE(^(0),U,2)
+35 IF VALUE["ATXAX"
SET ATXN=$ORDER(^ATXAX("B",TAX,""))
SET GLO=";ATXAX("
+36 IF VALUE["ATXLAB"
SET ATXN=$ORDER(^ATXLAB("B",TAX,""))
SET GLO=";ATXLAB("
+37 IF ATXN=""
QUIT
+38 SET $PIECE(^BQI(90507,RGN,20,RPN,10,TXN,0),U,2)=ATXN_GLO
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 ;Repoint taxonomies in 90508
+41 NEW BQIDA,TXN,TAX,VALUE,ATXN,GLO
+42 SET BQIDA=1
SET TXN=0
+43 FOR
SET TXN=$ORDER(^BQI(90508,BQIDA,10,TXN))
IF 'TXN
QUIT
Begin DoDot:1
+44 SET TAX=$PIECE(^BQI(90508,BQIDA,10,TXN,0),U,1)
SET TYP=$PIECE(^(0),U,3)
+45 IF TYP'=5
Begin DoDot:2
+46 SET ATXN=$ORDER(^ATXAX("B",TAX,""))
+47 IF ATXN'=""
SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("
End DoDot:2
+48 IF TYP=5
Begin DoDot:2
+49 SET ATXN=$ORDER(^ATXLAB("B",TAX,""))
+50 IF ATXN'=""
SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXLAB("
QUIT
+51 SET ATXN=$ORDER(^ATXAX("B",TAX,""))
+52 SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("
End DoDot:2
End DoDot:1
+53 ;
LTAX ;EP Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,TAXX,ATXN
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ; Loop through the Taxonomies
+4 DO LDLAB(.LTAX)
+5 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET X=LTAX(BJ)
Begin DoDot:1
+6 ; Skip pre-existing Lab taxonomies
IF $DATA(^ATXLAB("B",X))
QUIT
+7 DO ^DIC
SET DA=+Y
+8 IF DA<1
QUIT
+9 SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)
+10 SET BQTXUP(9002228,DA_",",.05)=DUZ
+11 SET BQTXUP(9002228,DA_",",.06)=DT
+12 SET BQTXUP(9002228,DA_",",.09)=60
+13 DO FILE^DIE("I","BQTXUP")
+14 SET BQTXUP(9002228,DA_",",.08)="B"
+15 DO FILE^DIE("E","BQTXUP")
End DoDot:1
+16 ;
+17 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET TAXX=LTAX(BJ)
Begin DoDot:1
+18 SET TXN=$ORDER(^BQI(90508,BQIDA,10,"B",TAXX,""))
IF TXN'=""
QUIT
+19 NEW DA,DIC,DLAYGO,IENS
+20 SET DA(1)=BQIDA
SET DIC(0)="L"
SET DLAYGO=90508.03
SET DIC="^BQI(90508,"_DA(1)_",10,"
SET X=TAXX
+21 DO ^DIC
+22 SET DA=+Y
IF DA=-1
QUIT
+23 SET IENS=$$IENS^DILF(.DA)
+24 SET BQIUPD(90508.03,IENS,.03)=5
SET BQIUPD(90508.03,IENS,.04)="Y"
SET BQIUPD(90508.03,IENS,.05)="T"
+25 DO FILE^DIE("","BQIUPD","ERROR")
+26 SET ATXN=$ORDER(^ATXLAB("B",TAXX,""))
+27 IF ATXN'=""
SET $PIECE(^BQI(90508,DA(1),10,DA,0),U,2)=ATXN_";ATXLAB("
QUIT
End DoDot:1
+28 KILL DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
+29 ;
+30 QUIT
+31 ;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
+1 NEW I,TEXT
+2 FOR I=1:1
SET TEXT=$PIECE($TEXT(LAB+I),";;",2)
IF TEXT=""
QUIT
SET ARRAY(I)=TEXT
+3 QUIT
+4 ;
LAB ;EP;LAB TESTS (SITE-POPULATED)
+1 ;;BQI MMR TITER TAX
+2 ;;BQI HEP A TITER TAX
+3 ;;BQI HEP B TITER TAX
+4 ;;BQI VARICELLA TITER TAX
