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

BQIIPTVW.m

Go to the documentation of this file. 
  1. BQIIPTVW ;VNGT/HS/ALA-IPC Tabs View ; 10 Aug 2011  10:52 AM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
  1.  ;
  1.  ;
  1. RET(DATA,TYPE) ; EP -- BQI GET IPC PREFS
  1.  ;Description
  1.  ;  Retrieve the IPC Preferences for an owner
  1.  ;  
  1.  ;Input
  1.  ;  TYPE (Optional) - (PD-Patient Detail/DP-Provider Detail)
  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,PARMS,TYP,MIEN,DZ
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIIPTVW",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00001TYPE^T03200PARMS"_$C(30)
  1.  ;
  1.  S TYPE=$G(TYPE,""),DZ=DUZ
  1.  ;
  1.  ;Return Patient Detail
  1.  ;
  1.  S MIEN=0,PARMS=""
  1.  I TYPE=""!(TYPE="PD") D
  1.  . S TYP="PD"
  1.  . S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
  1.  . ;No preferences on file - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DCAT(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1.  ;Return Provider Detail
  1.  ;
  1.  S MIEN=0,PARMS=""
  1.  I TYPE=""!(TYPE="DP") D
  1.  . S TYP="DP"
  1.  . S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
  1.  . ;No preferences on file - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DCAT(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1.  ;Return Team Aggregated
  1.  S MIEN=0,PARMS=""
  1.  I TYPE=""!(TYPE="TA") D
  1.  . S TYP="TA"
  1.  . S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
  1.  . ;No preferences on file - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DAGG(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1.  ;Return Provider Aggregated
  1.  S MIEN=0,PARMS=""
  1.  I TYPE=""!(TYPE="PA") D
  1.  . S TYP="PA"
  1.  . S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
  1.  . ;No preferences on file - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DAGG(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1.  ; Return Facility Aggregated
  1.  S MIEN=0,PARMS=""
  1.  I TYPE=""!(TYPE="FA") D
  1.  . S TYP="FA"
  1.  . S MIEN=$O(^BQICARE(DZ,8,"B",TYP,""))
  1.  . ;No preferences on file - use default
  1.  . I MIEN="" D  Q
  1.  .. S PARMS=$$DAGG(PARMS)
  1.  .. S II=II+1,@DATA@(II)=TYP_"^"_PARMS_$C(30)
  1.  . ;Preferences defined - pull values
  1.  . I MIEN'="" D GET(TYP,MIEN)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GET(TYPE,MIEN) ;EP - Pull the individual definition
  1.  ;
  1.  NEW PIEN,PARMS
  1.  S PIEN=0,PARMS=""
  1.  F  S PIEN=$O(^BQICARE(DZ,8,MIEN,1,PIEN)) Q:'PIEN  D
  1.  . NEW DA,IENS,NAME,VALUE
  1.  . S DA(2)=DZ,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)
  1.  . S NAME=$$GET1^DIQ(90505.171,IENS,.01,"E")
  1.  . ;
  1.  . ;Try pulling an individual value first
  1.  . S VALUE=$$GET1^DIQ(90505.171,IENS,.03,"E")
  1.  . I VALUE="" S VALUE=$$GET1^DIQ(90505.171,IENS,.02,"E")
  1.  . S PARMS=PARMS_$S(PARMS]"":$C(28),1:"")_NAME_"="
  1.  . I VALUE'="" S PARMS=PARMS_VALUE Q
  1.  . ;
  1.  . ;If no individual definition, check for multiple values
  1.  . NEW PMIEN,VALSTR
  1.  . S PMIEN=0,VALSTR=""
  1.  . F  S PMIEN=$O(^BQICARE(DZ,8,MIEN,1,PIEN,1,PMIEN)) Q:'PMIEN  D
  1.  .. NEW DA,IENS
  1.  .. S DA(3)=DZ,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)
  1.  .. S VALUE=$$GET1^DIQ(90505.1711,IENS,.02,"E")
  1.  .. I VALUE="" S VALUE=$$GET1^DIQ(90505.1711,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.  I TYPE="PD"!(TYPE="DP") S PARMS=$$DCAT(PARMS)  ;Add CAT values, if needed
  1.  E  S PARMS=$$DAGG(PARMS)
  1.  ;
  1.  S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
  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,PNRESET,PARMS) ;  EP -- BQI SET IPC PREFS
  1.  ;
  1.  ;Input
  1.  ;  TYPE    - PD - Patient Detail, DP - Panel Detail
  1.  ;  PNRESET - Set to 'Y' if previous panel values should be cleared
  1.  ;  PARMS   - Parameters
  1.  ;Assumes
  1.  ;  DUZ - User who signed onto iCare
  1.  ;
  1.  NEW UID,II,TYPN,QFL,BQ,ERROR,DZ
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIIPTVW",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0,TYPE=$G(TYPE,""),PNRESET=$G(PNRESET,""),DZ=DUZ
  1.  ;
  1.  I TYPE="" S BMXSEC="RPC Failed: No Type of Preferences passed in" Q
  1.  ;
  1.  I $D(PARMS)>10 D
  1.  . NEW LIST,BN,QFL,BQ
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  D
  1.  .. S LIST=LIST_PARMS(BN)
  1.  . K PARMS S PARMS=LIST
  1.  ;
  1.  ;PARMS ISN'T ALWAYS POPULATED
  1.  ;I PARMS="" S BMXSEC="RPC Failed: No parameters passed in" Q
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPTVW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S TYPN=$O(^BQICARE(DZ,8,"B",TYPE,""))
  1.  ;
  1.  ;Clean out all the previous parameters
  1.  I TYPN'="" D DEL(TYPN,PNRESET)
  1.  ;
  1.  ;If no previous, add new entry
  1.  I TYPN="" D
  1.  . NEW DA,DIC,DLAYGO,X,Y
  1.  . S DA(1)=DZ,X=$S(TYPE="PD":"Patient Detail",TYPE="DP":"Panel Detail",TYPE="TA":"Team Aggregated",TYPE="PA":"Provider Aggregated",TYPE="FA":"Facility Aggregated",1:"IPC")
  1.  . S DIC(0)="LNZ",DLAYGO=90505.17
  1.  . I $G(^BQICARE(DZ,8,0))="" S ^BQICARE(DZ,8,0)="^90505.17S^^"
  1.  . S DIC="^BQICARE("_DA(1)_",8,"
  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.  . ;
  1.  . N PDATA,NAME,VALUE,PDA,DA,IENS
  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,.DZ) I QFL Q
  1.  . I $G(DZ)="" S DZ=DUZ
  1.  . S DA(2)=DZ,DA(1)=TYPN,DA=PDA
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . ;
  1.  . ;Single value
  1.  . I VALUE'[$C(29) D NRC(IENS,VALUE,.ERROR) Q
  1.  . ;
  1.  . ;Multiple values
  1.  . I VALUE[$C(29) D  Q:QFL
  1.  .. N BQII,MVAL
  1.  .. I '$D(^BQICARE(DA(2),8,DA(1),1,PDA,1,0)) S ^BQICARE(DA(2),8,DA(1),1,PDA,1,0)="^90505.1711^^"
  1.  .. F BQII=1:1:$L(VALUE,$C(29)) D
  1.  ... S MVAL=$P(VALUE,$C(29),BQII)
  1.  ... D NML(TYPN,PDA,MVAL,.ERROR)
  1.  ;
  1.  S II=II+1
  1.  I $D(ERROR) S @DATA@(II)="-1"_$C(30)
  1.  E  S @DATA@(II)="1"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEL(TYPN,PNRESET) ; EP - Delete the previous User preferences for the Type
  1.  ;
  1.  I $G(DZ)="" S DZ=DUZ
  1.  I PNRESET="Y" D  Q
  1.  . NEW DA,DIK
  1.  . S DA(2)=DZ,DA(1)=TYPN,DA=0,DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
  1.  . F  S DA=$O(^BQICARE(DZ,8,TYPN,1,DA)) Q:'DA  D ^DIK
  1.  ;
  1.  ;Delete all but panel
  1.  NEW PARM
  1.  S PARM=0 F  S PARM=$O(^BQICARE(DZ,8,TYPN,1,PARM)) Q:'PARM  D
  1.  . NEW IEN,DA,DIK,PRM
  1.  . S DA(2)=DZ,DA(1)=TYPN,DA=PARM,IEN=$$IENS^DILF(.DA)
  1.  . S PRM=$$GET1^DIQ(90505.171,IEN,".01","I") Q:PRM="PANEL"
  1.  . S DA(2)=DZ,DA(1)=TYPN,DA=PARM,DIK="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
  1.  . D ^DIK
  1.  Q
  1.  ;
  1. NPM(TYPN,NAME,PDA,DZ) ;EP - Add new parameter
  1.  NEW DA,IENS,DIC,DLAYGO,X,DLAYGO
  1.  I $G(DZ)="" S DZ=DUZ
  1.  S DA(2)=DZ,DA(1)=TYPN,X=NAME,DIC="^BQICARE("_DA(2)_",8,"_DA(1)_",1,"
  1.  I '$D(^BQICARE(DA(2),8,DA(1),1,0)) S ^BQICARE(DA(2),8,DA(1),1,0)="^90505.171^^"
  1.  S DLAYGO=90505.171,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
  1.  Q
  1.  ;
  1. NRC(IENS,VALUE,ERROR) ;EP - New single record
  1.  N BQIUPD
  1.  I VALUE?.N S BQIUPD(90505.171,IENS,.03)=VALUE
  1.  I VALUE'?.N S BQIUPD(90505.171,IENS,.02)=VALUE
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  Q
  1.  ;
  1. NML(TYPN,PDA,MVAL,ERROR) ; EP - New multiple record
  1.  NEW DA,IENS,DLAYGO,DIC,Y,IENS,BQIUPD,ERROR
  1.  I $G(DZ)="" S DZ=DUZ
  1.  S DA(3)=DZ,DA(2)=TYPN,DA(1)=PDA,X=MVAL
  1.  S DLAYGO=90505.1711,DIC(0)="L",DIC("P")=DLAYGO
  1.  S DIC="^BQICARE("_DA(3)_",8,"_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.1711,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.  NEW IEN,VALUE,CAT,CRIPC
  1.  ;
  1.  S PARM=$G(PARM,"")
  1.  ;
  1.  ;Get the list of codes - Now pulling from 90506.8
  1.  S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  I PARM'["VERSION" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VERSION="_CRIPC
  1.  I PARM'["CAT" D
  1.  . S VALUE="",CAT=0 F  S CAT=$O(^BQI(90506.8,CAT)) Q:'CAT  D
  1.  .. I $P(^BQI(90506.8,CAT,0),U,2)=1 Q
  1.  .. I $P(^BQI(90506.8,CAT,0),U,5)'=CRIPC Q
  1.  .. S VALUE=VALUE_$S(VALUE="":"",1:$C(29))_CAT
  1.  . S PARM=PARM_$S(PARM="":"",1:$C(28))_"CAT="_VALUE
  1.  ;
  1. XDCAT Q PARM
  1.  ;
  1. DAGG(PARM) ; Add default
  1.  S PARM=$G(PARM,"")
  1.  S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
  1.  I PARM'["VERSION" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VERSION="_CRIPC
  1.  I PARM'["VIEW" S PARM=PARM_$S(PARM="":"",1:$C(28))_"VIEW=MONTHLY"
  1.  I PARM'["TMFRAME" S PARM=PARM_$S(PARM="":"",1:$C(28))_"TMFRAME=This Calendar Year"
  1.  ;
  1. XDAGG Q PARM