BQIPLADR.m

BQIPLADR ;VNGT/HS/ALA-Mail Merge RPC ; 12 May 2008  2:39 PM

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

 ;

 ;

EN(DATA,OWNR,PLIEN,PLIST) ; EP - BQI MAIL MERGE LIST

 ; Input

 ;   PLIST - List of patient IENs separated by $C(28)

 ;DUZ is assumed to be the user signed onto iCare.

 ;DFN is the Patient internal entry number

 ;

 NEW UID,II,ADATA,APCLPCNT,APCLPRNT,CITY,ZIP,STATE

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

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

 K @DATA

 ;

 S II=0

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

 ;

 D HDR

 S PLIST=$G(PLIST,""),OWNR=$G(OWNR,""),PLIEN=$G(PLIEN,"")

 ;

 I OWNR'="" D  G DONE

 . S DFN=0

 . F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D PARS

 ;

 I PLIST="" D

 . S LIST="",BN=""

 . F  S BN=$O(PLIST(BN)) Q:BN=""  S LIST=LIST_PLIST(BN)

 . K PLIST

 . S PLIST=LIST

 . K LIST

 F BQI=1:1 S DFN=$P(PLIST,$C(28),BQI) Q:DFN=""  D PARS

 ;

DONE ;

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

 Q

 ;

ERR ;

 D ^%ZTER

 N 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

 ;

HDR ;

 S @DATA@(II)="T00040Name^T00080Address_Line_1^T00080Address_Line_2^T00080Address_Line_3^T00015City^T00002State^T00010Zipcode^"

 S @DATA@(II)=@DATA@(II)_"T00020Home_Phone^T00020Business_Phone^T00020Alternate_Phone^T00030Community_of_Residence"_$C(30)

 Q

 ;

PARS ;

 NEW DA,EXE,X,NAME,ADR,APCLPRNM,PHN1,PHN2,COMM,PHN3

 S DA=$O(^APCLVSTS("B","First, Last Name",""))

 S EXE=^APCLVSTS(DA,3)

 X EXE

 S NAME=X

 S II=II+1,@DATA@(II)=NAME

 S DA=$O(^APCLVSTS("B","Mlg Address-Complete","")) I DA="" Q

 S EXE=^APCLVSTS(DA,3)

 X EXE

 S ADR=""

 S LAST=$O(APCLPRNM(""),-1)

 S ADATA=APCLPRNM(LAST) K APCLPRNM(LAST)

 ;

 F  S ADR=$O(APCLPRNM(ADR)) Q:ADR=""  D

 . S $P(@DATA@(II),U,1+ADR)=APCLPRNM(ADR)

 I APCLPCNT<4 S @DATA@(II)=@DATA@(II)_U

 I APCLPCNT<3 S @DATA@(II)=@DATA@(II)_U

 ;

 S CITY=$P(ADATA,",",1),RN=$L(ADATA," ")

 S ZIP=$P(ADATA," ",RN)

 S DA=$O(^APCLVSTS("B","Mlg Address-State Abbrv","")) I DA="" Q

 S EXE=^APCLVSTS(DA,3)

 X EXE

 S STATE=APCLPRNT

 S PHN1=$P($G(^DPT(DFN,.13)),U,1),PHN2=$P($G(^DPT(DFN,.13)),U,2)

 S PHN3=$P($G(^AUPNPAT(DFN,18)),U,1)

 S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"E")

 S @DATA@(II)=@DATA@(II)_U_CITY_U_STATE_U_ZIP_U_PHN1_U_PHN2_U_PHN3_U_COMM_$C(30)

 Q

 ;

GLS(DATA,FAKE) ;EP -- BQI GET MAIL MERGE GLOSSARY

 ;

 NEW UID,II,STIEN,IEN

 ;

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

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

 K @DATA

 ;

 S II=0

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

 ;

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

 S STIEN=$$SPM^BQIGPUTL()

 S IEN=0

 F  S IEN=$O(^BQI(90508,STIEN,17,IEN)) Q:'IEN  D

 . S II=II+1,@DATA@(II)=^BQI(90508,STIEN,17,IEN,0)

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

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

 Q

BQIPLADR  ;VNGT/HS/ALA-Mail Merge RPC ; 12 May 2008  2:39 PM

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

 +2       ;

 +3       ;

