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

BTPWPQVW.m

Go to the documentation of this file. 
  1. BTPWPQVW ;VNGT/HS/ALA-CMET Queue User View ; 16 Jun 2009  4:49 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;**2,3**;Feb 07, 2011;Build 63
  1.  ;
  1.  ;
  1. RET(DATA,FAKE) ; EP -- BTPW GET CMET PREFS
  1.  ;Description
  1.  ;  Retrieve the queue preferences for an owner
  1.  ;  
  1.  ;Input
  1.  ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1.  ;Output
  1.  ;  DATA  - name of global (passed by reference) in which the data
  1.  ;          is stored
  1.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,X,MIEN,SOURCE,PARMS,PIEN,NAME,PTYP,VALUE,PMIEN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPQVW",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPQVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00001TYPE^T03200PARMS"_$C(30)
  1.  ;
  1.  S MIEN=0,PARMS=""
  1.  ; if no defined user preference, set the default values
  1.  ;
  1.  ;Events
  1.  F TYPE="Q" D
  1.  . S MIEN=$O(^BQICARE(DUZ,9,"B",TYPE,""))
  1.  . I MIEN="" D
  1.  .. S PARMS="STATUS=P"_$C(28)_"TMFRAME=T-3M"
  1.  .. S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  .. S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
  1.  . I MIEN'="" D GET(TYPE,MIEN)
  1.  ;
  1.  ;Tracked
  1.  S MIEN=0,PARMS=""
  1.  F TYPE="T" D
  1.  . S MIEN=$O(^BQICARE(DUZ,9,"B",TYPE,""))
  1.  . I MIEN="" D
  1.  .. S PARMS="STATE=O"_$C(28)_"TMFRAME=T-12M"
  1.  .. S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  .. S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
  1.  . I MIEN'="" D GET(TYPE,MIEN)
  1.  ;
  1.  ;Followup
  1.  S MIEN=0,PARMS=""
  1.  F TYPE="P" D
  1.  . S MIEN=$O(^BQICARE(DUZ,9,"B",TYPE,""))
  1.  . I MIEN="" D
  1.  .. ;S PARMS="STATE=F"_$C(28)_"TMFRAME=T-12M"
  1.  .. S PARMS="TMFRAME=T+6M"
  1.  .. S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  .. S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
  1.  . I MIEN'="" D GET(TYPE,MIEN)
  1.  ;
  1.  ;Panel Events
  1.  F TYPE="PQ" D
  1.  . S MIEN=$O(^BQICARE(DUZ,9,"B",TYPE,""))
  1.  . I MIEN="" D
  1.  .. S PARMS="STATUS=P"_$C(28)_"TMFRAME=T-3M"
  1.  .. S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  .. S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
  1.  . I MIEN'="" D GET(TYPE,MIEN)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GET(TYPE,MIEN) ;EP
  1.  S PIEN=0,PARMS=""
  1.  F  S PIEN=$O(^BQICARE(DUZ,9,MIEN,1,PIEN)) Q:'PIEN  D
  1.  . NEW DA,IENS
  1.  . S DA(2)=DUZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.161,IENS,.01,"E")
  1.  . S VALUE=$$GET1^DIQ(90505.161,IENS,.03,"E")
  1.  . I VALUE="" S VALUE=$$GET1^DIQ(90505.161,IENS,.02,"E")
  1.  . S PARMS=PARMS_$S(PARMS]"":$C(28),1:"")_NAME_"="
  1.  . I VALUE'="" S PARMS=PARMS_VALUE Q
  1.  . ;
  1.  . ; Check for multiple values
  1.  . N VALSTR S VALSTR=""
  1.  . S PMIEN=0
  1.  . F  S PMIEN=$O(^BQICARE(DUZ,9,MIEN,1,PIEN,1,PMIEN)) Q:'PMIEN  D
  1.  .. NEW DA,IENS
  1.  .. S DA(3)=DUZ,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S VALUE=$$GET1^DIQ(90505.1611,IENS,.02,"E")
  1.  .. I VALUE="" S VALUE=$$GET1^DIQ(90505.1611,IENS,.01,"E")
  1.  .. S VALSTR=VALSTR_$S(VALSTR]"":$C(29),1:"")_VALUE
  1.  . ;
  1.  . ; Tack on Multiple Values
  1.  . S PARMS=PARMS_VALSTR
  1.  . K VALSTR
  1.  . ;
  1.  ;
  1.  S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  ;
  1.  S II=II+1,@DATA@(II)=TYPE_"^"_PARMS_$C(30)
  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. UPD(DATA,TYPE,PARMS) ;  EP - BTPW SET CMET PREFS
  1.  ;
  1.  ;Input
  1.  ;  TYPE  - 'P' for Planned preferences, 'Q' for Queued preferences and 'T' for Tracked preferences
  1.  ;  PARMS - Parameters
  1.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,X,MIEN,PIEN,PMIEN,VALUE,PDATA,ALDA,QFL,BQ,NAME,MVAL,BQII,PPIEN,TYPN,TEMP,LDTM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPQVW",UID)),TEMP=$NA(^TMP("TEMP",UID))
  1.  K @DATA,@TEMP
  1.  ;
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  ;
  1.  I TYPE="" S BMXSEC="RPC Failed: No Type of Preferences passed in" Q
  1.  I $D(PARMS)>10 D
  1.  . NEW LIST,BN,BBN
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  D
  1.  .. I BN=1,PARMS(BN)["COMM=" D
  1.  ... S @TEMP@(BN)="COMM="_$P(PARMS(BN),"COMM=",2)
  1.  ... S BBN=BN F  S BBN=$O(PARMS(BBN)) Q:BBN=""  S @TEMP@(BBN)=PARMS(BBN) K PARMS(BBN)
  1.  ... S PARMS(BN)=$P(PARMS(BN),"COMM=",1)
  1.  .. S LIST=LIST_PARMS(BN)
  1.  . K PARMS S PARMS=LIST
  1.  ;
  1.  ;I PARMS="" S BMXSEC="RPC Failed: No parameters passed in" Q
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPQVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S TYPN=$O(^BQICARE(DUZ,9,"B",TYPE,""))
  1.  ;  Clean out all the previous parameters
  1.  I TYPN'="" D DEL
  1.  I TYPN="" D
  1.  . NEW DA,DIC
  1.  . S DA(1)=DUZ,X=TYPE,DIC(0)="LNZ",DLAYGO=90505.16
  1.  . I $G(^BQICARE(DUZ,9,0))="" S ^BQICARE(DUZ,9,0)="^90505.16S^^"
  1.  . S DIC="^BQICARE("_DA(1)_",9,"
  1.  . D ^DIC S TYPN=+Y I TYPN=-1 K DO,DD D FILE^DICN S TYPN=+Y
  1.  ;
  1.  S QFL=0
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  G DONE:QFL
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . D NPM(TYPN,NAME,.PDA) I QFL Q
  1.  . ;
  1.  . NEW DA,IENS
  1.  . S DA(2)=DUZ,DA(1)=TYPN,DA=PDA
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . I VALUE'[$C(29) D NRC(IENS,VALUE) Q
  1.  . ;
  1.  . I VALUE[$C(29) D  Q:QFL
  1.  .. I '$D(^BQICARE(DA(2),9,DA(1),1,PDA,1,0)) S ^BQICARE(DA(2),9,DA(1),1,PDA,1,0)="^90505.1611^^"
  1.  .. F BQII=1:1:$L(VALUE,$C(29)) D
  1.  ... S MVAL=$P(VALUE,$C(29),BQII)
  1.  ... D NML(TYPN,PDA,MVAL)
  1.  ;
  1.  ; Check for community list
  1.  I $D(@TEMP)>0 D  Q:QFL
  1.  . D NPM(TYPN,"COMM",.PDA) I QFL Q
  1.  . S DA(2)=DUZ,DA(1)=TYPN,DA=PDA
  1.  . I '$D(^BQICARE(DA(2),9,DA(1),1,PDA,1,0)) S ^BQICARE(DA(2),9,DA(1),1,PDA,1,0)="^90505.1611^^"
  1.  . NEW BN,LINE,NBN,LSTI,BQII
  1.  . S BN="",LINE=""
  1.  . F  S BN=$O(@TEMP@(BN)) Q:BN=""  D
  1.  .. S NBN=$O(@TEMP@(BN))
  1.  .. S LINE=LINE_@TEMP@(BN) I NBN'="" S LINE=LINE_@TEMP@(NBN)
  1.  .. I LINE["COMM=" S LINE=$P(LINE,"COMM=",2)
  1.  .. S LSTI=$L(LINE,$C(29))-10
  1.  .. F BQII=1:1:LSTI S MVAL=$P(LINE,$C(29),BQII) D NML(TYPN,PDA,MVAL)
  1.  .. S LINE=$P(LINE,$C(29),LSTI+1,$L(LINE,$C(29)))
  1.  .. I NBN'="" S BN=NBN
  1.  . F BQII=1:1 S MVAL=$P(LINE,$C(29),BQII) Q:MVAL=""  D NML(TYPN,PDA,MVAL)
  1.  ;
  1.  S II=II+1,@DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K @TEMP
  1.  Q
  1.  ;
  1. DELA(DATA) ;  Delete all CMET User definitions
  1.  NEW UID,II,DA,DIK
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPQVW",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPQVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  S DA(1)=DUZ,DA=0,DIK="^BQICARE("_DA(1)_",9,"
  1.  F  S DA=$O(^BQICARE(DUZ,9,DA)) Q:'DA  D ^DIK
  1.  S II=II+1,@DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEL ;  Delete the previous User preferences for the Type
  1.  NEW DA,DIK
  1.  S DA(2)=DUZ,DA(1)=TYPN,DA=0,DIK="^BQICARE("_DA(2)_",9,"_DA(1)_",1,"
  1.  F  S DA=$O(^BQICARE(DUZ,9,TYPN,1,DA)) Q:'DA  D ^DIK
  1.  ;F  S DA=$O(^BQICARE(DUZ,9,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. NPM(TYPN,NAME,PDA) ;EP - Add new parameter
  1.  NEW DA,IENS,DIC,DLAYGO
  1.  S DA(2)=DUZ,DA(1)=TYPN,X=NAME,DIC="^BQICARE("_DA(2)_",9,"_DA(1)_",1,"
  1.  I '$D(^BQICARE(DA(2),9,DA(1),1,0)) S ^BQICARE(DA(2),9,DA(1),1,0)="^90505.161^^"
  1.  S DLAYGO=90505.161,DIC(0)="L",DIC("P")=DLAYGO
  1.  K DO,DD D FILE^DICN
  1.  S (DA,PDA)=+Y
  1.  I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1.  Q
  1.  ;
  1. NRC(IENS,VALUE) ;EP - New record
  1.  I VALUE?.N S BQIUPD(90505.161,IENS,.03)=VALUE
  1.  I VALUE'?.N S BQIUPD(90505.161,IENS,.02)=VALUE
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. NML(TYPN,PDA,MVAL) ; EP - New multiple record
  1.  NEW DA,IENS
  1.  S DA(3)=DUZ,DA(2)=TYPN,DA(1)=PDA,X=MVAL
  1.  S DLAYGO=90505.1611,DIC(0)="L",DIC("P")=DLAYGO
  1.  S DIC="^BQICARE("_DA(3)_",9,"_DA(2)_",1,"_DA(1)_",1,"
  1.  K DO,DD D FILE^DICN
  1.  S DA=+Y
  1.  I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1.  S IENS=$$IENS^DILF(.DA)
  1.  I MVAL?.N S BQIUPD(90505.1611,IENS,.02)=MVAL
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. DCAT(PARM) ; Add all categories if not present in return parameters
  1.  ;
  1.  N IEN,VALUE
  1.  I PARM["CAT=" G XDCAT
  1.  ;
  1.  S VALUE="",IEN=0 F  S IEN=$O(^BTPW(90621.2,IEN)) Q:'IEN  D
  1.  . N INACTIVE
  1.  . S INACTIVE=$$GET1^DIQ(90621.2,IEN_",",.03,"I") Q:INACTIVE=1
  1.  . S VALUE=VALUE_$S(VALUE="":"",1:$C(29))_IEN
  1.  S PARM=PARM_$S(PARM="":"",1:$C(28))_"CAT="_VALUE
  1.  ;
  1. XDCAT Q PARM