DGREGARP ;ALB/DW,ERC-Address audit reports ; 8/1/08 1:21pm
;;5.3;PIMS;**522,560,1015,1016**;JUN 30, 2012;Build 20
EN(TYPE) ;Entry point
N DGRNG,XMY,XMSUB,XMDUZ,XMTEXT,DGSRT,DGTOTAL
K ^TMP($J,"DG ADD CHNG")
K ^TMP($J,"DG BEFORE")
I ($G(TYPE)'="ALL")&($G(TYPE)'="RX") Q
;If mail group has no member or remote-member
I '$$MEMBER() D Q
. I '$D(ZTQUEUED) W !!,"DG DAILY ADDRESS CHANGE does not have a member. Report not sent." D EOP^DGREGAED
;Entry from TaskMan
I $D(ZTQUEUED) D Q
. D PRINT
;User runs the option
I '$D(ZTQUEUED) D
. W !!,"The report will be sent to mail group DG DAILY ADDRESS CHANGE."
. D QUE
. W !! D EOP^DGREGAED
Q
MEMBER() ;Return 0 if mail group has no local or remote member
N RESULT,DGIEN,DGRMT
S RESULT=1
S DGIEN=$$FIND1^DIC(3.8,"","X","DG DAILY ADDRESS CHANGE")
D LIST^DIC(3.812,","_DGIEN_",",.01,"P","","","","","","","DGRMT")
I ($P($G(DGRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("DG DAILY ADDRESS CHANGE")) S RESULT=0
Q RESULT
QUE ;Que the task if user invokes option
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
W !
S ZTIO=""
S ZTSAVE("TYPE")=""
S ZTRTN="PRINT^DGREGARP"
S ZTDESC="DG "_$G(TYPE)_" ADDRESS CHANGE REPORT"
D ^%ZTLOAD
D ^%ZISC,HOME^%ZIS
W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
Q
PRESORT ;Sort for the report
N DGRNG
D RANGE(.DGRNG)
I DGRNG=-1 Q
D SORT(.DGRNG,TYPE)
Q
PRINT ;Create the email message.
N DGLINE,DFN,SSN,IEN
S (DGLINE,DFN,SSN,IEN)=0
D CHKPAR
D HEADER
D PRESORT
D REPORT
D TOTAL
D EMAIL(TYPE)
Q
;
REPORT ;Create the address change report body
N DGNAME,DGSSN,DGDFN
N DGR,DGUSER,DGDATE,DGSRC,DG12
N DGA,DGFOR,DGN,DGO
N DGPRSCRP
S (DGNAME,DGSSN,DGDFN)=""
F S DGNAME=$O(^TMP($J,"DG BEFORE",DGNAME)) Q:DGNAME="" D
. S DGSSN=""
. F S DGSSN=$O(^TMP($J,"DG BEFORE",DGNAME,DGSSN)) Q:DGSSN="" D
.. S DGDFN=""
.. F S DGDFN=$O(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN)) Q:DGDFN="" D
... D GEN(DGNAME,DGSSN,DGDFN)
... D OLD(DGNAME,DGSSN,DGDFN)
... D NEW(DGNAME,DGSSN,DGDFN)
... D PRSCPT(DGDFN)
Q
GEN(DGNAME,DGSSN,DGDFN) ;General information for each patient
K DGR
D GETS^DIQ(2,DGDFN_",",".122;.118;.119;.12","E","DGR")
S DGUSER=$G(DGR(2,DGDFN_",",.122,"E"))
S DGDATE=$G(DGR(2,DGDFN_",",.118,"E"))
S DGSRC=$G(DGR(2,DGDFN_",",.119,"E"))
S DG12=$G(DGR(2,DGDFN_",",.12,"E"))
D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=""
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" PATIENT: "_DGNAME_" SSN: "_$E(DGSSN,6,10)
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" USER: "_DGUSER_" DATE: "_DGDATE
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" SOURCE: "_DGSRC_" "_DG12
Q
OLD(DGNAME,DGSSN,DGDFN) ;Get address as of 24 hours ago, assuming audits are on for all
S DGO("ADD1")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.111))
S DGO("ADD2")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.112))
S DGO("ADD3")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.113))
S DGO("CITY")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.114))
S DGO("ST")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.115))
S DGO("ZIP")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1112))
S DGO("CNTY")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.117))
S DGO("PROV")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1171))
S DGO("PCODE")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1172))
S DGO("CNTRY")=$G(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1173))
S DGFOR=$$FOR^DGADDUTL(DGO("CNTRY"))
I $G(DGO("CNTRY"))]"" D CNTRY^DGADDUT2(.DGO)
S DGO("TAG")="BEFORE"
D DISP(.DGO)
S DGFOR=0
Q
DISP(DGA) ;
D LNPLUS
S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_DGA("TAG")_": "_DGA("ADD1")
I $G(DGA("ADD2"))'="" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_DGA("ADD2")
I $G(DGA("ADD3"))'="" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_DGA("ADD3")
I 'DGFOR D
. I (DGA("CITY")'="")!(DGA("ST")'="") D
. . D LNPLUS
. . S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_DGA("CITY")_","_DGA("ST")_" "_DGA("ZIP")
I (DGA("CNTY")'="") D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_"COUNTY CODE: "_DGA("CNTY")
I DGFOR D
. I (DGA("CITY")'="")!(DGA("PROV")'="") D
.. D LNPLUS
.. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_$S(DGA("PCODE")]"":DGA("PCODE")_" ",1:"")_DGA("CITY")_","_DGA("PROV")
I DGA("CNTRY")]"" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_DGA("CNTRY")
I $G(DGA("HPHN"))'="" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_"PHONE(H): "_DGA("HPHN")
I $G(DGA("OPHN"))'="" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" "_"PHONE(O): "_DGA("OPHN")
Q
NEW(DGNAME,DGSSN,DGDFN) ;Get current address
K DGCURR
D GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117:1173;.119;.12;.1112;.131;.132","E","DGCURR")
S DGN("ADD1")=$G(DGCURR(2,DGDFN_",",.111,"E"))
S DGN("ADD2")=$G(DGCURR(2,DGDFN_",",.112,"E"))
S DGN("ADD3")=$G(DGCURR(2,DGDFN_",",.113,"E"))
S DGN("CITY")=$G(DGCURR(2,DGDFN_",",.114,"E"))
S DGN("ST")=$G(DGCURR(2,DGDFN_",",.115,"E"))
S DGN("ZIP")=$G(DGCURR(2,DGDFN_",",.1112,"E"))
S DGN("CNTY")=$G(DGCURR(2,DGDFN_",",.117,"E"))
S DGN("OPHN")=$G(DGCURR(2,DGDFN_",",.132,"E"))
S DGN("HPHN")=$G(DGCURR(2,DGDFN_",",.131,"E"))
S DGN("PROV")=$G(DGCURR(2,DGDFN_",",.1171,"E"))
S DGN("PCODE")=$G(DGCURR(2,DGDFN_",",.1172,"E"))
S DGN("CNTRY")=$G(DGCURR(2,DGDFN_",",.1173,"E"))
S DGFOR=$$FOR^DGADDUTL(DGN("CNTRY"))
I $G(DGN("CNTRY"))]"" D CNTRY^DGADDUT2(.DGN)
S DGN("TAG")="AFTER"
D DISP(.DGN)
Q
PRSCPT(DGDFN) ;Display if the patient has active prescription
S DGPRSCRP=$$EN^PSSRXACT(DGDFN)
I $G(DGPRSCRP)=1 D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)="Patient has active pharmacy prescription(s)"
Q
EXIT S:$D(ZTQUEUED) ZTREQ="@"
K ^TMP($J,"DG ADD CHNG")
K ^TMP($J,"DG BEFORE")
Q
CHKPAR ;Check if audit is on for the fields
N DGR,DGN,DGFLD
F DGN=.111,.112,.113,.114,.115,.116,.117,.1171,.1172,.1173,.1112 D
. K DGR
. D FIELD^DID(2,DGN,"","LABEL;AUDIT","DGR")
. I $D(DGR("DIERR")) Q
. I ($G(DGR("AUDIT"))'["YES")&($G(DGR("AUDIT"))'["EDITED OR DELETED") D
.. D LNPLUS^DGREGARP
.. S ^TMP($J,"DG ADD CHNG",DGLINE)="Audit is off for the "_$G(DGR("LABEL"))_" field"
Q
RANGE(RESULT) ;Get the range of the reports
K RESULT
N DGBEGIN,DGEND,DGNOW,DGAGO
N X,X1,X2
D NOW^%DTC
S DGNOW=%
S X1=%,X2="-1" D C^%DTC
S DGAGO=X
S DGNOW=$O(^DIA(2,"C",DGNOW),-1)
S DGAGO=$O(^DIA(2,"C",DGAGO))
I ($G(DGNOW)="")!($G(DGAGO)="") S RESULT=-1 Q
S (DGBEGIN,DGEND)=""
S DGBEGIN=$O(^DIA(2,"C",DGNOW,DGBEGIN),-1)
S DGEND=$O(^DIA(2,"C",DGAGO,DGEND))
I $G(DGBEGIN)=""!$G(DGEND)="" S RESULT=-1 Q
S DGBEGIN=DGBEGIN+1
S RESULT=DGBEGIN_U_DGEND
Q
SORT(RANGE,TYPE) ;Build the temp global to display
N DGBEGIN,DGEND,DGIEN,DGDFN,DGFLD
S DGIEN=$P($G(RANGE),U)
S DGEND=$P($G(RANGE),U,2)
F S DGIEN=$O(^DIA(2,DGIEN),-1) Q:DGIEN<DGEND D:$$SCRN(TYPE,DGIEN)
. D BUILD(TYPE,DGIEN)
Q
SCRN(TYPE,DGIEN) ;Screen Audit file to find address changes.
N DGFLD
S DGFLD=$P($G(^DIA(2,DGIEN,0)),U,3)
I (DGFLD=.114)!(DGFLD=.116)!(DGFLD=.117)!(DGFLD=.1112)!(DGFLD=.115) Q 1
I (DGFLD=.111)!(DGFLD=.112)!(DGFLD=.113)!(DGFLD=.1171)!(DGFLD=.1172)!(DGFLD=.1173) Q 1
Q 0
BUILD(TYPE,DGIEN) ;Build temp global
N DGDFN,DGFLD,DGNAME,DGSSN,DGCURR,DGN
S DGDFN=$P($G(^DIA(2,DGIEN,0)),U)
I $G(TYPE)="RX" Q:'$$EN^PSSRXACT(DGDFN)
D GETS^DIQ(2,DGDFN_",",".01;.09","E","DGCURR")
S DGNAME=$G(DGCURR(2,DGDFN_",",.01,"E"))
S DGSSN=$G(DGCURR(2,DGDFN_",",.09,"E"))
I ($G(DGNAME)="")!($G(DGSSN)="")!($G(DGDFN)="") Q
S DGFLD=$P($G(^DIA(2,DGIEN,0)),U,3)
I '$D(^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN)) D
. ;Get current address
. K DGCURR,DGN
. D GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117:.1173;.1112","E","DGCURR")
. F DGN=.111,.112,.113,.114,.115,.116,.117,.1171,.1172,.1173,.1112 D
.. S ^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,DGN)=$G(DGCURR(2,DGDFN_",",DGN,"E"))
. S DGTOTAL=$G(DGTOTAL)+1
S ^TMP($J,"DG BEFORE",DGNAME,DGSSN,DGDFN,DGFLD)=$P($G(^DIA(2,DGIEN,2)),U)
Q
LNPLUS ;Increase line number for the email text
S DGLINE=$G(DGLINE)+1
Q
N RDT,Y
I $G(TYPE)="ALL" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=""
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" ALL ADDRESS CHANGE REPORT"
I $G(TYPE)="RX" D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=""
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" ALL ADDRESS CHANGE FOR PATIENTS WITH ACTIVE PRESCRIPTIONS REPORT"
D NOW^%DTC S Y=% X ^DD("DD")
S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" The BEFORE address shown may not be accurate."
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" It is only valid as of 24 hours prior to running the report."
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" Changes within the last 24 hours will not be shown."
. D LNPLUS^DGREGARP
. S ^TMP($J,"DG ADD CHNG",DGLINE)=" Date/Time Report Run: "_RDT
. D LNPLUS^DGREGARP
. S ^TMP($J,"DG ADD CHNG",DGLINE)="-----------------------------------------------------------------------------"
Q
TOTAL ;Get the total of the patients
N DGCNT
;S DGCNT=$G(^TMP($J,"DG BEFORE","TOTAL"))
S DGCNT=$G(DGTOTAL)
I $G(DGCNT)>0 D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)=""
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)="TOTAL RECORD(S): "_DGCNT
Q
EMAIL(TYPE) ;Email the report to mailgroup.
;If called within a task, protect variables
I $D(ZTQUEUED) N %,DIFROM
N RDT
D NOW^%DTC S Y=% X ^DD("DD")
S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
S XMSUB="DG "_$G(TYPE)_" ADDRESS CHANGE ("_RDT_")"
S XMY("G.DG DAILY ADDRESS CHANGE")=""
I $G(DGTOTAL)'>0 D
. D LNPLUS
. S ^TMP($J,"DG ADD CHNG",DGLINE)="*** NO RECORDS TO PRINT ***"
S XMTEXT="^TMP($J,""DG ADD CHNG"","
D ^XMD
Q
DGREGARP ;ALB/DW,ERC-Address audit reports ; 8/1/08 1:21pm
+1 ;;5.3;PIMS;**522,560,1015,1016**;JUN 30, 2012;Build 20
EN(TYPE) ;Entry point
+1 NEW DGRNG,XMY,XMSUB,XMDUZ,XMTEXT,DGSRT,DGTOTAL
+2 KILL ^TMP($JOB,"DG ADD CHNG")
+3 KILL ^TMP($JOB,"DG BEFORE")
+4 IF ($GET(TYPE)'="ALL")&($GET(TYPE)'="RX")
QUIT
+5 ;If mail group has no member or remote-member
+6 IF '$$MEMBER()
Begin DoDot:1
+7 IF '$DATA(ZTQUEUED)
WRITE !!,"DG DAILY ADDRESS CHANGE does not have a member. Report not sent."
DO EOP^DGREGAED
End DoDot:1
QUIT
+8 ;Entry from TaskMan
+9 IF $DATA(ZTQUEUED)
Begin DoDot:1
+10 DO PRINT
End DoDot:1
QUIT
+11 ;User runs the option
+12 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+13 WRITE !!,"The report will be sent to mail group DG DAILY ADDRESS CHANGE."
+14 DO QUE
+15 WRITE !!
DO EOP^DGREGAED
End DoDot:1
+16 QUIT
MEMBER() ;Return 0 if mail group has no local or remote member
+1 NEW RESULT,DGIEN,DGRMT
+2 SET RESULT=1
+3 SET DGIEN=$$FIND1^DIC(3.8,"","X","DG DAILY ADDRESS CHANGE")
+4 DO LIST^DIC(3.812,","_DGIEN_",",.01,"P","","","","","","","DGRMT")
+5 IF ($PIECE($GET(DGRMT("DILIST",0)),U)'>0)
IF ('$$GOTLOCAL^XMXAPIG("DG DAILY ADDRESS CHANGE"))
SET RESULT=0
+6 QUIT RESULT
QUE ;Que the task if user invokes option
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
+2 WRITE !
+3 SET ZTIO=""
+4 SET ZTSAVE("TYPE")=""
+5 SET ZTRTN="PRINT^DGREGARP"
+6 SET ZTDESC="DG "_$GET(TYPE)_" ADDRESS CHANGE REPORT"
+7 DO ^%ZTLOAD
+8 DO ^%ZISC
DO HOME^%ZIS
+9 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
+10 QUIT
PRESORT ;Sort for the report
+1 NEW DGRNG
+2 DO RANGE(.DGRNG)
+3 IF DGRNG=-1
QUIT
+4 DO SORT(.DGRNG,TYPE)
+5 QUIT
PRINT ;Create the email message.
+1 NEW DGLINE,DFN,SSN,IEN
+2 SET (DGLINE,DFN,SSN,IEN)=0
+3 DO CHKPAR
+4 DO HEADER
+5 DO PRESORT
+6 DO REPORT
+7 DO TOTAL
+8 DO EMAIL(TYPE)
+9 QUIT
+10 ;
REPORT ;Create the address change report body
+1 NEW DGNAME,DGSSN,DGDFN
+2 NEW DGR,DGUSER,DGDATE,DGSRC,DG12
+3 NEW DGA,DGFOR,DGN,DGO
+4 NEW DGPRSCRP
+5 SET (DGNAME,DGSSN,DGDFN)=""
+6 FOR
SET DGNAME=$ORDER(^TMP($JOB,"DG BEFORE",DGNAME))
IF DGNAME=""
QUIT
Begin DoDot:1
+7 SET DGSSN=""
+8 FOR
SET DGSSN=$ORDER(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN))
IF DGSSN=""
QUIT
Begin DoDot:2
+9 SET DGDFN=""
+10 FOR
SET DGDFN=$ORDER(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN))
IF DGDFN=""
QUIT
Begin DoDot:3
+11 DO GEN(DGNAME,DGSSN,DGDFN)
+12 DO OLD(DGNAME,DGSSN,DGDFN)
+13 DO NEW(DGNAME,DGSSN,DGDFN)
+14 DO PRSCPT(DGDFN)
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
GEN(DGNAME,DGSSN,DGDFN) ;General information for each patient
+1 KILL DGR
+2 DO GETS^DIQ(2,DGDFN_",",".122;.118;.119;.12","E","DGR")
+3 SET DGUSER=$GET(DGR(2,DGDFN_",",.122,"E"))
+4 SET DGDATE=$GET(DGR(2,DGDFN_",",.118,"E"))
+5 SET DGSRC=$GET(DGR(2,DGDFN_",",.119,"E"))
+6 SET DG12=$GET(DGR(2,DGDFN_",",.12,"E"))
+7 Begin DoDot:1
+8 DO LNPLUS
+9 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=""
+10 DO LNPLUS
+11 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" PATIENT: "_DGNAME_" SSN: "_$EXTRACT(DGSSN,6,10)
+12 DO LNPLUS
+13 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" USER: "_DGUSER_" DATE: "_DGDATE
+14 DO LNPLUS
+15 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" SOURCE: "_DGSRC_" "_DG12
End DoDot:1
+16 QUIT
OLD(DGNAME,DGSSN,DGDFN) ;Get address as of 24 hours ago, assuming audits are on for all
+1 SET DGO("ADD1")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.111))
+2 SET DGO("ADD2")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.112))
+3 SET DGO("ADD3")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.113))
+4 SET DGO("CITY")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.114))
+5 SET DGO("ST")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.115))
+6 SET DGO("ZIP")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1112))
+7 SET DGO("CNTY")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.117))
+8 SET DGO("PROV")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1171))
+9 SET DGO("PCODE")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1172))
+10 SET DGO("CNTRY")=$GET(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,.1173))
+11 SET DGFOR=$$FOR^DGADDUTL(DGO("CNTRY"))
+12 IF $GET(DGO("CNTRY"))]""
DO CNTRY^DGADDUT2(.DGO)
+13 SET DGO("TAG")="BEFORE"
+14 DO DISP(.DGO)
+15 SET DGFOR=0
+16 QUIT
DISP(DGA) ;
+1 DO LNPLUS
+2 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_DGA("TAG")_": "_DGA("ADD1")
+3 IF $GET(DGA("ADD2"))'=""
Begin DoDot:1
+4 DO LNPLUS
+5 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_DGA("ADD2")
End DoDot:1
+6 IF $GET(DGA("ADD3"))'=""
Begin DoDot:1
+7 DO LNPLUS
+8 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_DGA("ADD3")
End DoDot:1
+9 IF 'DGFOR
Begin DoDot:1
+10 IF (DGA("CITY")'="")!(DGA("ST")'="")
Begin DoDot:2
+11 DO LNPLUS
+12 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_DGA("CITY")_","_DGA("ST")_" "_DGA("ZIP")
End DoDot:2
End DoDot:1
+13 IF (DGA("CNTY")'="")
Begin DoDot:1
+14 DO LNPLUS
+15 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_"COUNTY CODE: "_DGA("CNTY")
End DoDot:1
+16 IF DGFOR
Begin DoDot:1
+17 IF (DGA("CITY")'="")!(DGA("PROV")'="")
Begin DoDot:2
+18 DO LNPLUS
+19 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_$SELECT(DGA("PCODE")]"":DGA("PCODE")_" ",1:"")_DGA("CITY")_","_DGA("PROV")
End DoDot:2
End DoDot:1
+20 IF DGA("CNTRY")]""
Begin DoDot:1
+21 DO LNPLUS
+22 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_DGA("CNTRY")
End DoDot:1
+23 IF $GET(DGA("HPHN"))'=""
Begin DoDot:1
+24 DO LNPLUS
+25 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_"PHONE(H): "_DGA("HPHN")
End DoDot:1
+26 IF $GET(DGA("OPHN"))'=""
Begin DoDot:1
+27 DO LNPLUS
+28 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" "_"PHONE(O): "_DGA("OPHN")
End DoDot:1
+29 QUIT
NEW(DGNAME,DGSSN,DGDFN) ;Get current address
+1 KILL DGCURR
+2 DO GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117:1173;.119;.12;.1112;.131;.132","E","DGCURR")
+3 SET DGN("ADD1")=$GET(DGCURR(2,DGDFN_",",.111,"E"))
+4 SET DGN("ADD2")=$GET(DGCURR(2,DGDFN_",",.112,"E"))
+5 SET DGN("ADD3")=$GET(DGCURR(2,DGDFN_",",.113,"E"))
+6 SET DGN("CITY")=$GET(DGCURR(2,DGDFN_",",.114,"E"))
+7 SET DGN("ST")=$GET(DGCURR(2,DGDFN_",",.115,"E"))
+8 SET DGN("ZIP")=$GET(DGCURR(2,DGDFN_",",.1112,"E"))
+9 SET DGN("CNTY")=$GET(DGCURR(2,DGDFN_",",.117,"E"))
+10 SET DGN("OPHN")=$GET(DGCURR(2,DGDFN_",",.132,"E"))
+11 SET DGN("HPHN")=$GET(DGCURR(2,DGDFN_",",.131,"E"))
+12 SET DGN("PROV")=$GET(DGCURR(2,DGDFN_",",.1171,"E"))
+13 SET DGN("PCODE")=$GET(DGCURR(2,DGDFN_",",.1172,"E"))
+14 SET DGN("CNTRY")=$GET(DGCURR(2,DGDFN_",",.1173,"E"))
+15 SET DGFOR=$$FOR^DGADDUTL(DGN("CNTRY"))
+16 IF $GET(DGN("CNTRY"))]""
DO CNTRY^DGADDUT2(.DGN)
+17 SET DGN("TAG")="AFTER"
+18 DO DISP(.DGN)
+19 QUIT
PRSCPT(DGDFN) ;Display if the patient has active prescription
+1 SET DGPRSCRP=$$EN^PSSRXACT(DGDFN)
+2 IF $GET(DGPRSCRP)=1
Begin DoDot:1
+3 DO LNPLUS
+4 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)="Patient has active pharmacy prescription(s)"
End DoDot:1
+5 QUIT
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB,"DG ADD CHNG")
+2 KILL ^TMP($JOB,"DG BEFORE")
+3 QUIT
CHKPAR ;Check if audit is on for the fields
+1 NEW DGR,DGN,DGFLD
+2 FOR DGN=.111,.112,.113,.114,.115,.116,.117,.1171,.1172,.1173,.1112
Begin DoDot:1
+3 KILL DGR
+4 DO FIELD^DID(2,DGN,"","LABEL;AUDIT","DGR")
+5 IF $DATA(DGR("DIERR"))
QUIT
+6 IF ($GET(DGR("AUDIT"))'["YES")&($GET(DGR("AUDIT"))'["EDITED OR DELETED")
Begin DoDot:2
+7 DO LNPLUS^DGREGARP
+8 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)="Audit is off for the "_$GET(DGR("LABEL"))_" field"
End DoDot:2
End DoDot:1
+9 QUIT
RANGE(RESULT) ;Get the range of the reports
+1 KILL RESULT
+2 NEW DGBEGIN,DGEND,DGNOW,DGAGO
+3 NEW X,X1,X2
+4 DO NOW^%DTC
+5 SET DGNOW=%
+6 SET X1=%
SET X2="-1"
DO C^%DTC
+7 SET DGAGO=X
+8 SET DGNOW=$ORDER(^DIA(2,"C",DGNOW),-1)
+9 SET DGAGO=$ORDER(^DIA(2,"C",DGAGO))
+10 IF ($GET(DGNOW)="")!($GET(DGAGO)="")
SET RESULT=-1
QUIT
+11 SET (DGBEGIN,DGEND)=""
+12 SET DGBEGIN=$ORDER(^DIA(2,"C",DGNOW,DGBEGIN),-1)
+13 SET DGEND=$ORDER(^DIA(2,"C",DGAGO,DGEND))
+14 IF $GET(DGBEGIN)=""!$GET(DGEND)=""
SET RESULT=-1
QUIT
+15 SET DGBEGIN=DGBEGIN+1
+16 SET RESULT=DGBEGIN_U_DGEND
+17 QUIT
SORT(RANGE,TYPE) ;Build the temp global to display
+1 NEW DGBEGIN,DGEND,DGIEN,DGDFN,DGFLD
+2 SET DGIEN=$PIECE($GET(RANGE),U)
+3 SET DGEND=$PIECE($GET(RANGE),U,2)
+4 FOR
SET DGIEN=$ORDER(^DIA(2,DGIEN),-1)
IF DGIEN<DGEND
QUIT
IF $$SCRN(TYPE,DGIEN)
Begin DoDot:1
+5 DO BUILD(TYPE,DGIEN)
End DoDot:1
+6 QUIT
SCRN(TYPE,DGIEN) ;Screen Audit file to find address changes.
+1 NEW DGFLD
+2 SET DGFLD=$PIECE($GET(^DIA(2,DGIEN,0)),U,3)
+3 IF (DGFLD=.114)!(DGFLD=.116)!(DGFLD=.117)!(DGFLD=.1112)!(DGFLD=.115)
QUIT 1
+4 IF (DGFLD=.111)!(DGFLD=.112)!(DGFLD=.113)!(DGFLD=.1171)!(DGFLD=.1172)!(DGFLD=.1173)
QUIT 1
+5 QUIT 0
BUILD(TYPE,DGIEN) ;Build temp global
+1 NEW DGDFN,DGFLD,DGNAME,DGSSN,DGCURR,DGN
+2 SET DGDFN=$PIECE($GET(^DIA(2,DGIEN,0)),U)
+3 IF $GET(TYPE)="RX"
IF '$$EN^PSSRXACT(DGDFN)
QUIT
+4 DO GETS^DIQ(2,DGDFN_",",".01;.09","E","DGCURR")
+5 SET DGNAME=$GET(DGCURR(2,DGDFN_",",.01,"E"))
+6 SET DGSSN=$GET(DGCURR(2,DGDFN_",",.09,"E"))
+7 IF ($GET(DGNAME)="")!($GET(DGSSN)="")!($GET(DGDFN)="")
QUIT
+8 SET DGFLD=$PIECE($GET(^DIA(2,DGIEN,0)),U,3)
+9 IF '$DATA(^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN))
Begin DoDot:1
+10 ;Get current address
+11 KILL DGCURR,DGN
+12 DO GETS^DIQ(2,DGDFN_",",".111;.112;.113;.114;.115;.116;.117:.1173;.1112","E","DGCURR")
+13 FOR DGN=.111,.112,.113,.114,.115,.116,.117,.1171,.1172,.1173,.1112
Begin DoDot:2
+14 SET ^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,DGN)=$GET(DGCURR(2,DGDFN_",",DGN,"E"))
End DoDot:2
+15 SET DGTOTAL=$GET(DGTOTAL)+1
End DoDot:1
+16 SET ^TMP($JOB,"DG BEFORE",DGNAME,DGSSN,DGDFN,DGFLD)=$PIECE($GET(^DIA(2,DGIEN,2)),U)
+17 QUIT
LNPLUS ;Increase line number for the email text
+1 SET DGLINE=$GET(DGLINE)+1
+2 QUIT
+1 NEW RDT,Y
+2 IF $GET(TYPE)="ALL"
Begin DoDot:1
+3 DO LNPLUS
+4 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=""
+5 DO LNPLUS
+6 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" ALL ADDRESS CHANGE REPORT"
End DoDot:1
+7 IF $GET(TYPE)="RX"
Begin DoDot:1
+8 DO LNPLUS
+9 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=""
+10 DO LNPLUS
+11 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" ALL ADDRESS CHANGE FOR PATIENTS WITH ACTIVE PRESCRIPTIONS REPORT"
End DoDot:1
+12 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+13 SET RDT=$PIECE(Y,"@",1)_"@"_$PIECE($PIECE(Y,"@",2),":",1,2)
+14 Begin DoDot:1
+15 DO LNPLUS
+16 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" The BEFORE address shown may not be accurate."
+17 DO LNPLUS
+18 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" It is only valid as of 24 hours prior to running the report."
+19 DO LNPLUS
+20 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" Changes within the last 24 hours will not be shown."
+21 DO LNPLUS^DGREGARP
+22 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=" Date/Time Report Run: "_RDT
+23 DO LNPLUS^DGREGARP
+24 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)="-----------------------------------------------------------------------------"
End DoDot:1
+25 QUIT
TOTAL ;Get the total of the patients
+1 NEW DGCNT
+2 ;S DGCNT=$G(^TMP($J,"DG BEFORE","TOTAL"))
+3 SET DGCNT=$GET(DGTOTAL)
+4 IF $GET(DGCNT)>0
Begin DoDot:1
+5 DO LNPLUS
+6 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)=""
+7 DO LNPLUS
+8 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)="TOTAL RECORD(S): "_DGCNT
End DoDot:1
+9 QUIT
EMAIL(TYPE) ;Email the report to mailgroup.
+1 ;If called within a task, protect variables
+2 IF $DATA(ZTQUEUED)
NEW %,DIFROM
+3 NEW RDT
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+5 SET RDT=$PIECE(Y,"@",1)_"@"_$PIECE($PIECE(Y,"@",2),":",1,2)
+6 SET XMSUB="DG "_$GET(TYPE)_" ADDRESS CHANGE ("_RDT_")"
+7 SET XMY("G.DG DAILY ADDRESS CHANGE")=""
+8 IF $GET(DGTOTAL)'>0
Begin DoDot:1
+9 DO LNPLUS
+10 SET ^TMP($JOB,"DG ADD CHNG",DGLINE)="*** NO RECORDS TO PRINT ***"
End DoDot:1
+11 SET XMTEXT="^TMP($J,""DG ADD CHNG"","
+12 DO ^XMD
+13 QUIT
