DGMTREQB.m

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 ---DGMTREQB   1597     printed  Sep 02, 2024@19:30:35                                                                                                                                                                                                    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