- 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 Feb 19, 2025@00:11:17 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