BTPW1PST ;VNGT/HS/ALA-Post Installation for CMET ; 24 Apr 2008 7:46 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
EN ; Set up Site Parameters
NEW BHM,BHOME
I $G(U)="" D DT^DICRW
S BHM=$O(^BQI(90508,0))
I BHM'="" S BHOME=$P($G(^BQI(90508,BHM,0)),U,1)
I $G(BHOME)="" S BHOME=$P($G(^XTV(8989.3,1,"XUS")),U,17)
S BTPWDA=1,$P(^BTPW(90628,BTPWDA,0),U,1)=BHOME,^BTPW(90628,"B",BHOME,1)=""
;S BTPWUPD(90628,BTPWDA_",",.01)=BHOME
; Clear out and set up default fields
NEW FLD,PC
F FLD=.06,.07,1.01:.01:1.09 S BTPWUPD(90628,BTPWDA_",",FLD)="@"
D FILE^DIE("","BTPWUPD","ERROR")
K BTPWUPD
F PC=1:1:3 S $P(^BTPW(90628,BTPWDA,1),U,PC)=7
NEW DA,IENS
S DA(1)=BTPWDA,DA=0
F S DA=$O(^BTPW(90628,BTPWDA,2,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. I $$GET1^DIQ(90628.02,IENS,.01,"E")="PAP SMEAR" D
.. S $P(^BTPW(90628,DA(1),2,DA,0),U,2)="12M"
.. S $P(^BTPW(90628,DA(1),2,DA,0),U,5)=1
.. S ^BTPW(90628,DA(1),2,DA,1)=75
. I $$GET1^DIQ(90628.02,IENS,.01,"E")="MAMMOGRAM SCREENING" D
.. S $P(^BTPW(90628,DA(1),2,DA,0),U,2)="12M"
.. S $P(^BTPW(90628,DA(1),2,DA,0),U,5)=1
.. S ^BTPW(90628,DA(1),2,DA,1)=108
. F FLD=.03,.04 S BTPWUPD(90628.02,IENS,FLD)="@"
. D FILE^DIE("","BTPWUPD","ERROR")
. K BTPWUPD
;
TMPL ; Set list for templates with |V | data objects
NEW XDATA
S XDATA=$NA(^XTMP("BQITEMPL"))
K @XDATA
S @XDATA@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
NEW TMPN,BLN
S TMPN=0
F S TMPN=$O(^TIU(8927,TMPN)) Q:'TMPN D
. S BLN=0
. F S BLN=$O(^TIU(8927,TMPN,2,BLN)) Q:'BLN D
.. I ^TIU(8927,TMPN,2,BLN,0)["|V " S @XDATA@(TMPN)=""
;
NEW DZ,BKEY,USER
S DZ="" F S DZ=$O(^XTMP("BTPW1PRE",DZ)) Q:DZ="" D
. S BKEY="BTPWZCMGR",USER=DZ D ADD^BQISYKEY I $G(DZ)="" S DZ=USER
K ^XTMP("BTWP1PRE")
;
USR ; Remove user preferences for CMET
NEW DZ,TN
S DZ=0
F S DZ=$O(^BQICARE(DZ)) Q:'DZ D
. K ^BQICARE(DZ,9)
. S TN=0
. F S TN=$O(^BQICARE(DZ,15,TN)) Q:'TN D
.. I $P(^BQICARE(DZ,15,TN,0),U,1)="Queued Events Default" D UP("Events Default")
.. I $P(^BQICARE(DZ,15,TN,0),U,1)="Planned Events Default" D UP("Followup Events Default")
. S PNL=0
. F S PNL=$O(^BQICARE(DZ,1,PNL)) Q:'PNL D
.. S TL=0
.. F S TL=$O(^BQICARE(DZ,1,PNL,4,TL)) Q:'TL D
... I $P(^BQICARE(DZ,1,PNL,4,TL,0),U,1)="Queued Events Default" D UP1(DZ,PNL,TL,"Events Default")
... I $P(^BQICARE(DZ,1,PNL,4,TL,0),U,1)="Planned Events Default" D UP1(DZ,PNL,TL,"Followup Events Default")
.. S CS=0
.. F S CS=$O(^BQICARE(DZ,1,PNL,23,CS)) Q:'CS D
... I $P(^BQICARE(DZ,1,PNL,23,CS,0),U,1)="Queued Events" D UP2(DZ,PNL,CS,"Events")
... I $P(^BQICARE(DZ,1,PNL,23,CS,0),U,1)="Planned Events" D UP2(DZ,PNL,CS,"Followup Events")
I $D(BTPWUPD) D FILE^DIE("","BTPWUPD","ERROR")
;
; Create CMET Taxonomies
D ^BTPWUX
D ^BTPWVX
D ^BTPWWX
D ^BTPWXX
D ^BTPWYX
;
LTAX ; Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,BQTXUP
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
;
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")
;
; Update pointers IN CMET
NEW PRCN,TXN,TTYP,VAL,BTPWUPD
S PRCN=0
F S PRCN=$O(^BTPW(90621,PRCN)) Q:'PRCN D
. S TXN=0
. F S TXN=$O(^BTPW(90621,PRCN,1,TXN)) Q:'TXN D
.. S TTYP=$P(^BTPW(90621,PRCN,1,TXN,0),U,3),TAX=$P(^(0),U,1)
.. S TTYP=$S(TTYP=3:"L",1:"N")
.. S VAL=$$STXPT(TAX,TTYP)
.. NEW DA,IENS
.. S DA(1)=PRCN,DA=TXN,IENS=$$IENS^DILF(.DA)
.. S BTPWUPD(90621.01,IENS,.02)=VAL
D FILE^DIE("","BTPWUPD","ERROR")
;
; Add BTPW entries to 90506.1
NEW DA,DIK,NAME
S DIK="^BQI(90506.1,"
F NAME="BTPWFDUE","BTPWNDUE","BTPWPDT","BTPWPRC","BTPWRDUE","BTPWSTGE" S DA=$O(^BQI(90506.1,"B",NAME,"")) I DA'="" D ^DIK
;
NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
F BI=1:1 S TEXT=$P($T(CMET+BI),";;",2) Q:TEXT="" D
. F BJ=1:1:$L(TEXT,"~") D
.. S NDATA=$P(TEXT,"~",BJ)
.. S ND=$P(NDATA,"|",1),VAL=$P(NDATA,"|",2)
.. I ND=0 D
... NEW DIC,X,Y
... S DIC(0)="LQZ",DIC="^BQI(90506.1,",X=$P(VAL,U,1)
... D ^DIC
... S IEN=+Y
... I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
.. I ND=1 S BQIUPD(90506.1,IEN_",",1)=VAL Q
.. F BK=1:1:$L(VAL,"^") D
... S BN=$O(^DD(90506.1,"GL",ND,BK,"")) I BN="" Q
... I $P(VAL,"^",BK)'="" S BQIUPD(90506.1,IEN_",",BN)=$P(VAL,"^",BK) Q
... I $P(VAL,"^",BK)="" S BQIUPD(90506.1,IEN_",",BN)="@"
. D FILE^DIE("","BQIUPD","ERROR")
;
; Set tooltips
D TPS^BTPW1PSU
;
; Set up post-install job to run
NEW X,Y,%DT
S %DT="AEFR",%DT("A")="Enter Time to start CMET Queued Events Search Job: "
S %DT("B")=$$FMTE^XLFDT(DT_".20")
D ^%DT
I X="NOW" S ZTDTH=$$FMADD^XLFDT(Y,,,3)
E S ZTDTH=Y
S ZTDESC="CMET INITIALIZATION",ZTRTN="EN^BTPWPFND()",ZTIO=""
D ^%ZTLOAD
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
;
Q
;
UP(TXT) ;
NEW DA,IENS
S DA(1)=DZ,DA=TN,IENS=$$IENS^DILF(.DA)
S BTPWUPD(90505.015,IENS,.01)=TXT
Q
;
UP1(DZ,PNL,TL,TXT) ;
NEW DA,IENS
S DA(2)=DZ,DA(1)=PNL,DA=TL,IENS=$$IENS^DILF(.DA)
S BTPWUPD(90505.14,IENS,.01)=TXT
Q
;
UP2(DZ,PNL,CS,TXT) ;
NEW DA,IENS
S DA(2)=DZ,DA(1)=PNL,DA=CS,IENS=$$IENS^DILF(.DA)
S BTPWUPD(90505.123,IENS,.01)=TXT
Q
;
STXPT(TXNM,TYP) ; Set taxonomy pointer
;
;Input
; TXNM - Taxonomy name
; TYP - Taxonomy Type (L = LAB, N = Non Lab)
NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB
S VALUE=""
I TYP="L" D
. S IEN=$O(^ATXLAB("B",TXNM,"")),GLB="ATXLAB("
. I IEN="" S TYP="N"
I TYP="N" S IEN=$O(^ATXAX("B",TXNM,"")),GLB="ATXAX("
I IEN="" S VALUE="@"
I IEN'="" S VALUE=IEN_";"_GLB
Q VALUE
;
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)
;;BGP CHLAMYDIA TESTS TAX
;;BGP GPRA FOB TESTS
;;BGP PAP SMEAR TAX
;;BKM GONORRHEA TEST TAX
;;BTPW HPV DNA SCREEN TAX
;;BTPW PREGNANCY TEST TAX
;;
CMET ; Add new CMET Items
;;0|BTPWFDUE^^Followup Due^^^^^D00015BTPWFDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.06,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^5~5|
;;0|BTPWNCAT^^Category^^^^^T00040BTPWNCAT~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|21^^^D^^1^^^1~5|
;;0|BTPWNDUE^^Notification Due^^^^^D00015BTPWNDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.07,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^6~5|
;;0|BTPWNEDT^^Follow-up Event Date^^^^^D00015BTPWNEDT~1|NEW Y S Y=$$GET1^DIQ(90620,TIEN_",",.13,"I"),VAL=$$FMTE^BQIUL1(Y)~3|21^^^D^^2^^A^3~5|
;;0|BTPWNENM^^Follow-up Event Name^^^^^T00060BTPWNENM~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"E")~3|21^^^D^^^^^2~5|
;;0|BTPWNPEV^^Preceding Event^^^^^D00030BTPWNPEV~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.11,"I") I VAL]"" S VAL=$$GET1^DIQ(90620,VAL_",",.03,"I"),VAL=$$FMTE^BQIUL1(VAL)~3|21^^^D^^^^^4~5|
;;0|BTPWPDT^^Event Date^^^^^D00015BTPWPDT~1|NEW Y S Y=$$GET1^DIQ($S(VIEW="T":90620,1:90629),BTIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^2~5|
;;0|BTPWPRC^^Event^^^^^T00060BTPWPRC~1|S VAL=$$GET1^DIQ($S(VIEW="T":90620,1:90629),BTIEN_",",.01,"E")~3|18^^^D^1~5|
;;0|BTPWQCAT^^Category^^^^^T00040BTPWQCAT~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|19^^^D^^1^^^1~5|
;;0|BTPWQCOM^^Event Community^^^^^T00030BTPWQCOM^^1^3100101~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.16,"E") S:VAL="" VAL=$$GET1^DIQ(9000001,DFN_",",1117,"E")~3|19^^^O^7~5|
;;0|BTPWQEDT^^Event Date^^^^^D00015BTPWQEDT~1|NEW Y S Y=$$GET1^DIQ(90629,QIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|19^^^D^9^2^^D^~5|
;;0|BTPWQENM^^Event Name^^^^^T00060BTPWQENM~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.01,"E")~3|19^^^D^8~5|
;;0|BTPWQLDT^^Last Modified Date/Time^^^^^D00030BTPWQLDT^^^^^^^125~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",.11,"I"))~3|19^^^D^13~5|
;;0|BTPWQLMB^^Last Modified By^^^^^T00030BTPWQLMB~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.12,"E")~3|19^^^D^14~5|
;;0|BTPWQRES^^Result^^^^^T01024BTPWQRES~1|S VAL=$$QLNK^BTPWPTRG(QIEN,.06)~3|19^^^D^10~5|
;;0|BTPWQSCM^^Status Comments^^^^^T04096BTPWQSCM~1|S VAL=$$SCOMM^BTPWPDSP(QIEN)~3|19^^^D^12~5|
;;0|BTPWQSTS^^Status^^^^^T00020BTPWQSTS~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.08,"E")~3|19^^^D^11~5|
;;0|BTPWRDUE^^Finding Due^^^^^D00015BTPWRDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.05,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^4~5|
;;0|BTPWSTGE^^Event State^^^^^T00010BTPWSTGE^^^^^^^^^^D~1|S VAL=$S(VIEW="T":$$GET1^DIQ(90620,BTIEN_",",1.01,"E"),1:"")~3|18^^^D^3~5|
;;0|BTPWTCAT^^Category^^^^^T00040BTPWTCAT~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|20^^^D^^1^^^1~5|
;;0|BTPWTCLR^^Closed Reason^^^^^T00030BTPWTCLR~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.04,"E")~3|20^^^O^250~5|
;;0|BTPWTCOM^^Event Community^^^^^T00030BTPWTCOM^^1^3100101~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.16,"E") S:VAL="" VAL=$$GET1^DIQ(9000001,DFN_",",1117,"E")~3|20^^^O^~5|
;;0|BTPWTECM^^Event Comment^^^^^T04096BTPWTECM~1|S VAL=$$EVTCOM^BTPWPDSP(TIEN)~3|20^^^O^145~5|
;;0|BTPWTEDT^^Event Date^^^^^D00015BTPWTEDT~1|NEW Y S Y=$$GET1^DIQ(90620,TIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|20^^^D^110^1^^D^~5|
;;0|BTPWTENM^^1 - Event^^^^^T00060BTPWTENM~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"E")~3|20^^^D^100~5|
;;0|BTPWTEVS^^Event Summary^^^^^T04096BTPWTEVS~1|S VAL=$$EVTS^BTPWPLND(TIEN)~3|20^^^O^190~5|
;;0|BTPWTFDA^^Findings Summary^^^^^T02048BTPWTFDA~1|S VAL=$$FNDS^BTPWPLND(TIEN)~3|20^^^O^200~5|
;;0|BTPWTFNC^^Finding Comment^^^^^T04096BTPWTFNC~1|S VAL=$$FNDCMT^BTPWPDSP(TIEN)~3|20^^^O^155~5|
;;0|BTPWTFDD^^Finding Due By Date^^^^^D00015BTPWTFDD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.05,"I"))~3|20^^^O^280~5|
;;0|BTPWTFND^^2 - Finding(s)^^^^^T02048BTPWTFND~1|S VAL=$$FND^BTPWPEVT(TIEN)~3|20^^^D^140~5|
;;0|BTPWTFUA^^Follow-up Summary^^^^^T02048BTPWTFUA~1|S VAL=$$FUPS^BTPWPLND(TIEN)~3|20^^^O^210~5|
;;0|BTPWTFUC^^Follow-up Comment^^^^^T04096BTPWTFUC~1|S VAL=$$FUPCMT^BTPWPDSP(TIEN)~3|20^^^O^165~5|
;;0|BTPWTFUD^^Follow-up Decision Due By Date^^^^^D00015BTPWTFUD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.06,"I"))~3|20^^^O^290~5|
;;0|BTPWTFUP^^3 - Follow-up(s)^^^^^T02048BTPWTFUP~1|S VAL=$$FUP^BTPWPEVT(TIEN)~3|20^^^D^160~5|
;;0|BTPWTINT^^Interpretation^^^^^T00050BTPWTINT~1|S VAL=$$INTER^BTPWPEVT(TIEN)~3|20^^^D^150~5|
;;0|BTPWTLDT^^Last Modified Date/Time^^^^^D00030BTPWTLDT^^^^^^^125~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.09,"I"))~3|20^^^O^230~5|
;;0|BTPWTLMB^^Last Modified By^^^^^T00030BTPWTLMB~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.1,"E")~3|20^^^O^240~5|
;;0|BTPWTNOA^^Patient Notification Summary^^^^^T02048BTPWTNOA~1|S VAL=$$NOTS^BTPWPLND(TIEN)~3|20^^^O^220~5|
;;0|BTPWTNOC^^Pt. Notification Comment^^^^^T04096BTPWTNOC~1|S VAL=$$NOTCMT^BTPWPDSP(TIEN)~3|20^^^O^175~5|
;;0|BTPWTNOD^^Notification Due By Date^^^^^D00015BTPWTNOD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.07,"I"))~3|20^^^O^300~5|
;;0|BTPWTNOT^^4 - Patient Notification(s)^^^^^T02048BTPWTNOT~1|S VAL=$$NOT^BTPWPEVT(TIEN)~3|20^^^D^170~5|
;;0|BTPWTPEV^^Preceding Event^^^^^D00030BTPWTPEV~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.11,"I") I VAL]"" S VAL=$$GET1^DIQ(90620,VAL_",",.03,"I"),VAL=$$FMTE^BQIUL1(VAL)~3|20^^^D^120~5|
;;0|BTPWTRES^^Results^^^^^T01024BTPWTRES~1|S VAL=$$LNK^BTPWPTRG(TIEN,.06)~3|20^^^D^130~5|
;;0|BTPWTSTA^^State^^^^^T00015BTPWTSTA~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.01,"E")~3|20^^^D^180~5|
;;0|BTPWTSTC^^State Comment^^^^^T01024BTPWTSTC^^^~1|S VAL=$$STACOM^BTPWPEVT(TIEN)~3|20^^^O^135~5|
;;0|BTPWTSTS^^Status^^^^^T00010Status^^1^3100101~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.08,"E")~3|20^^^O^~5|
;;0|BTPWTTBY^^Event Tracked By^^^^^T00030BTPWTTBY~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.03,"E")~3|20^^^O^260~5|
;;0|BTPWTTDT^^Event Tracked Date/Time^^^^^D00030BTPWTTDT~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.02,"I"))~3|20^^^O^270~5|
;;
BTPW1PST ;VNGT/HS/ALA-Post Installation for CMET ; 24 Apr 2008 7:46 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
EN ; Set up Site Parameters
+1 NEW BHM,BHOME
+2 IF $GET(U)=""
DO DT^DICRW
+3 SET BHM=$ORDER(^BQI(90508,0))
+4 IF BHM'=""
SET BHOME=$PIECE($GET(^BQI(90508,BHM,0)),U,1)
+5 IF $GET(BHOME)=""
SET BHOME=$PIECE($GET(^XTV(8989.3,1,"XUS")),U,17)
+6 SET BTPWDA=1
SET $PIECE(^BTPW(90628,BTPWDA,0),U,1)=BHOME
SET ^BTPW(90628,"B",BHOME,1)=""
+7 ;S BTPWUPD(90628,BTPWDA_",",.01)=BHOME
+8 ; Clear out and set up default fields
+9 NEW FLD,PC
+10 FOR FLD=.06,.07,1.01:.01:1.09
SET BTPWUPD(90628,BTPWDA_",",FLD)="@"
+11 DO FILE^DIE("","BTPWUPD","ERROR")
+12 KILL BTPWUPD
+13 FOR PC=1:1:3
SET $PIECE(^BTPW(90628,BTPWDA,1),U,PC)=7
+14 NEW DA,IENS
+15 SET DA(1)=BTPWDA
SET DA=0
+16 FOR
SET DA=$ORDER(^BTPW(90628,BTPWDA,2,DA))
IF 'DA
QUIT
Begin DoDot:1
+17 SET IENS=$$IENS^DILF(.DA)
+18 IF $$GET1^DIQ(90628.02,IENS,.01,"E")="PAP SMEAR"
Begin DoDot:2
+19 SET $PIECE(^BTPW(90628,DA(1),2,DA,0),U,2)="12M"
+20 SET $PIECE(^BTPW(90628,DA(1),2,DA,0),U,5)=1
+21 SET ^BTPW(90628,DA(1),2,DA,1)=75
End DoDot:2
+22 IF $$GET1^DIQ(90628.02,IENS,.01,"E")="MAMMOGRAM SCREENING"
Begin DoDot:2
+23 SET $PIECE(^BTPW(90628,DA(1),2,DA,0),U,2)="12M"
+24 SET $PIECE(^BTPW(90628,DA(1),2,DA,0),U,5)=1
+25 SET ^BTPW(90628,DA(1),2,DA,1)=108
End DoDot:2
+26 FOR FLD=.03,.04
SET BTPWUPD(90628.02,IENS,FLD)="@"
+27 DO FILE^DIE("","BTPWUPD","ERROR")
+28 KILL BTPWUPD
End DoDot:1
+29 ;
TMPL ; Set list for templates with |V | data objects
+1 NEW XDATA
+2 SET XDATA=$NAME(^XTMP("BQITEMPL"))
+3 KILL @XDATA
+4 SET @XDATA@(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Templates containing |V | data objects"
+5 NEW TMPN,BLN
+6 SET TMPN=0
+7 FOR
SET TMPN=$ORDER(^TIU(8927,TMPN))
IF 'TMPN
QUIT
Begin DoDot:1
+8 SET BLN=0
+9 FOR
SET BLN=$ORDER(^TIU(8927,TMPN,2,BLN))
IF 'BLN
QUIT
Begin DoDot:2
+10 IF ^TIU(8927,TMPN,2,BLN,0)["|V "
SET @XDATA@(TMPN)=""
End DoDot:2
End DoDot:1
+11 ;
+12 NEW DZ,BKEY,USER
+13 SET DZ=""
FOR
SET DZ=$ORDER(^XTMP("BTPW1PRE",DZ))
IF DZ=""
QUIT
Begin DoDot:1
+14 SET BKEY="BTPWZCMGR"
SET USER=DZ
DO ADD^BQISYKEY
IF $GET(DZ)=""
SET DZ=USER
End DoDot:1
+15 KILL ^XTMP("BTWP1PRE")
+16 ;
USR ; Remove user preferences for CMET
+1 NEW DZ,TN
+2 SET DZ=0
+3 FOR
SET DZ=$ORDER(^BQICARE(DZ))
IF 'DZ
QUIT
Begin DoDot:1
+4 KILL ^BQICARE(DZ,9)
+5 SET TN=0
+6 FOR
SET TN=$ORDER(^BQICARE(DZ,15,TN))
IF 'TN
QUIT
Begin DoDot:2
+7 IF $PIECE(^BQICARE(DZ,15,TN,0),U,1)="Queued Events Default"
DO UP("Events Default")
+8 IF $PIECE(^BQICARE(DZ,15,TN,0),U,1)="Planned Events Default"
DO UP("Followup Events Default")
End DoDot:2
+9 SET PNL=0
+10 FOR
SET PNL=$ORDER(^BQICARE(DZ,1,PNL))
IF 'PNL
QUIT
Begin DoDot:2
+11 SET TL=0
+12 FOR
SET TL=$ORDER(^BQICARE(DZ,1,PNL,4,TL))
IF 'TL
QUIT
Begin DoDot:3
+13 IF $PIECE(^BQICARE(DZ,1,PNL,4,TL,0),U,1)="Queued Events Default"
DO UP1(DZ,PNL,TL,"Events Default")
+14 IF $PIECE(^BQICARE(DZ,1,PNL,4,TL,0),U,1)="Planned Events Default"
DO UP1(DZ,PNL,TL,"Followup Events Default")
End DoDot:3
+15 SET CS=0
+16 FOR
SET CS=$ORDER(^BQICARE(DZ,1,PNL,23,CS))
IF 'CS
QUIT
Begin DoDot:3
+17 IF $PIECE(^BQICARE(DZ,1,PNL,23,CS,0),U,1)="Queued Events"
DO UP2(DZ,PNL,CS,"Events")
+18 IF $PIECE(^BQICARE(DZ,1,PNL,23,CS,0),U,1)="Planned Events"
DO UP2(DZ,PNL,CS,"Followup Events")
End DoDot:3
End DoDot:2
End DoDot:1
+19 IF $DATA(BTPWUPD)
DO FILE^DIE("","BTPWUPD","ERROR")
+20 ;
+21 ; Create CMET Taxonomies
+22 DO ^BTPWUX
+23 DO ^BTPWVX
+24 DO ^BTPWWX
+25 DO ^BTPWXX
+26 DO ^BTPWYX
+27 ;
LTAX ; Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,BQTXUP
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ;
+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 ; Update pointers IN CMET
+18 NEW PRCN,TXN,TTYP,VAL,BTPWUPD
+19 SET PRCN=0
+20 FOR
SET PRCN=$ORDER(^BTPW(90621,PRCN))
IF 'PRCN
QUIT
Begin DoDot:1
+21 SET TXN=0
+22 FOR
SET TXN=$ORDER(^BTPW(90621,PRCN,1,TXN))
IF 'TXN
QUIT
Begin DoDot:2
+23 SET TTYP=$PIECE(^BTPW(90621,PRCN,1,TXN,0),U,3)
SET TAX=$PIECE(^(0),U,1)
+24 SET TTYP=$SELECT(TTYP=3:"L",1:"N")
+25 SET VAL=$$STXPT(TAX,TTYP)
+26 NEW DA,IENS
+27 SET DA(1)=PRCN
SET DA=TXN
SET IENS=$$IENS^DILF(.DA)
+28 SET BTPWUPD(90621.01,IENS,.02)=VAL
End DoDot:2
End DoDot:1
+29 DO FILE^DIE("","BTPWUPD","ERROR")
+30 ;
+31 ; Add BTPW entries to 90506.1
+32 NEW DA,DIK,NAME
+33 SET DIK="^BQI(90506.1,"
+34 FOR NAME="BTPWFDUE","BTPWNDUE","BTPWPDT","BTPWPRC","BTPWRDUE","BTPWSTGE"
SET DA=$ORDER(^BQI(90506.1,"B",NAME,""))
IF DA'=""
DO ^DIK
+35 ;
+36 NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
+37 FOR BI=1:1
SET TEXT=$PIECE($TEXT(CMET+BI),";;",2)
IF TEXT=""
QUIT
Begin DoDot:1
+38 FOR BJ=1:1:$LENGTH(TEXT,"~")
Begin DoDot:2
+39 SET NDATA=$PIECE(TEXT,"~",BJ)
+40 SET ND=$PIECE(NDATA,"|",1)
SET VAL=$PIECE(NDATA,"|",2)
+41 IF ND=0
Begin DoDot:3
+42 NEW DIC,X,Y
+43 SET DIC(0)="LQZ"
SET DIC="^BQI(90506.1,"
SET X=$PIECE(VAL,U,1)
+44 DO ^DIC
+45 SET IEN=+Y
+46 IF IEN=-1
KILL DO,DD
DO FILE^DICN
SET IEN=+Y
End DoDot:3
+47 IF ND=1
SET BQIUPD(90506.1,IEN_",",1)=VAL
QUIT
+48 FOR BK=1:1:$LENGTH(VAL,"^")
Begin DoDot:3
+49 SET BN=$ORDER(^DD(90506.1,"GL",ND,BK,""))
IF BN=""
QUIT
+50 IF $PIECE(VAL,"^",BK)'=""
SET BQIUPD(90506.1,IEN_",",BN)=$PIECE(VAL,"^",BK)
QUIT
+51 IF $PIECE(VAL,"^",BK)=""
SET BQIUPD(90506.1,IEN_",",BN)="@"
End DoDot:3
End DoDot:2
+52 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+53 ;
+54 ; Set tooltips
+55 DO TPS^BTPW1PSU
+56 ;
+57 ; Set up post-install job to run
+58 NEW X,Y,%DT
+59 SET %DT="AEFR"
SET %DT("A")="Enter Time to start CMET Queued Events Search Job: "
+60 SET %DT("B")=$$FMTE^XLFDT(DT_".20")
+61 DO ^%DT
+62 IF X="NOW"
SET ZTDTH=$$FMADD^XLFDT(Y,,,3)
+63 IF '$TEST
SET ZTDTH=Y
+64 SET ZTDESC="CMET INITIALIZATION"
SET ZTRTN="EN^BTPWPFND()"
SET ZTIO=""
+65 DO ^%ZTLOAD
+66 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+67 ;
+68 QUIT
+69 ;
UP(TXT) ;
+1 NEW DA,IENS
+2 SET DA(1)=DZ
SET DA=TN
SET IENS=$$IENS^DILF(.DA)
+3 SET BTPWUPD(90505.015,IENS,.01)=TXT
+4 QUIT
+5 ;
UP1(DZ,PNL,TL,TXT) ;
+1 NEW DA,IENS
+2 SET DA(2)=DZ
SET DA(1)=PNL
SET DA=TL
SET IENS=$$IENS^DILF(.DA)
+3 SET BTPWUPD(90505.14,IENS,.01)=TXT
+4 QUIT
+5 ;
UP2(DZ,PNL,CS,TXT) ;
+1 NEW DA,IENS
+2 SET DA(2)=DZ
SET DA(1)=PNL
SET DA=CS
SET IENS=$$IENS^DILF(.DA)
+3 SET BTPWUPD(90505.123,IENS,.01)=TXT
+4 QUIT
+5 ;
STXPT(TXNM,TYP) ; Set taxonomy pointer
+1 ;
+2 ;Input
+3 ; TXNM - Taxonomy name
+4 ; TYP - Taxonomy Type (L = LAB, N = Non Lab)
+5 NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB
+6 SET VALUE=""
+7 IF TYP="L"
Begin DoDot:1
+8 SET IEN=$ORDER(^ATXLAB("B",TXNM,""))
SET GLB="ATXLAB("
+9 IF IEN=""
SET TYP="N"
End DoDot:1
+10 IF TYP="N"
SET IEN=$ORDER(^ATXAX("B",TXNM,""))
SET GLB="ATXAX("
+11 IF IEN=""
SET VALUE="@"
+12 IF IEN'=""
SET VALUE=IEN_";"_GLB
+13 QUIT VALUE
+14 ;
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 ;;BGP CHLAMYDIA TESTS TAX
+2 ;;BGP GPRA FOB TESTS
+3 ;;BGP PAP SMEAR TAX
+4 ;;BKM GONORRHEA TEST TAX
+5 ;;BTPW HPV DNA SCREEN TAX
+6 ;;BTPW PREGNANCY TEST TAX
+7 ;;
CMET ; Add new CMET Items
+1 ;;0|BTPWFDUE^^Followup Due^^^^^D00015BTPWFDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.06,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^5~5|
+2 ;;0|BTPWNCAT^^Category^^^^^T00040BTPWNCAT~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|21^^^D^^1^^^1~5|
+3 ;;0|BTPWNDUE^^Notification Due^^^^^D00015BTPWNDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.07,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^6~5|
+4 ;;0|BTPWNEDT^^Follow-up Event Date^^^^^D00015BTPWNEDT~1|NEW Y S Y=$$GET1^DIQ(90620,TIEN_",",.13,"I"),VAL=$$FMTE^BQIUL1(Y)~3|21^^^D^^2^^A^3~5|
+5 ;;0|BTPWNENM^^Follow-up Event Name^^^^^T00060BTPWNENM~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"E")~3|21^^^D^^^^^2~5|
+6 ;;0|BTPWNPEV^^Preceding Event^^^^^D00030BTPWNPEV~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.11,"I") I VAL]"" S VAL=$$GET1^DIQ(90620,VAL_",",.03,"I"),VAL=$$FMTE^BQIUL1(VAL)~3|21^^^D^^^^^4~5|
+7 ;;0|BTPWPDT^^Event Date^^^^^D00015BTPWPDT~1|NEW Y S Y=$$GET1^DIQ($S(VIEW="T":90620,1:90629),BTIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^2~5|
+8 ;;0|BTPWPRC^^Event^^^^^T00060BTPWPRC~1|S VAL=$$GET1^DIQ($S(VIEW="T":90620,1:90629),BTIEN_",",.01,"E")~3|18^^^D^1~5|
+9 ;;0|BTPWQCAT^^Category^^^^^T00040BTPWQCAT~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|19^^^D^^1^^^1~5|
+10 ;;0|BTPWQCOM^^Event Community^^^^^T00030BTPWQCOM^^1^3100101~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.16,"E") S:VAL="" VAL=$$GET1^DIQ(9000001,DFN_",",1117,"E")~3|19^^^O^7~5|
+11 ;;0|BTPWQEDT^^Event Date^^^^^D00015BTPWQEDT~1|NEW Y S Y=$$GET1^DIQ(90629,QIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|19^^^D^9^2^^D^~5|
+12 ;;0|BTPWQENM^^Event Name^^^^^T00060BTPWQENM~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.01,"E")~3|19^^^D^8~5|
+13 ;;0|BTPWQLDT^^Last Modified Date/Time^^^^^D00030BTPWQLDT^^^^^^^125~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90629,QIEN_",",.11,"I"))~3|19^^^D^13~5|
+14 ;;0|BTPWQLMB^^Last Modified By^^^^^T00030BTPWQLMB~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.12,"E")~3|19^^^D^14~5|
+15 ;;0|BTPWQRES^^Result^^^^^T01024BTPWQRES~1|S VAL=$$QLNK^BTPWPTRG(QIEN,.06)~3|19^^^D^10~5|
+16 ;;0|BTPWQSCM^^Status Comments^^^^^T04096BTPWQSCM~1|S VAL=$$SCOMM^BTPWPDSP(QIEN)~3|19^^^D^12~5|
+17 ;;0|BTPWQSTS^^Status^^^^^T00020BTPWQSTS~1|S VAL=$$GET1^DIQ(90629,QIEN_",",.08,"E")~3|19^^^D^11~5|
+18 ;;0|BTPWRDUE^^Finding Due^^^^^D00015BTPWRDUE~1|NEW Y S Y=$$GET1^DIQ(90620,BTIEN_",",1.05,"I"),VAL=$$FMTE^BQIUL1(Y)~3|18^^^D^4~5|
+19 ;;0|BTPWSTGE^^Event State^^^^^T00010BTPWSTGE^^^^^^^^^^D~1|S VAL=$S(VIEW="T":$$GET1^DIQ(90620,BTIEN_",",1.01,"E"),1:"")~3|18^^^D^3~5|
+20 ;;0|BTPWTCAT^^Category^^^^^T00040BTPWTCAT~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"I") S:VAL]"" VAL=$$CAT^BTPWPDSP(VAL)~3|20^^^D^^1^^^1~5|
+21 ;;0|BTPWTCLR^^Closed Reason^^^^^T00030BTPWTCLR~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.04,"E")~3|20^^^O^250~5|
+22 ;;0|BTPWTCOM^^Event Community^^^^^T00030BTPWTCOM^^1^3100101~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.16,"E") S:VAL="" VAL=$$GET1^DIQ(9000001,DFN_",",1117,"E")~3|20^^^O^~5|
+23 ;;0|BTPWTECM^^Event Comment^^^^^T04096BTPWTECM~1|S VAL=$$EVTCOM^BTPWPDSP(TIEN)~3|20^^^O^145~5|
+24 ;;0|BTPWTEDT^^Event Date^^^^^D00015BTPWTEDT~1|NEW Y S Y=$$GET1^DIQ(90620,TIEN_",",.03,"I"),VAL=$$FMTE^BQIUL1(Y)~3|20^^^D^110^1^^D^~5|
+25 ;;0|BTPWTENM^^1 - Event^^^^^T00060BTPWTENM~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.01,"E")~3|20^^^D^100~5|
+26 ;;0|BTPWTEVS^^Event Summary^^^^^T04096BTPWTEVS~1|S VAL=$$EVTS^BTPWPLND(TIEN)~3|20^^^O^190~5|
+27 ;;0|BTPWTFDA^^Findings Summary^^^^^T02048BTPWTFDA~1|S VAL=$$FNDS^BTPWPLND(TIEN)~3|20^^^O^200~5|
+28 ;;0|BTPWTFNC^^Finding Comment^^^^^T04096BTPWTFNC~1|S VAL=$$FNDCMT^BTPWPDSP(TIEN)~3|20^^^O^155~5|
+29 ;;0|BTPWTFDD^^Finding Due By Date^^^^^D00015BTPWTFDD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.05,"I"))~3|20^^^O^280~5|
+30 ;;0|BTPWTFND^^2 - Finding(s)^^^^^T02048BTPWTFND~1|S VAL=$$FND^BTPWPEVT(TIEN)~3|20^^^D^140~5|
+31 ;;0|BTPWTFUA^^Follow-up Summary^^^^^T02048BTPWTFUA~1|S VAL=$$FUPS^BTPWPLND(TIEN)~3|20^^^O^210~5|
+32 ;;0|BTPWTFUC^^Follow-up Comment^^^^^T04096BTPWTFUC~1|S VAL=$$FUPCMT^BTPWPDSP(TIEN)~3|20^^^O^165~5|
+33 ;;0|BTPWTFUD^^Follow-up Decision Due By Date^^^^^D00015BTPWTFUD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.06,"I"))~3|20^^^O^290~5|
+34 ;;0|BTPWTFUP^^3 - Follow-up(s)^^^^^T02048BTPWTFUP~1|S VAL=$$FUP^BTPWPEVT(TIEN)~3|20^^^D^160~5|
+35 ;;0|BTPWTINT^^Interpretation^^^^^T00050BTPWTINT~1|S VAL=$$INTER^BTPWPEVT(TIEN)~3|20^^^D^150~5|
+36 ;;0|BTPWTLDT^^Last Modified Date/Time^^^^^D00030BTPWTLDT^^^^^^^125~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.09,"I"))~3|20^^^O^230~5|
+37 ;;0|BTPWTLMB^^Last Modified By^^^^^T00030BTPWTLMB~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.1,"E")~3|20^^^O^240~5|
+38 ;;0|BTPWTNOA^^Patient Notification Summary^^^^^T02048BTPWTNOA~1|S VAL=$$NOTS^BTPWPLND(TIEN)~3|20^^^O^220~5|
+39 ;;0|BTPWTNOC^^Pt. Notification Comment^^^^^T04096BTPWTNOC~1|S VAL=$$NOTCMT^BTPWPDSP(TIEN)~3|20^^^O^175~5|
+40 ;;0|BTPWTNOD^^Notification Due By Date^^^^^D00015BTPWTNOD~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.07,"I"))~3|20^^^O^300~5|
+41 ;;0|BTPWTNOT^^4 - Patient Notification(s)^^^^^T02048BTPWTNOT~1|S VAL=$$NOT^BTPWPEVT(TIEN)~3|20^^^D^170~5|
+42 ;;0|BTPWTPEV^^Preceding Event^^^^^D00030BTPWTPEV~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.11,"I") I VAL]"" S VAL=$$GET1^DIQ(90620,VAL_",",.03,"I"),VAL=$$FMTE^BQIUL1(VAL)~3|20^^^D^120~5|
+43 ;;0|BTPWTRES^^Results^^^^^T01024BTPWTRES~1|S VAL=$$LNK^BTPWPTRG(TIEN,.06)~3|20^^^D^130~5|
+44 ;;0|BTPWTSTA^^State^^^^^T00015BTPWTSTA~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.01,"E")~3|20^^^D^180~5|
+45 ;;0|BTPWTSTC^^State Comment^^^^^T01024BTPWTSTC^^^~1|S VAL=$$STACOM^BTPWPEVT(TIEN)~3|20^^^O^135~5|
+46 ;;0|BTPWTSTS^^Status^^^^^T00010Status^^1^3100101~1|S VAL=$$GET1^DIQ(90620,TIEN_",",.08,"E")~3|20^^^O^~5|
+47 ;;0|BTPWTTBY^^Event Tracked By^^^^^T00030BTPWTTBY~1|S VAL=$$GET1^DIQ(90620,TIEN_",",1.03,"E")~3|20^^^O^260~5|
+48 ;;0|BTPWTTDT^^Event Tracked Date/Time^^^^^D00030BTPWTTDT~1|S VAL=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.02,"I"))~3|20^^^O^270~5|
+49 ;;
