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