AMERERS ; IHS/OIT/SCR - ROUTINES TO SUPPORT MERGE OF PCC DATA TO ERS DATA ;
;;3.0;ER VISIT SYSTEM;**1,2,6,7**;MAR 03, 2009;Build 5
SYNCHERA(AMERDA,AMERPCC) ;
;IHS/OIT/SCR 12/31/08
;This routine is called when it is determined that PCC admission data needs to replace shared ERS Visit
;file admission information
; Compare ER "Presenting Complaint" to VISIT "Chief Complaint"
;N AMERVVAL,AMEREVAL,AMERDUZ,AMERSTRG,AMEREDTS
N AMERVVAL,AMEREVAL,AMERDUZ,AMERSTRG,AMEREDTS,AMERDR ;IHS/OIT/SCR 071509
;S AMERDUZ=DUZ
S AMEREVAL=$G(^AMERVSIT(AMERDA,1))
S AMERVVAL=$G(^AUPNVSIT(AMERPCC,14))
S AMERVVAL=$TR(AMERVVAL,";","~") ;IHS/OIT/SCR 05/07/09 patch 1 - don't try to save ";"
;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
I (AMEREVAL'=AMERVVAL) D
.Q:AMERVVAL=""
.;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
.NEW AMUPD
.S AMUPD(9009080,AMERDA_",",1)=AMERVVAL
.D FILE^DIE("","AMUPD","ERROR")
.;S AMERDR="1////"_AMERVVAL
.;D DIE^AMEREDIT(AMERDA,AMERDR)
.;D NOW^%DTC
.;S AMERSTRG="1;"_X_";"_AMEREVAL_";"_AMERVVAL_";Other;CHIEF COMPLAINT;Silent PCC SYNCH"
.;S AMEREDTS=AMERSTRG
.;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
.Q
; GET THE DEPARTURE OUT TIME FROM VISIT AND COMPARE TO CHECK OUT TIME IN ER VISIT
S AMEREVAL=$P($G(^AMERVSIT(AMERDA,6)),U,2) ; AMERDEPT IS DEPARTURE TIME
;S AMERVVAL=$$CODT^APCLV(AMERPCC,"I")
S AMERVVAL=$P(^AUPNVSIT(AMERPCC,0),"^",18) ;CHECKOUT TIME
I (AMEREVAL'=AMERVVAL) D
.Q:AMERVVAL=""
.;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
.S AMERDR="6.2////"_AMERVVAL
.D DIE^AMEREDIT(AMERDA,AMERDR)
.;D NOW^%DTC
.;S AMERSTRG="1;"_X_";"_$$EDDISPL^AMEREDAU(AMEREVAL,"D")_";"_$$EDDISPL^AMEREDAU(AMERVVAL,"D")_";Other;CHECK OUT TIME;Silent PCC SYNCH"
.;S AMEREDTS=AMERSTRG
.;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
.Q
Q
SYNCHERX(AMERDA,AMERPCC) ;EP from AMEREDIT and AMERPCC2
;IHS/OIT/SCR 12/29/08
;This routine is called when it is determined that PCC DX need to replace the ER VISIT file DXs.
;0. REMOVE ALL DX FROM ERS SO DX GO BACK IN SAME INDEX AS PCC ARRA
;1. GET ALL DX FROM PCC
;2. REPLACE THE PRIMARY DX INFO WITH THE FIRST DX
;3. REPLACE EACH DX NODE IN ERS WITH THAT PCC DX NODE
N AMERDXS,AMERINDX,AMERVERR,AMERDR,AMERONAR,AMERODX,AMEROLD,AMERNEW,AMERPDX,AMERNNAR,AMERSTRG,AMERAIEN,AMERDUZ
N AMEREDNM,AMEREDTS,AMERDIE,AMERERR,DA,DIC,X,Y,DIK,AMEROFST
N AMERPOV
;
S AMEREDTS=""
;S AMEROFST=0
S AMERERR=0
;S AMEREDNM=1
;S AMERDUZ=DUZ ;WHO EVER IS USING THIS APPLICATION WHEN THIS ROUTINE IS CALLED
;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
;
;Clear out exisiting AMER VISIT POV entries
S AMERINDX=0
F S AMERINDX=$O(^AMERVSIT(AMERDA,5,AMERINDX)) Q:(AMERINDX="") D
.S DA(1)=AMERDA,DA=AMERINDX
.S DIK="^AMERVSIT(DA(1),5,"
.D ^DIK,EN^DIK ; Delete identified entry and re-index diagnosis field
.Q
;
;Clear out primary Dx and Narrative
D
. NEW DIE,DA,DR
. S DIE="^AMERVSIT("
. S DA=AMERDA
. S DR="5.2////@;5.3////@"
. L +^AMERVSIT(DA):0 I $T D ^DIE L -^AMERVSIT(DA)
;
;AMER*3*6;Pull POV information using new call
;$$POV^AMERUTIL Returns
;AMERPOV(CNT)=[1]^[2]^[3]^[4]^[5]
;[1] - ICD code
;[2] - P-Primary, S-Secondary
;[3] - Provider Narrative
;[4] - IEN Pointer to file 80
;[5] - ICD Description Value
;[6] - V POV IEN
S AMERVERR=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
;
;Now update AMERVSIT
S AMERINDX="" F S AMERINDX=$O(AMERPOV(AMERINDX)) Q:AMERINDX="" D
. NEW DXNAR,DXIEN,DXPRM,DA,DIC,DIE,X,Y,DLAYGO,DR
. ;
. ;Retrieve values
. S DXNAR=$P(AMERPOV(AMERINDX),U,3) ;Provider Narrative
. S DXIEN=$P(AMERPOV(AMERINDX),U,4) ;POV IEN
. S DXPRM=$P(AMERPOV(AMERINDX),U,2) ;P/S
. ;
. ;If primary save special fields
. I DXPRM="P" D
.. ;AMER*3.0*7;Changes to handle special characters in narrative
.. NEW AMUPD
.. S AMUPD(9009080,AMERDA_",",5.2)=DXIEN
.. I DXNAR]"" S AMUPD(9009080,AMERDA_",",5.3)=DXNAR
.. D FILE^DIE("","AMUPD","ERROR")
.. ;S DIE="^AMERVSIT("
.. ;S DA=AMERDA
.. ;S DR="5.2////"_DXIEN
.. ;I DXNAR]"" S DR=DR_";5.3////"_DXNAR
.. ;L +^AMERVSIT(DA):0 I $T D ^DIE L -^AMERVSIT(DA)
. ;
. ;Save entry
. S DA(1)=AMERDA,DIC="^AMERVSIT("_DA(1)_",5,",DIC(0)="L"
. S DLAYGO=9009080.05
. S X=DXIEN
. K DO,DD D FILE^DICN
. Q:DXNAR="" ;Quit if no narrative
. Q:+Y<0
. ;AMER*3.0*7;Changes to handle special characters in narrative
. ;S DIE=DIC,DA(1)=AMERDA,DA=+Y,DR="1////"_DXNAR
. ;D ^DIE
. NEW IENS,AMUPD
. S DA(1)=AMERDA,DA=+Y,IENS=$$IENS^DILF(.DA)
. S AMUPD(9009080.05,IENS,1)=DXNAR
. D FILE^DIE("","AMUPD","ERROR")
;
Q
;
SYNCHERD(AMERDA,AMERPCC) ;EP from AMEREDIT and AMERPCC1
;IHS/OIT/SCR 12/30/08
;This routine is called when it is determined that PCC PROVIDERS need to replace the ER VISIT file PROVIDERS.
;1. GET ALL PROVIDERS FROM PCC
;2. REPLACE THE ERS DISCHARGE PROVIDER INFO WITH THE INFO IN THE PCC PRIMARY PROVIDER IF THEY ARE DIFFERENT
N AMERVINT,AMEREINT,AMERVERR,AMERDR,AMERSTRG,AMERAIEN,AMERDUZ,AMEREDTS
S AMEREDTS=""
;S AMERDUZ=DUZ ;WHO EVER IS USING THIS APPLICATION WHEN THIS ROUTINE IS CALLED
;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
S AMERVINT=$$PRIMPROV^APCLV(AMERPCC,"I") ;RETURNS ONE PCC PRIMARY PROVIDER
S AMEREINT=$P($G(^AMERVSIT(AMERDA,6)),U,3) ; DISCHARGE PROVIDER
I AMERVINT'=AMEREINT D
.Q:AMERVINT=""
.;UPDATE ERS DISCHARGE PROVIDER WITH THE PCC PRIMARY PROVIDER
.S AMERDR=""
.S AMERDR="6.3////"_AMERVINT
.D:AMERDR'="" DIE^AMEREDIT(AMERDA,AMERDR)
.;D NOW^%DTC
.;S AMERSTRG="6.3;"_X_";"_$$EDDISPL^AMEREDAU(AMEREINT,"N")_";"_$$EDDISPL^AMEREDAU(AMERVINT,"N")_";Other;DISCHARGE PROVIDER;Silent PCC SYNCH"
.;S AMEREDTS=AMERSTRG
.;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
.Q
Q
SYNCHERS(AMERSTRT,AMEREND) ;EP from ERS reporting routines to synch a range of records
;IHS/OIT/SCR 12/29/08
;This routine is called to check all ER VISITS in a date range and update them with PCC DATA when
;the 'last edited' date on the PCC VISIT is more recent than the 'last edited' 'date in the ERS VISIT
; 1. CREATE AN ARRAY OF ERS IEN, PCC VISIT IEN AND ERS LAST UPDATE INFO FOR ERS VISITS IN THE DATE RANGE
; 2. FOR EACH ENTRY IN THAT ARRAY, GET THE PCC 'LAST UPDATE DATE'
; COMPARE PCC 'LAST UPDATE' TO ERS 'LAST UPDATE'
; IF PCC LAST UPDATE IS MORE CURRENTCALL SYNCHER ROUTINES TO UPDATE ERS VISIT
N AMEREMOD,AMERPMOD,AMERPCC,AMERDA,AMERFRST,AMERLST,X,Y,X1,X2,AMERPAT
S %DT=""
S X=AMERSTRT
D ^%DT
S AMERFRST=Y
S X=AMEREND
D ^%DT
S AMERLST=Y
;S AMERIDX1=AMERFRST
S AMERIDX1=AMERFRST-1 ;IHS/OIT/SCR 2/27/09 not synching all entries when reports are run
F S AMERIDX1=$O(^AMERVSIT("B",AMERIDX1)) Q:($P(AMERIDX1,".",1)>AMERLST)!(AMERIDX1="") D
.I AMERIDX1<AMERFRST Q ;GET TO STARTING POINT
.S AMERDA=$O(^AMERVSIT("B",AMERIDX1,""))
.S AMEREMOD=$P($G(^AMERVSIT(AMERDA,12)),"^",6) ;DATE LAST MODIFIED IN ERS VISIT
.S AMERPCC=$P($G(^AMERVSIT(AMERDA,0)),"^",3) ;PCC IEN FOR THIS VISIT
.I AMERPCC<1 D Q ;IHS/OIT/SCR 05/07/09
..D EN^DDIOL("No PCC VISIT found for ERS VISIT IEN "_AMERDA_"!!","","!?5")
..D EN^DDIOL("Skipping this record","","!?10")
..Q
.S AMERPMOD=$$DLM^APCLV(AMERPCC,"I")
.I AMERPMOD>=$P(AMEREMOD,".",1) D
..D SYNCHERA(AMERDA,AMERPCC) ;SYNCH ADMISSION IFO
..D SYNCHERX(AMERDA,AMERPCC) ;SYNCH DIAG INFO
..D SYNCHERD(AMERDA,AMERPCC) ;SYNCH PRIMARY PROVIDER INFO
..;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST SYNCHED (NOW)
..D TIMESTMP^AMERSAV1(AMERDA)
..Q
.S AMERPAT=$P($G(^AMERVSIT(AMERDA,0)),U,2)
.D:AMERPAT>0 SYNCHERP(AMERPAT,AMERDA)
.Q
W !,"FINISHED SYNCHING ERS WITH CURRENT PCC DATA FROM "_AMERSTRT_" TO "_AMEREND
Q
SYNCHERP(AMERPAT,AMERDA) ; EP from AMER0, AMEREDIT AND AMERPCC
;SYNCHS MOST CURRENT PATIENT INFORMATION FOR DUPLICATED FIELDS HRN AND DOB
N AMERDOB,AMERHRN,AMERDR ;IHS/OIT/SCR 071509 patch 2
S AMERDOB=$$DOB^AUPNPAT(AMERPAT)
S AMERHRN=$$HRN^AUPNPAT(AMERPAT,DUZ(2))
I $P($G(^AMERVSIT(AMERDA,0)),U,12)'=AMERDOB D
.S AMERDR=".12////"_AMERDOB
.D DIE^AMEREDIT(AMERDA,AMERDR)
.Q
I $P($G(^AMERVSIT(AMERDA,0)),U,13)'=AMERHRN D
.S AMERDR=".13////"_AMERHRN
.D DIE^AMEREDIT(AMERDA,AMERDR)
.Q
Q
AMERERS ; IHS/OIT/SCR - ROUTINES TO SUPPORT MERGE OF PCC DATA TO ERS DATA ;
+1 ;;3.0;ER VISIT SYSTEM;**1,2,6,7**;MAR 03, 2009;Build 5
SYNCHERA(AMERDA,AMERPCC) ;
+1 ;IHS/OIT/SCR 12/31/08
+2 ;This routine is called when it is determined that PCC admission data needs to replace shared ERS Visit
+3 ;file admission information
+4 ; Compare ER "Presenting Complaint" to VISIT "Chief Complaint"
+5 ;N AMERVVAL,AMEREVAL,AMERDUZ,AMERSTRG,AMEREDTS
+6 ;IHS/OIT/SCR 071509
NEW AMERVVAL,AMEREVAL,AMERDUZ,AMERSTRG,AMEREDTS,AMERDR
+7 ;S AMERDUZ=DUZ
+8 SET AMEREVAL=$GET(^AMERVSIT(AMERDA,1))
+9 SET AMERVVAL=$GET(^AUPNVSIT(AMERPCC,14))
+10 ;IHS/OIT/SCR 05/07/09 patch 1 - don't try to save ";"
SET AMERVVAL=$TRANSLATE(AMERVVAL,";","~")
+11 ;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
+12 IF (AMEREVAL'=AMERVVAL)
Begin DoDot:1
+13 IF AMERVVAL=""
QUIT
+14 ;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
+15 NEW AMUPD
+16 SET AMUPD(9009080,AMERDA_",",1)=AMERVVAL
+17 DO FILE^DIE("","AMUPD","ERROR")
+18 ;S AMERDR="1////"_AMERVVAL
+19 ;D DIE^AMEREDIT(AMERDA,AMERDR)
+20 ;D NOW^%DTC
+21 ;S AMERSTRG="1;"_X_";"_AMEREVAL_";"_AMERVVAL_";Other;CHIEF COMPLAINT;Silent PCC SYNCH"
+22 ;S AMEREDTS=AMERSTRG
+23 ;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+24 QUIT
End DoDot:1
+25 ; GET THE DEPARTURE OUT TIME FROM VISIT AND COMPARE TO CHECK OUT TIME IN ER VISIT
+26 ; AMERDEPT IS DEPARTURE TIME
SET AMEREVAL=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,2)
+27 ;S AMERVVAL=$$CODT^APCLV(AMERPCC,"I")
+28 ;CHECKOUT TIME
SET AMERVVAL=$PIECE(^AUPNVSIT(AMERPCC,0),"^",18)
+29 IF (AMEREVAL'=AMERVVAL)
Begin DoDot:1
+30 IF AMERVVAL=""
QUIT
+31 ;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
+32 SET AMERDR="6.2////"_AMERVVAL
+33 DO DIE^AMEREDIT(AMERDA,AMERDR)
+34 ;D NOW^%DTC
+35 ;S AMERSTRG="1;"_X_";"_$$EDDISPL^AMEREDAU(AMEREVAL,"D")_";"_$$EDDISPL^AMEREDAU(AMERVVAL,"D")_";Other;CHECK OUT TIME;Silent PCC SYNCH"
+36 ;S AMEREDTS=AMERSTRG
+37 ;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+38 QUIT
End DoDot:1
+39 QUIT
SYNCHERX(AMERDA,AMERPCC) ;EP from AMEREDIT and AMERPCC2
+1 ;IHS/OIT/SCR 12/29/08
+2 ;This routine is called when it is determined that PCC DX need to replace the ER VISIT file DXs.
+3 ;0. REMOVE ALL DX FROM ERS SO DX GO BACK IN SAME INDEX AS PCC ARRA
+4 ;1. GET ALL DX FROM PCC
+5 ;2. REPLACE THE PRIMARY DX INFO WITH THE FIRST DX
+6 ;3. REPLACE EACH DX NODE IN ERS WITH THAT PCC DX NODE
+7 NEW AMERDXS,AMERINDX,AMERVERR,AMERDR,AMERONAR,AMERODX,AMEROLD,AMERNEW,AMERPDX,AMERNNAR,AMERSTRG,AMERAIEN,AMERDUZ
+8 NEW AMEREDNM,AMEREDTS,AMERDIE,AMERERR,DA,DIC,X,Y,DIK,AMEROFST
+9 NEW AMERPOV
+10 ;
+11 SET AMEREDTS=""
+12 ;S AMEROFST=0
+13 SET AMERERR=0
+14 ;S AMEREDNM=1
+15 ;S AMERDUZ=DUZ ;WHO EVER IS USING THIS APPLICATION WHEN THIS ROUTINE IS CALLED
+16 ;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
+17 ;
+18 ;Clear out exisiting AMER VISIT POV entries
+19 SET AMERINDX=0
+20 FOR
SET AMERINDX=$ORDER(^AMERVSIT(AMERDA,5,AMERINDX))
IF (AMERINDX="")
QUIT
Begin DoDot:1
+21 SET DA(1)=AMERDA
SET DA=AMERINDX
+22 SET DIK="^AMERVSIT(DA(1),5,"
+23 ; Delete identified entry and re-index diagnosis field
DO ^DIK
DO EN^DIK
+24 QUIT
End DoDot:1
+25 ;
+26 ;Clear out primary Dx and Narrative
+27 Begin DoDot:1
+28 NEW DIE,DA,DR
+29 SET DIE="^AMERVSIT("
+30 SET DA=AMERDA
+31 SET DR="5.2////@;5.3////@"
+32 LOCK +^AMERVSIT(DA):0
IF $TEST
DO ^DIE
LOCK -^AMERVSIT(DA)
End DoDot:1
+33 ;
+34 ;AMER*3*6;Pull POV information using new call
+35 ;$$POV^AMERUTIL Returns
+36 ;AMERPOV(CNT)=[1]^[2]^[3]^[4]^[5]
+37 ;[1] - ICD code
+38 ;[2] - P-Primary, S-Secondary
+39 ;[3] - Provider Narrative
+40 ;[4] - IEN Pointer to file 80
+41 ;[5] - ICD Description Value
+42 ;[6] - V POV IEN
+43 SET AMERVERR=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
+44 ;
+45 ;Now update AMERVSIT
+46 SET AMERINDX=""
FOR
SET AMERINDX=$ORDER(AMERPOV(AMERINDX))
IF AMERINDX=""
QUIT
Begin DoDot:1
+47 NEW DXNAR,DXIEN,DXPRM,DA,DIC,DIE,X,Y,DLAYGO,DR
+48 ;
+49 ;Retrieve values
+50 ;Provider Narrative
SET DXNAR=$PIECE(AMERPOV(AMERINDX),U,3)
+51 ;POV IEN
SET DXIEN=$PIECE(AMERPOV(AMERINDX),U,4)
+52 ;P/S
SET DXPRM=$PIECE(AMERPOV(AMERINDX),U,2)
+53 ;
+54 ;If primary save special fields
+55 IF DXPRM="P"
Begin DoDot:2
+56 ;AMER*3.0*7;Changes to handle special characters in narrative
+57 NEW AMUPD
+58 SET AMUPD(9009080,AMERDA_",",5.2)=DXIEN
+59 IF DXNAR]""
SET AMUPD(9009080,AMERDA_",",5.3)=DXNAR
+60 DO FILE^DIE("","AMUPD","ERROR")
+61 ;S DIE="^AMERVSIT("
+62 ;S DA=AMERDA
+63 ;S DR="5.2////"_DXIEN
+64 ;I DXNAR]"" S DR=DR_";5.3////"_DXNAR
+65 ;L +^AMERVSIT(DA):0 I $T D ^DIE L -^AMERVSIT(DA)
End DoDot:2
+66 ;
+67 ;Save entry
+68 SET DA(1)=AMERDA
SET DIC="^AMERVSIT("_DA(1)_",5,"
SET DIC(0)="L"
+69 SET DLAYGO=9009080.05
+70 SET X=DXIEN
+71 KILL DO,DD
DO FILE^DICN
+72 ;Quit if no narrative
IF DXNAR=""
QUIT
+73 IF +Y<0
QUIT
+74 ;AMER*3.0*7;Changes to handle special characters in narrative
+75 ;S DIE=DIC,DA(1)=AMERDA,DA=+Y,DR="1////"_DXNAR
+76 ;D ^DIE
+77 NEW IENS,AMUPD
+78 SET DA(1)=AMERDA
SET DA=+Y
SET IENS=$$IENS^DILF(.DA)
+79 SET AMUPD(9009080.05,IENS,1)=DXNAR
+80 DO FILE^DIE("","AMUPD","ERROR")
End DoDot:1
+81 ;
+82 QUIT
+83 ;
SYNCHERD(AMERDA,AMERPCC) ;EP from AMEREDIT and AMERPCC1
+1 ;IHS/OIT/SCR 12/30/08
+2 ;This routine is called when it is determined that PCC PROVIDERS need to replace the ER VISIT file PROVIDERS.
+3 ;1. GET ALL PROVIDERS FROM PCC
+4 ;2. REPLACE THE ERS DISCHARGE PROVIDER INFO WITH THE INFO IN THE PCC PRIMARY PROVIDER IF THEY ARE DIFFERENT
+5 NEW AMERVINT,AMEREINT,AMERVERR,AMERDR,AMERSTRG,AMERAIEN,AMERDUZ,AMEREDTS
+6 SET AMEREDTS=""
+7 ;S AMERDUZ=DUZ ;WHO EVER IS USING THIS APPLICATION WHEN THIS ROUTINE IS CALLED
+8 ;S AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
+9 ;RETURNS ONE PCC PRIMARY PROVIDER
SET AMERVINT=$$PRIMPROV^APCLV(AMERPCC,"I")
+10 ; DISCHARGE PROVIDER
SET AMEREINT=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,3)
+11 IF AMERVINT'=AMEREINT
Begin DoDot:1
+12 IF AMERVINT=""
QUIT
+13 ;UPDATE ERS DISCHARGE PROVIDER WITH THE PCC PRIMARY PROVIDER
+14 SET AMERDR=""
+15 SET AMERDR="6.3////"_AMERVINT
+16 IF AMERDR'=""
DO DIE^AMEREDIT(AMERDA,AMERDR)
+17 ;D NOW^%DTC
+18 ;S AMERSTRG="6.3;"_X_";"_$$EDDISPL^AMEREDAU(AMEREINT,"N")_";"_$$EDDISPL^AMEREDAU(AMERVINT,"N")_";Other;DISCHARGE PROVIDER;Silent PCC SYNCH"
+19 ;S AMEREDTS=AMERSTRG
+20 ;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+21 QUIT
End DoDot:1
+22 QUIT
SYNCHERS(AMERSTRT,AMEREND) ;EP from ERS reporting routines to synch a range of records
+1 ;IHS/OIT/SCR 12/29/08
+2 ;This routine is called to check all ER VISITS in a date range and update them with PCC DATA when
+3 ;the 'last edited' date on the PCC VISIT is more recent than the 'last edited' 'date in the ERS VISIT
+4 ; 1. CREATE AN ARRAY OF ERS IEN, PCC VISIT IEN AND ERS LAST UPDATE INFO FOR ERS VISITS IN THE DATE RANGE
+5 ; 2. FOR EACH ENTRY IN THAT ARRAY, GET THE PCC 'LAST UPDATE DATE'
+6 ; COMPARE PCC 'LAST UPDATE' TO ERS 'LAST UPDATE'
+7 ; IF PCC LAST UPDATE IS MORE CURRENTCALL SYNCHER ROUTINES TO UPDATE ERS VISIT
+8 NEW AMEREMOD,AMERPMOD,AMERPCC,AMERDA,AMERFRST,AMERLST,X,Y,X1,X2,AMERPAT
+9 SET %DT=""
+10 SET X=AMERSTRT
+11 DO ^%DT
+12 SET AMERFRST=Y
+13 SET X=AMEREND
+14 DO ^%DT
+15 SET AMERLST=Y
+16 ;S AMERIDX1=AMERFRST
+17 ;IHS/OIT/SCR 2/27/09 not synching all entries when reports are run
SET AMERIDX1=AMERFRST-1
+18 FOR
SET AMERIDX1=$ORDER(^AMERVSIT("B",AMERIDX1))
IF ($PIECE(AMERIDX1,".",1)>AMERLST)!(AMERIDX1="")
QUIT
Begin DoDot:1
+19 ;GET TO STARTING POINT
IF AMERIDX1<AMERFRST
QUIT
+20 SET AMERDA=$ORDER(^AMERVSIT("B",AMERIDX1,""))
+21 ;DATE LAST MODIFIED IN ERS VISIT
SET AMEREMOD=$PIECE($GET(^AMERVSIT(AMERDA,12)),"^",6)
+22 ;PCC IEN FOR THIS VISIT
SET AMERPCC=$PIECE($GET(^AMERVSIT(AMERDA,0)),"^",3)
+23 ;IHS/OIT/SCR 05/07/09
IF AMERPCC<1
Begin DoDot:2
+24 DO EN^DDIOL("No PCC VISIT found for ERS VISIT IEN "_AMERDA_"!!","","!?5")
+25 DO EN^DDIOL("Skipping this record","","!?10")
+26 QUIT
End DoDot:2
QUIT
+27 SET AMERPMOD=$$DLM^APCLV(AMERPCC,"I")
+28 IF AMERPMOD>=$PIECE(AMEREMOD,".",1)
Begin DoDot:2
+29 ;SYNCH ADMISSION IFO
DO SYNCHERA(AMERDA,AMERPCC)
+30 ;SYNCH DIAG INFO
DO SYNCHERX(AMERDA,AMERPCC)
+31 ;SYNCH PRIMARY PROVIDER INFO
DO SYNCHERD(AMERDA,AMERPCC)
+32 ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST SYNCHED (NOW)
+33 DO TIMESTMP^AMERSAV1(AMERDA)
+34 QUIT
End DoDot:2
+35 SET AMERPAT=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,2)
+36 IF AMERPAT>0
DO SYNCHERP(AMERPAT,AMERDA)
+37 QUIT
End DoDot:1
+38 WRITE !,"FINISHED SYNCHING ERS WITH CURRENT PCC DATA FROM "_AMERSTRT_" TO "_AMEREND
+39 QUIT
SYNCHERP(AMERPAT,AMERDA) ; EP from AMER0, AMEREDIT AND AMERPCC
+1 ;SYNCHS MOST CURRENT PATIENT INFORMATION FOR DUPLICATED FIELDS HRN AND DOB
+2 ;IHS/OIT/SCR 071509 patch 2
NEW AMERDOB,AMERHRN,AMERDR
+3 SET AMERDOB=$$DOB^AUPNPAT(AMERPAT)
+4 SET AMERHRN=$$HRN^AUPNPAT(AMERPAT,DUZ(2))
+5 IF $PIECE($GET(^AMERVSIT(AMERDA,0)),U,12)'=AMERDOB
Begin DoDot:1
+6 SET AMERDR=".12////"_AMERDOB
+7 DO DIE^AMEREDIT(AMERDA,AMERDR)
+8 QUIT
End DoDot:1
+9 IF $PIECE($GET(^AMERVSIT(AMERDA,0)),U,13)'=AMERHRN
Begin DoDot:1
+10 SET AMERDR=".13////"_AMERHRN
+11 DO DIE^AMEREDIT(AMERDA,AMERDR)
+12 QUIT
End DoDot:1
+13 QUIT
