Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWEVDF

BTPWEVDF.m

Go to the documentation of this file. 
  1. BTPWEVDF ;GDHS/HCSD/ALA-Event Definition ; 08 Dec 2016  1:35 PM
  1.  ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
  1.  ;
  1.  ;
  1. GET(DATA,FAKE) ;EP - BTPW DISPLAY EVENT DEF
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVDF",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  NEW PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,IEN,VAL,DATE,WHO
  1.  S @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030EVVALUE^I00010IVALIEN^D00030EVMODDT^T00040EVMODBY"_$C(30)
  1.  S PIEN=0
  1.  F  S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN  D
  1.  . I $P(^BTPW(90621,PIEN,0),U,3)'="" Q
  1.  . S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1) I PRCNAM="N/A" Q
  1.  . S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
  1.  . S TY=$$GET1^DIQ(90621,PIEN_",",.12,"I") I TY="" Q
  1.  . S DATE=$$FMTMDY^BQIUL1($$GET1^DIQ(90621,PIEN_",",.13,"I"))
  1.  . S WHO=$$GET1^DIQ(90621,PIEN_",",.14,"E")
  1.  . S VALUE=PIEN_U_PRCNAM_U_CAT_U
  1.  . S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  . S IEN=$O(^BTPW(90621,PIEN,1,"C",TY,"")) I IEN="" Q
  1.  . ;S VAL="",IVIEN="",II=II+1,@DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$C(30)
  1.  . S VAL=$P(^BTPW(90621,PIEN,1,IEN,0),"^",5),IVIEN=$P(^(0),"^",6)
  1.  . S II=II+1,@DATA@(II)=VALUE_TYPE_U_VAL_U_IVIEN_U_DATE_U_WHO_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. EEVT(DATA,EVIEN) ;EP - BTPW GET EVENT DEF DETAIL
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWEVDFD",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  NEW PIEN,PIEN,PRCNAM,CAT,VALUE,TY,TYPE,TAX,DEF,TAXP
  1.  ;S @DATA@(II)="I00010EVIEN^T00030EVNAME^T00030EVCAT^T00015EVTYPE^T00030TAXONOMY^T00020TAXIEN^T00040EVVALUE^I00010HIDE_DVALUE"_$C(30)
  1.  S @DATA@(II)="T00015EVTYPE^T00020TAXIEN"_$C(30)
  1.  I $G(EVIEN)="" S PIEN=0 F  S PIEN=$O(^BTPW(90621,PIEN)) Q:'PIEN  D EVT(PIEN)
  1.  I $G(EVIEN)'="" D EVT(EVIEN)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. EVT(PIEN) ;EP
  1.  S PRCNAM=$P(^BTPW(90621,PIEN,0),U,1) I PRCNAM="N/A" Q
  1.  S CAT=$$GET1^DIQ(90621,PIEN_",",.1,"E")
  1.  S VALUE=PIEN_U_PRCNAM_U_CAT_U
  1.  S N=0
  1.  F  S N=$O(^BTPW(90621,PIEN,1,N)) Q:'N  D
  1.  . 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)
  1.  . I TY=6 Q
  1.  . S LIEN=$P(^BTPW(90621,PIEN,1,N,0),U,6) I TY=3,LIEN'="" S DEF=$P(^LAB(60,LIEN,0),"^",1)
  1.  . S TYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  . ;S II=II+1,@DATA@(II)=VALUE_TYPE_U_TAX_U_TAXP_U_DEF_U_LIEN_$C(30)
  1.  . S II=II+1,@DATA@(II)=TYPE_U_TAXP_$C(30)
  1.  Q
  1.  ;
  1. UPD(DATA,EVIEN,PARMS) ;EP -- BTPW UPDATE EVENT DEF DETAIL
  1.  ; Updates the event definition detail
  1.  ;  Input
  1.  ;     EVIEN - Event IEN
  1.  ;     PARMS - Parameters 
  1.  ;             EVTYPE  - PCC File type
  1.  ;             IVALIEN - IEN of Event default value
  1.  ;
  1.  NEW UID,II,NAME,VALUE,PDATA,LIST,BN,BTIEN,DA,IENS,BTFILN,RESULT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWUEVT",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWEVDF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T001024ERROR"_$C(30)
  1.  ;
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . S @NAME=VALUE
  1.  ;
  1.  ;S TREF="BTPWTAX" K @TREF
  1.  ;I $$EVNN(EVTYPE)=3 D
  1.  ;. D BLD^BQITUTL(TAXONOMY,.TREF,"L")
  1.  ;E  D BLD^BQITUTL(TAXONOMY,.TREF)
  1.  ;S DVALUE=$P(@TREF@(EVVALUE),U,1)
  1.  S BTIEN=$$EVNN(EVTYPE),BTFILN=$P(^BTPW(90621.1,BTIEN,0),U,8)
  1.  S VALUE=$$GET1^DIQ(BTFILN,IVALIEN_",",.01,"E")
  1.  S DA=$O(^BTPW(90621,EVIEN,1,"C",BTIEN,"")),DA(1)=EVIEN
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BTPWUPD(90621.01,IENS,.05)=VALUE,BTPWUPD(90621.01,IENS,.06)=IVALIEN
  1.  S BTPWUPD(90621,EVIEN_",",.12)=BTIEN,BTPWUPD(90621,EVIEN_",",.14)=DUZ,BTPWUPD(90621,EVIEN_",",.13)=$$NOW^XLFDT()
  1.  D FILE^DIE("","BTPWUPD","ERROR")
  1.  ;
  1.  S RESULT=1_U
  1.  I $D(ERROR)>0 S RESULT=-1_U
  1.  K ERROR
  1.  I $D(BTPWDTA)>0 D FILE^DIE("","BTPWDTA","ERROR")
  1.  I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
  1.  I $P(RESULT,U,1)'=-1 S RESULT=1_U
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  K EVIEN,PARMS,IVALIEN,EVTYPE,NAME
  1.  Q
  1.  ;
  1. EVNN(EVTY) ;EP - Event type (PCC File)
  1.  NEW EVTIEN
  1.  S EVTIEN=$O(^BTPW(90621.1,"D",EVTY,""))
  1.  Q EVTIEN
  1.  ;
  1. EVNX(PIEN,EVTY) ;EP - Event's taxonomy entry
  1.  I EVTY'?.N S EVTY=$$EVNN(EVTY) I EVTY="" Q ""
  1.  S IEN=$O(^BTPW(90621,PIEN,1,"C",EVTY,""))
  1.  Q IEN
  1.  ;
  1. ARL ;EP - testing
  1.  S N=0
  1.  F  S N=$O(^BTPW(90621,N)) Q:'N  D
  1.  . S T=0
  1.  . F  S T=$O(^BTPW(90621,N,1,T)) Q:'+T  D
  1.  .. 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)
  1.  .. I TY=1!(TY=6) Q
  1.  .. S LIEN=$P(^BTPW(90621,N,1,T,0),U,6)
  1.  .. I LIEN'="" Q
  1.  .. I DEF="" Q
  1.  .. S TREF="ARLIS" K @TREF
  1.  .. I TAXP["LAB" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  .. E  D BLD^BQITUTL(TAX,.TREF)
  1.  .. S F="",DVAL=""
  1.  .. F  S F=$O(@TREF@(F)) Q:F=""  I $P(@TREF@(F),U,1)=DEF S DVAL=F
  1.  .. S $P(^BTPW(90621,N,1,T,0),U,6)=DVAL