DGMTREQB ;ALB/CAW Send mail bulletin if means test required ; 06/16/2004
;;5.3;Registration;**3,608**;Aug 13, 1993
;
;
EN ;
I '$D(SDATA) G ENQ
S (DGMTYPT,DGMSGF)=1,DFN=$P(SDATA,U,2)
S DGMT=$$LST^DGMTU($P(SDATA,U,2))
I $P($G(^DGMT(408.31,+DGMT,"BUL")),U)'=DT D MAIL
ENQ K DGMT,DGBUL,DGLN,VA,VAERR Q
MAIL ;
N XMDUZ,XMSUB,XMTEXT,SDATA1,SDATA2,SDWHAT
; use site specified mg and bull is only sent if mg defined
Q:"^1^4^5^"'[(U_SDAMEVT_U)!($P($G(^TMP("SDAMEVT",$J,"AFTER","DPT")),U,16)'=9) D ^DGMTR S DGMT=$$LST^DGMTU($P(SDATA,U,2))
I $P(DGMT,U,4)="R",$P($G(^DG(43,1,"NOT")),U,13) D
.S SDATA1=$G(^SC($P(SDATA,U,4),"S",$P(SDATA,U,3),1,+SDATA,0)),DFN=$P(SDATA,U,2) D PID^VADPT6
.I 'SDATA1,SDAMEVT=2 S SDATA2=$G(^TMP("SDAMEVT",$J,"AFTER","DPT")),SDATA1="^^^^^"_$P(SDATA2,U,12)_U_$P(SDATA2,U,14)
.D XMY^DGMTUTL(+$P(^DG(43,1,"NOT"),U,13),0,1)
.S XMSUB="Means Test Required ("_$E($P($G(^DPT($P(SDATA,U,2),0)),U),1)_VA("BID")_")",XMTEXT="DGBUL(" D
..D SET("Action was taken on the following appointment out and the patient 'REQUIRES' a means test.")
..D SET("")
..D SET("Date of Birth: "_$$FTIME^DGMTUTL($P(^DPT(DFN,0),U,3)))
..D SET(" Appointment: "_$$FTIME^DGMTUTL($P(SDATA,U,3)))
..D SET(" Action: "_$P(SDATA("AFTER","STATUS"),U,2))
..D SET(" Clinic: "_$P($G(^SC($P(SDATA,U,4),0)),U))
..D SET(" Entered By: "_$P($G(^VA(200,+$P(SDATA1,U,6),0)),U))
..D SET(" Entered On: "_$$FTIME^DGMTUTL($P(SDATA1,U,7)))
.D ^XMD
.S ^DGMT(408.31,+DGMT,"BUL")=DT
MAILQ Q
;
SET(X) ; -- set text into array
S DGLN=$G(DGLN)+1,DGBUL(DGLN,0)=X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTREQB 1597 printed Dec 13, 2024@02:45:15 Page 2
DGMTREQB ;ALB/CAW Send mail bulletin if means test required ; 06/16/2004
+1 ;;5.3;Registration;**3,608**;Aug 13, 1993
+2 ;
+3 ;
EN ;
+1 IF '$DATA(SDATA)
GOTO ENQ
+2 SET (DGMTYPT,DGMSGF)=1
SET DFN=$PIECE(SDATA,U,2)
+3 SET DGMT=$$LST^DGMTU($PIECE(SDATA,U,2))
+4 IF $PIECE($GET(^DGMT(408.31,+DGMT,"BUL")),U)'=DT
DO MAIL
ENQ KILL DGMT,DGBUL,DGLN,VA,VAERR
QUIT
MAIL ;
+1 NEW XMDUZ,XMSUB,XMTEXT,SDATA1,SDATA2,SDWHAT
+2 ; use site specified mg and bull is only sent if mg defined
+3 if "^1^4^5^"'[(U_SDAMEVT_U)!($PIECE($GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT")),U,16)'=9)
QUIT
DO ^DGMTR
SET DGMT=$$LST^DGMTU($PIECE(SDATA,U,2))
+4 IF $PIECE(DGMT,U,4)="R"
IF $PIECE($GET(^DG(43,1,"NOT")),U,13)
Begin DoDot:1
+5 SET SDATA1=$GET(^SC($PIECE(SDATA,U,4),"S",$PIECE(SDATA,U,3),1,+SDATA,0))
SET DFN=$PIECE(SDATA,U,2)
DO PID^VADPT6
+6 IF 'SDATA1
IF SDAMEVT=2
SET SDATA2=$GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT"))
SET SDATA1="^^^^^"_$PIECE(SDATA2,U,12)_U_$PIECE(SDATA2,U,14)
+7 DO XMY^DGMTUTL(+$PIECE(^DG(43,1,"NOT"),U,13),0,1)
+8 SET XMSUB="Means Test Required ("_$EXTRACT($PIECE($GET(^DPT($PIECE(SDATA,U,2),0)),U),1)_VA("BID")_")"
SET XMTEXT="DGBUL("
Begin DoDot:2
+9 DO SET("Action was taken on the following appointment out and the patient 'REQUIRES' a means test.")
+10 DO SET("")
+11 DO SET("Date of Birth: "_$$FTIME^DGMTUTL($PIECE(^DPT(DFN,0),U,3)))
+12 DO SET(" Appointment: "_$$FTIME^DGMTUTL($PIECE(SDATA,U,3)))
+13 DO SET(" Action: "_$PIECE(SDATA("AFTER","STATUS"),U,2))
+14 DO SET(" Clinic: "_$PIECE($GET(^SC($PIECE(SDATA,U,4),0)),U))
+15 DO SET(" Entered By: "_$PIECE($GET(^VA(200,+$PIECE(SDATA1,U,6),0)),U))
+16 DO SET(" Entered On: "_$$FTIME^DGMTUTL($PIECE(SDATA1,U,7)))
End DoDot:2
+17 DO ^XMD
+18 SET ^DGMT(408.31,+DGMT,"BUL")=DT
End DoDot:1
MAILQ QUIT
+1 ;
SET(X) ; -- set text into array
+1 SET DGLN=$GET(DGLN)+1
SET DGBUL(DGLN,0)=X
QUIT
