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
