YSGAFTR ;DALOI/MJE/MJD-GAF INT ENTRY BUILD ROUTINE ;09/01/98 16:17
;;5.01;MENTAL HEALTH;**43,49,59**;Dec 30, 1994
;
;This routine will be executed from option YS GAF TRANSMISSION.
;This routine will transmit GAF data for the dates entered. This
;routine will also be used to re-transmit GAF data as needed.
;It will only transmit GAF records containing all necessary
;pieces of information. A MAILMAN message for each GAF score
;transmitted will be sent to users enrolled in mail group
;YS GAF TRANSMISSION ACK.
;
;
Q
START ;
; Date range will be from no less than 10-01-1997 to any time
; in the future.
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=""
D DTRANGE Q:+Y<1
K ^TMP("YSGAFTR",$J)
S ZTRTN="GEN^YSGAFTR"
;
;VARIABLES TO BE SAVED IN ZTSAVE
S ZTSAVE("*")=""
;
S ZTDESC="MENTAL HEALTH - GAF TRANSMISSION"
S ZTIO=""
D ^%ZTLOAD
I '$D(ZTSK) QUIT ;-->
W !!,"The Mental Health GAF Transmission has been Tasked, job# "
W ZTSK,"...",!
Q
;
DTRANGE ;
W !
S (YSSTD,YSSPD)=0
S %DT("A")="Enter the Start date: ",%DT="AEQ",%DT(0)=2971001
D ^%DT K %DT
Q:+Y<1
S YSSTD=+Y
W !
S %DT("A")="Enter the End date: ",%DT="AEQ"
D ^%DT K %DT
Q:+Y<1
S YSSPD=+Y
I YSSPD<YSSTD D G DTRANGE
.W !?5,"... Start date is after the Ending date ..."
.W !?5,"... Please re-enter both the Start and Ending Dates ..."
.H 2 W $C(7)
Q
;
GEN ;
I $D(ZTQUEUED) S ZTREQ="@" K ZTSK
S (YSIEN,YSTOT,YSINC,YSTRMT,YSSUBT)=0
F YSJ="I","O" D
.S (YSTOT(YSJ),YSTRMT(YSJ),YSINC(YSJ))=0
F S YSIEN=$O(^YSD(627.8,YSIEN)) Q:YSIEN=""!('YSIEN) D
.S YSGFDATE=$P($P($G(^YSD(627.8,YSIEN,0)),"^",1),".",1)
.S YSO=$G(^YSD(627.8,YSIEN,0))
.S YSPATID=$P(YSO,U,2) ; Patient ID
.S YSGAFDT=$P(YSO,U,3) ; Date/time of diagnosis
.Q:YSGAFDT=""
.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 YSP=$G(^YSD(627.8,YSIEN,60)),YSPATYPE=$P(YSP,U,4)
..I YSPATYPE="" D Q:YSPATYPE=""
...Q:YSPATID=""
...S DFN=YSPATID
...D PATSTAT^YSDX3B
...I '$D(DFN) D QUIT ;--->
....D EN^YSGAFOBX(YSIEN)
...S YSPATYPE=YSSTAT
..S YSTOT(YSPATYPE)=YSTOT(YSPATYPE)+1
..S YSAX5=$P(YSP,U,3),YSPROV=$P(YSO,U,4)
..I YSAX5=""!(YSPROV="") D Q
...S YSINC=YSINC+1
...S YSINC(YSPATYPE)=YSINC(YSPATYPE)+1
..S YSTRMT=YSTRMT+1
..S YSTRMT(YSPATYPE)=YSTRMT(YSPATYPE)+1
..D EN^YSGAFOBX(YSIEN)
D REPORT,MAILIT,CLNUP
Q
REPORT ;
S YSSUBT=YSINC+YSTRMT,YSLN=0
S XTMP="GAF TRANSMISSION TOTALS" D YSLN,SPC
S XTMP="Total GAF Records:" D YSLN,SPC
F YSJ="I","O" D
.S XTMP=$J(+YSTOT(YSJ),8)_" "
.S XTMP=XTMP_$S(YSJ="I":"In",1:"Out")_"-patient" D YSLN
S XTMP=$J(YSTOT,8)_" Total GAF Records"
D YSLN,DSH,DSH,SPC
S XTMP="GAF Records Transmitted:" D YSLN,SPC
F YSJ="I","O" D
.S XTMP=$J(+YSTRMT(YSJ),8)_" "
.S XTMP=XTMP_$S(YSJ="I":"In",1:"Out")_"-patient" D YSLN
S XTMP=$J(YSTRMT,8)_" GAF Record(s) transmitted" D YSLN,SPC
S XTMP="GAF Records Not Transmitted:" D YSLN,SPC
F YSJ="I","O" D
.S XTMP=$J(+YSINC(YSJ),8)_" "
.S XTMP=XTMP_$S(YSJ="I":"In",1:"Out")_"-patient" D YSLN
S XTMP=$J(YSINC,8)_" GAF Record(s) not transmitted" D YSLN,DSH,SPC
S XTMP=$J(YSSUBT,8)_" Total GAF Records" D YSLN,DSH,DSH,SPC
S XTMP=$J((YSTOT-YSSUBT),8)_" Difference" D YSLN
Q
SPC ;
S XTMP=" " D YSLN
Q
DSH ;
S XTMP="--------" D YSLN
Q
YSLN ;Store to ^TMP for MAILMAN message
S YSLN=YSLN+1
S ^TMP("YSGAFTR",$J,YSLN)=XTMP
Q
MAILIT ; Mail totals
S DTIME=600
S XMSUB="GAF Transmission"
S XMTEXT="^TMP(""YSGAFTR"",$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
S DTIME=$$DTIME^XUP(DUZ)
Q
CLNUP ;This section for clean up of variables
K X,Y,YSDIROUT,YSDIRUT,YSDUOUT,YSDTOUT,YSGFDATE,YSIEN,YSSPD,YSSTD
K YSANIMA,YSHH,YSSTAT,YSAX5,YSGAFDT,YSINC,YSLN,YSO,YSP,YSPATID
K YSPATYPE,YSPROV,YSSUBT,YSTOT,YSTRMT,ZTDESC,ZTIO,ZTRTN,ZTSAVE
K XTMP,XMDUZ,XMSUB,XMTEXT,XMSUB,XMY,XCNP,XMZ,YSYEAR,YSJ,YSI
K ^TMP("YSGAFTR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAFTR 4256 printed Apr 09, 2024@21:19:18 Page 2
YSGAFTR ;DALOI/MJE/MJD-GAF INT ENTRY BUILD ROUTINE ;09/01/98 16:17
+1 ;;5.01;MENTAL HEALTH;**43,49,59**;Dec 30, 1994
+2 ;
+3 ;This routine will be executed from option YS GAF TRANSMISSION.
+4 ;This routine will transmit GAF data for the dates entered. This
+5 ;routine will also be used to re-transmit GAF data as needed.
+6 ;It will only transmit GAF records containing all necessary
+7 ;pieces of information. A MAILMAN message for each GAF score
+8 ;transmitted will be sent to users enrolled in mail group
+9 ;YS GAF TRANSMISSION ACK.
+10 ;
+11 ;
+12 QUIT
START ;
+1 ; Date range will be from no less than 10-01-1997 to any time
+2 ; in the future.
+3 IF '$DATA(DUZ)
Begin DoDot:1
+4 WRITE !!,$CHAR(7),"ERROR: DUZ is not defined. Use ^XUP or ask your "
+5 WRITE !,"IRM why you don't have a DUZ variable defined.",!!
+6 DO CLNUP
End DoDot:1
QUIT
+7 ;
+8 SET YSGFDATE=""
+9 DO DTRANGE
if +Y<1
QUIT
+10 KILL ^TMP("YSGAFTR",$JOB)
+11 SET ZTRTN="GEN^YSGAFTR"
+12 ;
+13 ;VARIABLES TO BE SAVED IN ZTSAVE
+14 SET ZTSAVE("*")=""
+15 ;
+16 SET ZTDESC="MENTAL HEALTH - GAF TRANSMISSION"
+17 SET ZTIO=""
+18 DO ^%ZTLOAD
+19 ;-->
IF '$DATA(ZTSK)
QUIT
+20 WRITE !!,"The Mental Health GAF Transmission has been Tasked, job# "
+21 WRITE ZTSK,"...",!
+22 QUIT
+23 ;
DTRANGE ;
+1 WRITE !
+2 SET (YSSTD,YSSPD)=0
+3 SET %DT("A")="Enter the Start date: "
SET %DT="AEQ"
SET %DT(0)=2971001
+4 DO ^%DT
KILL %DT
+5 if +Y<1
QUIT
+6 SET YSSTD=+Y
+7 WRITE !
+8 SET %DT("A")="Enter the End date: "
SET %DT="AEQ"
+9 DO ^%DT
KILL %DT
+10 if +Y<1
QUIT
+11 SET YSSPD=+Y
+12 IF YSSPD<YSSTD
Begin DoDot:1
+13 WRITE !?5,"... Start date is after the Ending date ..."
+14 WRITE !?5,"... Please re-enter both the Start and Ending Dates ..."
+15 HANG 2
WRITE $CHAR(7)
End DoDot:1
GOTO DTRANGE
+16 QUIT
+17 ;
GEN ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ZTSK
+2 SET (YSIEN,YSTOT,YSINC,YSTRMT,YSSUBT)=0
+3 FOR YSJ="I","O"
Begin DoDot:1
+4 SET (YSTOT(YSJ),YSTRMT(YSJ),YSINC(YSJ))=0
End DoDot:1
+5 FOR
SET YSIEN=$ORDER(^YSD(627.8,YSIEN))
if YSIEN=""!('YSIEN)
QUIT
Begin DoDot:1
+6 SET YSGFDATE=$PIECE($PIECE($GET(^YSD(627.8,YSIEN,0)),"^",1),".",1)
+7 SET YSO=$GET(^YSD(627.8,YSIEN,0))
+8 ; Patient ID
SET YSPATID=$PIECE(YSO,U,2)
+9 ; Date/time of diagnosis
SET YSGAFDT=$PIECE(YSO,U,3)
+10 if YSGAFDT=""
QUIT
+11 SET YSGFDATE=$PIECE($PIECE(YSO,U,3),".",1)
+12 IF (YSGFDATE>(YSSTD-1))&(YSGFDATE<(YSSPD+1))
Begin DoDot:2
+13 ; Count total records found in this date range
SET YSTOT=YSTOT+1
+14 SET YSP=$GET(^YSD(627.8,YSIEN,60))
SET YSPATYPE=$PIECE(YSP,U,4)
+15 IF YSPATYPE=""
Begin DoDot:3
+16 if YSPATID=""
QUIT
+17 SET DFN=YSPATID
+18 DO PATSTAT^YSDX3B
+19 ;--->
IF '$DATA(DFN)
Begin DoDot:4
+20 DO EN^YSGAFOBX(YSIEN)
End DoDot:4
QUIT
+21 SET YSPATYPE=YSSTAT
End DoDot:3
if YSPATYPE=""
QUIT
+22 SET YSTOT(YSPATYPE)=YSTOT(YSPATYPE)+1
+23 SET YSAX5=$PIECE(YSP,U,3)
SET YSPROV=$PIECE(YSO,U,4)
+24 IF YSAX5=""!(YSPROV="")
Begin DoDot:3
+25 SET YSINC=YSINC+1
+26 SET YSINC(YSPATYPE)=YSINC(YSPATYPE)+1
End DoDot:3
QUIT
+27 SET YSTRMT=YSTRMT+1
+28 SET YSTRMT(YSPATYPE)=YSTRMT(YSPATYPE)+1
+29 DO EN^YSGAFOBX(YSIEN)
End DoDot:2
End DoDot:1
+30 DO REPORT
DO MAILIT
DO CLNUP
+31 QUIT
REPORT ;
+1 SET YSSUBT=YSINC+YSTRMT
SET YSLN=0
+2 SET XTMP="GAF TRANSMISSION TOTALS"
DO YSLN
DO SPC
+3 SET XTMP="Total GAF Records:"
DO YSLN
DO SPC
+4 FOR YSJ="I","O"
Begin DoDot:1
+5 SET XTMP=$JUSTIFY(+YSTOT(YSJ),8)_" "
+6 SET XTMP=XTMP_$SELECT(YSJ="I":"In",1:"Out")_"-patient"
DO YSLN
End DoDot:1
+7 SET XTMP=$JUSTIFY(YSTOT,8)_" Total GAF Records"
+8 DO YSLN
DO DSH
DO DSH
DO SPC
+9 SET XTMP="GAF Records Transmitted:"
DO YSLN
DO SPC
+10 FOR YSJ="I","O"
Begin DoDot:1
+11 SET XTMP=$JUSTIFY(+YSTRMT(YSJ),8)_" "
+12 SET XTMP=XTMP_$SELECT(YSJ="I":"In",1:"Out")_"-patient"
DO YSLN
End DoDot:1
+13 SET XTMP=$JUSTIFY(YSTRMT,8)_" GAF Record(s) transmitted"
DO YSLN
DO SPC
+14 SET XTMP="GAF Records Not Transmitted:"
DO YSLN
DO SPC
+15 FOR YSJ="I","O"
Begin DoDot:1
+16 SET XTMP=$JUSTIFY(+YSINC(YSJ),8)_" "
+17 SET XTMP=XTMP_$SELECT(YSJ="I":"In",1:"Out")_"-patient"
DO YSLN
End DoDot:1
+18 SET XTMP=$JUSTIFY(YSINC,8)_" GAF Record(s) not transmitted"
DO YSLN
DO DSH
DO SPC
+19 SET XTMP=$JUSTIFY(YSSUBT,8)_" Total GAF Records"
DO YSLN
DO DSH
DO DSH
DO SPC
+20 SET XTMP=$JUSTIFY((YSTOT-YSSUBT),8)_" Difference"
DO YSLN
+21 QUIT
SPC ;
+1 SET XTMP=" "
DO YSLN
+2 QUIT
DSH ;
+1 SET XTMP="--------"
DO YSLN
+2 QUIT
YSLN ;Store to ^TMP for MAILMAN message
+1 SET YSLN=YSLN+1
+2 SET ^TMP("YSGAFTR",$JOB,YSLN)=XTMP
+3 QUIT
MAILIT ; Mail totals
+1 SET DTIME=600
+2 SET XMSUB="GAF Transmission"
+3 SET XMTEXT="^TMP(""YSGAFTR"",$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 SET DTIME=$$DTIME^XUP(DUZ)
+10 QUIT
CLNUP ;This section for clean up of variables
+1 KILL X,Y,YSDIROUT,YSDIRUT,YSDUOUT,YSDTOUT,YSGFDATE,YSIEN,YSSPD,YSSTD
+2 KILL YSANIMA,YSHH,YSSTAT,YSAX5,YSGAFDT,YSINC,YSLN,YSO,YSP,YSPATID
+3 KILL YSPATYPE,YSPROV,YSSUBT,YSTOT,YSTRMT,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+4 KILL XTMP,XMDUZ,XMSUB,XMTEXT,XMSUB,XMY,XCNP,XMZ,YSYEAR,YSJ,YSI
+5 KILL ^TMP("YSGAFTR",$JOB)
+6 QUIT
