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

AGGCMTCH.m

Go to the documentation of this file. 
  1. AGGCMTCH ; VNGT/HS/KDC - COMMUNITY REPORT;  
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ; Copied from AGCMATCH
  1.  ; 
  1.  ;This report is used for checking blank community, blank mailing
  1.  ;address city, and it they don't match.  Also checks if these fields
  1.  ;contain "unknown" anything.
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,TYPE,AGGDUZ2) ; EP -- AGG COMMUNITY REPORT
  1.  ;Description
  1.  ;  Generates AGG COMMUNITY REPORT
  1.  ;
  1.  ;Input
  1.  ;  TYPE - Type of daily report
  1.  ;
  1.  ;Output
  1.  ;  DATA - Name of global in which data is stored(^TMP("AGGCMTCH"))
  1.  ;
  1.  NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,I,N,AGDOD,AGDUZ2
  1.  NEW AG,AGB,AGE,AGIO,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI
  1.  NEW AGGI,AGALL,AGCNT1,AGCNT2,AGCNT3,AG1,AGADD,AGCOM
  1.  NEW AGEFLG,AGER,AGDUZ2,AGFLAG,AGHRN,AGINACT,AGNM,AGREC
  1.  NEW AGERROR,HRN,IO
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGCMTCH",UID))
  1.  K @DATA
  1.  S AGGI=0
  1.  D HDR
  1.  I $G(TYPE)="" S TYPE="B"
  1.  ;
  1.  I $$TMPFL^AGGUL1("W",UID,"AGG"_$J) G DONE
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGCMTCH D UNWIND^%ZTER"
  1.  S AGALL=""
  1.  S (AGCNT1,AGCNT2,AGCNT3)=0
  1.  S AGALL=TYPE
  1.  ;S AGBM=IOSL-4
  1.  U IO
  1.  N AGADDR,AGMAIL,AGCNT
  1.  S U="^"
  1.  S AGNAME=""
  1.  S AG1=""
  1.  S AGFLAG1=""
  1.  S AGPAGE=1
  1.  F  S AG1=$O(^DPT("B",AG1)) Q:AG1=""!AGFLAG1  D
  1.  .S AG2=0
  1.  .F  S AG2=$O(^DPT("B",AG1,AG2)) Q:'AG2!AGFLAG1  D
  1.  ..S AGWFLG=""
  1.  ..S AGEFLG=0,AGERROR=0
  1.  ..D AGCHECK                  ;checks if they have HRN
  1.  ..I $D(HRN),HRN["T" Q        ;check if temp numbers are included
  1.  ..I AGFLAG=0 Q
  1.  ..S AGNAME=$P($G(^DPT(AG2,0)),U)
  1.  ..I AGNAME'=AG1 Q                     ;makes sure names match
  1.  ..S AGCOMM=$P($G(^AUPNPAT(AG2,11)),U,18)  ;current community
  1.  ..S AGADDR=$P($G(^DPT(AG2,.11)),U,4)      ;mailing address city
  1.  ..I AGALL="C" D                           ;if complete
  1.  ...I AGCOMM=""!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGCOMM'=AGADDR) D  Q
  1.  ....I AGCOMM'="",AGADDR'="",AGCOMM'=AGADDR S AGERROR=3,AGEFLG=1
  1.  ....I AGCOMM=""!(AGADDR="") S AGERROR=1,AGEFLG=AGEFLG+1
  1.  ....I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2,AGEFLG=AGEFLG+1
  1.  ....I AGEFLG>1 D ERRCHK     ;if there is more than one error
  1.  ....D SAVE
  1.  ..I AGALL="B",((AGCOMM="")!(AGADDR="")) D  Q   ;blank
  1.  ...S AGERROR=1
  1.  ...D SAVE
  1.  ..;if unknowns
  1.  ..I AGALL="U",(AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")) D  Q
  1.  ...S AGERROR=2
  1.  ...D SAVE
  1.  ..;blanks&unknowns
  1.  ..I AGALL="A" D
  1.  ...I (AGCOMM="")!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") D  Q
  1.  ....I AGCOMM=""!(AGADDR="") S AGERROR=1
  1.  ....I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2
  1.  ....D SAVE
  1.  D WRITE
  1.  D BGL
  1.  K AGNAME,AG2,AGCOMM,AGADDR,AGFLAG1,AGPAGE,AGWFLG
  1.  K AGCNT1,AGCNT2,AGCNT3,TOT
  1.  Q
  1.  ;
  1. ERRCHK ;if more than one error sets priority error
  1.  I AGADDR="" S AGERROR=1 Q
  1.  I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2 Q
  1.  I AGCOMM]"",AGADDR]"",AGCOMM'=AGADDR S AGERROR=3
  1.  Q
  1.  ;
  1. SAVE ;
  1.  I HRN="" S HRN="NO HRN"
  1.  S AGINACT=$P($G(^AUPNPAT(AG2,41,AGDUZ2,0)),U,3)  ;inactive/deleted
  1.  S AGDOD=$P($G(^DPT(AG2,.35)),U)                  ;date of death
  1.  I $G(AGINACT)'=""!($G(AGDOD)'="") S AGADD="I"
  1.  E  S AGADD="A"
  1.  I AGCOMM="" S AGCOMM="AANONE"
  1.  S ^AGTMP($J,AGERROR,AGCOMM,AGADD,AGNAME,HRN)=AGADDR
  1.  I AGERROR=1 S AGCNT1=AGCNT1+1
  1.  I AGERROR=2 S AGCNT2=AGCNT2+1
  1.  I AGERROR=3 S AGCNT3=AGCNT3+1
  1.  S AGWFLG=1
  1.  Q
  1.  ;
  1. WRITE ;writes record to temp global if condition is met.  Also checks
  1.  ;for active/inactive status of patient; checks for new page/header.
  1.  ;
  1.  NEW Z
  1.  D RHDR
  1.  S (AGER,AGHRN,AGNM,AGADD,AGCOM,AGADDR)=""
  1.  F  S AGER=$O(^AGTMP($J,AGER)) Q:AGER=""!AGFLAG1  D
  1.  .I AGER=1 W !,"BLANK CITY/COMMUNITY",!
  1.  .I AGER=2 W !,"UNKNOWN/OTHER",!
  1.  .I AGER=3 W !,"MISMATCHES",!
  1.  .F  S AGCOM=$O(^AGTMP($J,AGER,AGCOM)) Q:AGCOM=""!AGFLAG1  D
  1.  ..F  S AGADD=$O(^AGTMP($J,AGER,AGCOM,AGADD))  Q:AGADD=""!AGFLAG1  D
  1.  ...F  S AGNM=$O(^AGTMP($J,AGER,AGCOM,AGADD,AGNM)) Q:AGNM=""!AGFLAG1  D
  1.  ....F  S AGHRN=$O(^AGTMP($J,AGER,AGCOM,AGADD,AGNM,AGHRN))  Q:AGHRN=""!AGFLAG1  D
  1.  .....S AGREC=$G(^AGTMP($J,AGER,AGCOM,AGADD,AGNM,AGHRN))
  1.  .....S AGADDR=$P(AGREC,U)
  1.  .....I AGCOM["AANONE" S AGCOMM=""
  1.  .....E  S AGCOMM=AGCOM
  1.  .....W ?3,AGNM
  1.  .....W ?27,AGADD
  1.  .....W ?31,AGHRN
  1.  .....W ?40,AGADDR
  1.  .....W ?60,AGCOMM
  1.  .....W !
  1.  .I 'AGFLAG1 D
  1.  ..F Z=1:1:80 W "-"
  1.  ..W !
  1.  W !!,"*** END OF REPORT ***",!!
  1.  K ^AGTMP($J)
  1.  Q
  1.  ;
  1. RHDR ;
  1.  NEW DATE
  1.  S TOT=0
  1.  S DATE=$$UP^XLFSTR($$FMTE^XLFDT(DT))
  1.  S X=DATE_"         COMMUNITY/CITY MISMATCH REPORT         Page "_AGPAGE
  1.  D CTR^AG
  1.  W !,X
  1.  S X=$P(^AUTTLOC(AGGDUZ2,0),U,2)
  1.  D CTR^AG
  1.  W !,X
  1.  I AGALL="C" S AGALL="BUM"
  1.  I AGALL="A" S AGALL="BU"
  1.  I AGPAGE=1 D
  1.  .W !!,"This report contains "
  1.  .I AGALL["B" D  ;blanks
  1.  ..W !?10,"BLANKS",?20,$J(+$G(AGCNT1),10)
  1.  ..S TOT=TOT+AGCNT1
  1.  .I AGALL["U" D                                 ;unknowns
  1.  ..W !?10,"UNKNOWNS",?20,$J(+$G(AGCNT2),10)
  1.  ..S TOT=TOT+AGCNT2
  1.  .I AGALL["M" D                                 ;mismatches
  1.  ..W !?10,"MISMATCHES",?20,$J(+$G(AGCNT3),10)
  1.  ..S TOT=TOT+AGCNT3
  1.  .W !?10,"TOTAL:  ",?20,$J(TOT,10)
  1.  W !!?3,"NAME",?26,"A/I",?31,"HRN",?40,"MAIL.ADDR-CITY",?60,"CURRENT COMM",!
  1.  F AG=1:1:80 W "="
  1.  W !
  1.  S AGPAGE=AGPAGE+1
  1.  Q
  1.  ;
  1. AGCHECK ;
  1.  ;looks that they have an HRN
  1.  S AGFLAG=0
  1.  S AGDUZ2=0
  1.  F  S AGDUZ2=$O(^AUPNPAT(AG2,41,AGDUZ2)) Q:AGDUZ2=""  D  Q:AGFLAG
  1.  .I AGDUZ2=AGGDUZ2 S HRN=$P($G(^AUPNPAT(AG2,41,AGDUZ2,0)),U,2),AGFLAG=1 Q
  1.  Q
  1.  ;
  1. BGL ;
  1.  U IO W $C(9)
  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 HSTEXT=$$CTRL^AGGUL1(HSTEXT)
  1.  . ;S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(30)
  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.  S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S @DATA@(AGGI)="T32000REPORT_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