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

BQIPLPM.m

Go to the documentation of this file.
  1. BQIPLPM ;PRXM/HC/ALA-Get Panel Parameters ; 13 Nov 2008 3:07 PM
  1. ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
  1. ;
  1. Q
  1. ;
  1. RET(DATA,OWNR,PLIEN) ; EP -- BQI GET PANEL PARAMS
  1. ;
  1. ;Description - Retrieves the panel parameters for a specific panel
  1. ;
  1. ;Input
  1. ; OWNR - Owner of the panel internal entry number
  1. ; PLIEN - Panel internal entry number
  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
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLPM",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLPM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S @DATA@(II)="T03200PARMS"_$C(30)
  1. ;
  1. NEW DA,IENS,EXEC,SOURCE,TYPE,PPIEN,PTYP,N,NN,PARMS,MPARMS,MMAP,MPFL,MPNAME
  1. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA),EXEC=""
  1. S SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"E")
  1. S TYPE=$$GET1^DIQ(90505.01,IENS,.03,"I")
  1. ;
  1. I TYPE'="P" G DONE
  1. ;
  1. ; Find predefined panel
  1. I SOURCE="" G DONE
  1. S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_SOURCE_" was not found" Q
  1. ;
  1. S N=0,PARMS="",MPARMS=""
  1. F S N=$O(^BQICARE(OWNR,1,PLIEN,10,N)) Q:'N D
  1. . NEW DA,IENS,NAME,VALUE
  1. . S DA(2)=OWNR,DA(1)=PLIEN,DA=N,IENS=$$IENS^DILF(.DA)
  1. . S NAME=$$GET1^DIQ(90505.02,IENS,.01,"E")
  1. . S VALUE=$$GET1^DIQ(90505.02,IENS,.03,"E")
  1. . I VALUE="" S VALUE=$$GET1^DIQ(90505.02,IENS,.02,"E")
  1. . S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1. . S MPFL=$$MPF^BQIDCDF(SOURCE,NAME)
  1. . I MPFL D Q
  1. .. S MPNAME=$$MPN^BQIDCDF(SOURCE,NAME)
  1. .. I $G(VALUE)'="" D MLMP Q
  1. .. ;
  1. .. S NN=0
  1. .. F S NN=$O(^BQICARE(OWNR,1,PLIEN,10,N,1,NN)) Q:'NN D
  1. ... NEW DA,IENS
  1. ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
  1. ... S VALUE=$$GET1^DIQ(90505.21,IENS,.02,"E")
  1. ... I VALUE="" S VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
  1. ... I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
  1. ... D MLMP
  1. . I 'MPFL S MPARMS=NAME_"="
  1. . ;
  1. . ;S MPARMS=NAME_"="
  1. . I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
  1. . I '$D(^BQICARE(OWNR,1,PLIEN,10,N,1)) S MPARMS=MPARMS_VALUE
  1. . I $D(^BQICARE(OWNR,1,PLIEN,10,N,1)) D
  1. .. S NN=0
  1. .. F S NN=$O(^BQICARE(OWNR,1,PLIEN,10,N,1,NN)) Q:'NN D
  1. ... NEW DA,IENS
  1. ... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
  1. ... S VALUE=$$GET1^DIQ(90505.21,IENS,.02,"E")
  1. ... I VALUE="" S VALUE=$$GET1^DIQ(90505.21,IENS,.01,"E")
  1. ... I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
  1. ... S MPARMS=MPARMS_VALUE_$C(29)
  1. .. S MPARMS=$$TKO^BQIUL1(MPARMS,$C(29))
  1. . S PARMS=PARMS_MPARMS_$C(28)
  1. ; Check on mapping values
  1. I $D(MMAP)>0 D
  1. . S PNAME=""
  1. . F S PNAME=$O(MMAP(PNAME)) Q:PNAME="" D
  1. .. S PRIEN=$O(^BQI(90506,PPIEN,3,"B",PNAME,"")) I PRIEN="" Q
  1. .. S VALUE=MMAP(PNAME)
  1. .. S VLIEN=$O(^BQI(90506,PPIEN,3,PRIEN,3,"AC",VALUE,"")) I VLIEN="" Q
  1. .. S PARMS=PARMS_PNAME_"="_$P(^BQI(90506,PPIEN,3,PRIEN,3,VLIEN,0),U,1)_$C(28)
  1. S II=II+1
  1. S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
  1. S @DATA@(II)=PARMS_$C(30)
  1. ;
  1. DONE ;
  1. S II=II+1,@DATA@(II)=$C(31)
  1. Q
  1. ;
  1. MLMP ; Map the values
  1. I '$D(MMAP(MPNAME)) S MMAP(MPNAME)=NAME_"="_VALUE Q
  1. ;S $P(MMAP(MPNAME),"~",2)=NAME_"="_VALUE
  1. S MMAP(MPNAME)=MMAP(MPNAME)_"~"_NAME_"="_VALUE
  1. D CKMP(MPNAME)
  1. I $A($E(PARMS,$L(PARMS),$L(PARMS)))'=28 S PARMS=PARMS_$C(28)
  1. Q
  1. ;
  1. CKMP(PNAME) ;EP - Check mapping
  1. S PRIEN=$O(^BQI(90506,PPIEN,3,"B",PNAME,"")) I PRIEN="" Q
  1. S VALUE=MMAP(PNAME)
  1. S VLIEN=$O(^BQI(90506,PPIEN,3,PRIEN,3,"AC",VALUE,"")) I VLIEN="" Q
  1. I PARMS[VALUE Q
  1. I PARMS[PNAME D Q
  1. . S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
  1. . S PARMS=PARMS_$C(29)_$P(^BQI(90506,PPIEN,3,PRIEN,3,VLIEN,0),U,1)
  1. . K MMAP(PNAME)
  1. S PARMS=PARMS_PNAME_"="_$P(^BQI(90506,PPIEN,3,PRIEN,3,VLIEN,0),U,1)
  1. K MMAP(PNAME)
  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,OWNR,PLIEN,PARMS) ; EP -- BQI SET PANEL PARAMS
  1. ;
  1. ;Description
  1. ; Update or set the panel parameters
  1. ;Input
  1. ; OWNR - Owner of panel IEN
  1. ; PLIEN - Panel internal entry number
  1. ; PARMS - Parameters (if NULL, deletes ALL)
  1. ; if PARMS contain a $C(29), then that is
  1. ; a multiple value parameter
  1. ;
  1. NEW UID,II,BN,RESULT
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLPM",UID))
  1. K @DATA
  1. ;
  1. ; Check if share and has write access
  1. I '$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLPM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S PARMS=$G(PARMS,"")
  1. S @DATA@(II)="I00010RESULT"_$C(30)
  1. S RESULT=1 ; Initialize value
  1. ;
  1. D DEL(.OWNR,.PLIEN)
  1. ;
  1. NEW DA,IENS,EXEC,SOURCE,TYPE,PPIEN,PTYP,BQ,BQIUPD,BQVAL,BI,NVAL
  1. NEW PDATA,MVAL,PDA,QFL,BQII,ERROR,PQ,BN,LIST
  1. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA),EXEC=""
  1. S SOURCE=$$GET1^DIQ(90505.01,IENS,.11,"E")
  1. S TYPE=$$GET1^DIQ(90505.01,IENS,.03,"I")
  1. ;
  1. I SOURCE="" D G DONE
  1. . D DSC
  1. . S II=II+1,@DATA@(II)="1"_$C(30)
  1. ;
  1. I TYPE'="P" D G DONE
  1. . D DSC
  1. . S II=II+1,@DATA@(II)="1"_$C(30)
  1. ;
  1. ; Find predefined panel
  1. S PPIEN=$$PP^BQIDCDF(SOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_SOURCE_" was not found" Q
  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. 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. . S PTYP=$$PTYP^BQIDCDF(SOURCE,NAME)
  1. . I PTYP="C" S PQ=0 D Q:PQ
  1. .. NEW PRIEN,VLIEN,VDATA,BJ,CPARM,CNAME,CVAL
  1. .. S PRIEN=$O(^BQI(90506,PPIEN,3,"B",NAME,"")) I PRIEN="" Q
  1. .. I VALUE[$C(29) D
  1. ... F BI=1:1:$L(VALUE,$C(29)) S BQVAL=$P(VALUE,$C(29),BI) D PARS(BQVAL)
  1. .. I VALUE'[$C(29) D PARS(VALUE)
  1. .. S II=II+1,@DATA@(II)=RESULT_$C(30),PQ=1
  1. . ;
  1. . ; Create a new parameter record
  1. . S (DA,PDA)=$$ANP(OWNR,PLIEN,NAME)
  1. . I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1. . ;
  1. . ; Update the parameter with the values
  1. . S RESULT=$$UPP(OWNR,PLIEN,PDA,VALUE,PTYP)
  1. . I RESULT=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1. ;
  1. S II=II+1,@DATA@(II)=RESULT_$C(30)
  1. S II=II+1,@DATA@(II)=$C(31)
  1. ;
  1. DSC ; Generate special panel description
  1. NEW DA,IENS
  1. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1. K DESC
  1. D DESC^BQIPDSCM(OWNR,PLIEN,.DESC)
  1. ;D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
  1. D WP^DIE(90505.01,IENS,5,"","DESC")
  1. K DESC
  1. Q
  1. ;
  1. DEL(OWNR,PLIEN) ;EP - Remove the previous parameters
  1. NEW DA,IENS,DIK
  1. S DA(2)=OWNR,DA(1)=PLIEN,DA=0
  1. S DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",10,"
  1. F S DA=$O(^BQICARE(OWNR,1,PLIEN,10,DA)) Q:'DA D ^DIK
  1. Q
  1. ;
  1. ANP(OWNR,PLIEN,NAME) ; EP - Add new parameter
  1. NEW DA,IENS,DIC,DLAYGO
  1. S DA(2)=OWNR,DA(1)=PLIEN,X=NAME
  1. S DLAYGO=90505.02,DIC(0)="L",DIC("P")=DLAYGO
  1. S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",10,"
  1. I '$D(^BQICARE(DA(2),1,DA(1),10,0)) S ^BQICARE(DA(2),1,DA(1),10,0)="^90505.02^^"
  1. K DO,DD D FILE^DICN
  1. Q +Y
  1. ;
  1. UPP(OWNR,PLIEN,PDA,VALUE,PTYP) ;EP - Update values for a parameter
  1. NEW DA,IENS,RESULT
  1. S RESULT=1
  1. S DA(2)=OWNR,DA(1)=PLIEN,DA=PDA
  1. S IENS=$$IENS^DILF(.DA)
  1. I VALUE'[$C(29) D
  1. . I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1. . I PTYP="T" S BQIUPD(90505.02,IENS,.03)=VALUE
  1. . I PTYP'="T" S BQIUPD(90505.02,IENS,.02)=VALUE
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. . I $D(ERROR) S RESULT=-1
  1. ;
  1. I VALUE[$C(29) D
  1. . I '$D(^BQICARE(DA(2),1,DA(1),10,DA,1,0)) S ^BQICARE(DA(2),1,DA(1),10,DA,1,0)="^90505.21^^"
  1. . F BQII=1:1:$L(VALUE,$C(29)) D
  1. .. S MVAL=$P(VALUE,$C(29),BQII)
  1. .. NEW DA,IENS
  1. .. S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=PDA,X=MVAL
  1. .. S DLAYGO=90505.21,DIC(0)="L",DIC("P")=DLAYGO
  1. .. S DIC="^BQICARE("_DA(3)_",1,"_DA(2)_",10,"_DA(1)_",1,"
  1. .. K DO,DD D FILE^DICN
  1. .. I +Y=-1 S RESULT=-1
  1. .. I PTYP="D" S MVAL=$$DATE^BQIUL1(MVAL)
  1. .. S DA=+Y,IENS=$$IENS^DILF(.DA)
  1. .. I PTYP="T" S BQIUPD(90505.21,IENS,.02)=MVAL
  1. .. I PTYP'="T" S BQIUPD(90505.21,IENS,.01)=MVAL
  1. .. D FILE^DIE("","BQIUPD","ERROR")
  1. .. K BQIUPD
  1. .. I $D(ERROR) S RESULT=-1
  1. Q RESULT
  1. ;
  1. PARS(NVAL) ;EP
  1. N PRDATA,PRMN
  1. S VLIEN=$O(^BQI(90506,PPIEN,3,PRIEN,3,"B",NVAL,"")) I VLIEN="" Q
  1. S VDATA=$P(^BQI(90506,PPIEN,3,PRIEN,3,VLIEN,0),U,2)
  1. S PVAL="",PRMN=$L(VDATA,"~")
  1. F BJ=1:1 S CPARM=$P(VDATA,"~",BJ) Q:CPARM="" D
  1. . S CNAME=$P(CPARM,"=",1),CVAL=$P(CPARM,"=",2)
  1. . S PRDATA=$P(VDATA,"~",BJ+1)
  1. . I $P(PRDATA,"=",1)'=CNAME,PVAL="" D Q
  1. .. S (DA,PDA)=$$ANP(OWNR,PLIEN,CNAME)
  1. .. I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30) Q
  1. .. S RESULT=$$UPP(OWNR,PLIEN,PDA,CVAL,PTYP)
  1. .. I RESULT=-1 S II=II+1,@DATA@(II)=RESULT_$C(30) Q
  1. . S PVAL=PVAL_CVAL_$C(29)
  1. I PVAL'="" D
  1. . S (DA,PDA)=$$ANP(OWNR,PLIEN,CNAME)
  1. . I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30) Q
  1. . S CVAL=$$TKO^BQIUL1(PVAL,$C(29))
  1. . S RESULT=$$UPP(OWNR,PLIEN,PDA,CVAL,PTYP)
  1. . I RESULT=-1 S II=II+1,@DATA@(II)=RESULT_$C(30) Q
  1. Q
  1. ;
  1. CRMP ;
  1. S (DA,PDA)=$$ANP(OWNR,PLIEN,CNAME)
  1. I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q
  1. S CVAL=$$TKO^BQIUL1(PVAL,$C(29))
  1. S RESULT=$$UPP(OWNR,PLIEN,PDA,CVAL,PTYP)
  1. I RESULT=-1 S II=II+1,@DATA@(II)=RESULT_$C(30),QFL=1 Q
  1. Q