BQIPLMY.m

BQIPLMY ;PRXM/HC/ALA-Get "My Patients" Definition ; 29 Nov 2005  4:59 PM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 Q

 ;

RET(DATA,OWNR) ;  EP - BQI GET USER MY PATIENTS DEF

 ;

 ;Description

 ;  Retrieve all the defined "my patients" definitions for an owner

 ;  

 ;Input

 ;  OWNR - Person to retrieve the "my patients" definition for

 ;         If not defined, it is assumed to be the user

 ;  

 ;Output

 ;  DATA  - name of global (passed by reference) in which the data

 ;          is stored

 ;Assumes

 ;  DUZ - User who signed onto iCare

 ;

 NEW UID,II,MIEN,PARMS,PIEN,PMIEN,VALUE,X

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLMY",UID))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLMY D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S OWNR=$G(OWNR,"") S:OWNR="" OWNR=DUZ

 S @DATA@(II)="T00030SOURCE_NAME^T00250GENERATED_DESCRIPTION^T03200PARMS"_$C(30)

 ;

 S MIEN=0

 F  S MIEN=$O(^BQICARE(OWNR,7,MIEN)) Q:'MIEN  D

 . NEW DA,IENS

 . S DA(1)=OWNR,DA=MIEN,IENS=$$IENS^DILF(.DA)

 . S II=II+1

 . S @DATA@(II)=$$GET1^DIQ(90505.07,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.07,IENS,2,"E")_"^"

 . S PIEN=0,PARMS=""

 . F  S PIEN=$O(^BQICARE(OWNR,7,MIEN,10,PIEN)) Q:'PIEN  D

 .. NEW DA,IENS

 .. S DA(2)=OWNR,DA(1)=MIEN,DA=PIEN,IENS=$$IENS^DILF(.DA)

 .. S PARMS=PARMS_$$GET1^DIQ(90505.08,IENS,.01,"E")_"="

 .. ;

 .. ;  Check for multiple values

 .. S PMIEN=0

 .. F  S PMIEN=$O(^BQICARE(OWNR,7,MIEN,10,PIEN,1,PMIEN)) Q:'PMIEN  D

 ... NEW DA,IENS

 ... S DA(3)=OWNR,DA(2)=MIEN,DA(1)=PIEN,DA=PMIEN,IENS=$$IENS^DILF(.DA)

 ... S VALUE=$S($$GET1^DIQ(90505.81,IENS,.02,"E")'="":$$GET1^DIQ(90505.81,IENS,.02,"E"),1:$$GET1^DIQ(90505.81,IENS,.01,"E"))

 ... S PARMS=PARMS_VALUE_$C(29)

 .. ; remove trailing $C(29)

 .. S PARMS=$$TKO^BQIUL1(PARMS,$C(29))

 .. S VALUE=$S($$GET1^DIQ(90505.08,IENS,.02,"E")'="":$$GET1^DIQ(90505.08,IENS,.02,"E"),1:$$GET1^DIQ(90505.08,IENS,.03,"E"))

 .. S PARMS=PARMS_VALUE_$C(28)

 . ; remove trailing $C(28)

 . S PARMS=$$TKO^BQIUL1(PARMS,$C(28))

 . S @DATA@(II)=@DATA@(II)_PARMS_$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

 ;

DEL ;  Delete the previous 'My Patients' definitions

 NEW DA,DIK

 S DA(1)=OWNR,DA=0,DIK="^BQICARE("_DA(1)_",7,"

 F  S DA=$O(^BQICARE(OWNR,7,DA)) Q:'DA  D ^DIK

 Q

 ;

UPD(DATA,SRCNM,PARMS) ;  EP - BQI SET USER MY PATIENTS DEF

 ;Input

 ;  SRCNM - Source Name of the My Patient definition

 ;  PARMS - Parameters for the source

 ;Assumes

 ;  DUZ - User who signed onto iCare

 ;

 NEW UID,II,MIEN,PIEN,PMIEN,VALUE,X,PPIEN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPLMY",UID))

 K @DATA

 ;

 I '$$OWNR^BQIPLUSR(DUZ) S BMXSEC="There is a problem with your entry." Q

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLMY D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S PARMS=$G(PARMS,"")

 S PPIEN=$$PP^BQIDCDF(SRCNM) I PPIEN=-1 S BMXSEC="Source not found." Q

 S @DATA@(II)="I00010RESULT"_$C(30)

 ;

 NEW DA,DIC,DLAYGO,BDATA,BQ,BQI,ALDA,QFL

 S DA(1)=DUZ,X=SRCNM

 S DLAYGO=90505.07,DIC(0)="LNXZ"

 S DIC="^BQICARE("_DA(1)_",7,"

 I '$D(^BQICARE(DA(1),7,0)) S ^BQICARE(DA(1),7,0)="^90505.07P^^"

 D ^DIC

 S ALDA=+Y

 I ALDA=-1 S II=II+1,@DATA@(II)="-1"_$C(30) G DONE

 ;

 ;  delete parameters before storing new values

 NEW DA,DIK,PN

 S DA(2)=DUZ,DA(1)=ALDA,DIK="^BQICARE("_DA(2)_",7,"_DA(1)_",10,",PN=0

 F  S PN=$O(^BQICARE(DA(2),7,DA(1),10,PN)) Q:'PN  S DA=PN D ^DIK

 ;

 NEW QFL,BQ,BDATA,PTYP,BQI,VALUE,MVAL,NAME,PDA

 S QFL=0

 F BQ=1:1:$L(PARMS,$C(28)) D  G DONE:QFL

 . S BDATA=$P(PARMS,$C(28),BQ) Q:BDATA=""

 . S NAME=$P(BDATA,"=",1),VALUE=$P(BDATA,"=",2,99)

 . S PTYP=$$PTYP^BQIDCDF(SRCNM,NAME)

 . NEW DA,IENS,DIC

 . S DA(2)=DUZ,DA(1)=ALDA,X=NAME

 . S DLAYGO=90505.08,DIC(0)="L",DIC("P")=DLAYGO

 . S DIC="^BQICARE("_DA(2)_",7,"_DA(1)_",10,"

 . I '$D(^BQICARE(DA(2),7,DA(1),10,0)) S ^BQICARE(DA(2),7,DA(1),10,0)="^90505.08^^"

 . K DO,DD D FILE^DICN

 . S (DA,PDA)=+Y

 . I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q

 . ;

 . NEW DA,IENS

 . S DA(2)=DUZ,DA(1)=ALDA,DA=PDA

 . S IENS=$$IENS^DILF(.DA)

 . I VALUE'[$C(29) D  Q

 .. I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)

 .. I PTYP="T" S BQIUPD(90505.08,IENS,.03)=VALUE

 .. I PTYP'="T" S BQIUPD(90505.08,IENS,.02)=VALUE

 .. D FILE^DIE("","BQIUPD","ERROR")

 .. K BQIUPD

 . ;

 . I VALUE[$C(29) D  Q:QFL

 .. I '$D(^BQICARE(DA(2),7,DA(1),1,DA,1,0)) S ^BQICARE(DA(2),7,DA(1),1,DA,1,0)="^90505.81^^"

 .. F BQI=1:1:$L(VALUE,$C(29)) D

 ... S MVAL=$P(VALUE,$C(29),BQI)

 ... NEW DA,IENS

 ... S DA(3)=DUZ,DA(2)=ALDA,DA(1)=PDA,X=MVAL

 ... S DLAYGO=90505.81,DIC(0)="L",DIC("P")=DLAYGO

 ... S DIC="^BQICARE("_DA(3)_",7,"_DA(2)_",10,"_DA(1)_",1,"

 ... K DO,DD D FILE^DICN

 ... S DA=+Y

 ... I DA=-1 S II=II+1,@DATA@(II)="-1"_$C(30),QFL=1 Q

 ... I PTYP="D" S MVAL=$$DATE^BQIUL1(MVAL)

 ... S IENS=$$IENS^DILF(.DA)

 ... I PTYP="T" S BQIUPD(90505.81,IENS,.02)=MVAL

 ... D FILE^DIE("","BQIUPD","ERROR")

 ... K BQIUPD

 ;

DSC ; Update generated description

 S ALDA=0

 F  S ALDA=$O(^BQICARE(DUZ,7,ALDA)) Q:'ALDA  D

 . NEW DA,IENS

 . S DA(1)=DUZ,DA=ALDA,IENS=$$IENS^DILF(.DA)

 . S BQIUPD(90505.07,IENS,2)=$$MEN^BQIPLDSC(DUZ,ALDA)

 . D FILE^DIE("","BQIUPD","ERROR")

 . K BQIUPD

 ;

 S II=II+1,@DATA@(II)="1"_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

 ;

 Q

BQIPLMY   ;PRXM/HC/ALA-Get "My Patients" Definition ; 29 Nov 2005  4:59 PM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3        QUIT 

 +4       ;

RET(DATA,OWNR) ;  EP - BQI GET USER MY PATIENTS DEF

 +1       ;

 +2       ;Description

 +3       ;  Retrieve all the defined "my patients" definitions for an owner

 +4       ;  

 +5       ;Input

 +6       ;  OWNR - Person to retrieve the "my patients" definition for

 +7       ;         If not defined, it is assumed to be the user

 +8       ;  

 +9       ;Output

 +10      ;  DATA  - name of global (passed by reference) in which the data

 +11      ;          is stored

 +12      ;Assumes

 +13      ;  DUZ - User who signed onto iCare

 +14      ;

 +15       NEW UID,II,MIEN,PARMS,PIEN,PMIEN,VALUE,X

 +16       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +17       SET DATA=$NAME(^TMP("BQIPLMY",UID))

 +18       KILL @DATA

 +19      ;

 +20       SET II=0

 +21      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLMY D UNWIND^%ZTER"

 +22      ;

 +23       SET OWNR=$GET(OWNR,"")

           IF OWNR=""

               SET OWNR=DUZ

 +24       SET @DATA@(II)="T00030SOURCE_NAME^T00250GENERATED_DESCRIPTION^T03200PARMS"_$CHAR(30)

 +25      ;

 +26       SET MIEN=0

 +27       FOR 

               SET MIEN=$ORDER(^BQICARE(OWNR,7,MIEN))

               IF 'MIEN

                   QUIT 

               Begin DoDot:1

 +28               NEW DA,IENS

 +29               SET DA(1)=OWNR

                   SET DA=MIEN

                   SET IENS=$$IENS^DILF(.DA)

 +30               SET II=II+1

 +31               SET @DATA@(II)=$$GET1^DIQ(90505.07,IENS,.01,"E")_"^"_$$GET1^DIQ(90505.07,IENS,2,"E")_"^"

 +32               SET PIEN=0

                   SET PARMS=""

 +33               FOR 

                       SET PIEN=$ORDER(^BQICARE(OWNR,7,MIEN,10,PIEN))

                       IF 'PIEN

                           QUIT 

                       Begin DoDot:2

 +34                       NEW DA,IENS

 +35                       SET DA(2)=OWNR

                           SET DA(1)=MIEN

                           SET DA=PIEN

                           SET IENS=$$IENS^DILF(.DA)

 +36                       SET PARMS=PARMS_$$GET1^DIQ(90505.08,IENS,.01,"E")_"="

 +37      ;

 +38      ;  Check for multiple values

 +39                       SET PMIEN=0

 +40                       FOR 

                               SET PMIEN=$ORDER(^BQICARE(OWNR,7,MIEN,10,PIEN,1,PMIEN))

                               IF 'PMIEN

                                   QUIT 

                               Begin DoDot:3

 +41                               NEW DA,IENS

 +42                               SET DA(3)=OWNR

                                   SET DA(2)=MIEN

                                   SET DA(1)=PIEN

                                   SET DA=PMIEN

                                   SET IENS=$$IENS^DILF(.DA)

 +43                               SET VALUE=$SELECT($$GET1^DIQ(90505.81,IENS,.02,"E")'="":$$GET1^DIQ(90505.81,IENS,.02,"E"),1:$$GET1^DIQ(90505.81,IENS,.01,"E"))

 +44                               SET PARMS=PARMS_VALUE_$CHAR(29)

                               End DoDot:3

 +45      ; remove trailing $C(29)

 +46                       SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(29))

 +47                       SET VALUE=$SELECT($$GET1^DIQ(90505.08,IENS,.02,"E")'="":$$GET1^DIQ(90505.08,IENS,.02,"E"),1:$$GET1^DIQ(90505.08,IENS,.03,"E"))

 +48                       SET PARMS=PARMS_VALUE_$CHAR(28)

                       End DoDot:2

 +49      ; remove trailing $C(28)

 +50               SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(28))

 +51               SET @DATA@(II)=@DATA@(II)_PARMS_$CHAR(30)

               End DoDot:1

 +52      ;

DONE       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +1        QUIT 

 +2       ;

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       ;

DEL       ;  Delete the previous 'My Patients' definitions

 +1        NEW DA,DIK

 +2        SET DA(1)=OWNR

           SET DA=0

           SET DIK="^BQICARE("_DA(1)_",7,"

 +3        FOR 

               SET DA=$ORDER(^BQICARE(OWNR,7,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +4        QUIT 

 +5       ;

UPD(DATA,SRCNM,PARMS) ;  EP - BQI SET USER MY PATIENTS DEF

 +1       ;Input

 +2       ;  SRCNM - Source Name of the My Patient definition

 +3       ;  PARMS - Parameters for the source

 +4       ;Assumes

 +5       ;  DUZ - User who signed onto iCare

 +6       ;

 +7        NEW UID,II,MIEN,PIEN,PMIEN,VALUE,X,PPIEN

 +8        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +9        SET DATA=$NAME(^TMP("BQIPLMY",UID))

 +10       KILL @DATA

 +11      ;

 +12       IF '$$OWNR^BQIPLUSR(DUZ)

               SET BMXSEC="There is a problem with your entry."

               QUIT 

 +13      ;

 +14       SET II=0

 +15      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPLMY D UNWIND^%ZTER"

 +16      ;

 +17       SET PARMS=$GET(PARMS,"")

 +18       SET PPIEN=$$PP^BQIDCDF(SRCNM)

           IF PPIEN=-1

               SET BMXSEC="Source not found."

               QUIT 

 +19       SET @DATA@(II)="I00010RESULT"_$CHAR(30)

 +20      ;

 +21       NEW DA,DIC,DLAYGO,BDATA,BQ,BQI,ALDA,QFL

 +22       SET DA(1)=DUZ

           SET X=SRCNM

 +23       SET DLAYGO=90505.07

           SET DIC(0)="LNXZ"

 +24       SET DIC="^BQICARE("_DA(1)_",7,"

 +25       IF '$DATA(^BQICARE(DA(1),7,0))

               SET ^BQICARE(DA(1),7,0)="^90505.07P^^"

 +26       DO ^DIC

 +27       SET ALDA=+Y

 +28       IF ALDA=-1

               SET II=II+1

               SET @DATA@(II)="-1"_$CHAR(30)

               GOTO DONE

 +29      ;

 +30      ;  delete parameters before storing new values

 +31       NEW DA,DIK,PN

 +32       SET DA(2)=DUZ

           SET DA(1)=ALDA

           SET DIK="^BQICARE("_DA(2)_",7,"_DA(1)_",10,"

           SET PN=0

 +33       FOR 

               SET PN=$ORDER(^BQICARE(DA(2),7,DA(1),10,PN))

               IF 'PN

                   QUIT 

               SET DA=PN

               DO ^DIK

 +34      ;

 +35       NEW QFL,BQ,BDATA,PTYP,BQI,VALUE,MVAL,NAME,PDA

 +36       SET QFL=0

 +37       FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +38               SET BDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF BDATA=""

                       QUIT 

 +39               SET NAME=$PIECE(BDATA,"=",1)

                   SET VALUE=$PIECE(BDATA,"=",2,99)

 +40               SET PTYP=$$PTYP^BQIDCDF(SRCNM,NAME)

 +41               NEW DA,IENS,DIC

 +42               SET DA(2)=DUZ

                   SET DA(1)=ALDA

                   SET X=NAME

 +43               SET DLAYGO=90505.08

                   SET DIC(0)="L"

                   SET DIC("P")=DLAYGO

 +44               SET DIC="^BQICARE("_DA(2)_",7,"_DA(1)_",10,"

 +45               IF '$DATA(^BQICARE(DA(2),7,DA(1),10,0))

                       SET ^BQICARE(DA(2),7,DA(1),10,0)="^90505.08^^"

 +46               KILL DO,DD

                   DO FILE^DICN

 +47               SET (DA,PDA)=+Y

 +48               IF DA=-1

                       SET II=II+1

                       SET @DATA@(II)="-1"_$CHAR(30)

                       SET QFL=1

                       QUIT 

 +49      ;

 +50               NEW DA,IENS

 +51               SET DA(2)=DUZ

                   SET DA(1)=ALDA

                   SET DA=PDA

 +52               SET IENS=$$IENS^DILF(.DA)

 +53               IF VALUE'[$CHAR(29)

                       Begin DoDot:2

 +54                       IF PTYP="D"

                               SET VALUE=$$DATE^BQIUL1(VALUE)

 +55                       IF PTYP="T"

                               SET BQIUPD(90505.08,IENS,.03)=VALUE

 +56                       IF PTYP'="T"

                               SET BQIUPD(90505.08,IENS,.02)=VALUE

 +57                       DO FILE^DIE("","BQIUPD","ERROR")

 +58                       KILL BQIUPD

                       End DoDot:2

                       QUIT 

 +59      ;

 +60               IF VALUE[$CHAR(29)

                       Begin DoDot:2

 +61                       IF '$DATA(^BQICARE(DA(2),7,DA(1),1,DA,1,0))

                               SET ^BQICARE(DA(2),7,DA(1),1,DA,1,0)="^90505.81^^"

 +62                       FOR BQI=1:1:$LENGTH(VALUE,$CHAR(29))

                               Begin DoDot:3

 +63                               SET MVAL=$PIECE(VALUE,$CHAR(29),BQI)

 +64                               NEW DA,IENS

 +65                               SET DA(3)=DUZ

                                   SET DA(2)=ALDA

                                   SET DA(1)=PDA

                                   SET X=MVAL

 +66                               SET DLAYGO=90505.81

                                   SET DIC(0)="L"

                                   SET DIC("P")=DLAYGO

 +67                               SET DIC="^BQICARE("_DA(3)_",7,"_DA(2)_",10,"_DA(1)_",1,"

 +68                               KILL DO,DD

                                   DO FILE^DICN

 +69                               SET DA=+Y

 +70                               IF DA=-1

                                       SET II=II+1

                                       SET @DATA@(II)="-1"_$CHAR(30)

                                       SET QFL=1

                                       QUIT 

 +71                               IF PTYP="D"

                                       SET MVAL=$$DATE^BQIUL1(MVAL)

 +72                               SET IENS=$$IENS^DILF(.DA)

 +73                               IF PTYP="T"

                                       SET BQIUPD(90505.81,IENS,.02)=MVAL

 +74                               DO FILE^DIE("","BQIUPD","ERROR")

 +75                               KILL BQIUPD

                               End DoDot:3

                       End DoDot:2

                       IF QFL

                           QUIT 

               End DoDot:1

               IF QFL

                   GOTO DONE

 +76      ;

DSC       ; Update generated description

 +1        SET ALDA=0

 +2        FOR 

               SET ALDA=$ORDER(^BQICARE(DUZ,7,ALDA))

               IF 'ALDA

                   QUIT 

               Begin DoDot:1

 +3                NEW DA,IENS

 +4                SET DA(1)=DUZ

                   SET DA=ALDA

                   SET IENS=$$IENS^DILF(.DA)

 +5                SET BQIUPD(90505.07,IENS,2)=$$MEN^BQIPLDSC(DUZ,ALDA)

 +6                DO FILE^DIE("","BQIUPD","ERROR")

 +7                KILL BQIUPD

               End DoDot:1

 +8       ;

 +9        SET II=II+1

           SET @DATA@(II)="1"_$CHAR(30)

 +10       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +11      ;

 +12       QUIT