AGGCMTCH ; VNGT/HS/KDC - COMMUNITY REPORT;
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
; Copied from AGCMATCH
;
;This report is used for checking blank community, blank mailing
;address city, and it they don't match. Also checks if these fields
;contain "unknown" anything.
;
;
Q
;
EN(DATA,TYPE,AGGDUZ2) ; EP -- AGG COMMUNITY REPORT
;Description
; Generates AGG COMMUNITY REPORT
;
;Input
; TYPE - Type of daily report
;
;Output
; DATA - Name of global in which data is stored(^TMP("AGGCMTCH"))
;
NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,I,N,AGDOD,AGDUZ2
NEW AG,AGB,AGE,AGIO,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI
NEW AGGI,AGALL,AGCNT1,AGCNT2,AGCNT3,AG1,AGADD,AGCOM
NEW AGEFLG,AGER,AGDUZ2,AGFLAG,AGHRN,AGINACT,AGNM,AGREC
NEW AGERROR,HRN,IO
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGCMTCH",UID))
K @DATA
S AGGI=0
D HDR
I $G(TYPE)="" S TYPE="B"
;
I $$TMPFL^AGGUL1("W",UID,"AGG"_$J) G DONE
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGCMTCH D UNWIND^%ZTER"
S AGALL=""
S (AGCNT1,AGCNT2,AGCNT3)=0
S AGALL=TYPE
;S AGBM=IOSL-4
U IO
N AGADDR,AGMAIL,AGCNT
S U="^"
S AGNAME=""
S AG1=""
S AGFLAG1=""
S AGPAGE=1
F S AG1=$O(^DPT("B",AG1)) Q:AG1=""!AGFLAG1 D
.S AG2=0
.F S AG2=$O(^DPT("B",AG1,AG2)) Q:'AG2!AGFLAG1 D
..S AGWFLG=""
..S AGEFLG=0,AGERROR=0
..D AGCHECK ;checks if they have HRN
..I $D(HRN),HRN["T" Q ;check if temp numbers are included
..I AGFLAG=0 Q
..S AGNAME=$P($G(^DPT(AG2,0)),U)
..I AGNAME'=AG1 Q ;makes sure names match
..S AGCOMM=$P($G(^AUPNPAT(AG2,11)),U,18) ;current community
..S AGADDR=$P($G(^DPT(AG2,.11)),U,4) ;mailing address city
..I AGALL="C" D ;if complete
...I AGCOMM=""!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGCOMM'=AGADDR) D Q
....I AGCOMM'="",AGADDR'="",AGCOMM'=AGADDR S AGERROR=3,AGEFLG=1
....I AGCOMM=""!(AGADDR="") S AGERROR=1,AGEFLG=AGEFLG+1
....I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2,AGEFLG=AGEFLG+1
....I AGEFLG>1 D ERRCHK ;if there is more than one error
....D SAVE
..I AGALL="B",((AGCOMM="")!(AGADDR="")) D Q ;blank
...S AGERROR=1
...D SAVE
..;if unknowns
..I AGALL="U",(AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")) D Q
...S AGERROR=2
...D SAVE
..;blanks&unknowns
..I AGALL="A" D
...I (AGCOMM="")!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") D Q
....I AGCOMM=""!(AGADDR="") S AGERROR=1
....I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2
....D SAVE
D WRITE
D BGL
K AGNAME,AG2,AGCOMM,AGADDR,AGFLAG1,AGPAGE,AGWFLG
K AGCNT1,AGCNT2,AGCNT3,TOT
Q
;
ERRCHK ;if more than one error sets priority error
I AGADDR="" S AGERROR=1 Q
I AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH") S AGERROR=2 Q
I AGCOMM]"",AGADDR]"",AGCOMM'=AGADDR S AGERROR=3
Q
;
SAVE ;
I HRN="" S HRN="NO HRN"
S AGINACT=$P($G(^AUPNPAT(AG2,41,AGDUZ2,0)),U,3) ;inactive/deleted
S AGDOD=$P($G(^DPT(AG2,.35)),U) ;date of death
I $G(AGINACT)'=""!($G(AGDOD)'="") S AGADD="I"
E S AGADD="A"
I AGCOMM="" S AGCOMM="AANONE"
S ^AGTMP($J,AGERROR,AGCOMM,AGADD,AGNAME,HRN)=AGADDR
I AGERROR=1 S AGCNT1=AGCNT1+1
I AGERROR=2 S AGCNT2=AGCNT2+1
I AGERROR=3 S AGCNT3=AGCNT3+1
S AGWFLG=1
Q
;
WRITE ;writes record to temp global if condition is met. Also checks
;for active/inactive status of patient; checks for new page/header.
;
NEW Z
D RHDR
S (AGER,AGHRN,AGNM,AGADD,AGCOM,AGADDR)=""
F S AGER=$O(^AGTMP($J,AGER)) Q:AGER=""!AGFLAG1 D
.I AGER=1 W !,"BLANK CITY/COMMUNITY",!
.I AGER=2 W !,"UNKNOWN/OTHER",!
.I AGER=3 W !,"MISMATCHES",!
.F S AGCOM=$O(^AGTMP($J,AGER,AGCOM)) Q:AGCOM=""!AGFLAG1 D
..F S AGADD=$O(^AGTMP($J,AGER,AGCOM,AGADD)) Q:AGADD=""!AGFLAG1 D
...F S AGNM=$O(^AGTMP($J,AGER,AGCOM,AGADD,AGNM)) Q:AGNM=""!AGFLAG1 D
....F S AGHRN=$O(^AGTMP($J,AGER,AGCOM,AGADD,AGNM,AGHRN)) Q:AGHRN=""!AGFLAG1 D
.....S AGREC=$G(^AGTMP($J,AGER,AGCOM,AGADD,AGNM,AGHRN))
.....S AGADDR=$P(AGREC,U)
.....I AGCOM["AANONE" S AGCOMM=""
.....E S AGCOMM=AGCOM
.....W ?3,AGNM
.....W ?27,AGADD
.....W ?31,AGHRN
.....W ?40,AGADDR
.....W ?60,AGCOMM
.....W !
.I 'AGFLAG1 D
..F Z=1:1:80 W "-"
..W !
W !!,"*** END OF REPORT ***",!!
K ^AGTMP($J)
Q
;
RHDR ;
NEW DATE
S TOT=0
S DATE=$$UP^XLFSTR($$FMTE^XLFDT(DT))
S X=DATE_" COMMUNITY/CITY MISMATCH REPORT Page "_AGPAGE
D CTR^AG
W !,X
S X=$P(^AUTTLOC(AGGDUZ2,0),U,2)
D CTR^AG
W !,X
I AGALL="C" S AGALL="BUM"
I AGALL="A" S AGALL="BU"
I AGPAGE=1 D
.W !!,"This report contains "
.I AGALL["B" D ;blanks
..W !?10,"BLANKS",?20,$J(+$G(AGCNT1),10)
..S TOT=TOT+AGCNT1
.I AGALL["U" D ;unknowns
..W !?10,"UNKNOWNS",?20,$J(+$G(AGCNT2),10)
..S TOT=TOT+AGCNT2
.I AGALL["M" D ;mismatches
..W !?10,"MISMATCHES",?20,$J(+$G(AGCNT3),10)
..S TOT=TOT+AGCNT3
.W !?10,"TOTAL: ",?20,$J(TOT,10)
W !!?3,"NAME",?26,"A/I",?31,"HRN",?40,"MAIL.ADDR-CITY",?60,"CURRENT COMM",!
F AG=1:1:80 W "="
W !
S AGPAGE=AGPAGE+1
Q
;
AGCHECK ;
;looks that they have an HRN
S AGFLAG=0
S AGDUZ2=0
F S AGDUZ2=$O(^AUPNPAT(AG2,41,AGDUZ2)) Q:AGDUZ2="" D Q:AGFLAG
.I AGDUZ2=AGGDUZ2 S HRN=$P($G(^AUPNPAT(AG2,41,AGDUZ2,0)),U,2),AGFLAG=1 Q
Q
;
BGL ;
U IO W $C(9)
;
I $$TMPFL^AGGUL1("C") G DONE
I $$TMPFL^AGGUL1("R",UID,"AGG"_$J) G DONE
;
F U IO R HSTEXT:.1 Q:HSTEXT[$C(9) D
. S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
. I HSTEXT="" S HSTEXT=" "
. S HSTEXT=$$CTRL^AGGUL1(HSTEXT)
. ;S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(30)
. S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(13)_$C(10)_$C(30)
;S AGGI=AGGI+1,@DATA@(AGGI)=$C(30)
;
I $$TMPFL^AGGUL1("C") G DONE
I $$TMPFL^AGGUL1("D",UID,"AGG"_$J) G DONE
;
DONE ;
S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)
Q
;
HDR ;
S @DATA@(AGGI)="T32000REPORT_TEXT"_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(AGGI),$D(DATA) S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)
I $$TMPFL^AGGUL1("C")
Q
AGGCMTCH ; VNGT/HS/KDC - COMMUNITY REPORT;
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ; Copied from AGCMATCH
+4 ;
+5 ;This report is used for checking blank community, blank mailing
+6 ;address city, and it they don't match. Also checks if these fields
+7 ;contain "unknown" anything.
+8 ;
+9 ;
+10 QUIT
+11 ;
EN(DATA,TYPE,AGGDUZ2) ; EP -- AGG COMMUNITY REPORT
+1 ;Description
+2 ; Generates AGG COMMUNITY REPORT
+3 ;
+4 ;Input
+5 ; TYPE - Type of daily report
+6 ;
+7 ;Output
+8 ; DATA - Name of global in which data is stored(^TMP("AGGCMTCH"))
+9 ;
+10 NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,I,N,AGDOD,AGDUZ2
+11 NEW AG,AGB,AGE,AGIO,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI
+12 NEW AGGI,AGALL,AGCNT1,AGCNT2,AGCNT3,AG1,AGADD,AGCOM
+13 NEW AGEFLG,AGER,AGDUZ2,AGFLAG,AGHRN,AGINACT,AGNM,AGREC
+14 NEW AGERROR,HRN,IO
+15 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+16 SET DATA=$NAME(^TMP("AGGCMTCH",UID))
+17 KILL @DATA
+18 SET AGGI=0
+19 DO HDR
+20 IF $GET(TYPE)=""
SET TYPE="B"
+21 ;
+22 IF $$TMPFL^AGGUL1("W",UID,"AGG"_$JOB)
GOTO DONE
+23 ;
+24 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGCMTCH D UNWIND^%ZTER"
+25 SET AGALL=""
+26 SET (AGCNT1,AGCNT2,AGCNT3)=0
+27 SET AGALL=TYPE
+28 ;S AGBM=IOSL-4
+29 USE IO
+30 NEW AGADDR,AGMAIL,AGCNT
+31 SET U="^"
+32 SET AGNAME=""
+33 SET AG1=""
+34 SET AGFLAG1=""
+35 SET AGPAGE=1
+36 FOR
SET AG1=$ORDER(^DPT("B",AG1))
IF AG1=""!AGFLAG1
QUIT
Begin DoDot:1
+37 SET AG2=0
+38 FOR
SET AG2=$ORDER(^DPT("B",AG1,AG2))
IF 'AG2!AGFLAG1
QUIT
Begin DoDot:2
+39 SET AGWFLG=""
+40 SET AGEFLG=0
SET AGERROR=0
+41 ;checks if they have HRN
DO AGCHECK
+42 ;check if temp numbers are included
IF $DATA(HRN)
IF HRN["T"
QUIT
+43 IF AGFLAG=0
QUIT
+44 SET AGNAME=$PIECE($GET(^DPT(AG2,0)),U)
+45 ;makes sure names match
IF AGNAME'=AG1
QUIT
+46 ;current community
SET AGCOMM=$PIECE($GET(^AUPNPAT(AG2,11)),U,18)
+47 ;mailing address city
SET AGADDR=$PIECE($GET(^DPT(AG2,.11)),U,4)
+48 ;if complete
IF AGALL="C"
Begin DoDot:3
+49 IF AGCOMM=""!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGCOMM'=AGADDR)
Begin DoDot:4
+50 IF AGCOMM'=""
IF AGADDR'=""
IF AGCOMM'=AGADDR
SET AGERROR=3
SET AGEFLG=1
+51 IF AGCOMM=""!(AGADDR="")
SET AGERROR=1
SET AGEFLG=AGEFLG+1
+52 IF AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")
SET AGERROR=2
SET AGEFLG=AGEFLG+1
+53 ;if there is more than one error
IF AGEFLG>1
DO ERRCHK
+54 DO SAVE
End DoDot:4
QUIT
End DoDot:3
+55 ;blank
IF AGALL="B"
IF ((AGCOMM="")!(AGADDR=""))
Begin DoDot:3
+56 SET AGERROR=1
+57 DO SAVE
End DoDot:3
QUIT
+58 ;if unknowns
+59 IF AGALL="U"
IF (AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH"))
Begin DoDot:3
+60 SET AGERROR=2
+61 DO SAVE
End DoDot:3
QUIT
+62 ;blanks&unknowns
+63 IF AGALL="A"
Begin DoDot:3
+64 IF (AGCOMM="")!(AGADDR="")!(AGCOMM["UNK")!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")
Begin DoDot:4
+65 IF AGCOMM=""!(AGADDR="")
SET AGERROR=1
+66 IF AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")
SET AGERROR=2
+67 DO SAVE
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+68 DO WRITE
+69 DO BGL
+70 KILL AGNAME,AG2,AGCOMM,AGADDR,AGFLAG1,AGPAGE,AGWFLG
+71 KILL AGCNT1,AGCNT2,AGCNT3,TOT
+72 QUIT
+73 ;
ERRCHK ;if more than one error sets priority error
+1 IF AGADDR=""
SET AGERROR=1
QUIT
+2 IF AGCOMM["UNK"!(AGCOMM["OTH")!(AGADDR["UNK")!(AGADDR["OTH")
SET AGERROR=2
QUIT
+3 IF AGCOMM]""
IF AGADDR]""
IF AGCOMM'=AGADDR
SET AGERROR=3
+4 QUIT
+5 ;
SAVE ;
+1 IF HRN=""
SET HRN="NO HRN"
+2 ;inactive/deleted
SET AGINACT=$PIECE($GET(^AUPNPAT(AG2,41,AGDUZ2,0)),U,3)
+3 ;date of death
SET AGDOD=$PIECE($GET(^DPT(AG2,.35)),U)
+4 IF $GET(AGINACT)'=""!($GET(AGDOD)'="")
SET AGADD="I"
+5 IF '$TEST
SET AGADD="A"
+6 IF AGCOMM=""
SET AGCOMM="AANONE"
+7 SET ^AGTMP($JOB,AGERROR,AGCOMM,AGADD,AGNAME,HRN)=AGADDR
+8 IF AGERROR=1
SET AGCNT1=AGCNT1+1
+9 IF AGERROR=2
SET AGCNT2=AGCNT2+1
+10 IF AGERROR=3
SET AGCNT3=AGCNT3+1
+11 SET AGWFLG=1
+12 QUIT
+13 ;
WRITE ;writes record to temp global if condition is met. Also checks
+1 ;for active/inactive status of patient; checks for new page/header.
+2 ;
+3 NEW Z
+4 DO RHDR
+5 SET (AGER,AGHRN,AGNM,AGADD,AGCOM,AGADDR)=""
+6 FOR
SET AGER=$ORDER(^AGTMP($JOB,AGER))
IF AGER=""!AGFLAG1
QUIT
Begin DoDot:1
+7 IF AGER=1
WRITE !,"BLANK CITY/COMMUNITY",!
+8 IF AGER=2
WRITE !,"UNKNOWN/OTHER",!
+9 IF AGER=3
WRITE !,"MISMATCHES",!
+10 FOR
SET AGCOM=$ORDER(^AGTMP($JOB,AGER,AGCOM))
IF AGCOM=""!AGFLAG1
QUIT
Begin DoDot:2
+11 FOR
SET AGADD=$ORDER(^AGTMP($JOB,AGER,AGCOM,AGADD))
IF AGADD=""!AGFLAG1
QUIT
Begin DoDot:3
+12 FOR
SET AGNM=$ORDER(^AGTMP($JOB,AGER,AGCOM,AGADD,AGNM))
IF AGNM=""!AGFLAG1
QUIT
Begin DoDot:4
+13 FOR
SET AGHRN=$ORDER(^AGTMP($JOB,AGER,AGCOM,AGADD,AGNM,AGHRN))
IF AGHRN=""!AGFLAG1
QUIT
Begin DoDot:5
+14 SET AGREC=$GET(^AGTMP($JOB,AGER,AGCOM,AGADD,AGNM,AGHRN))
+15 SET AGADDR=$PIECE(AGREC,U)
+16 IF AGCOM["AANONE"
SET AGCOMM=""
+17 IF '$TEST
SET AGCOMM=AGCOM
+18 WRITE ?3,AGNM
+19 WRITE ?27,AGADD
+20 WRITE ?31,AGHRN
+21 WRITE ?40,AGADDR
+22 WRITE ?60,AGCOMM
+23 WRITE !
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+24 IF 'AGFLAG1
Begin DoDot:2
+25 FOR Z=1:1:80
WRITE "-"
+26 WRITE !
End DoDot:2
End DoDot:1
+27 WRITE !!,"*** END OF REPORT ***",!!
+28 KILL ^AGTMP($JOB)
+29 QUIT
+30 ;
RHDR ;
+1 NEW DATE
+2 SET TOT=0
+3 SET DATE=$$UP^XLFSTR($$FMTE^XLFDT(DT))
+4 SET X=DATE_" COMMUNITY/CITY MISMATCH REPORT Page "_AGPAGE
+5 DO CTR^AG
+6 WRITE !,X
+7 SET X=$PIECE(^AUTTLOC(AGGDUZ2,0),U,2)
+8 DO CTR^AG
+9 WRITE !,X
+10 IF AGALL="C"
SET AGALL="BUM"
+11 IF AGALL="A"
SET AGALL="BU"
+12 IF AGPAGE=1
Begin DoDot:1
+13 WRITE !!,"This report contains "
+14 ;blanks
IF AGALL["B"
Begin DoDot:2
+15 WRITE !?10,"BLANKS",?20,$JUSTIFY(+$GET(AGCNT1),10)
+16 SET TOT=TOT+AGCNT1
End DoDot:2
+17 ;unknowns
IF AGALL["U"
Begin DoDot:2
+18 WRITE !?10,"UNKNOWNS",?20,$JUSTIFY(+$GET(AGCNT2),10)
+19 SET TOT=TOT+AGCNT2
End DoDot:2
+20 ;mismatches
IF AGALL["M"
Begin DoDot:2
+21 WRITE !?10,"MISMATCHES",?20,$JUSTIFY(+$GET(AGCNT3),10)
+22 SET TOT=TOT+AGCNT3
End DoDot:2
+23 WRITE !?10,"TOTAL: ",?20,$JUSTIFY(TOT,10)
End DoDot:1
+24 WRITE !!?3,"NAME",?26,"A/I",?31,"HRN",?40,"MAIL.ADDR-CITY",?60,"CURRENT COMM",!
+25 FOR AG=1:1:80
WRITE "="
+26 WRITE !
+27 SET AGPAGE=AGPAGE+1
+28 QUIT
+29 ;
AGCHECK ;
+1 ;looks that they have an HRN
+2 SET AGFLAG=0
+3 SET AGDUZ2=0
+4 FOR
SET AGDUZ2=$ORDER(^AUPNPAT(AG2,41,AGDUZ2))
IF AGDUZ2=""
QUIT
Begin DoDot:1
+5 IF AGDUZ2=AGGDUZ2
SET HRN=$PIECE($GET(^AUPNPAT(AG2,41,AGDUZ2,0)),U,2)
SET AGFLAG=1
QUIT
End DoDot:1
IF AGFLAG
QUIT
+6 QUIT
+7 ;
BGL ;
+1 USE IO
WRITE $CHAR(9)
+2 ;
+3 IF $$TMPFL^AGGUL1("C")
GOTO DONE
+4 IF $$TMPFL^AGGUL1("R",UID,"AGG"_$JOB)
GOTO DONE
+5 ;
+6 FOR
USE IO
READ HSTEXT:.1
IF HSTEXT[$CHAR(9)
QUIT
Begin DoDot:1
+7 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
+8 IF HSTEXT=""
SET HSTEXT=" "
+9 SET HSTEXT=$$CTRL^AGGUL1(HSTEXT)
+10 ;S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(30)
+11 SET AGGI=AGGI+1
SET @DATA@(AGGI)=HSTEXT_$CHAR(13)_$CHAR(10)_$CHAR(30)
End DoDot:1
+12 ;S AGGI=AGGI+1,@DATA@(AGGI)=$C(30)
+13 ;
+14 IF $$TMPFL^AGGUL1("C")
GOTO DONE
+15 IF $$TMPFL^AGGUL1("D",UID,"AGG"_$JOB)
GOTO DONE
+16 ;
DONE ;
+1 SET AGGI=AGGI+1
SET @DATA@(AGGI)=$CHAR(31)
+2 QUIT
+3 ;
HDR ;
+1 SET @DATA@(AGGI)="T32000REPORT_TEXT"_$CHAR(30)
+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(AGGI)
IF $DATA(DATA)
SET AGGI=AGGI+1
SET @DATA@(AGGI)=$CHAR(31)
+6 IF $$TMPFL^AGGUL1("C")
+7 QUIT
