Routine: AMERERS

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

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

 . 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")

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

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

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

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

AMERERS.m