- 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 Feb 18, 2025@23:40:54 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