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

DGREGARP.m

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