RGRSBULL ;ALB/RJS,CML-RGRSTEXT BULLETIN ROUTINE ;07/24/98
;;1.0;CLINICAL INFO RESOURCE NETWORK;**19**;30 Apr 99
BULL(XMB,XMTEXT) ;
;Entry point generates a bulletin when a notification
;from the MPI/PD package has been generated
;
;Input:Required variables
;
; XMB - Bulletin name e.g. ("RG CIRN DEMOGRAPHIC ISSUES")
; XMTEXT - global or array root (EX. "^TMP("), location of
; error message(s)
;
;If XMY is defined, the call to ^XMB will process accordingly.
;XMY is used to pass additional recipients.
;
Q:$G(XMB)=""!($G(XMTEXT)="")
D NOW^%DTC S XMDT=X K X
S XMDUZ="MPI/PD PACKAGE"
D ^XMB
K XMDT,XMDUZ
Q
BULL2(XMSUB,XMTEXT) ;
N XMY,XMDUZ
S XMY("G.RG CIRN DEMOGRAPHIC ISSUES")=""
S XMDUZ="MPI/PD PACKAGE"
D ^XMD
Q
;
ADDRESS(DFN,NAME,LINE1,LINE2,LINE3,SENDSITE,CITY,COUNTY,STATE,ZIP) ;
;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
;ISSUES mail group about changes to the address of a given patient.
;
;Input: Required Variables
;
; DFN - IEN in the PATIENT file (#2)
; NAME - Patient's Name
; LINE1,LINE2,LINE3 - Lines of the Address
; SENDSITE- The station number of the site that initiated the change
; CITY - city
; COUNTY - county
; STATE - state
; ZIP - zip
;
Q:$G(DFN)=""!($G(NAME)="")
Q:$G(^DPT(DFN,0))=""
N RGADRES,DA,DIC,DR,DIQ,ADDR1,ADDR11,ADDR2,ADDR22,ADDR3,ADDR33,LINE11,LINE22,LINE33,ADDR4,ADDR44,ADDR5,ADDR55,ADDR6,ADDR66,ADDR7,ADDR77,DELFLG
S DIC=2,DR=".111;.112;.113;.114;.115;.117;.1112",DA=DFN,DIQ="RGADRES",DIQ(0)="E" D EN^DIQ1
S ADDR1=$G(RGADRES(2,DFN,.111,"E")),ADDR2=$G(RGADRES(2,DFN,.112,"E")),ADDR3=$G(RGADRES(2,DFN,.113,"E")),ADDR4=$G(RGADRES(2,DFN,.114,"E")),ADDR5=$G(RGADRES(2,DFN,.115,"E")),ADDR6=$G(RGADRES(2,DFN,.117,"E")),ADDR7=$G(RGADRES(2,DFN,.1112,"E"))
;
S ADDR6=$$COUNTY^RGRSPARS(ADDR5,ADDR6)
;
;Check for null or deleted address fields from remote site
;
S DELFLG=0
;
I $S(LINE1="@":1,LINE1="""@""":1,LINE1="""""":1,1:LINE1="") D
.I ADDR1'="" S DELFLG=1,LINE1="<<DELETED>>" Q
.S LINE1=""
;
I $S(LINE2="@":1,LINE2="""@""":1,LINE2="""""":1,1:LINE2="") D
.I ADDR2'="" S LINE2="<<DELETED>>" Q
.S LINE2=""
;
I $S(LINE3="@":1,LINE3="""@""":1,LINE3="""""":1,1:LINE3="") D
.I ADDR3'="" S LINE3="<<DELETED>>" Q
.S LINE3=""
;
I $S(CITY="@":1,CITY="""@""":1,CITY="""""":1,1:CITY="") D
.I ADDR4'="" S DELFLG=1,CITY="<<DELETED>>" Q
.S CITY=""
;
I $S(STATE="@":1,STATE="""@""":1,STATE="""""":1,1:STATE="") D
.I ADDR5'="" S DELFLG=1,STATE="<<DELETED>>" Q
.S STATE=""
;
I $S(COUNTY="@":1,COUNTY="""@""":1,COUNTY="""""":1,1:COUNTY="") D
.I ADDR6'="" S DELFLG=1,COUNTY="<<DELETED>>" Q
.S COUNTY=""
;
I $S(ZIP="@":1,ZIP="""@""":1,ZIP="""""":1,1:ZIP="") D
.I ADDR7'="" S DELFLG=1,ZIP="<<DELETED>>" Q
.S ZIP=""
;
I DELFLG G SENDADD
;
EXITADD ;
Q
SENDADD ;
N RGRSTEXT,XMSUB
S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
S RGRSTEXT(2)=$$INST^RGRSBUL1(SENDSITE)
S RGRSTEXT(3)="This message deleted address information for Patient:"
S RGRSTEXT(4)=NAME
S RGRSTEXT(5)=" "
S RGRSTEXT(6)=" <<OLD ADDRESS>> <<NEW ADDRESS>>"
S RGRSTEXT(7)=" "
S RGRSTEXT(8)="STREET ADDRESS [LINE 1]: "_$$FORMAT^RGRSBUL1(ADDR1,LINE1)
S RGRSTEXT(9)="STREET ADDRESS [LINE 2]: "_$$FORMAT^RGRSBUL1(ADDR2,LINE2)
S RGRSTEXT(10)="STREET ADDRESS [LINE 3]: "_$$FORMAT^RGRSBUL1(ADDR3,LINE3)
S RGRSTEXT(11)=" CITY: "_$$FORMAT^RGRSBUL1(ADDR4,CITY)
S RGRSTEXT(12)=" COUNTY: "_$$FORMAT^RGRSBUL1(ADDR6,COUNTY)
S RGRSTEXT(13)=" STATE: "_$$FORMAT^RGRSBUL1(ADDR5,STATE)
S RGRSTEXT(14)=" ZIP+4: "_$$FORMAT^RGRSBUL1(ADDR7,ZIP)
D BULL2($P(NAME,",",1)_" **MPI/PD ADDRESS DELETION**","RGRSTEXT(")
G EXITADD
;
SKIPBULL(ARRAY) ;
;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
;ISSUES mail group about missing required data for a given patient.
;
;Input: Required Variables
;
; ARRAY - Array of information regarding missing required data
;
Q:'$D(@ARRAY)
N RGRSTEXT,INDEX,COUNTER
S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
S RGRSTEXT(2)=$$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))
S RGRSTEXT(3)="This message was missing required data"
S RGRSTEXT(4)=" "
S INDEX=0,COUNTER=5
F S INDEX=$O(@ARRAY@(INDEX)) Q:INDEX']"" D
. S RGRSTEXT(COUNTER)="FIELD: "_INDEX_" = "_@ARRAY@(INDEX)
. S COUNTER=COUNTER+1
D BULL2("MPI/PD - MISSING DATA","RGRSTEXT(")
Q
;
MTCHBULL(DFN,ARRAY,NAME,SSN,ICN,CMOR,BULSUB) ;
;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
;ISSUES mail group about differences in the data of a given patient.
;
;Input: Required Variables
;
; DFN - IEN in the PATIENT file (#2)
; ARRAY - Array of data containing sending sites station number
; NAME - Patient's Name
; SSN - Patient's SSN
; ICN - Patient's ICN (Integration Control Number)
; CMOR - Patient's CMOR (Coordinating Master of Record)
; BULSUB - Bulletin subject (Ex. ICN)
;
Q:$G(DFN)=""!($G(ARRAY)="")
N LOCDATA,RGRSTEXT,INDEX,COUNTER
S RGRSTEXT(1)="The MPI/PD Package has received a message from:"
S RGRSTEXT(2)=$$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))
S RGRSTEXT(3)="This message contains "_$P(BULSUB,"(")_" data that is"
S RGRSTEXT(4)="inconsistent with your site's data."
S RGRSTEXT(5)=" "
S RGRSTEXT(6)="=> "_$P($$SITE^VASITE(),"^",2)_" local data:"
S RGRSTEXT(7)="NAME: "_NAME
S RGRSTEXT(8)="SSN: "_SSN
S RGRSTEXT(9)="ICN: "_ICN
S RGRSTEXT(10)="CMOR: "_CMOR
S RGRSTEXT(11)="--------------------------------------------------------"
S RGRSTEXT(12)="=> "_$P($$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))," -->")_" data:"
S COUNTER=12
F INDEX="NAME","SSN","ICN","CMOR" D
. I $D(@ARRAY@(INDEX)) S COUNTER=COUNTER+1,RGRSTEXT(COUNTER)=INDEX_": "_@ARRAY@(INDEX)
D BULL2("MPI/PD - INCONSISTENT "_BULSUB,"RGRSTEXT(")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSBULL 6037 printed Dec 13, 2024@01:42:51 Page 2
RGRSBULL ;ALB/RJS,CML-RGRSTEXT BULLETIN ROUTINE ;07/24/98
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**19**;30 Apr 99
BULL(XMB,XMTEXT) ;
+1 ;Entry point generates a bulletin when a notification
+2 ;from the MPI/PD package has been generated
+3 ;
+4 ;Input:Required variables
+5 ;
+6 ; XMB - Bulletin name e.g. ("RG CIRN DEMOGRAPHIC ISSUES")
+7 ; XMTEXT - global or array root (EX. "^TMP("), location of
+8 ; error message(s)
+9 ;
+10 ;If XMY is defined, the call to ^XMB will process accordingly.
+11 ;XMY is used to pass additional recipients.
+12 ;
+13 if $GET(XMB)=""!($GET(XMTEXT)="")
QUIT
+14 DO NOW^%DTC
SET XMDT=X
KILL X
+15 SET XMDUZ="MPI/PD PACKAGE"
+16 DO ^XMB
+17 KILL XMDT,XMDUZ
+18 QUIT
BULL2(XMSUB,XMTEXT) ;
+1 NEW XMY,XMDUZ
+2 SET XMY("G.RG CIRN DEMOGRAPHIC ISSUES")=""
+3 SET XMDUZ="MPI/PD PACKAGE"
+4 DO ^XMD
+5 QUIT
+6 ;
ADDRESS(DFN,NAME,LINE1,LINE2,LINE3,SENDSITE,CITY,COUNTY,STATE,ZIP) ;
+1 ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+2 ;ISSUES mail group about changes to the address of a given patient.
+3 ;
+4 ;Input: Required Variables
+5 ;
+6 ; DFN - IEN in the PATIENT file (#2)
+7 ; NAME - Patient's Name
+8 ; LINE1,LINE2,LINE3 - Lines of the Address
+9 ; SENDSITE- The station number of the site that initiated the change
+10 ; CITY - city
+11 ; COUNTY - county
+12 ; STATE - state
+13 ; ZIP - zip
+14 ;
+15 if $GET(DFN)=""!($GET(NAME)="")
QUIT
+16 if $GET(^DPT(DFN,0))=""
QUIT
+17 NEW RGADRES,DA,DIC,DR,DIQ,ADDR1,ADDR11,ADDR2,ADDR22,ADDR3,ADDR33,LINE11,LINE22,LINE33,ADDR4,ADDR44,ADDR5,ADDR55,ADDR6,ADDR66,ADDR7,ADDR77,DELFLG
+18 SET DIC=2
SET DR=".111;.112;.113;.114;.115;.117;.1112"
SET DA=DFN
SET DIQ="RGADRES"
SET DIQ(0)="E"
DO EN^DIQ1
+19 SET ADDR1=$GET(RGADRES(2,DFN,.111,"E"))
SET ADDR2=$GET(RGADRES(2,DFN,.112,"E"))
SET ADDR3=$GET(RGADRES(2,DFN,.113,"E"))
SET ADDR4=$GET(RGADRES(2,DFN,.114,"E"))
SET ADDR5=$GET(RGADRES(2,DFN,.115,"E"))
SET ADDR6=$GET(RGADRES(2,DFN,.117,"E"))
SET ADDR7=$GET(RGADRES(2,DFN,.1112,"E"))
+20 ;
+21 SET ADDR6=$$COUNTY^RGRSPARS(ADDR5,ADDR6)
+22 ;
+23 ;Check for null or deleted address fields from remote site
+24 ;
+25 SET DELFLG=0
+26 ;
+27 IF $SELECT(LINE1="@":1,LINE1="""@""":1,LINE1="""""":1,1:LINE1="")
Begin DoDot:1
+28 IF ADDR1'=""
SET DELFLG=1
SET LINE1="<<DELETED>>"
QUIT
+29 SET LINE1=""
End DoDot:1
+30 ;
+31 IF $SELECT(LINE2="@":1,LINE2="""@""":1,LINE2="""""":1,1:LINE2="")
Begin DoDot:1
+32 IF ADDR2'=""
SET LINE2="<<DELETED>>"
QUIT
+33 SET LINE2=""
End DoDot:1
+34 ;
+35 IF $SELECT(LINE3="@":1,LINE3="""@""":1,LINE3="""""":1,1:LINE3="")
Begin DoDot:1
+36 IF ADDR3'=""
SET LINE3="<<DELETED>>"
QUIT
+37 SET LINE3=""
End DoDot:1
+38 ;
+39 IF $SELECT(CITY="@":1,CITY="""@""":1,CITY="""""":1,1:CITY="")
Begin DoDot:1
+40 IF ADDR4'=""
SET DELFLG=1
SET CITY="<<DELETED>>"
QUIT
+41 SET CITY=""
End DoDot:1
+42 ;
+43 IF $SELECT(STATE="@":1,STATE="""@""":1,STATE="""""":1,1:STATE="")
Begin DoDot:1
+44 IF ADDR5'=""
SET DELFLG=1
SET STATE="<<DELETED>>"
QUIT
+45 SET STATE=""
End DoDot:1
+46 ;
+47 IF $SELECT(COUNTY="@":1,COUNTY="""@""":1,COUNTY="""""":1,1:COUNTY="")
Begin DoDot:1
+48 IF ADDR6'=""
SET DELFLG=1
SET COUNTY="<<DELETED>>"
QUIT
+49 SET COUNTY=""
End DoDot:1
+50 ;
+51 IF $SELECT(ZIP="@":1,ZIP="""@""":1,ZIP="""""":1,1:ZIP="")
Begin DoDot:1
+52 IF ADDR7'=""
SET DELFLG=1
SET ZIP="<<DELETED>>"
QUIT
+53 SET ZIP=""
End DoDot:1
+54 ;
+55 IF DELFLG
GOTO SENDADD
+56 ;
EXITADD ;
+1 QUIT
SENDADD ;
+1 NEW RGRSTEXT,XMSUB
+2 SET RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+3 SET RGRSTEXT(2)=$$INST^RGRSBUL1(SENDSITE)
+4 SET RGRSTEXT(3)="This message deleted address information for Patient:"
+5 SET RGRSTEXT(4)=NAME
+6 SET RGRSTEXT(5)=" "
+7 SET RGRSTEXT(6)=" <<OLD ADDRESS>> <<NEW ADDRESS>>"
+8 SET RGRSTEXT(7)=" "
+9 SET RGRSTEXT(8)="STREET ADDRESS [LINE 1]: "_$$FORMAT^RGRSBUL1(ADDR1,LINE1)
+10 SET RGRSTEXT(9)="STREET ADDRESS [LINE 2]: "_$$FORMAT^RGRSBUL1(ADDR2,LINE2)
+11 SET RGRSTEXT(10)="STREET ADDRESS [LINE 3]: "_$$FORMAT^RGRSBUL1(ADDR3,LINE3)
+12 SET RGRSTEXT(11)=" CITY: "_$$FORMAT^RGRSBUL1(ADDR4,CITY)
+13 SET RGRSTEXT(12)=" COUNTY: "_$$FORMAT^RGRSBUL1(ADDR6,COUNTY)
+14 SET RGRSTEXT(13)=" STATE: "_$$FORMAT^RGRSBUL1(ADDR5,STATE)
+15 SET RGRSTEXT(14)=" ZIP+4: "_$$FORMAT^RGRSBUL1(ADDR7,ZIP)
+16 DO BULL2($PIECE(NAME,",",1)_" **MPI/PD ADDRESS DELETION**","RGRSTEXT(")
+17 GOTO EXITADD
+18 ;
SKIPBULL(ARRAY) ;
+1 ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+2 ;ISSUES mail group about missing required data for a given patient.
+3 ;
+4 ;Input: Required Variables
+5 ;
+6 ; ARRAY - Array of information regarding missing required data
+7 ;
+8 if '$DATA(@ARRAY)
QUIT
+9 NEW RGRSTEXT,INDEX,COUNTER
+10 SET RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+11 SET RGRSTEXT(2)=$$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))
+12 SET RGRSTEXT(3)="This message was missing required data"
+13 SET RGRSTEXT(4)=" "
+14 SET INDEX=0
SET COUNTER=5
+15 FOR
SET INDEX=$ORDER(@ARRAY@(INDEX))
if INDEX']""
QUIT
Begin DoDot:1
+16 SET RGRSTEXT(COUNTER)="FIELD: "_INDEX_" = "_@ARRAY@(INDEX)
+17 SET COUNTER=COUNTER+1
End DoDot:1
+18 DO BULL2("MPI/PD - MISSING DATA","RGRSTEXT(")
+19 QUIT
+20 ;
MTCHBULL(DFN,ARRAY,NAME,SSN,ICN,CMOR,BULSUB) ;
+1 ;Entry point generates a bulletin to the RG CIRN DEMOGRAPHIC
+2 ;ISSUES mail group about differences in the data of a given patient.
+3 ;
+4 ;Input: Required Variables
+5 ;
+6 ; DFN - IEN in the PATIENT file (#2)
+7 ; ARRAY - Array of data containing sending sites station number
+8 ; NAME - Patient's Name
+9 ; SSN - Patient's SSN
+10 ; ICN - Patient's ICN (Integration Control Number)
+11 ; CMOR - Patient's CMOR (Coordinating Master of Record)
+12 ; BULSUB - Bulletin subject (Ex. ICN)
+13 ;
+14 if $GET(DFN)=""!($GET(ARRAY)="")
QUIT
+15 NEW LOCDATA,RGRSTEXT,INDEX,COUNTER
+16 SET RGRSTEXT(1)="The MPI/PD Package has received a message from:"
+17 SET RGRSTEXT(2)=$$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))
+18 SET RGRSTEXT(3)="This message contains "_$PIECE(BULSUB,"(")_" data that is"
+19 SET RGRSTEXT(4)="inconsistent with your site's data."
+20 SET RGRSTEXT(5)=" "
+21 SET RGRSTEXT(6)="=> "_$PIECE($$SITE^VASITE(),"^",2)_" local data:"
+22 SET RGRSTEXT(7)="NAME: "_NAME
+23 SET RGRSTEXT(8)="SSN: "_SSN
+24 SET RGRSTEXT(9)="ICN: "_ICN
+25 SET RGRSTEXT(10)="CMOR: "_CMOR
+26 SET RGRSTEXT(11)="--------------------------------------------------------"
+27 SET RGRSTEXT(12)="=> "_$PIECE($$INST^RGRSBUL1(@ARRAY@("SENDING SITE"))," -->")_" data:"
+28 SET COUNTER=12
+29 FOR INDEX="NAME","SSN","ICN","CMOR"
Begin DoDot:1
+30 IF $DATA(@ARRAY@(INDEX))
SET COUNTER=COUNTER+1
SET RGRSTEXT(COUNTER)=INDEX_": "_@ARRAY@(INDEX)
End DoDot:1
+31 DO BULL2("MPI/PD - INCONSISTENT "_BULSUB,"RGRSTEXT(")
+32 QUIT