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
