AMERPCC2.m

AMERPCC2 ; IHS/OIT/SCR - SUPPORTING ROUTINES FOR V POV SYNCHING ;

 ;;3.0;ER VISIT SYSTEM;**1,3,6**;MAR 03, 2009;Build 30

 ;

SYNCHPOV(AMERDA,AMERPCC,AMERPAT,AMERTIME,AMERDOC,AMERCLN)  ; EP from SYNCHPCC^AMERPCC

 ;AMER*3.0*6;AMER no longer storing DX information directly to AMER

 ;          ;Information now gets updated using SYNC^AMERPOV

 Q

 ; Q  ; DX SYNCHRONIZATION VALIDATION BETWEEN ER VISIT FILE AND V POV NOW MANAGED ELSEWHERE

 ; This routine LOOKS AT EACH V POV entry and tries to find it in ERS for comparison

 ;  IF differences exist will prompt user to identify which data to save 

 ;  When each V POV entry has been looked at, each ERS entry is examined in VPOVUPDT

 ;  IF DX codes exist in the ERS entry that aren't in V POV user is prompted to identify which data to save

 ; INPUT:

 ;  AMERDA - IEN OF ER VISIT FILE

 ;  AMERPCC - IEN OF VISIT FILE

 ;  AMERPAT -IEN OF PATIENT FILE

 ;  AMERTIME - DATE TIME OF VISIT

 ;  AMERDOC - PROVIDER IEN

 ;  AMERCLN - NAME OF CLINIC STOP (EMERGENCY OR URGENT CARE)

 N AMERVERR,AMEREPOV,AMERENAR,AMERVNAR,AMERVPOV,AMER9999,AMERPDX,AMERDX,AMERPNAR,AMERICD9,AMERPOV,AMERNXT,AMERANS,AMERDONE,AMERFND

 ;N AMERSLNT,AMER9999,AMERV999,AMERE999,AMERVICD,AMERNDXI

 N AMER9999,AMERV999,AMERE999,AMERVICD,AMERNDXI

 ; This routine updates V POV entires with DX information in ER VISIT file

 ; First get any CODES that are in V POV

 ;S AMERDONE=0,AMERSLNT=0

 S AMERDONE=0

 S AMERV999=0 ;COUNTS HOW MANY 999 CODES ARE IN V POV ENTRIES

 S AMERE999=0 ; COUNTS HOW MANY 9999 CODES WERE MATCHED IN ERS

 S AMER9999=$P($$ICDDX^ICDCODE(".9999",,,1),U,1) ;POINTER TO .9999 CODE IN ICD9 CODE - THIS CODE CAN BE ENTERED MORE THAN ONCE

 S AMERPDX=$P($G(^AMERVSIT(AMERDA,5.1)),U,2)  ; PRIMARY DX POINTER

 S AMERPNAR=$P($G(^AMERVSIT(AMERDA,5.1)),U,3) ; PRIMARY NARRATIVE

 K APCLV

 S AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")

 ; This will return:

 ; APCLV(x)=^^^^internal value of V POV^^ ICD9 code^^^^Cause of injury^place of injury^provider narrative^date of injury

 ; for each V POV x in the file for this visit

 S AMERVPOV=0,AMERVIEN=""

 F  S AMERVPOV=$O(APCLV(AMERVPOV)) Q:AMERVPOV=""  D

 .S AMERVIEN=$P(APCLV(AMERVPOV),U,5)

 .S AMERVICD=$P(APCLV(AMERVPOV),U,7)

 .;IHS/OIT/SCR 2/4/09 try to deal with VA LOCAL CODE PROBLEM start changes

 .;I AMER9999=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1) S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF .9999 CODES SO FAR

 .S AMERVDXI=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)

 .I AMERVDXI<1 D

 ..S AMERVDXI=$P($$ICDDX^ICDCODE(".9999",,,1),U,1)   ;start by setting it to 'uncoded'

 ..I AMERVICD="VA LOCAL CODE SELECTED" D

 ...;LOOK IT UP THROUGH FILEMAN

 ...S DIC="^AUPNVPOV(",DIC(0)="NX",X="`"_$P(APCLV(AMERVPOV),"^",5)

 ...D ^DIC

 ...I Y'=-1 S AMERVDXI=$P(Y,"^",2)   ;brings back the ICD ien

 ...S AMERVICD=$P($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)  ;brings back the code

 ..Q

 ..;I AMER9999=AMERVDXI S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF PCC .9999 CODES SO FAR

 .;IHS/OIT/SCR 2/4/09 try to deal with VA LOCAL CODE PROBLEM end changes

 .I AMERVPOV=1 D   ; IF THIS IS THE FIRST V POV RETURNED

 ..;I $P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)'=$P(APCLV(AMERVPOV),U,7) D

 ..I $P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)'=AMERVICD D

 ...;IHS/OIT/SCR 12/19 - if the values are different, user needs to choose

 ...D EN^DDIOL("**The PRIMARY DX in the PCC VISIT file is different from ERS PRIMARY DX**","","!!?3")

 ...D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$P(APCLV(AMERVPOV),U,14),"","!?3")

 ...D EN^DDIOL("ERS ENTERED VALUE: "_$P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)_" - "_AMERPNAR,"","!?3")

 ...S DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 ...S DIR("A")="Which would you like to do"

 ...D ^DIR K DIR

 ...S AMERANS=+Y

 ...I Y=""!(Y="^")!(AMERANS=2) D  ;if user selects to or up-hats out, keep PCC info

 ....D SYNCHERX^AMERERS(AMERDA,AMERPCC)   ;REPLACE ANY ER VISIT DX INFO WITH INFO THAT IS IN PCC AND STOP

 ....S AMERDONE=1

 ....Q

 ...I AMERANS=1 D

 ....; UPDATE THE PCC VISIT WITH THE PRIMARY DX THE USER JUST ENTERED - START BY DELETING WHAT IS THERE

 ....I $$DELETPOV^AMERVSIT(AMERPCC)=0 D EN^DDIOL("THERE WAS A PROBLEM DELETING V POV ENTRIES","","!!")

 ....K APCLV   ; ALL V POVS WERE DELETED, SO GET RID OF THIS ARRAY, AND BUILD IT AGAIN

 ....S AMERVPOV=0  ; RESET LOOP VARIABLE to get out of loop

 ....S AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")

 ....;S AMERSLNT=1

 ....Q

 ...Q

 ..Q:((AMERVPOV<1)!AMERDONE)

 ..S AMERVNAR=$P(APCLV(AMERVPOV),U,14)  ;IHS/OIT/SCR patch 1

 ..S AMERVNAR=$$STRIPNAR(AMERVNAR) ;IHS/OIT/SCR - remove ";" from narrative

 ..;I (AMERPNAR'=$P(APCLV(AMERVPOV),U,14)) D  

 ..I (AMERPNAR'=AMERVNAR) D  ;IHS/OIT/SCR patch 1

 ...D EN^DDIOL("**The value for PRIMARY NARRATIVE in the PCC visit file is different from ERS NARRATIVE**","","!!?3")

 ...;D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$P(APCLV(AMERVPOV),U,14),"","!?3")

 ...D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_AMERVNAR,"","!?3")

 ...D EN^DDIOL("ERS ENTERED VALUE: "_$P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)_" - "_AMERPNAR,"","!?3")

 ...S DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 ...S DIR("A")="Which would you like to do"

 ...D ^DIR K DIR

 ...S AMERANS=+Y

 ...;I Y=""!(Y="^")!(AMERANS=2) D

 ...I (AMERANS=0)!(AMERANS=2) D  Q  ;IHS/OIT/GIS 8/23/11 patch 3

 ....;UPDATE ERS PRIMARY NARRATIVE WITH THE NARRATIVE FOR THIS PCC DX

 ....;IHS/OIT/SCR 05/14/09 ...But this means updating in PRIMARY and in DX MULTIPLE...

 ....;S DR=$S(DR'="":DR_";",1:""),DR=DR_"5.3////"_AMERVNAR

 ....;S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERINDX,DR=""

 ....;S DR="1////"_$P(APCLV(AMERVPOV),U,14)

 ....;S DR="1////"_AMERVNAR ;IHS/OIT/SCR 05/05/09

 ....;D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 ....S DR="5.3////"_AMERVNAR

 ....D DIE^AMEREDIT(AMERDA,DR)

 ....;K DIE

 ....;now you have to find the old narrative in the multiple DX file; check code and replace

 ....S AMERINDX=0

 ....S AMERINDX=0,AMERFND=0

 ....I AMER9999=AMERVDXI S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF PCC .9999 CODES THAT AREN'T PRIMARY SO FAR

 ....F  S AMERINDX=$O(^AMERVSIT(AMERDA,5,AMERINDX)) Q:AMERINDX="B"!AMERFND  D

 .....I AMERINDX="" S AMERINDX="B"  ;if we have no DX info for some reason, get out of loop

 .....I (AMERPNAR=$G(^AMERVSIT(AMERDA,5,AMERINDX,1)))&(AMERPDX=$G(^AMERVSIT(AMERDA,5,AMERINDX,0))) D  Q

 ......S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERINDX,DR=""

 ......D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 ......S AMERFND=1

 ......Q

 .....Q

 ....Q

 ....I AMERFND=0 D   ;This primary DX was not found in the ERS record...synch with PCC now

 .....D EN^DDIOL("Corrupted ERS DX record found","","!!")

 .....D EN^DDIOL("Replacing with PCC V POV entries","","!!")

 .....D SYNCHERX^AMERERS(AMERDA,AMERPCC)   ;REPLACE ANY ER VISIT DX INFO WITH INFO THAT IS IN PCC AND STOP

 .....S AMERDONE=1

 .....Q

 ....Q

 ...I AMERANS=1 D UPDTNAR^AMERVSIT(AMERVIEN,AMERPNAR) ;IHS/OIT/GIS 8/23/11 patch 3

 ...Q  ;IF AMERENAR'=$P(APCLV(AMERVPOV),U,14)

 ..Q

 .I AMERVPOV>1 D

 ..;THIS IS  NOT THE PRIMARY DX IN PCC, LOOK FOR IT IN THE ER VISIT FILE DIAGNOSIS SUB-ENTRIES

 ..;IF IT IS THERE COMPARE THE TWO NARRATIVES AND GIVE USER A CHANCE TO UPDATE WITH CHOOSEN  VERSION

 ..;IF IT IS NOT THERE ASK THE USER IF THEY WANT TO ADD THE CODE TO ERS, OR REMOVE IT FROM PCC

 ..S AMERINDX=0,AMERFND=0,AMERNXT=0,AMERE999=0

 ..I AMER9999=AMERVDXI S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF PCC .9999 CODES THAT AREN'T PRIMARY SO FAR

 ..F  S AMERINDX=$O(^AMERVSIT(AMERDA,5,AMERINDX)) Q:AMERINDX="B"!AMERFND  D

 ...S AMERDX=^AMERVSIT(AMERDA,5,AMERINDX,0)

 ...;S AMERNAR=$G(^AMERVSIT(AMERDA,5,AMERINDX,1))

 ...S AMERENAR=$G(^AMERVSIT(AMERDA,5,AMERINDX,1))

 ...;Q:(AMERDX=AMERPDX)&(AMERNAR=AMERPNAR)  ;IHS/OIT/SCR 01/13/08 - if this is the primary DX, don't mess with it

 ...Q:(AMERDX=AMERPDX)&(AMERENAR=AMERPNAR)  ;IHS/OIT/SCR 01/13/08 - if this is the primary DX, don't mess with it

 ...I AMERDX=AMER9999 S AMERE999=AMERE999+1

 ...Q:(AMERDX=AMER9999)&(AMERE999<AMERV999)  ;if this is a .9999 code and we've already considered it, move on

 ...I $P($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)=AMERVICD D

 ....S AMERFND=1

 ....;I AMERNAR'=$P(APCLV(AMERVPOV),U,14) D

 ....I AMERENAR'=$P(APCLV(AMERVPOV),U,14) D

 .....S AMERVNAR=$$STRIPNAR(AMERVNAR) ;IHS/OIT/SCR 5/5/09 patch 1

 .....D EN^DDIOL("**The value for NARRATIVE in the PCC visit file is different from ERS NARRATIVE**","","!!?3")

 .....D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$P(APCLV(AMERVPOV),U,14),"","!?3")

 .....;D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_AMERVNAR,"","!?3") ;IHS/OIT/SCR 5/5/09 patch 1

 .....;D EN^DDIOL("ERS ENTERED VALUE: "_$P($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)_" - "_AMERNAR,"","!?3")

 .....D EN^DDIOL("ERS ENTERED VALUE: "_$P($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)_" - "_AMERENAR,"","!?3") ;IHS/OIT/SCR 5/5/09 patch 1

 .....S DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 .....S DIR("A")="Which would you like to do"

 .....D ^DIR K DIR

 .....S AMERANS=+Y

 .....;I Y=""!(Y="^")!(AMERANS=2) D ;IHS/OIT/SCR 5/5/09 patch 1

 .....I (AMERANS=0)!(AMERANS=2) D  ;IHS/OIT/GIS 8/23/11 patch 3

 ......;UPDATE ERS NARRATIVE WITH THE NARRATIVE FOR THIS PCC DX

 ......S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERINDX,DR=""

 ......;IHS/OIT/SCR 5/5/09 first strip ";"

 ......;S DR="1////"_$P(APCLV(AMERVPOV),U,14)

 ......S DR="1////"_AMERVNAR ;IHS/OIT/SCR 05/05/09

 ......D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 ......K DIE

 ......Q

 .....I Y=1 D UPDTNAR^AMERVSIT(AMERVIEN,AMERENAR)

 .....Q

 ....Q  ;IF AMERENAR'=$P(APCLV(AMERVPOV),U,14)

 ...Q

 ..I 'AMERFND D

 ...D EN^DDIOL("**There is no ERS DIAGNOSIS CODE CORRESPONDING TO V POV ENTRY**","","!!?3")

 ...D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$P(APCLV(AMERVPOV),U,14),"","!?3")

 ...S DIR(0)="SO^1:Correct ERS data by adding this diagnosis;2:Correct PCC data by removing this V POV entry"

 ...S DIR("A")="Which would you like to do"

 ...D ^DIR K DIR

 ...S AMERANS=+Y

 ...;I Y=""!(Y="^")!(AMERANS=1) D

 ...I (AMERANS=0)!(AMERANS=1) D

 ....;ADD THIS V POV DX TO ERS VISIT

 ....;S AMERNDXI=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)

 ....S AMERVNAR=$P(APCLV(AMERVPOV),U,14)

 ....S AMERVNAR=$$STRIPNAR(AMERVNAR) ;IHS/OIT/SCR 05/05/09 - remove ";" from narrative

 ....;CAN'T USE DIE TO ADD A SUBENTRY...WE WANT TO USE DIC

 ....;S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERNXT,DR=""

 ....;S DR=".01////"_AMERVDXI

 ....;S DR=DR_";1////"_AMERNNAR

 ....;D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 ....;K DIE

 ....S DA(1)=AMERDA,DIC="^AMERVSIT("_DA(1)_",5,",DIC(0)="" ; DIAGNOSES

 ....S X=AMERVDXI

 ....D FILE^DICN

 ....Q:+Y<0

 ....S DIE=DIC,DA(1)=AMERDA,DA=+Y,DR="1////"_AMERVNAR

 ....D ^DIE

 ....K DIC,DIE,DA,Y,DR

 ....Q

 ...I AMERANS=2 D

 ....;REMOVE THE V POV ENTRY

 ....L +^AUPNVPOV:3 E  Q

 ....S DA=AMERVIEN,DIK="^AUPNVPOV(" D ^DIK,EN^DIK

 ....L -^AUPNVPOV

 ....Q

 ....;K APCLV(AMERVPOV)  ;

 ..Q

 .Q

 Q:AMERPDX=""  ; Don't try to update AUPNVPOV if no primary DX has been identified in ERS

 Q:AMERDONE    ;If the routine has just updated ERS to match PCC its done

 D VPOVUPDT^AMERPCC3(AMERPAT,AMERPCC,AMERTIME,AMERDOC)

 Q