EN(DATA,OWNR,PLIEN,PLIST) ; EP - BQI MAIL MERGE LIST

 +1       ; Input

 +2       ;   PLIST - List of patient IENs separated by $C(28)

 +3       ;DUZ is assumed to be the user signed onto iCare.

 +4       ;DFN is the Patient internal entry number

 +5       ;

 +6        NEW UID,II,ADATA,APCLPCNT,APCLPRNT,CITY,ZIP,STATE

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

 +8        SET DATA=$NAME(^TMP("BQIPLADR",UID))

 +9        KILL @DATA

 +10      ;

 +11       SET II=0

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +13      ;

 +14       DO HDR

 +15       SET PLIST=$GET(PLIST,"")

           SET OWNR=$GET(OWNR,"")

           SET PLIEN=$GET(PLIEN,"")

 +16      ;

 +17       IF OWNR'=""

               Begin DoDot:1

 +18               SET DFN=0

 +19               FOR 

                       SET DFN=$ORDER(^BQICARE(OWNR,1,PLIEN,40,DFN))

                       IF 'DFN

                           QUIT 

                       DO PARS

               End DoDot:1

               GOTO DONE

 +20      ;

 +21       IF PLIST=""

               Begin DoDot:1

 +22               SET LIST=""

                   SET BN=""

 +23               FOR 

                       SET BN=$ORDER(PLIST(BN))

                       IF BN=""

                           QUIT 

                       SET LIST=LIST_PLIST(BN)

 +24               KILL PLIST

 +25               SET PLIST=LIST

 +26               KILL LIST

               End DoDot:1

 +27       FOR BQI=1:1

               SET DFN=$PIECE(PLIST,$CHAR(28),BQI)

               IF DFN=""

                   QUIT 

               DO PARS

 +28      ;

DONE      ;

 +1        SET II=II+1

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

 +2        QUIT 

 +3       ;

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       ;

HDR       ;

 +1        SET @DATA@(II)="T00040Name^T00080Address_Line_1^T00080Address_Line_2^T00080Address_Line_3^T00015City^T00002State^T00010Zipcode^"

 +2        SET @DATA@(II)=@DATA@(II)_"T00020Home_Phone^T00020Business_Phone^T00020Alternate_Phone^T00030Community_of_Residence"_$CHAR(30)

 +3        QUIT 

 +4       ;

PARS      ;

 +1        NEW DA,EXE,X,NAME,ADR,APCLPRNM,PHN1,PHN2,COMM,PHN3

 +2        SET DA=$ORDER(^APCLVSTS("B","First, Last Name",""))

 +3        SET EXE=^APCLVSTS(DA,3)

 +4        XECUTE EXE

 +5        SET NAME=X

 +6        SET II=II+1

           SET @DATA@(II)=NAME

 +7        SET DA=$ORDER(^APCLVSTS("B","Mlg Address-Complete",""))

           IF DA=""

               QUIT 

 +8        SET EXE=^APCLVSTS(DA,3)

 +9        XECUTE EXE

 +10       SET ADR=""

 +11       SET LAST=$ORDER(APCLPRNM(""),-1)

 +12       SET ADATA=APCLPRNM(LAST)

           KILL APCLPRNM(LAST)

 +13      ;

 +14       FOR 

               SET ADR=$ORDER(APCLPRNM(ADR))

               IF ADR=""

                   QUIT 

               Begin DoDot:1

 +15               SET $PIECE(@DATA@(II),U,1+ADR)=APCLPRNM(ADR)

               End DoDot:1

 +16       IF APCLPCNT<4

               SET @DATA@(II)=@DATA@(II)_U

 +17       IF APCLPCNT<3

               SET @DATA@(II)=@DATA@(II)_U

 +18      ;

 +19       SET CITY=$PIECE(ADATA,",",1)

           SET RN=$LENGTH(ADATA," ")

 +20       SET ZIP=$PIECE(ADATA," ",RN)

 +21       SET DA=$ORDER(^APCLVSTS("B","Mlg Address-State Abbrv",""))

           IF DA=""

               QUIT 

 +22       SET EXE=^APCLVSTS(DA,3)

 +23       XECUTE EXE

 +24       SET STATE=APCLPRNT

 +25       SET PHN1=$PIECE($GET(^DPT(DFN,.13)),U,1)

           SET PHN2=$PIECE($GET(^DPT(DFN,.13)),U,2)

 +26       SET PHN3=$PIECE($GET(^AUPNPAT(DFN,18)),U,1)

 +27       SET COMM=$$GET1^DIQ(9000001,DFN_",",1117,"E")

 +28       SET @DATA@(II)=@DATA@(II)_U_CITY_U_STATE_U_ZIP_U_PHN1_U_PHN2_U_PHN3_U_COMM_$CHAR(30)

 +29       QUIT 

 +30      ;

GLS(DATA,FAKE) ;EP -- BQI GET MAIL MERGE GLOSSARY

 +1       ;

 +2        NEW UID,II,STIEN,IEN

 +3       ;

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

 +5        SET DATA=$NAME(^TMP("BQIMMHLP",UID))

 +6        KILL @DATA

 +7       ;

 +8        SET II=0

 +9       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +10      ;

 +11       SET @DATA@(II)="T32767TEXT"_$CHAR(30)

 +12       SET STIEN=$$SPM^BQIGPUTL()

 +13       SET IEN=0

 +14       FOR 

               SET IEN=$ORDER(^BQI(90508,STIEN,17,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +15               SET II=II+1

                   SET @DATA@(II)=^BQI(90508,STIEN,17,IEN,0)

               End DoDot:1

 +16       SET @DATA@(II)=@DATA@(II)_$CHAR(30)

 +17       SET II=II+1

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

 +18       QUIT