BTPWEVDF ;GDHS/HCSD/ALA-Event Definition ; 08 Dec 2016 1:35 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
;
GET(DATA,FAKE) ;EP - BTPW DISPLAY EVENT DEF
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWEVDF",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,IEN,VAL,DATE,WHO
S @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030EVVALUE^I00010IVALIEN^D00030EVMODDT^T00040EVMODBY"_$C(30)
S PIEN=0
F S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN D
. I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
. S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1) I PRCNAM="N/A" Q
. S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
. S TY=$$GET1^DIQ(90621,PIEN_",",.12,"I") I TY="" Q
. S DATE=$$FMTMDY^BQIUL1($$GET1^DIQ(90621,PIEN_",",.13,"I"))
. S WHO=$$GET1^DIQ(90621,PIEN_",",.14,"E")
. S VALUE=PIEN_U_PRCNAM_U_CAT_U
. S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
. S IEN=$O(^BTPW(90621,PIEN,1,"C",TY,"")) I IEN="" Q
. ;S VAL="",IVIEN="",II=II+1,@DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$C(30)
. S VAL=$P(^BTPW(90621,PIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6)
. S II=II+1,@DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
EEVT(DATA,EVIEN) ;EP - BTPW GET EVENT DEF DETAIL
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWEVDFD",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW PIEN,PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,TAXP
;S @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030TAXONOMY^T00020TAXIEN^T00040EVVALUE^I00010HIDE_DVALUE"_$C(30)
S @DATA@(II)="T00015EVTYPE^T00020TAXIEN"_$C(30)
I $G(EVIEN)="" S PIEN=0 F S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN D EVT(PIEN)
I $G(EVIEN)'="" D EVT(EVIEN)
S II=II+1,@DATA@(II)=$C(31)
Q
;
EVT(PIEN) ;EP
S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1) I PRCNAM="N/A" Q
S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
S VALUE=PIEN_U_PRCNAM_U_CAT_U
S N=0
F S N=$O(^BTPW(90621,PIEN,1,N)) Q:'N D
. S TY=$P(^BTPW(90621,PIEN,1,N,0),U,3),TAX=$P(^(0),U,1),DEF=$P(^(0),U,5),TAXP=$P(^(0),U,2)
. I TY=6 Q
. S LIEN=$P(^BTPW(90621,PIEN,1,N,0),U,6) I TY=3,LIEN'="" S DEF=$P(^LAB(60,LIEN,0),"^",1)
. S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
. ;S II=II+1,@DATA@(II)=VALUE_TYPE_U_TAX_U_TAXP_U_DEF_U_LIEN_$C(30)
. S II=II+1,@DATA@(II)=TYPE_U_TAXP_$C(30)
Q
;
UPD(DATA,EVIEN,PARMS) ;EP -- BTPW UPDATE EVENT DEF DETAIL
; Updates the event definition detail
; Input
; EVIEN - Event IEN
; PARMS - Parameters
; EVTYPE - PCC File type
; IVALIEN - IEN of Event default value
;
NEW UID,II,NAME,VALUE,PDATA,LIST,BN,BTIEN,DA,IENS,BTFILN,RESULT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWUEVT",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T001024ERROR"_$C(30)
;
S PARMS=$G(PARMS,"")
I PARMS="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. S @NAME=VALUE
;
;S TREF="BTPWTAX" K @TREF
;I $$EVNN(EVTYPE)=3 D
;. D BLD^BQITUTL(TAXONOMY,.TREF,"L")
;E D BLD^BQITUTL(TAXONOMY,.TREF)
;S DVALUE=$P(@TREF@(EVVALUE),U,1)
S BTIEN=$$EVNN(EVTYPE),BTFILN=$P(^BTPW(90621.1,BTIEN,0),U,8)
S VALUE=$$GET1^DIQ(BTFILN,IVALIEN_",",.01,"E")
S DA=$O(^BTPW(90621,EVIEN,1,"C",BTIEN,"")),DA(1)=EVIEN
S IENS=$$IENS^DILF(.DA)
S BTPWUPD(90621.01,IENS,.05)=VALUE,BTPWUPD(90621.01,IENS,.06)=IVALIEN
S BTPWUPD(90621,EVIEN_",",.12)=BTIEN,BTPWUPD(90621,EVIEN_",",.14)=DUZ,BTPWUPD(90621,EVIEN_",",.13)=$$NOW^XLFDT()
D FILE^DIE("","BTPWUPD","ERROR")
;
S RESULT=1_U
I $D(ERROR)>0 S RESULT=-1_U
K ERROR
I $D(BTPWDTA)>0 D FILE^DIE("","BTPWDTA","ERROR")
I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
I $P(RESULT,U,1)'=-1 S RESULT=1_U
S II=II+1,@DATA@(II)=RESULT_$C(30)
K EVIEN,PARMS,IVALIEN,EVTYPE,NAME
Q
;
EVNN(EVTY) ;EP - Event type (PCC File)
NEW EVTIEN
S EVTIEN=$O(^BTPW(90621.1,"D",EVTY,""))
Q EVTIEN
;
EVNX(PIEN,EVTY) ;EP - Event's taxonomy entry
I EVTY'?.N S EVTY=$$EVNN(EVTY) I EVTY="" Q ""
S IEN=$O(^BTPW(90621,PIEN,1,"C",EVTY,""))
Q IEN
;
ARL ;EP - testing
S N=0
F S N=$O(^BTPW(90621,N)) Q:'N D
. S T=0
. F S T=$O(^BTPW(90621,N,1,T)) Q:'+T D
.. S TY=$P(^BTPW(90621,N,1,T,0),U,3),TAX=$P(^(0),U,1),DEF=$P(^(0),U,5),TAXP=$P(^(0),U,2)
.. I TY=1!(TY=6) Q
.. S LIEN=$P(^BTPW(90621,N,1,T,0),U,6)
.. I LIEN'="" Q
.. I DEF="" Q
.. S TREF="ARLIS" K @TREF
.. I TAXP["LAB" D BLD^BQITUTL(TAX,.TREF,"L")
.. E D BLD^BQITUTL(TAX,.TREF)
.. S F="",DVAL=""
.. F S F=$O(@TREF@(F)) Q:F="" I $P(@TREF@(F),U,1)=DEF S DVAL=F
.. S $P(^BTPW(90621,N,1,T,0),U,6)=DVAL
BTPWEVDF ;GDHS/HCSD/ALA-Event Definition ; 08 Dec 2016 1:35 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
+3 ;
GET(DATA,FAKE) ;EP - BTPW DISPLAY EVENT DEF
+1 NEW UID,II
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWEVDF",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER"
+8 ;
+9 NEW PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,IEN,VAL,DATE,WHO
+10 SET @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030EVVALUE^I00010IVALIEN^D00030EVMODDT^T00040EVMODBY"_$CHAR(30)
+11 SET PIEN=0
+12 FOR
SET PIEN=$ORDER(^BTPW(90621,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+13 IF $PIECE(^BTPW(90621,PIEN,0),U,3)'=""
QUIT
+14 SET PRCNAM=$PIECE(^BTPW(90621,PIEN,0),U,1)
IF PRCNAM="N/A"
QUIT
+15 SET CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
+16 SET TY=$$GET1^DIQ(90621,PIEN_",",.12,"I")
IF TY=""
QUIT
+17 SET DATE=$$FMTMDY^BQIUL1($$GET1^DIQ(90621,PIEN_",",.13,"I"))
+18 SET WHO=$$GET1^DIQ(90621,PIEN_",",.14,"E")
+19 SET VALUE=PIEN_U_PRCNAM_U_CAT_U
+20 SET TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+21 SET IEN=$ORDER(^BTPW(90621,PIEN,1,"C",TY,""))
IF IEN=""
QUIT
+22 ;S VAL="",IVIEN="",II=II+1,@DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$C(30)
+23 SET VAL=$PIECE(^BTPW(90621,PIEN,1,IEN,0),"^",5)
SET IVIEN=$PIECE(^(0),"^",6)
+24 SET II=II+1
SET @DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$CHAR(30)
End DoDot:1
+25 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
EEVT(DATA,EVIEN) ;EP - BTPW GET EVENT DEF DETAIL
+1 NEW UID,II
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWEVDFD",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER"
+8 ;
+9 NEW PIEN,PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,TAXP
+10 ;S @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030TAXONOMY^T00020TAXIEN^T00040EVVALUE^I00010HIDE_DVALUE"_$C(30)
+11 SET @DATA@(II)="T00015EVTYPE^T00020TAXIEN"_$CHAR(30)
+12 IF $GET(EVIEN)=""
SET PIEN=0
FOR
SET PIEN=$ORDER(^BTPW(90621,PIEN))
IF 'PIEN
QUIT
DO EVT(PIEN)
+13 IF $GET(EVIEN)'=""
DO EVT(EVIEN)
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
EVT(PIEN) ;EP
+1 SET PRCNAM=$PIECE(^BTPW(90621,PIEN,0),U,1)
IF PRCNAM="N/A"
QUIT
+2 SET CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
+3 SET VALUE=PIEN_U_PRCNAM_U_CAT_U
+4 SET N=0
+5 FOR
SET N=$ORDER(^BTPW(90621,PIEN,1,N))
IF 'N
QUIT
Begin DoDot:1
+6 SET TY=$PIECE(^BTPW(90621,PIEN,1,N,0),U,3)
SET TAX=$PIECE(^(0),U,1)
SET DEF=$PIECE(^(0),U,5)
SET TAXP=$PIECE(^(0),U,2)
+7 IF TY=6
QUIT
+8 SET LIEN=$PIECE(^BTPW(90621,PIEN,1,N,0),U,6)
IF TY=3
IF LIEN'=""
SET DEF=$PIECE(^LAB(60,LIEN,0),"^",1)
+9 SET TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
+10 ;S II=II+1,@DATA@(II)=VALUE_TYPE_U_TAX_U_TAXP_U_DEF_U_LIEN_$C(30)
+11 SET II=II+1
SET @DATA@(II)=TYPE_U_TAXP_$CHAR(30)
End DoDot:1
+12 QUIT
+13 ;
UPD(DATA,EVIEN,PARMS) ;EP -- BTPW UPDATE EVENT DEF DETAIL
+1 ; Updates the event definition detail
+2 ; Input
+3 ; EVIEN - Event IEN
+4 ; PARMS - Parameters
+5 ; EVTYPE - PCC File type
+6 ; IVALIEN - IEN of Event default value
+7 ;
+8 NEW UID,II,NAME,VALUE,PDATA,LIST,BN,BTIEN,DA,IENS,BTFILN,RESULT
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BTPWUEVT",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER"
+15 SET @DATA@(II)="I00010RESULT^T001024ERROR"_$CHAR(30)
+16 ;
+17 SET PARMS=$GET(PARMS,"")
+18 IF PARMS=""
Begin DoDot:1
+19 SET LIST=""
SET BN=""
+20 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+21 KILL PARMS
+22 SET PARMS=LIST
+23 KILL LIST
End DoDot:1
+24 ;
+25 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+26 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+27 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+28 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+29 ;
+30 ;S TREF="BTPWTAX" K @TREF
+31 ;I $$EVNN(EVTYPE)=3 D
+32 ;. D BLD^BQITUTL(TAXONOMY,.TREF,"L")
+33 ;E D BLD^BQITUTL(TAXONOMY,.TREF)
+34 ;S DVALUE=$P(@TREF@(EVVALUE),U,1)
+35 SET BTIEN=$$EVNN(EVTYPE)
SET BTFILN=$PIECE(^BTPW(90621.1,BTIEN,0),U,8)
+36 SET VALUE=$$GET1^DIQ(BTFILN,IVALIEN_",",.01,"E")
+37 SET DA=$ORDER(^BTPW(90621,EVIEN,1,"C",BTIEN,""))
SET DA(1)=EVIEN
+38 SET IENS=$$IENS^DILF(.DA)
+39 SET BTPWUPD(90621.01,IENS,.05)=VALUE
SET BTPWUPD(90621.01,IENS,.06)=IVALIEN
+40 SET BTPWUPD(90621,EVIEN_",",.12)=BTIEN
SET BTPWUPD(90621,EVIEN_",",.14)=DUZ
SET BTPWUPD(90621,EVIEN_",",.13)=$$NOW^XLFDT()
+41 DO FILE^DIE("","BTPWUPD","ERROR")
+42 ;
+43 SET RESULT=1_U
+44 IF $DATA(ERROR)>0
SET RESULT=-1_U
+45 KILL ERROR
+46 IF $DATA(BTPWDTA)>0
DO FILE^DIE("","BTPWDTA","ERROR")
+47 IF $DATA(ERROR)>0
SET RESULT=-1_U_$GET(ERROR("DIERR",1,"TEXT",1))
+48 IF $PIECE(RESULT,U,1)'=-1
SET RESULT=1_U
+49 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+50 KILL EVIEN,PARMS,IVALIEN,EVTYPE,NAME
+51 QUIT
+52 ;
EVNN(EVTY) ;EP - Event type (PCC File)
+1 NEW EVTIEN
+2 SET EVTIEN=$ORDER(^BTPW(90621.1,"D",EVTY,""))
+3 QUIT EVTIEN
+4 ;
EVNX(PIEN,EVTY) ;EP - Event's taxonomy entry
+1 IF EVTY'?.N
SET EVTY=$$EVNN(EVTY)
IF EVTY=""
QUIT ""
+2 SET IEN=$ORDER(^BTPW(90621,PIEN,1,"C",EVTY,""))
+3 QUIT IEN
+4 ;
ARL ;EP - testing
+1 SET N=0
+2 FOR
SET N=$ORDER(^BTPW(90621,N))
IF 'N
QUIT
Begin DoDot:1
+3 SET T=0
+4 FOR
SET T=$ORDER(^BTPW(90621,N,1,T))
IF '+T
QUIT
Begin DoDot:2
+5 SET TY=$PIECE(^BTPW(90621,N,1,T,0),U,3)
SET TAX=$PIECE(^(0),U,1)
SET DEF=$PIECE(^(0),U,5)
SET TAXP=$PIECE(^(0),U,2)
+6 IF TY=1!(TY=6)
QUIT
+7 SET LIEN=$PIECE(^BTPW(90621,N,1,T,0),U,6)
+8 IF LIEN'=""
QUIT
+9 IF DEF=""
QUIT
+10 SET TREF="ARLIS"
KILL @TREF
+11 IF TAXP["LAB"
DO BLD^BQITUTL(TAX,.TREF,"L")
+12 IF '$TEST
DO BLD^BQITUTL(TAX,.TREF)
+13 SET F=""
SET DVAL=""
+14 FOR
SET F=$ORDER(@TREF@(F))
IF F=""
QUIT
IF $PIECE(@TREF@(F),U,1)=DEF
SET DVAL=F
+15 SET $PIECE(^BTPW(90621,N,1,T,0),U,6)=DVAL
End DoDot:2
End DoDot:1
