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

AGGRPTDP.m

Go to the documentation of this file. 
  1. AGGRPTDP ; VNGT/HS/KDC - POTENTIAL DUPLICATE PATIENT REPORT
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ; Copied from AGRPTPDP
  1.  ; 
  1.  ;REPORT OF POTENTIAL DUPLICATE PATIENTS BASED ON 5 CRITERIA
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,QNAM,QDOB,QSSN,QCOM,QM,QALL,QIN) ; EP -AGG POTENTIAL DUPLICATE PATIENT REPORT
  1.  ;Description
  1.  ;  Generates AGG POTENTIAL DUPLICATE PATIENT REPORT
  1.  ;
  1.  ;Input
  1.  ;  QNAM - A flag inticating user's selection
  1.  ;  QDOB - A flag inticating user's selection
  1.  ;  QSSN - A flag inticating user's selection
  1.  ;  QCOM - A flag inticating user's selection
  1.  ;  QM - A flag inticating user's selection
  1.  ;  QALL - A flag inticating user's selection
  1.  ;  QIN - A flag inticating user's selection
  1.  ;
  1.  ;Output
  1.  ;  DATA - Name of global in which data is stored(^TMP("AGGRPTDP"))
  1.  ;
  1.  NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N
  1.  NEW CRITERIA,INCACTDE,ALLLOC,CRITSTRE,AGLINE,CURCOM,DECEASE
  1.  NEW FUNNYSUB,MAIDEN,PAGE,PATIEN,RPTDATE,RPTREQ,UCI,CNT,CRITSTR
  1.  ;I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
  1.  I '$D(DT) D DT^DICRW
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGRPTDP",UID))
  1.  K @DATA
  1.  S AGGI=0
  1.  D HDR
  1.  I $$TMPFL^AGGUL1("W",UID,"AGG"_$J) G DONE
  1.  ;I $L($G(RPTCRT),U)'=7 S BMXSEC="Invalid search criteria." G DONE
  1.  S CRITERIA=""
  1.  S CNT=0
  1.  I $G(QNAM)="Y" S CRITERIA="1:NAME",CNT=CNT+1
  1.  I $G(QDOB)="Y" S CNT=CNT+1 S:CRITERIA]"" CRITERIA=CRITERIA_U_"2:DOB" S:CRITERIA="" CRITERIA="2:DOB"
  1.  I $G(QSSN)="Y" S CNT=CNT+1 S:CRITERIA]"" CRITERIA=CRITERIA_U_"3:SSN" S:CRITERIA="" CRITERIA="3:SSN"
  1.  I $G(QCOM)="Y" S CNT=CNT+1 S:CRITERIA]"" CRITERIA=CRITERIA_U_"4:COM" S:CRITERIA="" CRITERIA="4:COM"
  1.  I $G(QM)="Y" S CNT=CNT+1 S:CRITERIA]"" CRITERIA=CRITERIA_U_"5:MAIDEN" S:CRITERIA="" CRITERIA="5:MAIDEN"
  1.  I CNT<2 D  G DONE
  1.  . S @DATA@(AGGI)="T01024REPORT_TEXT"_$C(30)
  1.  . S AGGI=AGGI+1
  1.  . S @DATA@(AGGI)="NOT ENOUGH CRITERIA SELECTED!"_$C(30)
  1.  S (ALLLOC,INCACTDE)=0
  1.  I $G(QALL)="Y" S ALLLOC=1
  1.  I $G(QIN)="Y" S INCACTDE=1
  1.  U IO
  1.  W @IOF
  1.  S RPTREQ=$P($G(^VA(200,DUZ,0)),U)  ;REPORT REQUESTED BY
  1.  X ^%ZOSF("UCI")
  1.  S UCI=$P(Y,",")
  1.  S ROUTINE=$T(+0)
  1.  S:$G(AGLINE("EQ"))="" $P(AGLINE("EQ"),"=",81)=""
  1.  S:$G(AGLINE("-"))="" $P(AGLINE("-"),"-",81)=""
  1.  D SHOWCRIT(CRITERIA)
  1.  D MAIN(CRITERIA)
  1.  D BGL
  1.  ;IF PRINTING TO A SLAVE PRINTER FREEZES UP, THE CAUSE IS THE 'CLOSE EXECUTE' IN 
  1.  ;THE 'TERMINAL TYPE' FILE IS NOT FILLED IN FOR THE 'SUBTYPE' OF THE SLAVE 
  1.  ;DEVICE CHOSEN.
  1.  ;D ^%ZISC
  1.  K ROUTINE
  1.  Q
  1. MAIN(CRITERIA) ;MAIN
  1.  NEW FIRSTINI,LASTINI,LASTNAME,SSN,NAME,DOB,COM,%
  1.  K ^TMP("AGG",$J)
  1.  D NOW^%DTC S Y=% X ^DD("DD")
  1.  S RPTDATE=Y
  1.  S (LASTINI,DOB,SSN,COM,MAIDEN)=""
  1.  S PATIEN=0
  1.  F  S PATIEN=$O(^AUPNPAT(PATIEN)) Q:+PATIEN=0  D
  1.  .S DECEASE=$$CHKDEATH^AGEDERR(PATIEN)
  1.  .I 'INCACTDE Q:DECEASE  ;INCLUDE DECEASE AND INACTIVE IS NO QUIT
  1.  .I CRITERIA[("NAME") D
  1.  ..S NAME=$P($G(^DPT(PATIEN,0)),U)
  1.  ..S LASTNAME=$P(NAME,",")
  1.  ..S FIRSTINI=$E($P(NAME,",",2))
  1.  ..S LASTINI=LASTNAME_" "_FIRSTINI
  1.  .I CRITERIA[("DOB") D
  1.  ..S DOB=$P($G(^DPT(PATIEN,0)),U,3)
  1.  .I CRITERIA[("SSN") D
  1.  ..S SSN=$P($G(^DPT(PATIEN,0)),U,9)
  1.  .I CRITERIA[("COM") D
  1.  ..S COM=$P($G(^AUPNPAT(PATIEN,11)),U,18)  ;FREE TEXT - NOT A GOOD CRITERIA
  1.  .I CRITERIA[("MAIDEN") D
  1.  ..S MAIDEN=$P($G(^DPT(PATIEN,.24)),U,3)  ;FREE TEXT - NOT A GOOD CRITERIA
  1.  .S FUNNYSUB=LASTINI_U_DOB_U_SSN_U_COM_U_MAIDEN
  1.  .S ^TMP("AGG",$J,FUNNYSUB,PATIEN)=""
  1.  .S ^TMP("AGG",$J,FUNNYSUB)=$G(^TMP("AGG",$J,FUNNYSUB))+1
  1.  D REPORT(CRITERIA)
  1.  Q
  1. REPORT(CRITERIA) ;EP
  1.  NEW ESCAPE,HRNFAC,INACTIVE,LN1,LN2,PATDOB,PATNAME,PSEUDO,HRN
  1.  S PAGE=0
  1.  S ESCAPE=0
  1.  D RHDR(CRITERIA)
  1.  S FUNNYSUB=""
  1.  F  S FUNNYSUB=$O(^TMP("AGG",$J,FUNNYSUB)) Q:FUNNYSUB=""  D  Q:ESCAPE
  1.  .S PATIEN=""
  1.  .F LN1=1:1 S PATIEN=$O(^TMP("AGG",$J,FUNNYSUB,PATIEN)) Q:PATIEN=""  D  Q:ESCAPE
  1.  ..Q:$G(^TMP("AGG",$J,FUNNYSUB))<2
  1.  ..S PATNAME=$P($G(^DPT(PATIEN,0)),U)
  1.  ..S DECEASE=$$CHKDEATH^AGEDERR(PATIEN)
  1.  ..S PATDOB=$P($G(^DPT(PATIEN,0)),U,3)
  1.  ..I PATDOB'="" S Y=PATDOB X ^DD("DD") S PATDOB=Y
  1.  ..E  S PATDOB="<none>"
  1.  ..S MAIDEN=$P($G(^DPT(PATIEN,.24)),U,3)
  1.  ..S CURCOM=$P($G(^AUPNPAT(PATIEN,11)),U,18)
  1.  ..S:PATNAME="" PATNAME="<none>"
  1.  ..S:MAIDEN="" MAIDEN="<none>"
  1.  ..S:CURCOM="" CURCOM="<none>"
  1.  ..S:MAIDEN="" MAIDEN="<none>"
  1.  ..;I $Y>(IOSL-1),(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=$D(DUOUT) Q:ESCAPE  D RHDR(CRITERIA)
  1.  ..;I $D(IO("S")),($Y>(IOSL-1)),(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=$D(DUOUT) Q:ESCAPE  D RHDR(CRITERIA)  ;IHS/SD/IHS 2/17/2006 IM19904 FIX SUBMITTED BY MICHAEL TAYLOR
  1.  ..;I $Y>(IOSL-1),(IOST'[("C-")) D RHDR(CRITERIA)
  1.  ..;W:LN1=1 !!,"COMPARISON STRING=",FUNNYSUB PROGRAMMER ONLY
  1.  ..W !,$E(PATNAME,1,25),$S(DECEASE:"#",1:""),?26,PATDOB,?38,$E(MAIDEN,1,15),?54,$E(CURCOM,1,15)
  1.  ..S HRNFAC=0
  1.  ..F LN2=1:1 S HRNFAC=$O(^AUPNPAT(PATIEN,41,HRNFAC)) Q:+HRNFAC=0  D
  1.  ...Q:'$$ACTFAC(HRNFAC)
  1.  ...S PSEUDO=$P($G(^AUTTLOC(HRNFAC,1)),U,2)
  1.  ...S INACTIVE=$S((U_"I"_U)[(U_$P($G(^AUPNPAT(PATIEN,41,HRNFAC,0)),U,5)_U):"*",1:"")
  1.  ...I 'INCACTDE Q:INACTIVE
  1.  ...S HRN=$P($G(^AUPNPAT(PATIEN,41,HRNFAC,0)),U,2)
  1.  ...W:LN2'=1 !
  1.  ...W ?69,PSEUDO,?73,HRN_INACTIVE
  1.  ;I IOST[("C-") W ! K DIR S DIR(0)="E" D ^DIR
  1.  ;I $D(IO("S")),(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR  ;IHS/SD/IHS 2/17/2006 IM19904 FIX SUBMITTED BY MICHAEL TAYLOR
  1.  Q
  1. ACTFAC(FAC) ;EP - IS THE FACILITY ACTIVE?
  1.  NEW INACTDT
  1.  S INACTDT=$P($G(^AUTTLOC(FAC,0)),U,21)
  1.  Q:INACTDT="" 1
  1.  I INACTDT>DT Q 1
  1.  Q 0
  1. EXIT ;CLEANUP VARS
  1.  K EFFDATE,EMPLECNT,COUNT,EMPLEE,EMPLEENM,EMPLEREC,EMPLRBEG,EMPLRCNT,EMPLREND
  1.  K EMPLRNM,EMPLRREC,EMPREC
  1.  Q
  1. SHOWCRIT(CRITERIA) ;EP - DISPLAY CRITERIA SELECTED
  1.  NEW PIECE,SEL
  1.  S CRITSTR=""
  1.  ;W !!,"You have selected "
  1.  F PIECE=1:1 S SEL=$P(CRITERIA,U,PIECE) Q:SEL=""  D
  1.  .;I PIECE'=1 W " and " S CRITSTR=CRITSTR_" and "
  1.  .;W "#"_$P($T(CRITTXT+SEL),";;",2)
  1.  .S CRITSTR=CRITSTR_"#"_$P($T(CRITTXT+SEL),";;",2)
  1.  Q
  1. RHDR(CRITERIA) ;EP - MAIN HEADER
  1.  S PAGE=PAGE+1,IOM=80
  1.  W @IOF
  1.  W !,RPTREQ,?69,"page ",PAGE
  1.  W !
  1.  D CENTER^AGUTILS("INDIAN HEALTH HOSPITAL")
  1.  W !
  1.  D CENTER^AGUTILS("POTENTIAL DUPLICATE PATIENT FILES REPORT")
  1.  W !
  1.  D WRAP^AGUTILS("CHECKING AGAINST "_CRITSTR,20,"WC50")
  1.  W !
  1.  D CENTER^AGUTILS("UCI: "_UCI)
  1.  W !
  1.  D CENTER^AGUTILS("('*' = INACTIVE), ('#' = DECEASED)")
  1.  W !!
  1.  D CENTER^AGUTILS("as of "_RPTDATE)
  1.  W !!
  1.  W "PATIENT NAME",?26,"BIRTH DATE",?38,"MOTHERS MAIDEN",?54,"CUR. COMMUNITY",?69,"LOC",?73,"HRN"
  1.  W !,"============",?26,"==========",?38,"==============",?54,"==============",?69,"===",?73,"======"
  1.  Q
  1. QUE ;EP
  1.  ;K IO("Q")
  1.  ;S ZTRTN="MAIN^AGRPTPDP(CRITERIA)",ZTDESC="LISTING OF POTENTIAL DUPLICATE PATIENTS"
  1.  ;S ZTSAVE("CRITERIA")=""
  1.  ;S ZTSAVE("ALLLOC")=""
  1.  ;S ZTSAVE("INCACTDE")=""
  1.  ;S ZTSAVE("ROUTINE")=""
  1.  ;S ZTSAVE("RPTREQ")=""
  1.  ;S ZTSAVE("CRITSTR")=""
  1.  ;S ZTSAVE("UCI")=""
  1.  ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED AS TASK # "_ZTSK_" !",!
  1.  Q
  1. CRITTXT ;;1:NAME^2:DOB^3:SSN^4:COM^5:MAIDEN
  1.  ;;1-Last Name and First initial of Patient
  1.  ;;2-Patient Date of Birth
  1.  ;;3-Social Security Number
  1.  ;;4-Current Community
  1.  ;;5-Mother's Maiden Name
  1.  ;;*END*
  1.  ;;
  1. BGL U IO W !,$C(9)
  1.  ;
  1.  ;
  1.  I $$TMPFL^AGGUL1("C") G DONE
  1.  I $$TMPFL^AGGUL1("R",UID,"AGG"_$J) G DONE
  1.  ;
  1.  F  U IO R HSTEXT:.1 Q:HSTEXT[$C(9)  D
  1.  . S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
  1.  . I HSTEXT="" S HSTEXT=" "
  1.  . S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(13)_$C(10)_$C(30)
  1.  S AGGI=AGGI+1,@DATA@(AGGI)=$C(30)
  1.  ;
  1.  I $$TMPFL^AGGUL1("C") G DONE
  1.  I $$TMPFL^AGGUL1("D",UID,"AGG"_$J) G DONE
  1.  ;
  1. DONE ;
  1.  ;
  1.  S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S @DATA@(AGGI)="T01024REPORT_TEXT"_$C(30)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(AGGI),$D(DATA) S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)
  1.  I $$TMPFL^AGGUL1("C")
  1.  Q