Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53P951

DG53P951.m

Go to the documentation of this file.
  1. DG53P951 ;SHRPE/YMG - Post Install for DG patch 951 ;03-May-2018
  1. ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; entry point
  1. N XPDIDTOT,XPDIDVT
  1. S XPDIDTOT=2,XPDIDVT=0
  1. D USR(1) ; 1. create non-human user for PRF interface
  1. D EN1(2) ;entry point for HL7 CHECK POST INSTALLATION REPORT
  1. Q
  1. ;
  1. USR(DGXPD) ; create non-human user for PRF interface
  1. N UIEN
  1. I '$D(ZTQUEUED) D ;if not background
  1. .D BMES^XPDUTL(" STEP "_DGXPD_" of "_XPDIDTOT)
  1. .D MES^XPDUTL("-------------")
  1. .D MES^XPDUTL("Creating non-human user for PRF interface ... ")
  1. .Q
  1. ;
  1. ; either in taskmode or not
  1. ; ICR #4677.
  1. S UIEN=$$CREATE^XUSAP("DGPRF,INTERFACE","")
  1. I '$D(ZTQUEUED) D
  1. .I +UIEN=0 D BMES^XPDUTL(" Already exists.")
  1. .I +UIEN>0 D BMES^XPDUTL(" Successfully added.")
  1. .I +UIEN<0 D BMES^XPDUTL(" ERROR: user NOT added.")
  1. .D UPDATE^XPDID(DGXPD)
  1. .Q
  1. Q
  1. ;
  1. ; This subroutine is the post installation for patch DG*5.3*951
  1. ; that will generate HL7 CHECK POST INSTALLATION REPORT.
  1. ;
  1. ; The generation of report is required as there is a risk about being
  1. ; out of synchronization when flags are being transferred from one site
  1. ; to another, however, one of the sites has not installed the patch yet.
  1. ; This will produce errors in HL7.
  1. ;
  1. ;ICR# TYPE DESCRIPTION
  1. ;----- ---- ---------------------
  1. ;10103 Sup ^XLFDT: $$FMADD,$$DT,$$HL7TFM
  1. ;2056 Sup ^DIQ: $$GET1,GETS
  1. ;10070 Sup ^XMD
  1. ;2171 Sup ^XUAF4: $$IEN,$$NAME
  1. ;2172 Sup UPDATE^XPDID
  1. ;2701 Sup $$GETDFN^MPIF001
  1. ;10000 Sup NOW^%DTC
  1. ;10003 Sup DD^%DT
  1. ;3099 Sup $$MSG^HLCSUTL
  1. ;4669 Private DG has approval for direct global read of "B" index of FILE #773; Fileman read of field #2
  1. ;10035 Sup Fileman read of FILE #2 ;field #.01
  1. ;2052 Sup $$GET1^DID
  1. ;10141 Sup ^XPDUTL:BMES, MES
  1. ;10063 Sup %ZTLOAD
  1. ;
  1. ;
  1. EN1(DGXPD) ;Queue the HL7 CHECK POST INSTALLATION REPORT to Taskman
  1. I $D(ZTQUEUED) D EN3 Q ;queued to Taskman
  1. N X,MES,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSK,ZTSAVE
  1. S MES(1)=" "
  1. S MES(2)=" STEP "_DGXPD_" of "_XPDIDTOT
  1. S MES(3)="-------------"
  1. S MES(4)=" "
  1. S MES(5)="You will now be prompted for Requested Start Time to generate"
  1. S MES(6)="the HL7 CHECK POST INSTALLATION REPORT"
  1. S MES(7)=" "
  1. S MES(8)="If you do not enter a time, then this report will be queued to run NOW."
  1. S MES(9)=" "
  1. D MES^XPDUTL(.MES)
  1. S ZTDESC="DGPF HL7 CHECK POST INSTALLATION REPORT GENERATION"
  1. S ZTRTN="EN3^DG53P951"
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. I $D(ZTSK) S X="Queued to Task #"_$G(ZTSK) D BMES^XPDUTL(X)
  1. I '$D(ZTSK) D
  1. . K MES
  1. . S MES(1)=" "
  1. . S MES(2)="******************************************"
  1. . S MES(3)="Since you did not enter a time to run the report"
  1. . S MES(4)="Running Post Installation Report NOW."
  1. . S MES(5)=" "
  1. . S MES(6)="Depending upon the size of your database, this report could take"
  1. . S MES(7)="sometime to run."
  1. . S MES(8)=" "
  1. . S MES(9)="There will be no further screen display while running this report."
  1. . S MES(10)="******************************************"
  1. . S MES(11)=" "
  1. . D MES^XPDUTL(.MES)
  1. . S ZTDESC="DGPF HL7 CHECK POST INSTALLATION REPORT GENERATION"
  1. . S ZTRTN="EN3^DG53P951"
  1. . S ZTIO=""
  1. . S ZTDTH=$H
  1. . D ^%ZTLOAD
  1. . S X="Queued to Task #"_$G(ZTSK) D BMES^XPDUTL(X)
  1. . Q
  1. D UPDATE^XPDID(DGXPD)
  1. Q
  1. ;
  1. EN3 ;
  1. N DGLIST ;temp global name used for report list
  1. N DGSORT ;array or report parameters
  1. N ACTNARY ;array that contain all the PRF ACTIONs
  1. N LN ;subscript line
  1. N DGRCPNT
  1. N SNDMAIL
  1. S DGLIST=$NA(^TMP("DG951PST",$J))
  1. K @DGLIST
  1. ;
  1. D BLDARR ;build PRF ACTION array
  1. S SNDMAIL=0
  1. ;beginning and ending date
  1. S DGSORT("DGBEG")=$$FMADD^XLFDT(DT,-4)
  1. S DGSORT("DGEND")=$$DT^XLFDT
  1. D LOOP1(DGLIST)
  1. D PRINT1(DGLIST)
  1. D RECPIENT
  1. D MAIL1
  1. K @DGLIST
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. BLDARR ;
  1. ;build PRF ACTION Array
  1. N I,X,DGERR,Y
  1. S X=$$GET1^DID(26.14,.03,,"SET OF CODES",,"DGERR")
  1. Q:$D(DGERR)
  1. F I=1:1:$L(X,";") S Y=$P(X,";",I) Q:Y="" S ACTNARY($P(Y,":",2))=""
  1. Q
  1. ;
  1. LOOP1(DGLIST) ;
  1. ;loop variable pointer flag x-ref file to run report
  1. N DG772,DG773,DGPROCDT,DGMSGTYP,DGREF,DGEVNTYP,DGPTICN
  1. N DGSTANUM,DGSTNAME,DGACTN,DGPTNAME,DGSSN
  1. S DGREF=$NA(^TMP("DG53951P1",$J))
  1. S DG772="" F S DG772=$O(^HLMA("B",DG772),-1) Q:DG772="" D
  1. . S DG773="" F S DG773=$O(^HLMA("B",DG772,DG773),-1) Q:DG773="" D
  1. . . K @DGREF,DGPROCDT,DGMSGTYP,DGEVNTYP,DGPTICN
  1. . . K DGSTANUM,DGSTNAME,DGACTN,DGPTNAME,DGSSN
  1. . . Q:$$MSG^HLCSUTL($$GET1^DIQ(773,DG773_",",2,"I"),$NA(@DGREF@(1)))<1
  1. . . D PARSE(DGREF)
  1. K @DGREF
  1. Q
  1. ;
  1. PARSE(DGREF) ;
  1. N SUB1,SUB2,DGSGMENT,DGBEHAV,DFN,DGOUT
  1. S (SUB1,SUB2,DGSGMENT(0))=""
  1. S DGOUT=0
  1. F S SUB1=$O(@DGREF@(SUB1)) Q:SUB1=""!DGOUT D
  1. . N DGBEHAV,DFN
  1. . S DGBEHAV=0
  1. . F S SUB2=$O(@DGREF@(SUB1,SUB2)) Q:SUB2=""!DGOUT D
  1. . . S DGSGMENT(0)=$P(@DGREF@(SUB1,SUB2),U)
  1. . . I (",MSH,PID,QRD,OBR,OBX,")[(","_DGSGMENT(0)_",") D @DGSGMENT(0)
  1. Q
  1. ;
  1. MSH ;Parse MSH segment
  1. ;Processing date/time check...
  1. S DGPROCDT=$$HL7TFM^XLFDT($P($P(@DGREF@(SUB1,SUB2),U,7),"-"))
  1. I DGPROCDT'>0 S DGOUT=1 Q
  1. ;check if date is within the date range TODAY-4 and TODAY
  1. I ($P(DGPROCDT,".")<DGSORT("DGBEG"))!($P(DGPROCDT,".")>DGSORT("DGEND")) S DGOUT=1 Q
  1. ;extract the message and event type
  1. S DGMSGTYP=$P($P(@DGREF@(SUB1,SUB2),U,9),"~")
  1. S DGEVNTYP=$P($P(@DGREF@(SUB1,SUB2),U,9),"~",2)
  1. I ((DGMSGTYP["ORU")&(DGEVNTYP["R01"))!((DGMSGTYP["ORF")&(DGEVNTYP["R04")) D
  1. . S DGSTANUM=$P($P(@DGREF@(SUB1,SUB2),U,4),"~")
  1. . I DGSTANUM'="" S DGSTNAME=$$NAME^XUAF4($$IEN^XUAF4(DGSTANUM))
  1. E S DGOUT=1
  1. Q
  1. ;
  1. PID ;Parse PID segment
  1. S DGPTICN=$P($P(@DGREF@(SUB1,SUB2),U,4),"~")
  1. S DFN=$$GETDFN^MPIF001(DGPTICN)
  1. Q:+DFN'>0
  1. S DGPTNAME=$$GET1^DIQ(2,DFN,.01)
  1. D SSN
  1. Q
  1. ;
  1. QRD ;Parse QRD segment
  1. S DGPTICN=$P($P(@DGREF@(SUB1,SUB2),U,9),"~")
  1. S DFN=$$GETDFN^MPIF001(DGPTICN)
  1. Q:+DFN'>0
  1. S DGPTNAME=$$GET1^DIQ(2,DFN,.01)
  1. D SSN
  1. Q
  1. ;
  1. OBR ;Parse OBR segment
  1. ;only check "BEHAVIORAL"
  1. I $P($P(@DGREF@(SUB1,SUB2),U,5),"~",2)="BEHAVIORAL" S DGBEHAV=1
  1. Q
  1. ;
  1. OBX ;Parse OBX segment
  1. ;check the OBX segment if it contains the new DBRS DATA
  1. Q:DGBEHAV<1
  1. I $P(@DGREF@(SUB1,SUB2),U,3)="ST" S DGACTN=$P(@DGREF@(SUB1,SUB2),U,6)
  1. I $G(DGACTN)'="",$D(ACTNARY($G(DGACTN))),$P($P(@DGREF@(SUB1,SUB2),U,4),"~")="D" D BLDLST1(DGLIST)
  1. Q
  1. ;
  1. SSN ;extract patient's SSN4
  1. D GETS^DIQ(2,DFN_",",.0905,"ER","DGSSN")
  1. S DGSSN=DGSSN(2,DFN_",","1U4N","E")
  1. Q
  1. ;
  1. BLDLST1(DGLIST) ;
  1. ;Build the list to be printed later
  1. I DGPTNAME=""!DGSTANUM="" Q
  1. S @DGLIST@(DGPTNAME,DGSTANUM)=DGSSN_U_DGPTICN_U_DGSTANUM_U_DGSTNAME_U_DG772_U_DG773
  1. Q
  1. ;
  1. PRINT1(DGLIST) ;
  1. ;
  1. N DDASH,DGSITE,DGPTNAME,DGCNT
  1. S DDASH="",$P(DDASH,"-",81)=""
  1. I $O(@DGLIST@(""))="" D Q
  1. . S @DGLIST@(1,0)=" "
  1. . S @DGLIST@(2,0)=">>> No incoming ""BEHAVIORAL"" PRF HL7 transaction messages found"
  1. . S @DGLIST@(3,0)=" for the last 4 days "
  1. . S @DGLIST@(4,0)=" "
  1. . S @DGLIST@(5,0)=" NO REPORT GENERATED"
  1. S (DGSITE,DGPTNAME)="",DGCNT=0
  1. F S DGPTNAME=$O(@DGLIST@(DGPTNAME)) Q:DGPTNAME="" D
  1. . N DGDATA,TEXT
  1. . D:'DGCNT HEAD1(DGLIST)
  1. . F S DGSITE=$O(@DGLIST@(DGPTNAME,DGSITE)) Q:DGSITE="" D
  1. . . S DGDATA=@DGLIST@(DGPTNAME,DGSITE)
  1. . . S TEXT=DGSITE_"/"_$E($P(DGDATA,U,4),1,25)
  1. . . S TEXT=$$BLDSTR(DGSITE_"/"_$E($P(DGDATA,U,4),1,25),TEXT,1,30)
  1. . . S TEXT=$$BLDSTR($E(DGPTNAME,1,20),TEXT,33,20)
  1. . . S TEXT=$$BLDSTR($P(DGDATA,U,2),TEXT,55,17)
  1. . . S TEXT=$$BLDSTR($P(DGDATA,U),TEXT,75,5)
  1. . . S LN=LN+1
  1. . . S @DGLIST@(LN,0)=TEXT
  1. Q
  1. ;
  1. HEAD1(DGLIST) ;
  1. ;Display user instruction
  1. N DDASH,TEXT
  1. S LN=1
  1. S @DGLIST@(LN,0)=""
  1. S DDASH="",$P(DDASH,"=",80)=""
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="The list of PRF BEHAVIORAL flags that will be reported to the help desk"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="are contained below."
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="These flags need to be re-sent after the DG*5.3*951 compliance date by"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="using the REFRESH option for the sites and patients listed below:"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=""
  1. S TEXT="SENDING SITE#/NAME"
  1. S TEXT=$$BLDSTR("SENDING SITE#/NAME",TEXT,1,30)
  1. S TEXT=$$BLDSTR("PATIENT NAME",TEXT,33,20)
  1. S TEXT=$$BLDSTR("ICN #",TEXT,55,17)
  1. S TEXT=$$BLDSTR("SSN4",TEXT,75,5)
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=TEXT
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=DDASH
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=""
  1. S DGCNT=1
  1. Q
  1. ;
  1. BLDSTR(NSTR,STR,COL,NSL) ;build a string
  1. Q $E(STR_$J("",COL-1),1,COL-1)_$E(NSTR_$J("",NSL),1,NSL)_$E(STR,COL+NSL,999)
  1. ;
  1. RECPIENT ;
  1. ;mail recipient
  1. S DGRCPNT(1)="G.DGPF BEHAVIORAL FLAG REVIEW"
  1. S DGRCPNT(2)="G.IRM"
  1. Q
  1. ;
  1. MAIL1 ;Send mailman message to user with results
  1. ;
  1. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
  1. S (XMDUZ,XMSUB)="HL7 CHECK POST-INSTALL REPORT"
  1. S XMTEXT="^TMP(""DG951PST"",$J,"
  1. S (XMY(DUZ),XMY(.5))=""
  1. S DGRCPNT="" F S DGRCPNT=$O(DGRCPNT(DGRCPNT)) Q:DGRCPNT="" S XMY(DGRCPNT(DGRCPNT))=""
  1. D NOW^%DTC S Y=% D DD^%DT
  1. D ^XMD
  1. S SNDMAIL=1
  1. Q
  1. ;
  1. ; This subroutine is the post installation for patch DG*5.3*951
  1. ; that will generate IOC SITE DBRS PATIENTS POST-RELEASE REPORT
  1. ;
  1. ; The "IOC SITE DBRS PATIENTS POST-RELEASE REPORT" will be developed to determine patients
  1. ; in the IOC site that meet the following criteria:
  1. ; - have DBRS numbers in their behavioral flag in database by the end
  1. ; of National Release period,
  1. ; - are registered in other sites
  1. ; HL7 messages for these patients need to be re-sent to other site to
  1. ; ensure synchronization of DBRS data
  1. ;
  1. ; ICR# TYPE DESCRIPTION
  1. ;----- ---- ---------------------
  1. ;10112 Sup $$SITE^VASITE
  1. ;2056 Sup ^DIQ: $$GET1,GETS
  1. ;10070 Sup ^XMD
  1. ;10000 Sup NOW^%DTC
  1. ;10003 Sup DD^%DT
  1. ;2171 Sup ^XUAF4: $$STA
  1. ;2990 Sup TFL^VAFCTFU1
  1. ;
  1. EN2 ;
  1. ;entry point for IOC SITE DBRS PATIENTS POST-RELEASE REPORT
  1. N DGLIST ;temp global name used for report list
  1. N LN ;subscript line
  1. N SNDMAIL
  1. N DGRCPNT
  1. S DGLIST=$NA(^TMP("DG53951P2",$J))
  1. K @DGLIST
  1. W @IOF
  1. W !,"DG*5.3*951 IOC SITE DBRS PATIENTS POST-RELEASE REPORT",!
  1. ;
  1. ;user description message
  1. D MSG2
  1. W !
  1. S SNDMAIL=0
  1. D LOOP2(DGLIST)
  1. D PRINT2(DGLIST)
  1. Q:$O(@DGLIST@(""))=""
  1. D RECPIENT
  1. D MAIL2
  1. K @DGLIST
  1. I $G(SNDMAIL) D
  1. . W !!,"SUCCESSFULLY SENT EMAIL : IOC SITE DBRS PATIENTS POST-RELEASE REPORT",!!
  1. . W "To the following recipient:",!
  1. . W ?3,"POSTMASTER"
  1. . S DGRCPNT="" F S DGRCPNT=$O(DGRCPNT(DGRCPNT)) Q:DGRCPNT="" W !,?3,$G(DGRCPNT(DGRCPNT))
  1. W !!
  1. Q
  1. ;
  1. MSG2 ;
  1. W !,"This post install routine will check all patients with DBRS data in the local"
  1. W !,"PRF ASSIGNMENT FILE (#26.13) and verify if patients are registered in other VA"
  1. W !,"sites."
  1. ;
  1. W !!,"HL7 transaction messages for these patients need to be re-sent to other site to"
  1. W !,"ensure synchronization of DBRS data.",!
  1. Q
  1. ;
  1. LOOP2(DGLIST) ;
  1. ;loop variable pointer flag x-ref file to run report
  1. N DGDFN,DGIEN,DGINST,DGOWN,IOC
  1. I '$D(ZTQUEUED) S IOC=0 W "Working..."
  1. S DGDFN="" F S DGDFN=$O(^DGPF(26.13,"B",DGDFN)) Q:DGDFN="" D
  1. . S IOC=IOC+1
  1. . I '$D(ZTQUEUED),'(IOC#15) W "."
  1. . s DGIEN="" F S DGIEN=$O(^DGPF(26.13,"B",DGDFN,DGIEN)) Q:DGIEN="" D
  1. . . N DGFLDS,DGERR,DGRESULT,DGSITE,DGPTNAME,DGSSN4,DGOWN,DGCURNT
  1. . . D GETS^DIQ(26.13,DGIEN_",","**","IE","DGFLDS","DGERR")
  1. . . Q:$D(DGERR)
  1. . . ;check if BEHAVIORAL and contain DBRS data
  1. . . ;if true, check if patient is registered to other VA site
  1. . . I DGFLDS(26.13,DGIEN_",",.02,"E")="BEHAVIORAL",$D(DGFLDS(26.131)) D TFL^VAFCTFU1(.DGRESULT,DGDFN)
  1. . . Q:'$D(DGRESULT)
  1. . . Q:DGRESULT(1)'>0
  1. . . S DGPTNAME=DGFLDS(26.13,DGIEN_",",.01,"E") ;patient name
  1. . . ;extract the patient SSN terminal digits
  1. . . D GETS^DIQ(2,DGDFN_",",.0905,"ER","DGSSN4")
  1. . . S DGSSN4=DGSSN4(2,DGDFN_",","1U4N","E")
  1. . . ;PRF owned by this site?
  1. . . S DGSITE=DGFLDS(26.13,DGIEN_",",.04,"I")
  1. . . S DGOWN=$S($G(DGSITE)=$P($$SITE^VASITE,U):1,1:0)
  1. . . S DGCURNT=$$STA^XUAF4(DGSITE)
  1. . . D BLDLST2(DGLIST)
  1. Q
  1. ;
  1. BLDLST2(DGLIST) ;
  1. ;build list
  1. S @DGLIST@(DGSITE,DGIEN,DGPTNAME)=DGSSN4_U_$S(DGOWN:"YES",1:"NO")_U_DGCURNT
  1. Q
  1. ;
  1. PRINT2(DGLIST) ;
  1. ;print the list
  1. N DDASH,DGIEN,DGSITE,DGPTNAME,DGCNT
  1. S DDASH="",$P(DDASH,"-",81)=""
  1. I $O(@DGLIST@(""))="" D Q
  1. . W !!," >>> No IOC SITE DBRS PATIENTS record have been found."
  1. . W !!," NO EMAIL GENERATED.",!
  1. S (DGSITE,DGPTNAME,DGIEN)="",DGCNT=0
  1. F S DGSITE=$O(@DGLIST@(DGSITE)) Q:DGSITE="" D
  1. . N DGDATA,TEXT
  1. . D:'DGCNT HEAD2(DGLIST)
  1. . F S DGIEN=$O(@DGLIST@(DGSITE,DGIEN)) Q:DGIEN="" D
  1. . . F S DGPTNAME=$O(@DGLIST@(DGSITE,DGIEN,DGPTNAME)) Q:DGPTNAME="" D
  1. . . . S DGDATA=@DGLIST@(DGSITE,DGIEN,DGPTNAME)
  1. . . . S TEXT=$E(DGPTNAME,1,30)
  1. . . . S TEXT=$$BLDSTR($E(DGPTNAME,1,30),TEXT,1,25)
  1. . . . S TEXT=$$BLDSTR($P(DGDATA,U),TEXT,28,5)
  1. . . . S TEXT=$$BLDSTR($P(DGDATA,U,2),TEXT,37,24)
  1. . . . S TEXT=$$BLDSTR($P(DGDATA,U,3),TEXT,62,18)
  1. . . . S LN=LN+1
  1. . . . S @DGLIST@(LN,0)=TEXT
  1. Q
  1. ;
  1. HEAD2(DGLIST) ;
  1. ;Display user instruction
  1. N DDASH,TEXT
  1. S LN=1
  1. S @DGLIST@(LN,0)=""
  1. S DDASH="",$P(DDASH,"=",80)=""
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="The list of IOC SITE DBRS PATIENTS whose HL7 transaction messages needs to be"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="re-sent using the REFRESH option to other site to ensure synchronization"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)="of DBRS data are listed below:"
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=""
  1. S TEXT="PATIENT NAME"
  1. S TEXT=$$BLDSTR("PATIENT NAME",TEXT,1,25)
  1. S TEXT=$$BLDSTR("SSN4",TEXT,28,5)
  1. S TEXT=$$BLDSTR("PRF OWNED BY THIS SITE?",TEXT,37,23)
  1. S TEXT=$$BLDSTR("CURRENT SITE OWNER",TEXT,62,18)
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=TEXT
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=DDASH
  1. S LN=LN+1
  1. S @DGLIST@(LN,0)=""
  1. S DGCNT=1
  1. Q
  1. ;
  1. MAIL2 ;Send mailman message to user will results
  1. ;
  1. N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY
  1. S (XMDUZ,XMSUB)="IOC SITE DBRS PATIENTS REPORT"
  1. S XMTEXT="^TMP(""DG53951P2"",$J,"
  1. S (XMY(DUZ),XMY(.5))=""
  1. S DGRCPNT="" F S DGRCPNT=$O(DGRCPNT(DGRCPNT)) Q:DGRCPNT="" S XMY(DGRCPNT(DGRCPNT))=""
  1. D NOW^%DTC S Y=% D DD^%DT
  1. D ^XMD
  1. S SNDMAIL=1
  1. Q
  1. ;