AMERPCC3 ; IHS/OIT/SCR - SUPPORTING ROUTINES FOR V POV SYNCHING ;
;;3.0;ER VISIT SYSTEM;**1,2**;FEB 23, 2009
;
VPOVUPDT(AMERPAT,AMERPCC,AMERTIME,AMERDOC) ;
; For each ER DX, check to see if an entry has been made in V POV
; - If entry has been made:
; -- Compare data and ask user to update if needed
; - If entry has not been made
; -- ask user to add V POV entry or remove from ERS
; For each V POV entry that is not matched to an ER DX, either add to ERS or remove from PCC
N AMERFND,AMERPOV,AMERVPOV,AMERVDR,AMERVIEN,AMERDX,AMERNAR,AMERVDXI,AMERVICD
N AMEREDNM,AMERDUZ,AMERAIEN,AMEREDTS,AMERCODE,AMERCNT,AMEREPOV,AMERENAR,AMER9999,AMERSLNT
N Y,X,DIC,DIE
N AMERCLN ;IHS/OIT/SCR 072309 patch 2
S AMERSLNT=0 ;IHS/OIT/SCR 060409 patch 1
S AMEREDNM=0
S AMERVPOV=0
S AMERDUZ=DUZ
S AMEREDTS=""
S AMER9999=$P($$ICDDX^ICDCODE(".9999",,,1),U,1) ;POINTER TO .9999 CODE IN ICD9 CODE - THIS CODE CAN BE ENTERED MORE THAN ONCE
; Now build array of the VALID ICD9 codes and narratives that exist in ER VISIT
I $G(^AMERVSIT(AMERDA,5,0))'="" D
.S AMERCNT=0
.;S AMEREPOV(1)=$P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,1) ;pointer to the primary ICD9 code
.;S AMERENAR(1)=AMERPNAR ; PRIMARY NARRATIVE
.S AMERPOV=0
.F S AMERPOV=$O(^AMERVSIT(AMERDA,5,AMERPOV)) Q:AMERPOV="B"!(AMERPOV="") D
..S AMERCNT=AMERCNT+1
..I $P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)=AMER9999 D
...S AMERE999=AMERE999+1
...;Q:((AMEREPOV(1)=AMER9999)&(AMERE999=1))
...S AMERDX=AMER9999
...S AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
...S AMERENAR(AMERCNT)=$G(^AMERVSIT(AMERDA,5,AMERPOV,1))
...Q
..;E I ($P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMERPDX) D
..I $P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMER9999 D
...S AMERCNT=AMERCNT+1
...S AMERDX=$P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)
...S AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
...S AMERENAR(AMERCNT)=$G(^AMERVSIT(AMERDA,5,AMERPOV,1)) ; DX NARATIVE
...Q
..Q ;IF THIS ISN'T THE PRIMARY, ADD IT TO THE LIST OF DX'S TO ADD
.Q ; FOR EACH ERS VISIT
S (AMERVDR,AMERVIEN)=""
;IHS/OIT/SCR 072209 patch 2 - GET THE CLINIC THAT IS IN THE ER VISIT FILE
S AMERCLN=$P(^AMERVSIT(AMERDA,0),U,4) ;this is a pointer to the ER OPTION FILE
;S AMERCLN=$P($G(^AMER(3,AMERCLN,0)),U,4) ; this is a clinic stop code
S:AMERCLN>0 AMERCLN=$P($G(^AMER(3,AMERCLN,0)),U,4) ; IHS/OIT/SCR 10/05/09 patch 2
S AMERCODE=$S($G(AMERCLN)>0:$G(AMERCLN),1:80)
;IHS/OIT/SCR 072309 if this code is not what is in V POV, update V POV to match
K APCLV
S AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17") ;bring back current V POV info
; The V POV PRIMARY/SECODARY explainations in SAC Developers handbook state that the field is
; Required for Hospitalizations.
; For other visits, the first POV entered for a visit is considered the
; primary one.
; With this kind of business rule, we need to delete all V POV's and recreate
; them when the "primary DX" in ERS is changed, and be sure the first one adeded is always the primary
S AMERPOV=0
I $O(APCLV(0))="" S AMERSLNT=1 ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
F S AMERPOV=$O(AMEREPOV(AMERPOV)) Q:AMERPOV="" D
.S AMERDX=$P(AMEREPOV(AMERPOV),"^",1)
.S AMERICD9=$P($$ICDDX^ICDCODE(AMERDX,,,1),U,2)
.S AMERINDX=$P(AMEREPOV(AMERPOV),"^",2) ;DX INDEX IN ER VISIT FILE
.S AMERNAR=AMERENAR(AMERPOV)
.;I $O(APCLV(0))="" S AMERSLNT=1 ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
.S AMERFND=0,AMERVPOV=0 ; Flag set to 1 if DX CODE is later found in V POV file which should be looked at from the begining for each ER DX
.Q:AMEREPOV(AMERPOV)="" ; If there is no valid DX CODE, quit
.F S AMERVPOV=$O(APCLV(AMERVPOV)) Q:((AMERVPOV="")!AMERFND=1) D
..;IHS/OIT/SCR 02/05/09 START LOCAL CODE CHANFES
..S AMERVICD=$P(APCLV(AMERVPOV),U,7)
..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) D
.....S AMERVDXI=$P(Y,"^",2) ;brings back the ICD ien
.....Q
....Q ;IF THIS WAS A LOCAL CODE
...S AMERVICD=$P($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2) ;brings back the code
...Q
..;IHS/OIT/SCR 02/05/09 END LOCAL CODE CHANGES
..I (AMERVICD=AMERICD9) D
...S AMERFND=1
...;IHS/OIT/SCR 072309 - update CLINIC STOP to match what is in ERS
...D UPDTCLNC($P(APCLV(AMERVPOV),U,5),AMERCLN)
...K APCLV(AMERVPOV) ;REMOVE THIS ENTRY SINCE WE JUST MATCHED IT UP WITH AN ERS ENTRY
...Q
..Q ;FOR EACH V POV ENTRY
.I AMERFND=0 D ; Add this ER DIAGNOSIS TO THE PCC VISIT since it isn't there
..I AMERSLNT S AMERANS=1 ;ADD ALL ERS ENTRIES TO V POV WITHOUT ASKING if there are no DX in PCC yet
..E D
...D EN^DDIOL("**AN ERS DX CODE WAS NOT FOUND IN A V POV ENTRY FOR THIS PCC VISIT**","","!!?3")
...;D EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
...D EN^DDIOL("ERS DX CODE: "_AMERICD9_" - "_AMERNAR,"","!?3")
...S DIR(0)="SO^1:ADD A NEW V POV ENTRY TO THIS PCC VISIT;2:REMOVE THE ERS DX CODE FROM THE ERS VISIT"
...S DIR("A")="Which would you like to do"
...D ^DIR K DIR
...I (Y="^"!Y="") S AMERANS=2 ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY REMOVING THIS CODE
...E S AMERANS=+Y
...Q
..I (AMERANS=1) D
...;ADD A V POV TO THIS PCC VISIT
...I $P($G(^AMER(2.5,DUZ(2),0)),U,5)="N" S:AMERICD9'=".9999" AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE) Q
...I $P($G(^AMER(2.5,DUZ(2),0)),U,5)'="N" S AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE)
...I +AMERVIEN<1 D Q ; WRITE INFO TO SCREEN AND QUIT
....D EN^DDIOL("UNABLE TO ADD PCC V POV "_AMERICD9,"","!!")
....D EN^DDIOL("ERROR RETURNED : "_$P(AMERVIEN,U,2))
....D:$P(AMERVIEN,U,2)="FAILED FM EDITS" EN^DDIOL("CONSIDER FINDING A MORE DETAILED CODE","","!!")
....Q ;IF ADD VPOV WAS NOT SUCCESSFUL
...D EN^DDIOL("","","!")
...D EN^DDIOL("** V POV ADDED TO PCC VISIT **","","!?3")
...Q ;I (AMERANS=1)
..I (AMERANS=2) D
...;REMOVE THE DX FROM THE ERS VISIT
...D NOW^%DTC
...;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
...;S AMEREDNM=AMEREDNM+1
...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERDX,"X")_";;Other;DIAGNOSIS;Silent PCC SYNCH"
...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERONAR_";;Other;PROVIDER NARRATIVE;Silent PCC SYNCH"
...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
...S DA(1)=AMERDA,DA=AMERINDX
...S DIK="^AMERVSIT(DA(1),5,"
...D ^DIK,EN^DIK ; Delete identified entry and re-index diagnosis field
...D EN^DDIOL("** DIAGNOSIS REMOVED FROM ERS VISIT **","","!?3")
...Q ;IF AMERANS=2 DELETE THE V POV ENTRY TO MATCH WHAT IS IN ERS
..Q ;IF ERS ENTRY WAS NOT FOUND IN V POV ARRAY
.Q ;FOR EACH ERS ENTRY
;IHS/OIT/SCR ...ANY V POV ENTRIES THAT ARE LEFT NEED TO BE REMOVED FROM PCC OR ADDED TO ERS
;IF 'SILENT' ONLY ADD TO ERS
F S AMERVPOV=$O(APCLV(AMERVPOV)) Q:AMERVPOV="" D
.; APCLV(x)=^^^^internal value of V POV^^ ICD9 code^^^^Cause of injury^place of injury^provider narrative^date of injury
.S AMERVIEN=$P(APCLV(AMERVPOV),"^",1)
.S AMERVICD=$P(APCLV(AMERVPOV),"^",7)
.S AMERVNAR=$P(APCLV(AMERVPOV),"^",14)
.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
...Q
..S AMERVICD=$P($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2) ;brings back the code
..Q
.I AMERSLNT S AMERANS=2
.E D
..D EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
..D EN^DDIOL("V POV ENTRY: "_AMERVICD_" - "_AMERVNAR,"","!?3")
..;S DIR(0)="SO^1:ADD THIS DX INFORMATION TO THE ERS VISIT;2:REMOVE THE V POV ENTRY FROM THE PCC VISIT"
..S DIR(0)="SO^1:REMOVE THE V POV ENTRY FROM THE PCC VISIT;2:ADD THIS DX INFORMATION TO THE ERS VISIT"
..;S DIR("A")="Which would you like to do"
..D ^DIR K DIR
..I (Y="^"!Y="") S AMERANS=2 ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY ADDING THIS CODE TO ERS
..E S AMERANS=+Y
..Q
.I AMERANS=2 D
..;ADD NEW DX TO ERS VISIT
..;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0
..S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),5,",DIC(0)="L" ; DIAGNOSES
..S X="`"_AMERVDXI
..D ^DIC
..I +Y>0 D
...;S AMEREDNM=AMEREDNM+1
...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERNDXI,"X")_";;Other;DIAGNOSIS; PCC SYNCH"
...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERVNAR_";;Other;PROVIDER NARRATIVE; PCC SYNCH"
...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
...D EN^DDIOL("** DIAGNOSIS ADDED TO ERS VISIT **","","!?3")
...Q
..Q
.I AMERANS=1 D
..I $$REMOVPOV^AMERVSIT(AMERVIEN) D EN^DDIOL("** V POV REMOVED FROM PCC VISIT **","","!?3")
..E D EN^DDIOL("** COULD NOT REMOVE V POV FROM PCC VISIT! **","","!?3")
..Q
.Q
K APCLV
Q
ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERDFN,AMERTIME,AMERDOC,AMERCLN) ; ADD AN ENTRY TO V POV
; AMERPCC - VISIT IEN
; AMERICD9 - ICD9 CODE
; AMERNAR - PROVIDER NARRATIVE
; AMERDFN - PATIENT IEN
; AMERTIME - VA FILE MAN FORMAT OF VISIT TIME
; AMERDOC - POIINTER TO NEW PERSON PROVIDER
; AMERCLN - IS NOT A POINTER TO ^DIC(40.2 - "CLINIC STOP" FILE - NO
; if I send through a pointer "72" - ^DIC(40.7,72,0)=URGENT CARE^80
; I see the clinic stop "MAMMOGRAPHY" ^DIC(40.7,67,0)=MAMMOGRAPHY^72
; SO
; AMERCLN - CLINC CODE:30 - EMERGENCY MEDICINE or 80 - URGENT CARE
K APCDALVR,APCDAFLE,APCDTPAT,APCDTPOV,APCDTNQ,APCDTPRO
I 'AMERPCC>0 Q 0 ; INVALID VISIT IEN
I 'AMERDFN>0 Q 0 ; INVALID PATIENT IEN
S APCDAFLE("APCDAFLE")="9000010.07" ; THIS IS DOCUMENTED IN SAC Developer Handbook
S APCDALVR("APCDTPOV")=AMERICD9 ; ICD9 CODE - pre-screened during "finalization"
S APCDALVR("APCDPAT")=AMERDFN ; PATIENT IEN
S APCDALVR("APCDVSIT")=AMERPCC ; VISIT IEN
S APCDALVR("APCDTNQ")=AMERNAR ; NARRATIVE
S APCDALVR("APCDTCDT")=AMERTIME ; EVENT DATE AND TIME - date diagnosis
S APCDALVR("APCDTCLN")=AMERCLN ; CLINIC - pointer to clinic stop file
S APCDALVR("APCDTEPR")="`"_AMERDOC ; PROVIDER who made DIAGNOSIS - but in DD definition this is the encounter provider who treated the Dx...
S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
D EN^APCDALVR
S AMERVIEN=$G(APCDALVR("APCDADFN"))
I AMERVIEN="" D
.S AMERVIEN=-1_"^"_$S($G(APCDALVR("APCDAFLG"))=1:"NO VISIT SELECTED",$G(APCDALVR("APCDAFLG"))=2:"FAILED FM EDITS",1:"UNSPECIFIFED ERROR")
D:+AMERVIEN>0 MOD^AUPNVSIT
K APCDALVR,APCDAFLE,APCDTPOV,APCDTPAT,APCDVSIT,APCDTNQ,APCDTCDT,APCDTCLN,APCDTEPR,APCDATMP
Q AMERVIEN
UPDTCLNC(AMERVPOV,AMERCLN) ;update the CLINIC STOP field in V POV to match the value in ERS
;IHS/OIT/SCR 090309 patch 2
N DIE,DA,DR
S DIE="^AUPNVPOV("
S DA=AMERVPOV
S DR="1203///"_AMERCLN
D ^DIE
Q
AMERPCC3 ; IHS/OIT/SCR - SUPPORTING ROUTINES FOR V POV SYNCHING ;
+1 ;;3.0;ER VISIT SYSTEM;**1,2**;FEB 23, 2009
+2 ;
VPOVUPDT(AMERPAT,AMERPCC,AMERTIME,AMERDOC) ;
+1 ; For each ER DX, check to see if an entry has been made in V POV
+2 ; - If entry has been made:
+3 ; -- Compare data and ask user to update if needed
+4 ; - If entry has not been made
+5 ; -- ask user to add V POV entry or remove from ERS
+6 ; For each V POV entry that is not matched to an ER DX, either add to ERS or remove from PCC
+7 NEW AMERFND,AMERPOV,AMERVPOV,AMERVDR,AMERVIEN,AMERDX,AMERNAR,AMERVDXI,AMERVICD
+8 NEW AMEREDNM,AMERDUZ,AMERAIEN,AMEREDTS,AMERCODE,AMERCNT,AMEREPOV,AMERENAR,AMER9999,AMERSLNT
+9 NEW Y,X,DIC,DIE
+10 ;IHS/OIT/SCR 072309 patch 2
NEW AMERCLN
+11 ;IHS/OIT/SCR 060409 patch 1
SET AMERSLNT=0
+12 SET AMEREDNM=0
+13 SET AMERVPOV=0
+14 SET AMERDUZ=DUZ
+15 SET AMEREDTS=""
+16 ;POINTER TO .9999 CODE IN ICD9 CODE - THIS CODE CAN BE ENTERED MORE THAN ONCE
SET AMER9999=$PIECE($$ICDDX^ICDCODE(".9999",,,1),U,1)
+17 ; Now build array of the VALID ICD9 codes and narratives that exist in ER VISIT
+18 IF $GET(^AMERVSIT(AMERDA,5,0))'=""
Begin DoDot:1
+19 SET AMERCNT=0
+20 ;S AMEREPOV(1)=$P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,1) ;pointer to the primary ICD9 code
+21 ;S AMERENAR(1)=AMERPNAR ; PRIMARY NARRATIVE
+22 SET AMERPOV=0
+23 FOR
SET AMERPOV=$ORDER(^AMERVSIT(AMERDA,5,AMERPOV))
IF AMERPOV="B"!(AMERPOV="")
QUIT
Begin DoDot:2
+24 SET AMERCNT=AMERCNT+1
+25 IF $PIECE($GET(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)=AMER9999
Begin DoDot:3
+26 SET AMERE999=AMERE999+1
+27 ;Q:((AMEREPOV(1)=AMER9999)&(AMERE999=1))
+28 SET AMERDX=AMER9999
+29 ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
SET AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV
+30 SET AMERENAR(AMERCNT)=$GET(^AMERVSIT(AMERDA,5,AMERPOV,1))
+31 QUIT
End DoDot:3
+32 ;E I ($P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMERPDX) D
+33 IF $PIECE($GET(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMER9999
Begin DoDot:3
+34 SET AMERCNT=AMERCNT+1
+35 SET AMERDX=$PIECE($GET(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)
+36 ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
SET AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV
+37 ; DX NARATIVE
SET AMERENAR(AMERCNT)=$GET(^AMERVSIT(AMERDA,5,AMERPOV,1))
+38 QUIT
End DoDot:3
+39 ;IF THIS ISN'T THE PRIMARY, ADD IT TO THE LIST OF DX'S TO ADD
QUIT
End DoDot:2
+40 ; FOR EACH ERS VISIT
QUIT
End DoDot:1
+41 SET (AMERVDR,AMERVIEN)=""
+42 ;IHS/OIT/SCR 072209 patch 2 - GET THE CLINIC THAT IS IN THE ER VISIT FILE
+43 ;this is a pointer to the ER OPTION FILE
SET AMERCLN=$PIECE(^AMERVSIT(AMERDA,0),U,4)
+44 ;S AMERCLN=$P($G(^AMER(3,AMERCLN,0)),U,4) ; this is a clinic stop code
+45 ; IHS/OIT/SCR 10/05/09 patch 2
IF AMERCLN>0
SET AMERCLN=$PIECE($GET(^AMER(3,AMERCLN,0)),U,4)
+46 SET AMERCODE=$SELECT($GET(AMERCLN)>0:$GET(AMERCLN),1:80)
+47 ;IHS/OIT/SCR 072309 if this code is not what is in V POV, update V POV to match
+48 KILL APCLV
+49 ;bring back current V POV info
SET AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")
+50 ; The V POV PRIMARY/SECODARY explainations in SAC Developers handbook state that the field is
+51 ; Required for Hospitalizations.
+52 ; For other visits, the first POV entered for a visit is considered the
+53 ; primary one.
+54 ; With this kind of business rule, we need to delete all V POV's and recreate
+55 ; them when the "primary DX" in ERS is changed, and be sure the first one adeded is always the primary
+56 SET AMERPOV=0
+57 ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
IF $ORDER(APCLV(0))=""
SET AMERSLNT=1
+58 FOR
SET AMERPOV=$ORDER(AMEREPOV(AMERPOV))
IF AMERPOV=""
QUIT
Begin DoDot:1
+59 SET AMERDX=$PIECE(AMEREPOV(AMERPOV),"^",1)
+60 SET AMERICD9=$PIECE($$ICDDX^ICDCODE(AMERDX,,,1),U,2)
+61 ;DX INDEX IN ER VISIT FILE
SET AMERINDX=$PIECE(AMEREPOV(AMERPOV),"^",2)
+62 SET AMERNAR=AMERENAR(AMERPOV)
+63 ;I $O(APCLV(0))="" S AMERSLNT=1 ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
+64 ; Flag set to 1 if DX CODE is later found in V POV file which should be looked at from the begining for each ER DX
SET AMERFND=0
SET AMERVPOV=0
+65 ; If there is no valid DX CODE, quit
IF AMEREPOV(AMERPOV)=""
QUIT
+66 FOR
SET AMERVPOV=$ORDER(APCLV(AMERVPOV))
IF ((AMERVPOV="")!AMERFND=1)
QUIT
Begin DoDot:2
+67 ;IHS/OIT/SCR 02/05/09 START LOCAL CODE CHANFES
+68 SET AMERVICD=$PIECE(APCLV(AMERVPOV),U,7)
+69 SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)
+70 IF AMERVDXI<1
Begin DoDot:3
+71 ;start by setting it to 'uncoded'
SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(".9999",,,1),U,1)
+72 IF AMERVICD="VA LOCAL CODE SELECTED"
Begin DoDot:4
+73 ;LOOK IT UP THROUGH FILEMAN
+74 SET DIC="^AUPNVPOV("
SET DIC(0)="NX"
SET X="`"_$PIECE(APCLV(AMERVPOV),"^",5)
+75 DO ^DIC
+76 IF (Y'=-1)
Begin DoDot:5
+77 ;brings back the ICD ien
SET AMERVDXI=$PIECE(Y,"^",2)
+78 QUIT
End DoDot:5
+79 ;IF THIS WAS A LOCAL CODE
QUIT
End DoDot:4
+80 ;brings back the code
SET AMERVICD=$PIECE($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)
+81 QUIT
End DoDot:3
+82 ;IHS/OIT/SCR 02/05/09 END LOCAL CODE CHANGES
+83 IF (AMERVICD=AMERICD9)
Begin DoDot:3
+84 SET AMERFND=1
+85 ;IHS/OIT/SCR 072309 - update CLINIC STOP to match what is in ERS
+86 DO UPDTCLNC($PIECE(APCLV(AMERVPOV),U,5),AMERCLN)
+87 ;REMOVE THIS ENTRY SINCE WE JUST MATCHED IT UP WITH AN ERS ENTRY
KILL APCLV(AMERVPOV)
+88 QUIT
End DoDot:3
+89 ;FOR EACH V POV ENTRY
QUIT
End DoDot:2
+90 ; Add this ER DIAGNOSIS TO THE PCC VISIT since it isn't there
IF AMERFND=0
Begin DoDot:2
+91 ;ADD ALL ERS ENTRIES TO V POV WITHOUT ASKING if there are no DX in PCC yet
IF AMERSLNT
SET AMERANS=1
+92 IF '$TEST
Begin DoDot:3
+93 DO EN^DDIOL("**AN ERS DX CODE WAS NOT FOUND IN A V POV ENTRY FOR THIS PCC VISIT**","","!!?3")
+94 ;D EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
+95 DO EN^DDIOL("ERS DX CODE: "_AMERICD9_" - "_AMERNAR,"","!?3")
+96 SET DIR(0)="SO^1:ADD A NEW V POV ENTRY TO THIS PCC VISIT;2:REMOVE THE ERS DX CODE FROM THE ERS VISIT"
+97 SET DIR("A")="Which would you like to do"
+98 DO ^DIR
KILL DIR
+99 ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY REMOVING THIS CODE
IF (Y="^"!Y="")
SET AMERANS=2
+100 IF '$TEST
SET AMERANS=+Y
+101 QUIT
End DoDot:3
+102 IF (AMERANS=1)
Begin DoDot:3
+103 ;ADD A V POV TO THIS PCC VISIT
+104 IF $PIECE($GET(^AMER(2.5,DUZ(2),0)),U,5)="N"
IF AMERICD9'=".9999"
SET AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE)
QUIT
+105 IF $PIECE($GET(^AMER(2.5,DUZ(2),0)),U,5)'="N"
SET AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE)
+106 ; WRITE INFO TO SCREEN AND QUIT
IF +AMERVIEN<1
Begin DoDot:4
+107 DO EN^DDIOL("UNABLE TO ADD PCC V POV "_AMERICD9,"","!!")
+108 DO EN^DDIOL("ERROR RETURNED : "_$PIECE(AMERVIEN,U,2))
+109 IF $PIECE(AMERVIEN,U,2)="FAILED FM EDITS"
DO EN^DDIOL("CONSIDER FINDING A MORE DETAILED CODE","","!!")
+110 ;IF ADD VPOV WAS NOT SUCCESSFUL
QUIT
End DoDot:4
QUIT
+111 DO EN^DDIOL("","","!")
+112 DO EN^DDIOL("** V POV ADDED TO PCC VISIT **","","!?3")
+113 ;I (AMERANS=1)
QUIT
End DoDot:3
+114 IF (AMERANS=2)
Begin DoDot:3
+115 ;REMOVE THE DX FROM THE ERS VISIT
+116 DO NOW^%DTC
+117 ;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0 ;CREATE AN AUDIT FILE RECORD
+118 ;S AMEREDNM=AMEREDNM+1
+119 ;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERDX,"X")_";;Other;DIAGNOSIS;Silent PCC SYNCH"
+120 ;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+121 ;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERONAR_";;Other;PROVIDER NARRATIVE;Silent PCC SYNCH"
+122 ;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+123 ;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+124 SET DA(1)=AMERDA
SET DA=AMERINDX
+125 SET DIK="^AMERVSIT(DA(1),5,"
+126 ; Delete identified entry and re-index diagnosis field
DO ^DIK
DO EN^DIK
+127 DO EN^DDIOL("** DIAGNOSIS REMOVED FROM ERS VISIT **","","!?3")
+128 ;IF AMERANS=2 DELETE THE V POV ENTRY TO MATCH WHAT IS IN ERS
QUIT
End DoDot:3
+129 ;IF ERS ENTRY WAS NOT FOUND IN V POV ARRAY
QUIT
End DoDot:2
+130 ;FOR EACH ERS ENTRY
QUIT
End DoDot:1
+131 ;IHS/OIT/SCR ...ANY V POV ENTRIES THAT ARE LEFT NEED TO BE REMOVED FROM PCC OR ADDED TO ERS
+132 ;IF 'SILENT' ONLY ADD TO ERS
+133 FOR
SET AMERVPOV=$ORDER(APCLV(AMERVPOV))
IF AMERVPOV=""
QUIT
Begin DoDot:1
+134 ; APCLV(x)=^^^^internal value of V POV^^ ICD9 code^^^^Cause of injury^place of injury^provider narrative^date of injury
+135 SET AMERVIEN=$PIECE(APCLV(AMERVPOV),"^",1)
+136 SET AMERVICD=$PIECE(APCLV(AMERVPOV),"^",7)
+137 SET AMERVNAR=$PIECE(APCLV(AMERVPOV),"^",14)
+138 SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)
+139 IF AMERVDXI<1
Begin DoDot:2
+140 ;start by setting it to 'uncoded'
SET AMERVDXI=$PIECE($$ICDDX^ICDCODE(".9999",,,1),U,1)
+141 IF AMERVICD="VA LOCAL CODE SELECTED"
Begin DoDot:3
+142 ;LOOK IT UP THROUGH FILEMAN
+143 SET DIC="^AUPNVPOV("
SET DIC(0)="NX"
SET X="`"_$PIECE(APCLV(AMERVPOV),"^",5)
+144 DO ^DIC
+145 ;brings back the ICD ien
IF Y'=-1
SET AMERVDXI=$PIECE(Y,"^",2)
+146 QUIT
End DoDot:3
+147 ;brings back the code
SET AMERVICD=$PIECE($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)
+148 QUIT
End DoDot:2
+149 IF AMERSLNT
SET AMERANS=2
+150 IF '$TEST
Begin DoDot:2
+151 DO EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
+152 DO EN^DDIOL("V POV ENTRY: "_AMERVICD_" - "_AMERVNAR,"","!?3")
+153 ;S DIR(0)="SO^1:ADD THIS DX INFORMATION TO THE ERS VISIT;2:REMOVE THE V POV ENTRY FROM THE PCC VISIT"
+154 SET DIR(0)="SO^1:REMOVE THE V POV ENTRY FROM THE PCC VISIT;2:ADD THIS DX INFORMATION TO THE ERS VISIT"
+155 ;S DIR("A")="Which would you like to do"
+156 DO ^DIR
KILL DIR
+157 ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY ADDING THIS CODE TO ERS
IF (Y="^"!Y="")
SET AMERANS=2
+158 IF '$TEST
SET AMERANS=+Y
+159 QUIT
End DoDot:2
+160 IF AMERANS=2
Begin DoDot:2
+161 ;ADD NEW DX TO ERS VISIT
+162 ;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0
+163 ; DIAGNOSES
SET DA(1)=AMERDA
SET DIC="^AMERVSIT(DA(1),5,"
SET DIC(0)="L"
+164 SET X="`"_AMERVDXI
+165 DO ^DIC
+166 IF +Y>0
Begin DoDot:3
+167 ;S AMEREDNM=AMEREDNM+1
+168 ;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERNDXI,"X")_";;Other;DIAGNOSIS; PCC SYNCH"
+169 ;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+170 ;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERVNAR_";;Other;PROVIDER NARRATIVE; PCC SYNCH"
+171 ;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+172 ;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+173 DO EN^DDIOL("** DIAGNOSIS ADDED TO ERS VISIT **","","!?3")
+174 QUIT
End DoDot:3
+175 QUIT
End DoDot:2
+176 IF AMERANS=1
Begin DoDot:2
+177 IF $$REMOVPOV^AMERVSIT(AMERVIEN)
DO EN^DDIOL("** V POV REMOVED FROM PCC VISIT **","","!?3")
+178 IF '$TEST
DO EN^DDIOL("** COULD NOT REMOVE V POV FROM PCC VISIT! **","","!?3")
+179 QUIT
End DoDot:2
+180 QUIT
End DoDot:1
+181 KILL APCLV
+182 QUIT
ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERDFN,AMERTIME,AMERDOC,AMERCLN) ; ADD AN ENTRY TO V POV
+1 ; AMERPCC - VISIT IEN
+2 ; AMERICD9 - ICD9 CODE
+3 ; AMERNAR - PROVIDER NARRATIVE
+4 ; AMERDFN - PATIENT IEN
+5 ; AMERTIME - VA FILE MAN FORMAT OF VISIT TIME
+6 ; AMERDOC - POIINTER TO NEW PERSON PROVIDER
+7 ; AMERCLN - IS NOT A POINTER TO ^DIC(40.2 - "CLINIC STOP" FILE - NO
+8 ; if I send through a pointer "72" - ^DIC(40.7,72,0)=URGENT CARE^80
+9 ; I see the clinic stop "MAMMOGRAPHY" ^DIC(40.7,67,0)=MAMMOGRAPHY^72
+10 ; SO
+11 ; AMERCLN - CLINC CODE:30 - EMERGENCY MEDICINE or 80 - URGENT CARE
+12 KILL APCDALVR,APCDAFLE,APCDTPAT,APCDTPOV,APCDTNQ,APCDTPRO
+13 ; INVALID VISIT IEN
IF 'AMERPCC>0
QUIT 0
+14 ; INVALID PATIENT IEN
IF 'AMERDFN>0
QUIT 0
+15 ; THIS IS DOCUMENTED IN SAC Developer Handbook
SET APCDAFLE("APCDAFLE")="9000010.07"
+16 ; ICD9 CODE - pre-screened during "finalization"
SET APCDALVR("APCDTPOV")=AMERICD9
+17 ; PATIENT IEN
SET APCDALVR("APCDPAT")=AMERDFN
+18 ; VISIT IEN
SET APCDALVR("APCDVSIT")=AMERPCC
+19 ; NARRATIVE
SET APCDALVR("APCDTNQ")=AMERNAR
+20 ; EVENT DATE AND TIME - date diagnosis
SET APCDALVR("APCDTCDT")=AMERTIME
+21 ; CLINIC - pointer to clinic stop file
SET APCDALVR("APCDTCLN")=AMERCLN
+22 ; PROVIDER who made DIAGNOSIS - but in DD definition this is the encounter provider who treated the Dx...
SET APCDALVR("APCDTEPR")="`"_AMERDOC
+23 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
+24 DO EN^APCDALVR
+25 SET AMERVIEN=$GET(APCDALVR("APCDADFN"))
+26 IF AMERVIEN=""
Begin DoDot:1
+27 SET AMERVIEN=-1_"^"_$SELECT($GET(APCDALVR("APCDAFLG"))=1:"NO VISIT SELECTED",$GET(APCDALVR("APCDAFLG"))=2:"FAILED FM EDITS",1:"UNSPECIFIFED ERROR")
End DoDot:1
+28 IF +AMERVIEN>0
DO MOD^AUPNVSIT
+29 KILL APCDALVR,APCDAFLE,APCDTPOV,APCDTPAT,APCDVSIT,APCDTNQ,APCDTCDT,APCDTCLN,APCDTEPR,APCDATMP
+30 QUIT AMERVIEN
UPDTCLNC(AMERVPOV,AMERCLN) ;update the CLINIC STOP field in V POV to match the value in ERS
+1 ;IHS/OIT/SCR 090309 patch 2
+2 NEW DIE,DA,DR
+3 SET DIE="^AUPNVPOV("
+4 SET DA=AMERVPOV
+5 SET DR="1203///"_AMERCLN
+6 DO ^DIE
+7 QUIT
