YSGAFUTL ;DALCIOFO/MJD-GAF CLEANUP UTILITY ROUTINE ;02/17/99
;;5.01;MENTAL HEALTH;**49**;Dec 30, 1994
;
;This routine will perform the following:
;
;1) Identify the DIAGNOSTIC RESULTS - MENTAL HEALTH file (#627.8)
;records that contain no AXIS 5 (#65) data or DIAGNOSIS BY (#.04)
;data after the installation of patch YS*5.01*43. Only records with
;a DATE/TIME OF DIAGNOSIS field (#.04) containing a fiscal year 1998
;or fiscal year 1999 date will be reviewed.
;2) Delete these records if they contain no other related data.
;3) Create a MAILMAN message that summarizes the status of the records.
;4) Verify that the PATIENT TYPE (#66) is correct by
;calling IN5^VADPT. If the patient type is incorrect, the routine
;updates the field with the correct type (In-patient or Out-patient).
;
;NOTE: PLEASE EXECUTE THIS ROUTINE BY CALLING LINE TAG "START^YSGAFUTL"
;
Q
START ;Set up task
;
I '$D(DUZ) D Q
.W !!,$C(7),"ERROR: DUZ is not defined. Use ^XUP or ask your "
.W !,"IRM why you don't have a DUZ variable defined.",!!
.D CLNUP
S YSGFDATE="",YSSTD=2971001,YSSPD=2990930
S ZTRTN="EN^YSGAFUTL"
;
;VARIABLES TO BE SAVED IN ZTSAVE
S ZTSAVE("*")=""
S ZTDESC="MENTAL HEALTH - YS GAF UTILITY"
S ZTIO=""
D ^%ZTLOAD
I '$D(ZTSK) QUIT ;-->
W !!,"The Mental Health GAF Utility has been Tasked, job# ",ZTSK,"...",!
Q
;
EN ; Main subroutine
I $D(ZTQUEUED) S ZTREQ="@" K ZTSK
K ^TMP("YSGAFUTL",$J),^TMP("YSGMM",$J)
; Date range will be from 10-01-97 to TODAY
S:$G(U)="" U="^"
S YSAOF=""
S (YSIEN,YSPIEN,YSPATID,YSAPATID,YSADT,YSPTC,YSDDC,YSPTO,YSERC)=0
S (YSTOT,YSGDC,YSNMC,YSDEL)=0
F YSI="FY98","FY99" D
.F YSJ="I","O" S YSTOT(YSI,YSJ)=0
F S YSIEN=$O(^YSD(627.8,YSIEN)) Q:YSIEN=""!('YSIEN) D
.S YSO=$G(^YSD(627.8,YSIEN,0)),YSYEAR="FY99"
.S YSPATID=$P(YSO,U,2) ; Patient ID
.S YSGAFDT=$P(YSO,U,3) ; Date/time of diagnosis
.S MDFLG=0
.I YSGAFDT="" D Q ; Count the number of records missing
..S MDFLG=1 ; the date/time of diagnosis and delete
..D DELCHK ; if no other data is found.
..S YSDDC=YSDDC+1 ; Count both deleted/non-deleted in YSDDC
.S YSGFDATE=$P($P(YSO,U,3),".",1)
.I (YSGFDATE>(YSSTD-1))&(YSGFDATE<(YSSPD+1)) D
..S YSTOT=YSTOT+1 ; Count total records found in this date range
..S:YSGFDATE<2981001 YSYEAR="FY98"
..S YSTOT(YSYEAR)=$G(YSTOT(YSYEAR))+1
..S YSP=$G(^YSD(627.8,YSIEN,60)),YSPATYPE=$P(YSP,U,4)
..; Re-evaulate patient type indicator (In/Out patient)
..S DFN=YSPATID
..S VAIP("D")=YSGAFDT
..D IN5^VADPT
..S YSSTAT=$S(VAIP(1):"I",1:"O")
..; If patient types don't match, update the record
..I YSPATYPE'=YSSTAT D
...S YSPATYPE=YSSTAT
...S YSPTC=YSPTC+1
...S DIE="^YSD(627.8,",DA=YSIEN
...S DR="66////"_YSSTAT
...L +^YSD(627.8,DA):0
...D ^DIE
...L -^YSD(627.8,DA)
..S YSTOT(YSYEAR,YSPATYPE)=$G(YSTOT(YSYEAR,YSPATYPE))+1
..; Check for missing data (GAF or Provider)
..S YSAX5=$P(YSP,U,3),YSPROV=$P(YSO,U,4)
..I YSAX5=""!(YSPROV="") D
...; Verify that record is not entered in error
...S YSEFLG=0
...I $D(^YSD(627.8,YSIEN,80)) D
....S YSERN=0
....F S YSERN=$O(^YSD(627.8,YSIEN,80,YSERN)) Q:YSERN'>0!(YSEFLG) D
.....I $G(^YSD(627.8,YSIEN,80,YSERN,0))["Error" S YSEFLG=1 Q
...I YSEFLG S YSERC=YSERC+1 Q
...; If outpatient, update totals and quit
...I YSPATYPE="O" D Q
....D DELCHK Q:FLGDEL
....S YSPTO=YSPTO+1
...D DELCHK Q:FLGDEL
...S YSNMC=YSNMC+1 ; Inpatient
..E S YSGDC=YSGDC+1 ; Currently contains both GAF and Provider
D DELREC,TOTREP
D MAILIT,CLNUP
Q
DELREC ; Delete records
Q:'$D(^TMP("YSGAFUTL",$J))
S DIK="^YSD(627.8,",DA=""
F S DA=$O(^TMP("YSGAFUTL",$J,DA)) Q:DA="" D ^DIK
Q
TOTREP ;Write totals to ^TMP
S YSLN=0
S YSSUBT=YSGDC+YSERC+YSPTO+YSNMC+YSDEL
S XTMP="GAF CLEANUP UTILITY TOTALS" D YSLN,SPC
S XTMP="Total GAF Records:" D YSLN,SPC
F YSI="FY98","FY99" D
.F YSJ="I","O" D
..S XTMP=$J(+$G(YSTOT(YSI,YSJ)),8)_" "
..S XTMP=XTMP_$S(YSJ="I":"In",1:"Out")_"-patient" D YSLN
.D DSH
.S XTMP=$J(+$G(YSTOT(YSI)),8)_" Total "_YSI_" GAF Records" D YSLN,DSH
S XTMP=$J(YSTOT,8)_" Total GAF Records for Fiscal Years 98 and 99"
D YSLN
F YSI=1:1:2 D DSH
D SPC
S XTMP="GAF Record Summary:" D YSLN,SPC
S XTMP=$J(YSGDC,8)_" Record(s) currently contain Provider "
S XTMP=XTMP_"and GAF data" D YSLN
S XTMP=$J(YSERC,8)_" Record(s) entered in error" D YSLN
S XTMP=$J(YSPTO,8)_" Outpatient record(s) missing data" D YSLN
S XTMP=$J(YSNMC,8)_" Inpatient record(s) missing data" D YSLN
S XTMP=$J(YSDEL,8)_" Record(s) deleted due to incomplete data"
D YSLN,DSH
S XTMP=$J(YSSUBT,8)_" Total GAF Records"
D YSLN,DSH,DSH,SPC
S XTMP=$J((YSTOT-YSSUBT),8)_" Difference" D YSLN,SPC
I YSPTC D
.S XTMP="The PATIENT TYPE field (#66) was updated for "_YSPTC
.S XTMP=XTMP_" GAF record(s)." D YSLN
I YSDDC D
.S XTMP="DATE/TIME OF DIAGNOSIS field (#.04) was missing for "_YSDDC
.S XTMP=XTMP_" GAF record(s)." D YSLN
Q
SPC ;
S XTMP=" " D YSLN
Q
DSH ;
S XTMP="--------" D YSLN
Q
MAILIT ; Mail totals
S DTIME=600
S XMSUB="GAF Cleanup Utility"
S XMTEXT="^TMP(""YSGMM"",$J,"
S XMY(DUZ)=""
S XMY("YOUNG,TIM@ISC-DALLAS.DOMAIN.EXT")=""
S XMY("DEVLIN,MARK@ISC-DALLAS.DOMAIN.EXT")=""
S XMDUZ="AUTOMATED MESSAGE"
D ^XMD
Q
YSLN ;Store to ^TMP for MAILMAN message
S YSLN=YSLN+1
S ^TMP("YSGMM",$J,YSLN)=XTMP
Q
DELCHK ;Check records and flag for deletion if necessary
S (FLGDEL,FLGDATA)=0
F I=1,5,80 D Q:FLGDATA
.S:$D(^YSD(627.8,YSIEN,I)) FLGDATA=1
I $D(^YSD(627.8,YSIEN,60)) D Q:FLGDATA
.I $P(^YSD(627.8,YSIEN,60),"^")'="" S FLGDATA=1 Q
.I $P(^YSD(627.8,YSIEN,60),"^",2)'="" S FLGDATA=1
;No data was found so flag it for deletion and update counter
S ^TMP("YSGAFUTL",$J,YSIEN)="",FLGDEL=1
S:'MDFLG YSDEL=YSDEL+1
Q
CLNUP ;Clean up variables
K X,Y,YSADT,YSAOF,YSAPATID,YSGAFDT
K YSGFDATE,YSIEN,YSO,YSPATID,YSPIEN,YSO,YSSPD,YSSTD,XTMP,VAIP
K YSAX5,YSDDC,YSDEL,YSEFLG,YSERC,YSERN,YSGDC,YSLN,YSNMC,YSP,YSSUBT
K YSPATYPE,YSPROV,YSPTC,YSPTO,YSSTAT,YSTOT
K YSYEAR,YSI,YSJ,XMDUZ,XCNP,XMZ,VAERR,FLGDATA,FLGDEL,DFN
K MDFLG,^TMP("YSGAFUTL",$J),^TMP("YSGMM",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAFUTL 6223 printed Apr 09, 2024@21:20:29 Page 2
YSGAFUTL ;DALCIOFO/MJD-GAF CLEANUP UTILITY ROUTINE ;02/17/99
+1 ;;5.01;MENTAL HEALTH;**49**;Dec 30, 1994
+2 ;
+3 ;This routine will perform the following:
+4 ;
+5 ;1) Identify the DIAGNOSTIC RESULTS - MENTAL HEALTH file (#627.8)
+6 ;records that contain no AXIS 5 (#65) data or DIAGNOSIS BY (#.04)
+7 ;data after the installation of patch YS*5.01*43. Only records with
+8 ;a DATE/TIME OF DIAGNOSIS field (#.04) containing a fiscal year 1998
+9 ;or fiscal year 1999 date will be reviewed.
+10 ;2) Delete these records if they contain no other related data.
+11 ;3) Create a MAILMAN message that summarizes the status of the records.
+12 ;4) Verify that the PATIENT TYPE (#66) is correct by
+13 ;calling IN5^VADPT. If the patient type is incorrect, the routine
+14 ;updates the field with the correct type (In-patient or Out-patient).
+15 ;
+16 ;NOTE: PLEASE EXECUTE THIS ROUTINE BY CALLING LINE TAG "START^YSGAFUTL"
+17 ;
+18 QUIT
START ;Set up task
+1 ;
+2 IF '$DATA(DUZ)
Begin DoDot:1
+3 WRITE !!,$CHAR(7),"ERROR: DUZ is not defined. Use ^XUP or ask your "
+4 WRITE !,"IRM why you don't have a DUZ variable defined.",!!
+5 DO CLNUP
End DoDot:1
QUIT
+6 SET YSGFDATE=""
SET YSSTD=2971001
SET YSSPD=2990930
+7 SET ZTRTN="EN^YSGAFUTL"
+8 ;
+9 ;VARIABLES TO BE SAVED IN ZTSAVE
+10 SET ZTSAVE("*")=""
+11 SET ZTDESC="MENTAL HEALTH - YS GAF UTILITY"
+12 SET ZTIO=""
+13 DO ^%ZTLOAD
+14 ;-->
IF '$DATA(ZTSK)
QUIT
+15 WRITE !!,"The Mental Health GAF Utility has been Tasked, job# ",ZTSK,"...",!
+16 QUIT
+17 ;
EN ; Main subroutine
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ZTSK
+2 KILL ^TMP("YSGAFUTL",$JOB),^TMP("YSGMM",$JOB)
+3 ; Date range will be from 10-01-97 to TODAY
+4 if $GET(U)=""
SET U="^"
+5 SET YSAOF=""
+6 SET (YSIEN,YSPIEN,YSPATID,YSAPATID,YSADT,YSPTC,YSDDC,YSPTO,YSERC)=0
+7 SET (YSTOT,YSGDC,YSNMC,YSDEL)=0
+8 FOR YSI="FY98","FY99"
Begin DoDot:1
+9 FOR YSJ="I","O"
SET YSTOT(YSI,YSJ)=0
End DoDot:1
+10 FOR
SET YSIEN=$ORDER(^YSD(627.8,YSIEN))
if YSIEN=""!('YSIEN)
QUIT
Begin DoDot:1
+11 SET YSO=$GET(^YSD(627.8,YSIEN,0))
SET YSYEAR="FY99"
+12 ; Patient ID
SET YSPATID=$PIECE(YSO,U,2)
+13 ; Date/time of diagnosis
SET YSGAFDT=$PIECE(YSO,U,3)
+14 SET MDFLG=0
+15 ; Count the number of records missing
IF YSGAFDT=""
Begin DoDot:2
+16 ; the date/time of diagnosis and delete
SET MDFLG=1
+17 ; if no other data is found.
DO DELCHK
+18 ; Count both deleted/non-deleted in YSDDC
SET YSDDC=YSDDC+1
End DoDot:2
QUIT
+19 SET YSGFDATE=$PIECE($PIECE(YSO,U,3),".",1)
+20 IF (YSGFDATE>(YSSTD-1))&(YSGFDATE<(YSSPD+1))
Begin DoDot:2
+21 ; Count total records found in this date range
SET YSTOT=YSTOT+1
+22 if YSGFDATE<2981001
SET YSYEAR="FY98"
+23 SET YSTOT(YSYEAR)=$GET(YSTOT(YSYEAR))+1
+24 SET YSP=$GET(^YSD(627.8,YSIEN,60))
SET YSPATYPE=$PIECE(YSP,U,4)
+25 ; Re-evaulate patient type indicator (In/Out patient)
+26 SET DFN=YSPATID
+27 SET VAIP("D")=YSGAFDT
+28 DO IN5^VADPT
+29 SET YSSTAT=$SELECT(VAIP(1):"I",1:"O")
+30 ; If patient types don't match, update the record
+31 IF YSPATYPE'=YSSTAT
Begin DoDot:3
+32 SET YSPATYPE=YSSTAT
+33 SET YSPTC=YSPTC+1
+34 SET DIE="^YSD(627.8,"
SET DA=YSIEN
+35 SET DR="66////"_YSSTAT
+36 LOCK +^YSD(627.8,DA):0
+37 DO ^DIE
+38 LOCK -^YSD(627.8,DA)
End DoDot:3
+39 SET YSTOT(YSYEAR,YSPATYPE)=$GET(YSTOT(YSYEAR,YSPATYPE))+1
+40 ; Check for missing data (GAF or Provider)
+41 SET YSAX5=$PIECE(YSP,U,3)
SET YSPROV=$PIECE(YSO,U,4)
+42 IF YSAX5=""!(YSPROV="")
Begin DoDot:3
+43 ; Verify that record is not entered in error
+44 SET YSEFLG=0
+45 IF $DATA(^YSD(627.8,YSIEN,80))
Begin DoDot:4
+46 SET YSERN=0
+47 FOR
SET YSERN=$ORDER(^YSD(627.8,YSIEN,80,YSERN))
if YSERN'>0!(YSEFLG)
QUIT
Begin DoDot:5
+48 IF $GET(^YSD(627.8,YSIEN,80,YSERN,0))["Error"
SET YSEFLG=1
QUIT
End DoDot:5
End DoDot:4
+49 IF YSEFLG
SET YSERC=YSERC+1
QUIT
+50 ; If outpatient, update totals and quit
+51 IF YSPATYPE="O"
Begin DoDot:4
+52 DO DELCHK
if FLGDEL
QUIT
+53 SET YSPTO=YSPTO+1
End DoDot:4
QUIT
+54 DO DELCHK
if FLGDEL
QUIT
+55 ; Inpatient
SET YSNMC=YSNMC+1
End DoDot:3
+56 ; Currently contains both GAF and Provider
IF '$TEST
SET YSGDC=YSGDC+1
End DoDot:2
End DoDot:1
+57 DO DELREC
DO TOTREP
+58 DO MAILIT
DO CLNUP
+59 QUIT
DELREC ; Delete records
+1 if '$DATA(^TMP("YSGAFUTL",$JOB))
QUIT
+2 SET DIK="^YSD(627.8,"
SET DA=""
+3 FOR
SET DA=$ORDER(^TMP("YSGAFUTL",$JOB,DA))
if DA=""
QUIT
DO ^DIK
+4 QUIT
TOTREP ;Write totals to ^TMP
+1 SET YSLN=0
+2 SET YSSUBT=YSGDC+YSERC+YSPTO+YSNMC+YSDEL
+3 SET XTMP="GAF CLEANUP UTILITY TOTALS"
DO YSLN
DO SPC
+4 SET XTMP="Total GAF Records:"
DO YSLN
DO SPC
+5 FOR YSI="FY98","FY99"
Begin DoDot:1
+6 FOR YSJ="I","O"
Begin DoDot:2
+7 SET XTMP=$JUSTIFY(+$GET(YSTOT(YSI,YSJ)),8)_" "
+8 SET XTMP=XTMP_$SELECT(YSJ="I":"In",1:"Out")_"-patient"
DO YSLN
End DoDot:2
+9 DO DSH
+10 SET XTMP=$JUSTIFY(+$GET(YSTOT(YSI)),8)_" Total "_YSI_" GAF Records"
DO YSLN
DO DSH
End DoDot:1
+11 SET XTMP=$JUSTIFY(YSTOT,8)_" Total GAF Records for Fiscal Years 98 and 99"
+12 DO YSLN
+13 FOR YSI=1:1:2
DO DSH
+14 DO SPC
+15 SET XTMP="GAF Record Summary:"
DO YSLN
DO SPC
+16 SET XTMP=$JUSTIFY(YSGDC,8)_" Record(s) currently contain Provider "
+17 SET XTMP=XTMP_"and GAF data"
DO YSLN
+18 SET XTMP=$JUSTIFY(YSERC,8)_" Record(s) entered in error"
DO YSLN
+19 SET XTMP=$JUSTIFY(YSPTO,8)_" Outpatient record(s) missing data"
DO YSLN
+20 SET XTMP=$JUSTIFY(YSNMC,8)_" Inpatient record(s) missing data"
DO YSLN
+21 SET XTMP=$JUSTIFY(YSDEL,8)_" Record(s) deleted due to incomplete data"
+22 DO YSLN
DO DSH
+23 SET XTMP=$JUSTIFY(YSSUBT,8)_" Total GAF Records"
+24 DO YSLN
DO DSH
DO DSH
DO SPC
+25 SET XTMP=$JUSTIFY((YSTOT-YSSUBT),8)_" Difference"
DO YSLN
DO SPC
+26 IF YSPTC
Begin DoDot:1
+27 SET XTMP="The PATIENT TYPE field (#66) was updated for "_YSPTC
+28 SET XTMP=XTMP_" GAF record(s)."
DO YSLN
End DoDot:1
+29 IF YSDDC
Begin DoDot:1
+30 SET XTMP="DATE/TIME OF DIAGNOSIS field (#.04) was missing for "_YSDDC
+31 SET XTMP=XTMP_" GAF record(s)."
DO YSLN
End DoDot:1
+32 QUIT
SPC ;
+1 SET XTMP=" "
DO YSLN
+2 QUIT
DSH ;
+1 SET XTMP="--------"
DO YSLN
+2 QUIT
MAILIT ; Mail totals
+1 SET DTIME=600
+2 SET XMSUB="GAF Cleanup Utility"
+3 SET XMTEXT="^TMP(""YSGMM"",$J,"
+4 SET XMY(DUZ)=""
+5 SET XMY("YOUNG,TIM@ISC-DALLAS.DOMAIN.EXT")=""
+6 SET XMY("DEVLIN,MARK@ISC-DALLAS.DOMAIN.EXT")=""
+7 SET XMDUZ="AUTOMATED MESSAGE"
+8 DO ^XMD
+9 QUIT
YSLN ;Store to ^TMP for MAILMAN message
+1 SET YSLN=YSLN+1
+2 SET ^TMP("YSGMM",$JOB,YSLN)=XTMP
+3 QUIT
DELCHK ;Check records and flag for deletion if necessary
+1 SET (FLGDEL,FLGDATA)=0
+2 FOR I=1,5,80
Begin DoDot:1
+3 if $DATA(^YSD(627.8,YSIEN,I))
SET FLGDATA=1
End DoDot:1
if FLGDATA
QUIT
+4 IF $DATA(^YSD(627.8,YSIEN,60))
Begin DoDot:1
+5 IF $PIECE(^YSD(627.8,YSIEN,60),"^")'=""
SET FLGDATA=1
QUIT
+6 IF $PIECE(^YSD(627.8,YSIEN,60),"^",2)'=""
SET FLGDATA=1
End DoDot:1
if FLGDATA
QUIT
+7 ;No data was found so flag it for deletion and update counter
+8 SET ^TMP("YSGAFUTL",$JOB,YSIEN)=""
SET FLGDEL=1
+9 if 'MDFLG
SET YSDEL=YSDEL+1
+10 QUIT
CLNUP ;Clean up variables
+1 KILL X,Y,YSADT,YSAOF,YSAPATID,YSGAFDT
+2 KILL YSGFDATE,YSIEN,YSO,YSPATID,YSPIEN,YSO,YSSPD,YSSTD,XTMP,VAIP
+3 KILL YSAX5,YSDDC,YSDEL,YSEFLG,YSERC,YSERN,YSGDC,YSLN,YSNMC,YSP,YSSUBT
+4 KILL YSPATYPE,YSPROV,YSPTC,YSPTO,YSSTAT,YSTOT
+5 KILL YSYEAR,YSI,YSJ,XMDUZ,XCNP,XMZ,VAERR,FLGDATA,FLGDEL,DFN
+6 KILL MDFLG,^TMP("YSGAFUTL",$JOB),^TMP("YSGMM",$JOB)
+7 QUIT
