source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTREQB.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DGMTREQB ;ALB/CAW Send mail bulletin if means test required ; 06/16/2004
2 ;;5.3;Registration;**3,608**;Aug 13, 1993
3 ;
4 ;
5EN ;
6 I '$D(SDATA) G ENQ
7 S (DGMTYPT,DGMSGF)=1,DFN=$P(SDATA,U,2)
8 S DGMT=$$LST^DGMTU($P(SDATA,U,2))
9 I $P($G(^DGMT(408.31,+DGMT,"BUL")),U)'=DT D MAIL
10ENQ K DGMT,DGBUL,DGLN,VA,VAERR Q
11MAIL ;
12 N XMDUZ,XMSUB,XMTEXT,SDATA1,SDATA2,SDWHAT
13 ; use site specified mg and bull is only sent if mg defined
14 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))
15 I $P(DGMT,U,4)="R",$P($G(^DG(43,1,"NOT")),U,13) D
16 .S SDATA1=$G(^SC($P(SDATA,U,4),"S",$P(SDATA,U,3),1,+SDATA,0)),DFN=$P(SDATA,U,2) D PID^VADPT6
17 .I 'SDATA1,SDAMEVT=2 S SDATA2=$G(^TMP("SDAMEVT",$J,"AFTER","DPT")),SDATA1="^^^^^"_$P(SDATA2,U,12)_U_$P(SDATA2,U,14)
18 .D XMY^DGMTUTL(+$P(^DG(43,1,"NOT"),U,13),0,1)
19 .S XMSUB="Means Test Required ("_$E($P($G(^DPT($P(SDATA,U,2),0)),U),1)_VA("BID")_")",XMTEXT="DGBUL(" D
20 ..D SET("Action was taken on the following appointment out and the patient 'REQUIRES' a means test.")
21 ..D SET("")
22 ..D SET("Date of Birth: "_$$FTIME^DGMTUTL($P(^DPT(DFN,0),U,3)))
23 ..D SET(" Appointment: "_$$FTIME^DGMTUTL($P(SDATA,U,3)))
24 ..D SET(" Action: "_$P(SDATA("AFTER","STATUS"),U,2))
25 ..D SET(" Clinic: "_$P($G(^SC($P(SDATA,U,4),0)),U))
26 ..D SET(" Entered By: "_$P($G(^VA(200,+$P(SDATA1,U,6),0)),U))
27 ..D SET(" Entered On: "_$$FTIME^DGMTUTL($P(SDATA1,U,7)))
28 .D ^XMD
29 .S ^DGMT(408.31,+DGMT,"BUL")=DT
30MAILQ Q
31 ;
32SET(X) ; -- set text into array
33 S DGLN=$G(DGLN)+1,DGBUL(DGLN,0)=X Q
Note: See TracBrowser for help on using the repository browser.