STRIPNAR(AMERSTG)  ;IHS/OIT/SCR 050709

 S AMERSTG=$TR(AMERSTG,";","~")

 Q AMERSTG

AMERPCC2  ; IHS/OIT/SCR - SUPPORTING ROUTINES FOR V POV SYNCHING ;

 +1       ;;3.0;ER VISIT SYSTEM;**1,3,6**;MAR 03, 2009;Build 30

 +2       ;

SYNCHPOV(AMERDA,AMERPCC,AMERPAT,AMERTIME,AMERDOC,AMERCLN) ; EP from SYNCHPCC^AMERPCC

 +1       ;AMER*3.0*6;AMER no longer storing DX information directly to AMER

 +2       ;          ;Information now gets updated using SYNC^AMERPOV

 +3        QUIT 

 +4       ; Q  ; DX SYNCHRONIZATION VALIDATION BETWEEN ER VISIT FILE AND V POV NOW MANAGED ELSEWHERE

 +5       ; This routine LOOKS AT EACH V POV entry and tries to find it in ERS for comparison

 +6       ;  IF differences exist will prompt user to identify which data to save 

 +7       ;  When each V POV entry has been looked at, each ERS entry is examined in VPOVUPDT

 +8       ;  IF DX codes exist in the ERS entry that aren't in V POV user is prompted to identify which data to save

 +9       ; INPUT:

 +10      ;  AMERDA - IEN OF ER VISIT FILE

 +11      ;  AMERPCC - IEN OF VISIT FILE

 +12      ;  AMERPAT -IEN OF PATIENT FILE

 +13      ;  AMERTIME - DATE TIME OF VISIT

 +14      ;  AMERDOC - PROVIDER IEN

 +15      ;  AMERCLN - NAME OF CLINIC STOP (EMERGENCY OR URGENT CARE)

 +16       NEW AMERVERR,AMEREPOV,AMERENAR,AMERVNAR,AMERVPOV,AMER9999,AMERPDX,AMERDX,AMERPNAR,AMERICD9,AMERPOV,AMERNXT,AMERANS,AMERDONE,AMERFND

 +17      ;N AMERSLNT,AMER9999,AMERV999,AMERE999,AMERVICD,AMERNDXI

 +18       NEW AMER9999,AMERV999,AMERE999,AMERVICD,AMERNDXI

 +19      ; This routine updates V POV entires with DX information in ER VISIT file

 +20      ; First get any CODES that are in V POV

 +21      ;S AMERDONE=0,AMERSLNT=0

 +22       SET AMERDONE=0

 +23      ;COUNTS HOW MANY 999 CODES ARE IN V POV ENTRIES

           SET AMERV999=0

 +24      ; COUNTS HOW MANY 9999 CODES WERE MATCHED IN ERS

           SET AMERE999=0

 +25      ;POINTER TO .9999 CODE IN ICD9 CODE - THIS CODE CAN BE ENTERED MORE THAN ONCE

           SET AMER9999=$PIECE($$ICDDX^ICDCODE(".9999",,,1),U,1)

 +26      ; PRIMARY DX POINTER

           SET AMERPDX=$PIECE($GET(^AMERVSIT(AMERDA,5.1)),U,2)

 +27      ; PRIMARY NARRATIVE

           SET AMERPNAR=$PIECE($GET(^AMERVSIT(AMERDA,5.1)),U,3)

 +28       KILL APCLV

 +29       SET AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")

 +30      ; This will return:

 +31      ; APCLV(x)=^^^^internal value of V POV^^ ICD9 code^^^^Cause of injury^place of injury^provider narrative^date of injury

 +32      ; for each V POV x in the file for this visit

 +33       SET AMERVPOV=0

           SET AMERVIEN=""

 +34       FOR 

               SET AMERVPOV=$ORDER(APCLV(AMERVPOV))

               IF AMERVPOV=""

                   QUIT 

               Begin DoDot:1

 +35               SET AMERVIEN=$PIECE(APCLV(AMERVPOV),U,5)

 +36               SET AMERVICD=$PIECE(APCLV(AMERVPOV),U,7)

 +37      ;IHS/OIT/SCR 2/4/09 try to deal with VA LOCAL CODE PROBLEM start changes

 +38      ;I AMER9999=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1) S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF .9999 CODES SO FAR

 +39               SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)

 +40               IF AMERVDXI<1

                       Begin DoDot:2

 +41      ;start by setting it to 'uncoded'

                           SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(".9999",,,1),U,1)

 +42                       IF AMERVICD="VA LOCAL CODE SELECTED"

                               Begin DoDot:3

 +43      ;LOOK IT UP THROUGH FILEMAN

 +44                               SET DIC="^AUPNVPOV("

                                   SET DIC(0)="NX"

                                   SET X="`"_$PIECE(APCLV(AMERVPOV),"^",5)

 +45                               DO ^DIC

 +46      ;brings back the ICD ien

                                   IF Y'=-1

                                       SET AMERVDXI=$PIECE(Y,"^",2)

 +47      ;brings back the code

                                   SET AMERVICD=$PIECE($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)

                               End DoDot:3

 +48                       QUIT 

 +49      ;I AMER9999=AMERVDXI S AMERV999=AMERV999+1 ;THIS IS THE NUMBER OF PCC .9999 CODES SO FAR

                       End DoDot:2

 +50      ;IHS/OIT/SCR 2/4/09 try to deal with VA LOCAL CODE PROBLEM end changes

 +51      ; IF THIS IS THE FIRST V POV RETURNED

                   IF AMERVPOV=1

                       Begin DoDot:2

 +52      ;I $P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)'=$P(APCLV(AMERVPOV),U,7) D

 +53                       IF $PIECE($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)'=AMERVICD

                               Begin DoDot:3

 +54      ;IHS/OIT/SCR 12/19 - if the values are different, user needs to choose

 +55                               DO EN^DDIOL("**The PRIMARY DX in the PCC VISIT file is different from ERS PRIMARY DX**","","!!?3")

 +56                               DO EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$PIECE(APCLV(AMERVPOV),U,14),"","!?3")

 +57                               DO EN^DDIOL("ERS ENTERED VALUE: "_$PIECE($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)_" - "_AMERPNAR,"","!?3")

 +58                               SET DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 +59                               SET DIR("A")="Which would you like to do"

 +60                               DO ^DIR

                                   KILL DIR

 +61                               SET AMERANS=+Y

 +62      ;if user selects to or up-hats out, keep PCC info

                                   IF Y=""!(Y="^")!(AMERANS=2)

                                       Begin DoDot:4

 +63      ;REPLACE ANY ER VISIT DX INFO WITH INFO THAT IS IN PCC AND STOP

                                           DO SYNCHERX^AMERERS(AMERDA,AMERPCC)

 +64                                       SET AMERDONE=1

 +65                                       QUIT 

                                       End DoDot:4

 +66                               IF AMERANS=1

                                       Begin DoDot:4

 +67      ; UPDATE THE PCC VISIT WITH THE PRIMARY DX THE USER JUST ENTERED - START BY DELETING WHAT IS THERE

 +68                                       IF $$DELETPOV^AMERVSIT(AMERPCC)=0

                                               DO EN^DDIOL("THERE WAS A PROBLEM DELETING V POV ENTRIES","","!!")

 +69      ; ALL V POVS WERE DELETED, SO GET RID OF THIS ARRAY, AND BUILD IT AGAIN

                                           KILL APCLV

 +70      ; RESET LOOP VARIABLE to get out of loop

                                           SET AMERVPOV=0

 +71                                       SET AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")

 +72      ;S AMERSLNT=1

 +73                                       QUIT 

                                       End DoDot:4

 +74                               QUIT 

                               End DoDot:3

 +75                       IF ((AMERVPOV<1)!AMERDONE)

                               QUIT 

 +76      ;IHS/OIT/SCR patch 1

                           SET AMERVNAR=$PIECE(APCLV(AMERVPOV),U,14)

 +77      ;IHS/OIT/SCR - remove ";" from narrative

                           SET AMERVNAR=$$STRIPNAR(AMERVNAR)

 +78      ;I (AMERPNAR'=$P(APCLV(AMERVPOV),U,14)) D  

 +79      ;IHS/OIT/SCR patch 1

                           IF (AMERPNAR'=AMERVNAR)

                               Begin DoDot:3

 +80                               DO EN^DDIOL("**The value for PRIMARY NARRATIVE in the PCC visit file is different from ERS NARRATIVE**","","!!?3")

 +81      ;D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$P(APCLV(AMERVPOV),U,14),"","!?3")

 +82                               DO EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_AMERVNAR,"","!?3")

 +83                               DO EN^DDIOL("ERS ENTERED VALUE: "_$PIECE($$ICDDX^ICDCODE(+AMERPDX,,,1),U,2)_" - "_AMERPNAR,"","!?3")

 +84                               SET DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 +85                               SET DIR("A")="Which would you like to do"

 +86                               DO ^DIR

                                   KILL DIR

 +87                               SET AMERANS=+Y

 +88      ;I Y=""!(Y="^")!(AMERANS=2) D

 +89      ;IHS/OIT/GIS 8/23/11 patch 3

                                   IF (AMERANS=0)!(AMERANS=2)

                                       Begin DoDot:4

 +90      ;UPDATE ERS PRIMARY NARRATIVE WITH THE NARRATIVE FOR THIS PCC DX

 +91      ;IHS/OIT/SCR 05/14/09 ...But this means updating in PRIMARY and in DX MULTIPLE...

 +92      ;S DR=$S(DR'="":DR_";",1:""),DR=DR_"5.3////"_AMERVNAR

 +93      ;S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERINDX,DR=""

 +94      ;S DR="1////"_$P(APCLV(AMERVPOV),U,14)

 +95      ;S DR="1////"_AMERVNAR ;IHS/OIT/SCR 05/05/09

 +96      ;D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 +97                                       SET DR="5.3////"_AMERVNAR

 +98                                       DO DIE^AMEREDIT(AMERDA,DR)

 +99      ;K DIE

 +100     ;now you have to find the old narrative in the multiple DX file; check code and replace

 +101                                      SET AMERINDX=0

 +102                                      SET AMERINDX=0

                                           SET AMERFND=0

 +103     ;THIS IS THE NUMBER OF PCC .9999 CODES THAT AREN'T PRIMARY SO FAR

                                           IF AMER9999=AMERVDXI

                                               SET AMERV999=AMERV999+1

 +104                                      FOR 

                                               SET AMERINDX=$ORDER(^AMERVSIT(AMERDA,5,AMERINDX))

                                               IF AMERINDX="B"!AMERFND

                                                   QUIT 

                                               Begin DoDot:5

 +105     ;if we have no DX info for some reason, get out of loop

                                                   IF AMERINDX=""

                                                       SET AMERINDX="B"

 +106                                              IF (AMERPNAR=$GET(^AMERVSIT(AMERDA,5,AMERINDX,1)))&(AMERPDX=$GET(^AMERVSIT(AMERDA,5,AMERINDX,0)))

                                                       Begin DoDot:6

 +107                                                      SET DIE="^AMERVSIT(DA(1),5,"

                                                           SET DA(1)=AMERDA

                                                           SET DA=AMERINDX

                                                           SET DR=""

 +108                                                      DO MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 +109                                                      SET AMERFND=1

 +110                                                      QUIT 

                                                       End DoDot:6

                                                       QUIT 

 +111                                              QUIT 

                                               End DoDot:5

 +112                                      QUIT 

 +113     ;This primary DX was not found in the ERS record...synch with PCC now

                                           IF AMERFND=0

                                               Begin DoDot:5

 +114                                              DO EN^DDIOL("Corrupted ERS DX record found","","!!")

 +115                                              DO EN^DDIOL("Replacing with PCC V POV entries","","!!")

 +116     ;REPLACE ANY ER VISIT DX INFO WITH INFO THAT IS IN PCC AND STOP

                                                   DO SYNCHERX^AMERERS(AMERDA,AMERPCC)

 +117                                              SET AMERDONE=1

 +118                                              QUIT 

                                               End DoDot:5

 +119                                      QUIT 

                                       End DoDot:4

                                       QUIT 

 +120     ;IHS/OIT/GIS 8/23/11 patch 3

                                   IF AMERANS=1

                                       DO UPDTNAR^AMERVSIT(AMERVIEN,AMERPNAR)

 +121     ;IF AMERENAR'=$P(APCLV(AMERVPOV),U,14)

                                   QUIT 

                               End DoDot:3

 +122                      QUIT 

                       End DoDot:2

 +123              IF AMERVPOV>1

                       Begin DoDot:2

 +124     ;THIS IS  NOT THE PRIMARY DX IN PCC, LOOK FOR IT IN THE ER VISIT FILE DIAGNOSIS SUB-ENTRIES

 +125     ;IF IT IS THERE COMPARE THE TWO NARRATIVES AND GIVE USER A CHANCE TO UPDATE WITH CHOOSEN  VERSION

 +126     ;IF IT IS NOT THERE ASK THE USER IF THEY WANT TO ADD THE CODE TO ERS, OR REMOVE IT FROM PCC

 +127                      SET AMERINDX=0

                           SET AMERFND=0

                           SET AMERNXT=0

                           SET AMERE999=0

 +128     ;THIS IS THE NUMBER OF PCC .9999 CODES THAT AREN'T PRIMARY SO FAR

                           IF AMER9999=AMERVDXI

                               SET AMERV999=AMERV999+1

 +129                      FOR 

                               SET AMERINDX=$ORDER(^AMERVSIT(AMERDA,5,AMERINDX))

                               IF AMERINDX="B"!AMERFND

                                   QUIT 

                               Begin DoDot:3

 +130                              SET AMERDX=^AMERVSIT(AMERDA,5,AMERINDX,0)

 +131     ;S AMERNAR=$G(^AMERVSIT(AMERDA,5,AMERINDX,1))

 +132                              SET AMERENAR=$GET(^AMERVSIT(AMERDA,5,AMERINDX,1))

 +133     ;Q:(AMERDX=AMERPDX)&(AMERNAR=AMERPNAR)  ;IHS/OIT/SCR 01/13/08 - if this is the primary DX, don't mess with it

 +134     ;IHS/OIT/SCR 01/13/08 - if this is the primary DX, don't mess with it

                                   IF (AMERDX=AMERPDX)&(AMERENAR=AMERPNAR)

                                       QUIT 

 +135                              IF AMERDX=AMER9999

                                       SET AMERE999=AMERE999+1

 +136     ;if this is a .9999 code and we've already considered it, move on

                                   IF (AMERDX=AMER9999)&(AMERE999<AMERV999)

                                       QUIT 

 +137                              IF $PIECE($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)=AMERVICD

                                       Begin DoDot:4

 +138                                      SET AMERFND=1

 +139     ;I AMERNAR'=$P(APCLV(AMERVPOV),U,14) D

 +140                                      IF AMERENAR'=$PIECE(APCLV(AMERVPOV),U,14)

                                               Begin DoDot:5

 +141     ;IHS/OIT/SCR 5/5/09 patch 1

                                                   SET AMERVNAR=$$STRIPNAR(AMERVNAR)

 +142                                              DO EN^DDIOL("**The value for NARRATIVE in the PCC visit file is different from ERS NARRATIVE**","","!!?3")

 +143                                              DO EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$PIECE(APCLV(AMERVPOV),U,14),"","!?3")

 +144     ;D EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_AMERVNAR,"","!?3") ;IHS/OIT/SCR 5/5/09 patch 1

 +145     ;D EN^DDIOL("ERS ENTERED VALUE: "_$P($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)_" - "_AMERNAR,"","!?3")

 +146     ;IHS/OIT/SCR 5/5/09 patch 1

                                                   DO EN^DDIOL("ERS ENTERED VALUE: "_$PIECE($$ICDDX^ICDCODE(+AMERDX,,,1),U,2)_" - "_AMERENAR,"","!?3")

 +147                                              SET DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"

 +148                                              SET DIR("A")="Which would you like to do"

 +149                                              DO ^DIR

                                                   KILL DIR

 +150                                              SET AMERANS=+Y

 +151     ;I Y=""!(Y="^")!(AMERANS=2) D ;IHS/OIT/SCR 5/5/09 patch 1

 +152     ;IHS/OIT/GIS 8/23/11 patch 3

                                                   IF (AMERANS=0)!(AMERANS=2)

                                                       Begin DoDot:6

 +153     ;UPDATE ERS NARRATIVE WITH THE NARRATIVE FOR THIS PCC DX

 +154                                                      SET DIE="^AMERVSIT(DA(1),5,"

                                                           SET DA(1)=AMERDA

                                                           SET DA=AMERINDX

                                                           SET DR=""

 +155     ;IHS/OIT/SCR 5/5/09 first strip ";"

 +156     ;S DR="1////"_$P(APCLV(AMERVPOV),U,14)

 +157     ;IHS/OIT/SCR 05/05/09

                                                           SET DR="1////"_AMERVNAR

 +158                                                      DO MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 +159                                                      KILL DIE

 +160                                                      QUIT 

                                                       End DoDot:6

 +161                                              IF Y=1

                                                       DO UPDTNAR^AMERVSIT(AMERVIEN,AMERENAR)

 +162                                              QUIT 

                                               End DoDot:5

 +163     ;IF AMERENAR'=$P(APCLV(AMERVPOV),U,14)

                                           QUIT 

                                       End DoDot:4

 +164                              QUIT 

                               End DoDot:3

 +165                      IF 'AMERFND

                               Begin DoDot:3

 +166                              DO EN^DDIOL("**There is no ERS DIAGNOSIS CODE CORRESPONDING TO V POV ENTRY**","","!!?3")

 +167                              DO EN^DDIOL("PCC VISIT VALUE: "_AMERVICD_" - "_$PIECE(APCLV(AMERVPOV),U,14),"","!?3")

 +168                              SET DIR(0)="SO^1:Correct ERS data by adding this diagnosis;2:Correct PCC data by removing this V POV entry"

 +169                              SET DIR("A")="Which would you like to do"

 +170                              DO ^DIR

                                   KILL DIR

 +171                              SET AMERANS=+Y

 +172     ;I Y=""!(Y="^")!(AMERANS=1) D

 +173                              IF (AMERANS=0)!(AMERANS=1)

                                       Begin DoDot:4

 +174     ;ADD THIS V POV DX TO ERS VISIT

 +175     ;S AMERNDXI=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)

 +176                                      SET AMERVNAR=$PIECE(APCLV(AMERVPOV),U,14)

 +177     ;IHS/OIT/SCR 05/05/09 - remove ";" from narrative

                                           SET AMERVNAR=$$STRIPNAR(AMERVNAR)

 +178     ;CAN'T USE DIE TO ADD A SUBENTRY...WE WANT TO USE DIC

 +179     ;S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERNXT,DR=""

 +180     ;S DR=".01////"_AMERVDXI

 +181     ;S DR=DR_";1////"_AMERNNAR

 +182     ;D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)

 +183     ;K DIE

 +184     ; DIAGNOSES

                                           SET DA(1)=AMERDA

                                           SET DIC="^AMERVSIT("_DA(1)_",5,"

                                           SET DIC(0)=""

 +185                                      SET X=AMERVDXI

 +186                                      DO FILE^DICN

 +187                                      IF +Y<0

                                               QUIT 

 +188                                      SET DIE=DIC

                                           SET DA(1)=AMERDA

                                           SET DA=+Y

                                           SET DR="1////"_AMERVNAR

 +189                                      DO ^DIE

 +190                                      KILL DIC,DIE,DA,Y,DR

 +191                                      QUIT 

                                       End DoDot:4

 +192                              IF AMERANS=2

                                       Begin DoDot:4

 +193     ;REMOVE THE V POV ENTRY

 +194                                      LOCK +^AUPNVPOV:3

                                          IF '$TEST

                                               QUIT 

 +195                                      SET DA=AMERVIEN

                                           SET DIK="^AUPNVPOV("

                                           DO ^DIK

                                           DO EN^DIK

 +196                                      LOCK -^AUPNVPOV

 +197                                      QUIT 

 +198     ;K APCLV(AMERVPOV)  ;

                                       End DoDot:4

                               End DoDot:3

 +199                      QUIT 

                       End DoDot:2

 +200              QUIT 

               End DoDot:1

 +201     ; Don't try to update AUPNVPOV if no primary DX has been identified in ERS

           IF AMERPDX=""

               QUIT 

 +202     ;If the routine has just updated ERS to match PCC its done

           IF AMERDONE

               QUIT 

 +203      DO VPOVUPDT^AMERPCC3(AMERPAT,AMERPCC,AMERTIME,AMERDOC)

 +204      QUIT 

STRIPNAR(AMERSTG) ;IHS/OIT/SCR 050709

 +1        SET AMERSTG=$TRANSLATE(AMERSTG,";","~")

 +2        QUIT AMERSTG