AMEREDTI ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of INJURY INFORMATION
;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
;
EDINJRY(AMERDA,AMERAIEN) ;EP CALLED BY AMEREDIT when "INJURY" is selected for editing
;
;Make call to new injury editing code
D INJURY($G(AMERDA),$G(AMERAIEN))
;
Q 1
;
;AMER*3.0*6;Rewrote Injury Edit Option
INJURY(AMERDA,AMERAIEN) ;New edit injury section
;
;Edit all entries then perform an update to PCC
;
NEW QUIT,AMERPOV,VAL,POV,CNT
;
;Reset QUIT value
INJ S QUIT=""
;
;Injury?
D I QUIT]"" G INJUPD
. NEW INJ,DIR,X,Y,DIR,DUOUT,DTOUT,DR,NINJ,AMERSTRG
. ;
. ;Show warning message
. D EN^DDIOL("**Setting the following field to No will cause all injury data to be deleted**","","!!?3")
. ;
. ;Retrieve current value and perform edit
. S INJ=$$GET1^DIQ(9009080,AMERDA_",",3.1,"I"),INJ=$S(INJ=1:1,1:0)
. S DIR("B")=$S(INJ=1:"YES",1:"NO")
. S DIR(0)="YO",DIR("A")="Was this ER visit caused by an injury"
. D ^DIR
. S NINJ=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;If original non injury and current non injury quit
. I INJ=0,NINJ=0 S QUIT="^" Q
. ;
. ;If original injury and current injury quit
. I INJ=1,NINJ=1 Q
. ;
. ;If original injury and current non injury - remove injury information
. S DR="" I INJ=1,NINJ=0 S QUIT="^",DR=$S(DR'="":DR_";",1:""),DR=DR_"3.2////@;3.3////@;3.4////@;3.5////@;3.6////@;13.1////@;13.2////@;13.3////@;13.4////@;13.5////@;13.6////@"
. ;
. ;If original non injury and current injury - update the entry
. S DR=DR_$S(DR="":";",1:"")_"3.1////"_NINJ
. ;
. ;File/Audit
. I DR]"" D
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("3.1",$$EDDISPL^AMEREDAU(INJ,"B"),$$EDDISPL^AMEREDAU(NINJ,"B"),"INJURED")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Cause of Injury Entry
INJ1 S QUIT="" D G INJ:QUIT="^",INJUPD:QUIT
. NEW AMERPCC,AMERQUIT,DFN,CAUSE,NCAUSE,EDIT,DUOUT,DTOUT
. S AMERPCC=$$GET1^DIQ(9009080,AMERDA_",",.03,"I") I AMERPCC="" S QUIT=1 Q
. S DFN=$$GET1^DIQ(9000010,AMERPCC_",",.05,"I") I DFN="" S QUIT=1 Q
. ;
. ;Show warning message
. D EN^DDIOL("**Changing this Cause of Injury value can cause injury data to be deleted**","","!!?3")
. ;
. ;Get the current cause of injury
. S CAUSE=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")
. ;
. ;Make the call to get the cause
. D QD33^AMER2B(AMERPCC,.DTOUT)
. I $D(DTOUT) S QUIT=1 Q
. I $G(X)="^" S QUIT="^" Q
. I +$G(Y)>0,'$D(^ICD9(+$G(Y),0)) S QUIT="^" Q
. S NCAUSE=+Y
. ;
. ;If old cause does not equal new cause save/audit
. I CAUSE'=NCAUSE D
.. NEW DR,AMERSTRG
.. S DR="3.2////"_NCAUSE
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("3.2",$$EDDISPL^AMEREDAU(CAUSE,"C"),$$EDDISPL^AMEREDAU(NCAUSE,"C"),"CAUSE OF INJURY")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Setting of injury
INJ2 S QUIT="" D G INJ1:QUIT="^",INJUPD:QUIT
. NEW DIC,X,Y,PLACE,NPLACE,DUOUT,DTOUT
. S DIC("A")="*Setting of accident/injury: " K DIC("B")
. S PLACE=$$GET1^DIQ(9009080,AMERDA_",",3.3,"I")
. I PLACE'="" S DIC("B")=$$GET1^DIQ(9009083,PLACE_",",.01,"I")
. S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY"),DIC(0)="AEQ"
. ;
. ;Get new value
. D ^DIC K DIC
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. I Y<0 S NPLACE=""
. E S NPLACE=+Y
. ;
. ;Save/audit
. I NPLACE'=PLACE D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("3.3",$$EDDISPL^AMEREDAU(PLACE,"S"),$$EDDISPL^AMEREDAU(NPLACE,"S"),"SCENE OF INJURY")
.. S DR="3.3////"_$S(NPLACE]"":NPLACE,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Safety Equipment
INJ3 S QUIT="" D G INJ2:QUIT="^",INJUPD:QUIT
. NEW DIC,X,Y,SAFE,NSAFE,DUOUT,DTOUT
. ;
. ;Retrieve current value
. S SAFE=$$GET1^DIQ(9009080,AMERDA_",",3.5,"I")
. S:SAFE'="" DIC("B")=$$GET1^DIQ(9009083,SAFE_",",.01,"I")
. ;
. ;Get new value
. S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT"),DIC(0)="AEQ"
. S DIC("A")="*Safety equipment used: "
. D ^DIC K DIC
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/audit
. S NSAFE=+Y
. I NSAFE'=+SAFE D
.. NEW AMERSTRG,DR
.. S DR="3.5////"_$S(+NSAFE>0:+NSAFE,1:"@")
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("3.5",$$EDDISPL^AMEREDAU(SAFE,"Q"),$$EDDISPL^AMEREDAU(+NSAFE,"Q"),"SAFETY EQUIPMENT")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;TIME OF INJURY
INJ4 S QUIT="" D G INJ3:QUIT="^",INJUPD:QUIT
. NEW DIR,INJDT,NINJDT,VDT,X,Y,DUOUT,DTOUT
. ;
. ;Pull the current value
. S INJDT=$$GET1^DIQ(9009080,AMERDA_",",3.4,"I")
. I INJDT'="" S Y=INJDT X ^DD("DD") S DIR("B")=Y
. ;
. ;Get the admission date/time
. S VDT=$$GET1^DIQ(9009080,AMERDA_",",.01,"I")
. ;
. ;Prompt for the new value
. S DIR(0)="DO^::ER",DIR("A")="*Enter the exact time and date of injury"
. S DIR("?")="Enter a time and date in the usual FileMan format (e.g., 1/3/90@1PM)."
. F D I (Y="^")!(QUIT) Q
.. NEW DUOUT,DTOUT
.. D ^DIR
.. ;
.. ;Process timeouts and "^"
.. I $D(DUOUT) S QUIT="^" Q
.. I $D(DTOUT) S QUIT=1 Q
.. ;
.. I $$TCK^AMER2A(VDT,Y,0,"admission")=0 D
... S NINJDT=Y
... S:NINJDT<0 NINJDT=""
... ;
... ;Save/Audit
... I NINJDT'=INJDT D
.... NEW AMERSTRG,DR
.... S AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",$$EDDISPL^AMEREDAU(INJDT,"D"),$$EDDISPL^AMEREDAU(NINJDT,"D"),"TIME OF INJURY")
.... S DR="3.4////"_$S(NINJDT]"":NINJDT,1:"@")
.... D DIE^AMEREDIT(AMERDA,DR)
.... I AMERSTRG="^" Q
.... D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.... S Y="^"
... E S Y="^"
;
;Town of Injury
INJ5 S QUIT="" D G INJ4:QUIT="^",INJUPD:QUIT
. NEW DIR,TOWN,NTOWN,DUOUT,DTOUT,X,Y
. ;
. ;Retrieve the old value
. S TOWN=$$GET1^DIQ(9009080,AMERDA_",",3.6,"I")
. I TOWN]"" S DIR("B")=TOWN
. ;
. ;Prompt for the new value
. S DIR(0)="FO^1:30",DIR("A")="Town/village where injury occurred"
. D ^DIR
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. S NTOWN=Y
. S:NTOWN<0 NTOWN=""
. ;
. ;Save/Audit
. I NTOWN'=TOWN D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("3.6",TOWN,NTOWN,"TOWN OF INJURY")
.. S DR="3.6////"_$S(NTOWN]"":NTOWN,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
..I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Description of MVA Location
INJ6 S QUIT="" D G INJ5:QUIT="^",INJUPD:QUIT
. NEW DIR,DUOUT,DTOUT,MVAL,NMVAL,X,Y
. ;
. ;Retrieve current value
. S MVAL=$$GET1^DIQ(9009080,AMERDA_",",13.1,"I")
. I MVAL]"" S DIR("B")=MVAL
. ;
. ;Get the new value
. S DIR(0)="FO^1:100",DIR("A")="Location of MVC (if applicable)"
. S DIR("?")="If MVC, enter free text location description (100 characters max.)"
. D ^DIR
. S NMVAL=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
. I NMVAL'=MVAL D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.1",MVAL,NMVAL,"EXACT MVC LOCATION")
.. S DR="13.1////"_$S(NMVAL]"":NMVAL,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;MVC - Driver Insurance Company
INJ7 S QUIT="" D G INJ6:QUIT="^",INJUPD:QUIT
. NEW DIR,DUOUT,DTOUT,MVAC,NMVAC,X,Y
. ;
. ;Pull current value
. S MVAC=$$GET1^DIQ(9009080,AMERDA_",",13.2,"I")
. I MVAC'="" S DIR("B")=MVAC
. ;
. ;Get the new value
. S DIR(0)="FO^1:100",DIR("A")="Driver's insurance company (if applicable)"
. S DIR("?")="Enter free text description"
. D ^DIR
. S NMVAC=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
. I NMVAC'=MVAC D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.2",MVAC,NMVAC,"DRIVER INSURANCE COMPANY")
.. S DR="13.2////"_$S(NMVAC]"":NMVAC,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
INJ8 S QUIT="" D G INJ7:QUIT="^",INJUPD:QUIT
. NEW DIR,DIPN,NDIPN,X,Y,DUOUT,DTOUT
. ;
. ;Retrieve current value
. S DIPN=$$GET1^DIQ(9009080,AMERDA_",",13.3,"I")
. I DIPN]"" S DIR("B")=DIPN
. ;
. ;Get the new value
. S DIR(0)="FO^1:100",DIR("A")="Driver's insurance policy number (if applicable)"
. S DIR("?")="Enter free text description"
. D ^DIR
. S NDIPN=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
. I NDIPN'=DIPN D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.3",DIPN,NDIPN,"DRIVER POLICY #")
.. S DR="13.3////"_$S(NDIPN]"":NDIPN,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Owners name
INJ9 S QUIT="" D G INJ8:QUIT="^",INJUPD:QUIT
. NEW DIR,OWN,NOWN,X,Y,DUOUT,DTOUT
. ;
. ;Retrieve the current value
. S OWN=$$GET1^DIQ(9009080,AMERDA_",",13.4,"I")
. I OWN]"" S DIR("B")=OWN
. ;
. ;Get the new value
. S DIR(0)="FO^1:100",DIR("A")="Owner of vehicle, if different than driver (if applicable)"
. S DIR("?")="Enter free text description"
. D ^DIR
. S NOWN=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
.I NOWN'=OWN D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.4",OWN,NOWN,"OWNER NAME")
..S DR="13.4////"_$S(NOWN]"":NOWN,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
;Owners Insurance Company
INJ10 S QUIT="" D G INJ9:QUIT="^",INJUPD:QUIT
. NEW DIR,X,Y,DUOUT,DTOUT,OINS,NOINS
. ;
. ;Retrieve the current value
. S OINS=$$GET1^DIQ(9009080,AMERDA_",",13.5,"I")
. I OINS]"" S DIR("B")=OINS
. ;
. ;Get the new value
. S DIR(0)="FO^1:100",DIR("A")="Owner's insurance company (if applicable)"
. S DIR("?")="Enter free text description"
. D ^DIR
. S NOINS=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
. I NOINS'=OINS D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.5",OINS,NOINS,"OWNER INSURANCE CO.")
.. S DR="13.5////"_$S(NOINS]"":NOINS,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
INJ11 S QUIT="" D G INJ10:QUIT="^",INJUPD:QUIT
. NEW DIR,X,Y,DTOUT,DUOUT,POL,NPOL
. ;
. ;Retrieve the current value
. S POL=$$GET1^DIQ(9009080,AMERDA_",",13.6)
. I POL]"" S DIR("B")=POL
. ;
. ;Get current value
. S DIR(0)="FO^1:100",DIR("A")="Owner's insurance policy number (if applicable)"
. S DIR("?")="Enter free text description"
. D ^DIR
. S NPOL=Y
. ;
. ;Process timeouts and "^"
. I $D(DUOUT) S QUIT="^" Q
. I $D(DTOUT) S QUIT=1 Q
. ;
. ;Save/Audit
. I NPOL'=POL D
.. NEW AMERSTRG,DR
.. S AMERSTRG=$$EDAUDIT^AMEREDAU("13.6",POL,NPOL,"OWNER POLICY #")
.. S DR="13.6////"_$S(NPOL]"":NPOL,1:"@")
.. D DIE^AMEREDIT(AMERDA,DR)
.. I AMERSTRG="^" Q
.. D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
;
INJUPD ;Push changes to V POV
;
;First get the POV entries on file
S AMERPOV=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
;
;Get the number of V POV entries
S POVCNT=+$G(AMERPOV) Q:'POVCNT
;
;Set up scratch global
K ^TMP("AMER",$J)
;
;Pull Injury Date
S VAL=$P($$GET1^DIQ(9009080,AMERDA_",",3.4,"I"),".")
S ^TMP("AMER",$J,2,32)=VAL
;
;Pull Injury Cause
S VAL=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")
S ^TMP("AMER",$J,2,33)=VAL
;
;Place of Accident - Convert
S VAL=$$GET1^DIQ(9009080,AMERDA_",",3.3,"I")
S ^TMP("AMER",$J,2,34)=VAL
;
;If only 1 POV on file update that one
I $P(AMERPOV,U)=1 D G XINJURY
. NEW VPOVIEN
. Q:'$D(AMERPOV(1))
. S VPOVIEN=$P($G(AMERPOV(1)),U,6) Q:VPOVIEN=""
. D UPDPOV^AMER31(VPOVIEN)
;
;If multiple POV on file select the correct one(s)
I $P(AMERPOV,U)>1 D
. NEW POVLST
. W $$S^AMERUTIL("RVN")
. W !!,"Current POV information on file:"
. W $$S^AMERUTIL("RVF")
. W !!,"# ",?3,"P/S",?7,"Code",?18,"Description",?50,"Provider Narrative"
. F CNT=1:1:POVCNT D
.. Q:'$D(AMERPOV(CNT))
.. W !,CNT,?3,$P(AMERPOV(CNT),U,2),?7,$P(AMERPOV(CNT),U),?18,$E($P(AMERPOV(CNT),U,5),1,30),?50,$E($P(AMERPOV(CNT),U,3),1,29)
. ;
. ;Prompt user for which one(s) to match injury to
. S DIR(0)="L^1:"_POVCNT
. S DIR("A")="Select the POV entry or entries to match the injury information to"
. W !
. D ^DIR
. I $D(DIRUT) S X="^" Q
. S POVLST=Y
. ;
. ;Match selected entry or entries to the injury information
. F CNT=1:1:$L(POVLST,",") S VAL=$P(POVLST,",",CNT) I +VAL D
.. NEW VPOVIEN
.. Q:'$D(AMERPOV(+VAL))
.. S VPOVIEN=$P($G(AMERPOV(+VAL)),U,6) Q:VPOVIEN=""
.. D UPDPOV^AMER31(VPOVIEN)
;
XINJURY ;
Q
AMEREDTI ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of INJURY INFORMATION
+1 ;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
+2 ;
EDINJRY(AMERDA,AMERAIEN) ;EP CALLED BY AMEREDIT when "INJURY" is selected for editing
+1 ;
+2 ;Make call to new injury editing code
+3 DO INJURY($GET(AMERDA),$GET(AMERAIEN))
+4 ;
+5 QUIT 1
+6 ;
+7 ;AMER*3.0*6;Rewrote Injury Edit Option
INJURY(AMERDA,AMERAIEN) ;New edit injury section
+1 ;
+2 ;Edit all entries then perform an update to PCC
+3 ;
+4 NEW QUIT,AMERPOV,VAL,POV,CNT
+5 ;
+6 ;Reset QUIT value
INJ SET QUIT=""
+1 ;
+2 ;Injury?
+3 Begin DoDot:1
+4 NEW INJ,DIR,X,Y,DIR,DUOUT,DTOUT,DR,NINJ,AMERSTRG
+5 ;
+6 ;Show warning message
+7 DO EN^DDIOL("**Setting the following field to No will cause all injury data to be deleted**","","!!?3")
+8 ;
+9 ;Retrieve current value and perform edit
+10 SET INJ=$$GET1^DIQ(9009080,AMERDA_",",3.1,"I")
SET INJ=$SELECT(INJ=1:1,1:0)
+11 SET DIR("B")=$SELECT(INJ=1:"YES",1:"NO")
+12 SET DIR(0)="YO"
SET DIR("A")="Was this ER visit caused by an injury"
+13 DO ^DIR
+14 SET NINJ=Y
+15 ;
+16 ;Process timeouts and "^"
+17 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+18 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+19 ;
+20 ;If original non injury and current non injury quit
+21 IF INJ=0
IF NINJ=0
SET QUIT="^"
QUIT
+22 ;
+23 ;If original injury and current injury quit
+24 IF INJ=1
IF NINJ=1
QUIT
+25 ;
+26 ;If original injury and current non injury - remove injury information
+27 SET DR=""
IF INJ=1
IF NINJ=0
SET QUIT="^"
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_"3.2////@;3.3////@;3.4////@;3.5////@;3.6////@;13.1////@;13.2////@;13.3////@;13.4////@;13.5////@;13.6////@"
+28 ;
+29 ;If original non injury and current injury - update the entry
+30 SET DR=DR_$SELECT(DR="":";",1:"")_"3.1////"_NINJ
+31 ;
+32 ;File/Audit
+33 IF DR]""
Begin DoDot:2
+34 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.1",$$EDDISPL^AMEREDAU(INJ,"B"),$$EDDISPL^AMEREDAU(NINJ,"B"),"INJURED")
+35 DO DIE^AMEREDIT(AMERDA,DR)
+36 IF AMERSTRG="^"
QUIT
+37 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT]""
GOTO INJUPD
+38 ;
+39 ;Cause of Injury Entry
INJ1 SET QUIT=""
Begin DoDot:1
+1 NEW AMERPCC,AMERQUIT,DFN,CAUSE,NCAUSE,EDIT,DUOUT,DTOUT
+2 SET AMERPCC=$$GET1^DIQ(9009080,AMERDA_",",.03,"I")
IF AMERPCC=""
SET QUIT=1
QUIT
+3 SET DFN=$$GET1^DIQ(9000010,AMERPCC_",",.05,"I")
IF DFN=""
SET QUIT=1
QUIT
+4 ;
+5 ;Show warning message
+6 DO EN^DDIOL("**Changing this Cause of Injury value can cause injury data to be deleted**","","!!?3")
+7 ;
+8 ;Get the current cause of injury
+9 SET CAUSE=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")
+10 ;
+11 ;Make the call to get the cause
+12 DO QD33^AMER2B(AMERPCC,.DTOUT)
+13 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+14 IF $GET(X)="^"
SET QUIT="^"
QUIT
+15 IF +$GET(Y)>0
IF '$DATA(^ICD9(+$GET(Y),0))
SET QUIT="^"
QUIT
+16 SET NCAUSE=+Y
+17 ;
+18 ;If old cause does not equal new cause save/audit
+19 IF CAUSE'=NCAUSE
Begin DoDot:2
+20 NEW DR,AMERSTRG
+21 SET DR="3.2////"_NCAUSE
+22 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.2",$$EDDISPL^AMEREDAU(CAUSE,"C"),$$EDDISPL^AMEREDAU(NCAUSE,"C"),"CAUSE OF INJURY")
+23 DO DIE^AMEREDIT(AMERDA,DR)
+24 IF AMERSTRG="^"
QUIT
+25 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ
IF QUIT
GOTO INJUPD
+26 ;
+27 ;Setting of injury
INJ2 SET QUIT=""
Begin DoDot:1
+1 NEW DIC,X,Y,PLACE,NPLACE,DUOUT,DTOUT
+2 SET DIC("A")="*Setting of accident/injury: "
KILL DIC("B")
+3 SET PLACE=$$GET1^DIQ(9009080,AMERDA_",",3.3,"I")
+4 IF PLACE'=""
SET DIC("B")=$$GET1^DIQ(9009083,PLACE_",",.01,"I")
+5 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY")
SET DIC(0)="AEQ"
+6 ;
+7 ;Get new value
+8 DO ^DIC
KILL DIC
+9 ;
+10 ;Process timeouts and "^"
+11 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+12 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+13 ;
+14 IF Y<0
SET NPLACE=""
+15 IF '$TEST
SET NPLACE=+Y
+16 ;
+17 ;Save/audit
+18 IF NPLACE'=PLACE
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.3",$$EDDISPL^AMEREDAU(PLACE,"S"),$$EDDISPL^AMEREDAU(NPLACE,"S"),"SCENE OF INJURY")
+21 SET DR="3.3////"_$SELECT(NPLACE]"":NPLACE,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ1
IF QUIT
GOTO INJUPD
+25 ;
+26 ;Safety Equipment
INJ3 SET QUIT=""
Begin DoDot:1
+1 NEW DIC,X,Y,SAFE,NSAFE,DUOUT,DTOUT
+2 ;
+3 ;Retrieve current value
+4 SET SAFE=$$GET1^DIQ(9009080,AMERDA_",",3.5,"I")
+5 IF SAFE'=""
SET DIC("B")=$$GET1^DIQ(9009083,SAFE_",",.01,"I")
+6 ;
+7 ;Get new value
+8 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT")
SET DIC(0)="AEQ"
+9 SET DIC("A")="*Safety equipment used: "
+10 DO ^DIC
KILL DIC
+11 ;
+12 ;Process timeouts and "^"
+13 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+14 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+15 ;
+16 ;Save/audit
+17 SET NSAFE=+Y
+18 IF NSAFE'=+SAFE
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET DR="3.5////"_$SELECT(+NSAFE>0:+NSAFE,1:"@")
+21 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.5",$$EDDISPL^AMEREDAU(SAFE,"Q"),$$EDDISPL^AMEREDAU(+NSAFE,"Q"),"SAFETY EQUIPMENT")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ2
IF QUIT
GOTO INJUPD
+25 ;
+26 ;TIME OF INJURY
INJ4 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,INJDT,NINJDT,VDT,X,Y,DUOUT,DTOUT
+2 ;
+3 ;Pull the current value
+4 SET INJDT=$$GET1^DIQ(9009080,AMERDA_",",3.4,"I")
+5 IF INJDT'=""
SET Y=INJDT
XECUTE ^DD("DD")
SET DIR("B")=Y
+6 ;
+7 ;Get the admission date/time
+8 SET VDT=$$GET1^DIQ(9009080,AMERDA_",",.01,"I")
+9 ;
+10 ;Prompt for the new value
+11 SET DIR(0)="DO^::ER"
SET DIR("A")="*Enter the exact time and date of injury"
+12 SET DIR("?")="Enter a time and date in the usual FileMan format (e.g., 1/3/90@1PM)."
+13 FOR
Begin DoDot:2
+14 NEW DUOUT,DTOUT
+15 DO ^DIR
+16 ;
+17 ;Process timeouts and "^"
+18 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+19 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+20 ;
+21 IF $$TCK^AMER2A(VDT,Y,0,"admission")=0
Begin DoDot:3
+22 SET NINJDT=Y
+23 IF NINJDT<0
SET NINJDT=""
+24 ;
+25 ;Save/Audit
+26 IF NINJDT'=INJDT
Begin DoDot:4
+27 NEW AMERSTRG,DR
+28 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.4",$$EDDISPL^AMEREDAU(INJDT,"D"),$$EDDISPL^AMEREDAU(NINJDT,"D"),"TIME OF INJURY")
+29 SET DR="3.4////"_$SELECT(NINJDT]"":NINJDT,1:"@")
+30 DO DIE^AMEREDIT(AMERDA,DR)
+31 IF AMERSTRG="^"
QUIT
+32 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+33 SET Y="^"
End DoDot:4
+34 IF '$TEST
SET Y="^"
End DoDot:3
End DoDot:2
IF (Y="^")!(QUIT)
QUIT
End DoDot:1
IF QUIT="^"
GOTO INJ3
IF QUIT
GOTO INJUPD
+35 ;
+36 ;Town of Injury
INJ5 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,TOWN,NTOWN,DUOUT,DTOUT,X,Y
+2 ;
+3 ;Retrieve the old value
+4 SET TOWN=$$GET1^DIQ(9009080,AMERDA_",",3.6,"I")
+5 IF TOWN]""
SET DIR("B")=TOWN
+6 ;
+7 ;Prompt for the new value
+8 SET DIR(0)="FO^1:30"
SET DIR("A")="Town/village where injury occurred"
+9 DO ^DIR
+10 ;
+11 ;Process timeouts and "^"
+12 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+13 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+14 ;
+15 SET NTOWN=Y
+16 IF NTOWN<0
SET NTOWN=""
+17 ;
+18 ;Save/Audit
+19 IF NTOWN'=TOWN
Begin DoDot:2
+20 NEW AMERSTRG,DR
+21 SET AMERSTRG=$$EDAUDIT^AMEREDAU("3.6",TOWN,NTOWN,"TOWN OF INJURY")
+22 SET DR="3.6////"_$SELECT(NTOWN]"":NTOWN,1:"@")
+23 DO DIE^AMEREDIT(AMERDA,DR)
+24 IF AMERSTRG="^"
QUIT
+25 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ4
IF QUIT
GOTO INJUPD
+26 ;
+27 ;Description of MVA Location
INJ6 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,DUOUT,DTOUT,MVAL,NMVAL,X,Y
+2 ;
+3 ;Retrieve current value
+4 SET MVAL=$$GET1^DIQ(9009080,AMERDA_",",13.1,"I")
+5 IF MVAL]""
SET DIR("B")=MVAL
+6 ;
+7 ;Get the new value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Location of MVC (if applicable)"
+9 SET DIR("?")="If MVC, enter free text location description (100 characters max.)"
+10 DO ^DIR
+11 SET NMVAL=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NMVAL'=MVAL
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.1",MVAL,NMVAL,"EXACT MVC LOCATION")
+21 SET DR="13.1////"_$SELECT(NMVAL]"":NMVAL,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ5
IF QUIT
GOTO INJUPD
+25 ;
+26 ;MVC - Driver Insurance Company
INJ7 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,DUOUT,DTOUT,MVAC,NMVAC,X,Y
+2 ;
+3 ;Pull current value
+4 SET MVAC=$$GET1^DIQ(9009080,AMERDA_",",13.2,"I")
+5 IF MVAC'=""
SET DIR("B")=MVAC
+6 ;
+7 ;Get the new value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Driver's insurance company (if applicable)"
+9 SET DIR("?")="Enter free text description"
+10 DO ^DIR
+11 SET NMVAC=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NMVAC'=MVAC
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.2",MVAC,NMVAC,"DRIVER INSURANCE COMPANY")
+21 SET DR="13.2////"_$SELECT(NMVAC]"":NMVAC,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ6
IF QUIT
GOTO INJUPD
+25 ;
INJ8 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,DIPN,NDIPN,X,Y,DUOUT,DTOUT
+2 ;
+3 ;Retrieve current value
+4 SET DIPN=$$GET1^DIQ(9009080,AMERDA_",",13.3,"I")
+5 IF DIPN]""
SET DIR("B")=DIPN
+6 ;
+7 ;Get the new value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Driver's insurance policy number (if applicable)"
+9 SET DIR("?")="Enter free text description"
+10 DO ^DIR
+11 SET NDIPN=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NDIPN'=DIPN
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.3",DIPN,NDIPN,"DRIVER POLICY #")
+21 SET DR="13.3////"_$SELECT(NDIPN]"":NDIPN,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ7
IF QUIT
GOTO INJUPD
+25 ;
+26 ;Owners name
INJ9 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,OWN,NOWN,X,Y,DUOUT,DTOUT
+2 ;
+3 ;Retrieve the current value
+4 SET OWN=$$GET1^DIQ(9009080,AMERDA_",",13.4,"I")
+5 IF OWN]""
SET DIR("B")=OWN
+6 ;
+7 ;Get the new value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Owner of vehicle, if different than driver (if applicable)"
+9 SET DIR("?")="Enter free text description"
+10 DO ^DIR
+11 SET NOWN=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NOWN'=OWN
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.4",OWN,NOWN,"OWNER NAME")
+21 SET DR="13.4////"_$SELECT(NOWN]"":NOWN,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ8
IF QUIT
GOTO INJUPD
+25 ;
+26 ;Owners Insurance Company
INJ10 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,X,Y,DUOUT,DTOUT,OINS,NOINS
+2 ;
+3 ;Retrieve the current value
+4 SET OINS=$$GET1^DIQ(9009080,AMERDA_",",13.5,"I")
+5 IF OINS]""
SET DIR("B")=OINS
+6 ;
+7 ;Get the new value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Owner's insurance company (if applicable)"
+9 SET DIR("?")="Enter free text description"
+10 DO ^DIR
+11 SET NOINS=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NOINS'=OINS
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.5",OINS,NOINS,"OWNER INSURANCE CO.")
+21 SET DR="13.5////"_$SELECT(NOINS]"":NOINS,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ9
IF QUIT
GOTO INJUPD
+25 ;
INJ11 SET QUIT=""
Begin DoDot:1
+1 NEW DIR,X,Y,DTOUT,DUOUT,POL,NPOL
+2 ;
+3 ;Retrieve the current value
+4 SET POL=$$GET1^DIQ(9009080,AMERDA_",",13.6)
+5 IF POL]""
SET DIR("B")=POL
+6 ;
+7 ;Get current value
+8 SET DIR(0)="FO^1:100"
SET DIR("A")="Owner's insurance policy number (if applicable)"
+9 SET DIR("?")="Enter free text description"
+10 DO ^DIR
+11 SET NPOL=Y
+12 ;
+13 ;Process timeouts and "^"
+14 IF $DATA(DUOUT)
SET QUIT="^"
QUIT
+15 IF $DATA(DTOUT)
SET QUIT=1
QUIT
+16 ;
+17 ;Save/Audit
+18 IF NPOL'=POL
Begin DoDot:2
+19 NEW AMERSTRG,DR
+20 SET AMERSTRG=$$EDAUDIT^AMEREDAU("13.6",POL,NPOL,"OWNER POLICY #")
+21 SET DR="13.6////"_$SELECT(NPOL]"":NPOL,1:"@")
+22 DO DIE^AMEREDIT(AMERDA,DR)
+23 IF AMERSTRG="^"
QUIT
+24 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
End DoDot:2
End DoDot:1
IF QUIT="^"
GOTO INJ10
IF QUIT
GOTO INJUPD
+25 ;
INJUPD ;Push changes to V POV
+1 ;
+2 ;First get the POV entries on file
+3 SET AMERPOV=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
+4 ;
+5 ;Get the number of V POV entries
+6 SET POVCNT=+$GET(AMERPOV)
IF 'POVCNT
QUIT
+7 ;
+8 ;Set up scratch global
+9 KILL ^TMP("AMER",$JOB)
+10 ;
+11 ;Pull Injury Date
+12 SET VAL=$PIECE($$GET1^DIQ(9009080,AMERDA_",",3.4,"I"),".")
+13 SET ^TMP("AMER",$JOB,2,32)=VAL
+14 ;
+15 ;Pull Injury Cause
+16 SET VAL=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")
+17 SET ^TMP("AMER",$JOB,2,33)=VAL
+18 ;
+19 ;Place of Accident - Convert
+20 SET VAL=$$GET1^DIQ(9009080,AMERDA_",",3.3,"I")
+21 SET ^TMP("AMER",$JOB,2,34)=VAL
+22 ;
+23 ;If only 1 POV on file update that one
+24 IF $PIECE(AMERPOV,U)=1
Begin DoDot:1
+25 NEW VPOVIEN
+26 IF '$DATA(AMERPOV(1))
QUIT
+27 SET VPOVIEN=$PIECE($GET(AMERPOV(1)),U,6)
IF VPOVIEN=""
QUIT
+28 DO UPDPOV^AMER31(VPOVIEN)
End DoDot:1
GOTO XINJURY
+29 ;
+30 ;If multiple POV on file select the correct one(s)
+31 IF $PIECE(AMERPOV,U)>1
Begin DoDot:1
+32 NEW POVLST
+33 WRITE $$S^AMERUTIL("RVN")
+34 WRITE !!,"Current POV information on file:"
+35 WRITE $$S^AMERUTIL("RVF")
+36 WRITE !!,"# ",?3,"P/S",?7,"Code",?18,"Description",?50,"Provider Narrative"
+37 FOR CNT=1:1:POVCNT
Begin DoDot:2
+38 IF '$DATA(AMERPOV(CNT))
QUIT
+39 WRITE !,CNT,?3,$PIECE(AMERPOV(CNT),U,2),?7,$PIECE(AMERPOV(CNT),U),?18,$EXTRACT($PIECE(AMERPOV(CNT),U,5),1,30),?50,$EXTRACT($PIECE(AMERPOV(CNT),U,3),1,29)
End DoDot:2
+40 ;
+41 ;Prompt user for which one(s) to match injury to
+42 SET DIR(0)="L^1:"_POVCNT
+43 SET DIR("A")="Select the POV entry or entries to match the injury information to"
+44 WRITE !
+45 DO ^DIR
+46 IF $DATA(DIRUT)
SET X="^"
QUIT
+47 SET POVLST=Y
+48 ;
+49 ;Match selected entry or entries to the injury information
+50 FOR CNT=1:1:$LENGTH(POVLST,",")
SET VAL=$PIECE(POVLST,",",CNT)
IF +VAL
Begin DoDot:2
+51 NEW VPOVIEN
+52 IF '$DATA(AMERPOV(+VAL))
QUIT
+53 SET VPOVIEN=$PIECE($GET(AMERPOV(+VAL)),U,6)
IF VPOVIEN=""
QUIT
+54 DO UPDPOV^AMER31(VPOVIEN)
End DoDot:2
End DoDot:1
+55 ;
XINJURY ;
+1 QUIT
