AMER31 ; IHS/ANMC/GIS -ISC - ENTER DIAGNOSES ;
;;3.0;ER VISIT SYSTEM;**6,7,8**;MAR 03, 2009;Build 23
;
QD11 ; ENTRY POINT FROM AMER3
;
NEW PVCNT,DLAYGO,AMERDUZ,AMERPOV,AMERIEN,AMERNCHK
NEW APCDCAT,APCDVSIT,APCDPAT,APCDLOC,APCDTYPE,APCDMODE,APCDPARM
NEW APCDMNE,APCDVLDT,APCDVLK,DIC,AMERPCC,VDT,ICD10,DIDEL,AMERPOV
;
;Make sure variables are set up properly to allow adds/deletes
S (DLAYGO,DIDEL)=9000010.07
I $G(DUZ("AG"))="I" S AMERDUZ=DUZ(0),DUZ(0)="@"
;
QD11E ;Get the visit IEN
S AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I") I AMERPCC="" G QD11X
S VDT=$P($$GET1^DIQ(9000010,AMERPCC,.01,"I"),".")
;
;Determine if ICD-10 has been implemented
S ICD10=0 I $$VERSION^XPDUTL("AICD")>3.51,$$IMP^ICDEXA(30)'>VDT S ICD10=1
;
;AMER*3.0*6;Display any POV information already on file
S AMERPOV="" F PVCNT=1:1 S AMERPOV=$O(^AUPNVPOV("AD",AMERPCC,AMERPOV)) Q:AMERPOV="" D
. NEW ICDIEN,INFO,PS,PNARR
. I PVCNT=1 D
.. W $$S^AMERUTIL("RVN")
.. W !!,"Current Purpose of Visit entries on file for this visit:",!
.. W $$S^AMERUTIL("RVF")
. ;
. ;Display each entry
. S ICDIEN=$$GET1^DIQ(9000010.07,AMERPOV,.01,"I")
. S PS=$$GET1^DIQ(9000010.07,AMERPOV,.12,"I")
. S INFO=$$ICDDX^AUPNVUTL(ICDIEN,VDT)
. S PNARR=$$VAL^XBDIQ1(9000010.07,AMERPOV,.04)
. W !,"Code: ",$P(INFO,U,2),?15,"P/S: ",PS,?23,"Description: ",$E($P(INFO,U,4),1,55)
. I PNARR="" W $$S^AMERUTIL("RVN")
. W !?3,"Prov Narrative: ",PNARR
. I PNARR="" W $$S^AMERUTIL("RVF")
;
;Prompt for Edits
S X=$G(X)
I PVCNT>1 D Q:X]""
. ;
. NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Edit Existing Purpose of Visit Information"
. W !
. D ^DIR
. I $G(DTOUT)!$G(DUOUT)!$G(DIRUT)!$G(DIROUT) S X="^" Q
. S X=$S(Y=1:"",Y=0:"",1:X)
. I Y'=1 Q
. ;
. ;Perform Purpose of Visit Edit
. W $$S^AMERUTIL("RVN")
. W !!,"Select the Purpose of Visit Entry to Edit"
. W $$S^AMERUTIL("RVF")
. S X=$$AEPOV(AMERPCC,DFN,"M")
;
;Perform POV adds
I PVCNT>1 W !!,"*Enter Additional Purpose of Visit Information"
E W !!,"*Enter Purpose of Visit Information"
W !," Enter ",$$S^AMERUTIL("RVN"),$S(ICD10:"ZZZ.999",1:".9999"),$$S^AMERUTIL("RVF")," to log an uncoded diagnosis"
S X=$$AEPOV(AMERPCC,DFN,"A")
;
;Make sure a POV entry was logged
S AMERPOV=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
I ($P(AMERPOV,U)<1) D G QD11E:X="",QD11X:X]""
. NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
. W !!,"This answer is mandatory."
. S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
. S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
. W !
. D ^DIR
. I Y'="E" S X="^",Y="^" Q
. S X=""
;
;Make sure a primary POV entry was logged
I ($P(AMERPOV,U,2)<1) D G QD11E:X="",QD11X:X]""
. NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
. W !!,"A primary Purpose of Visit is required."
. S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
. S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
. W !
. D ^DIR
. I Y'="E" S X="^" Q
. S X=""
;
;Make sure only one primary POV entry was logged
I ($P(AMERPOV,U,2)>1) D G QD11E:X="",QD11X:X]""
. NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
. W !!,"Only one primary POV is permitted."
. S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
. S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
. W !
. D ^DIR
. I Y'="E" S X="^" Q
. S X=""
;
;AMER*3.0*8;Validate provider narrative
S (AMERNCHK,AMERIEN)="" F S AMERIEN=$O(AMERPOV(AMERIEN)) Q:AMERIEN="" D Q:+AMERNCHK
. NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
. I $P(AMERPOV(AMERIEN),U,3)]"" Q
. S AMERNCHK="1"
. W $$S^AMERUTIL("RVN")
. W !!,"**POV ",$P(AMERPOV(AMERIEN),U)," is missing a required PROVIDER NARRATIVE entry**",!
. W $$S^AMERUTIL("RVF")
I +AMERNCHK G QD11E
;
;Handle Injury Matching
D INJURY(.AMERPOV,.X) I $G(X)="^" G QD11E
;
;Set DUZ(0) back to original value
I $G(DUZ("AG"))="I" S DUZ(0)=$G(AMERDUZ)
;
;BEE;Fix for endless loop issue
S Y=1
;
QD11X S:$G(AMERDUZ)]"" DUZ(0)=AMERDUZ
Q
;
AEPOV(AMERPCC,DFN,APCDMODE) ;EP - Add/Edit POV information
NEW APCDCAT,APCDVSIT,APCDVLK,APCDPAT
NEW APCDPARM,APCDDATE,APCDVLDT,APCDLOC,APCDTYPE
NEW DIC,X,Y,DTOUT,DUOUT,APCDMNE,AMERGBL
;
;Verify that DUZ was passed in and set up
D DUZ^XUP(DUZ)
;
S APCDCAT="H",(APCDVSIT,APCDVLK)=AMERPCC,APCDPAT=DFN
S APCDPARM=$G(^APCDSITE(DUZ(2),0))
S (APCDDATE,APCDVLDT)=$$GET1^DIQ(9000010,AMERPCC,.01,"I")
S APCDLOC=DUZ(2),APCDTYPE=$$GET1^DIQ(9000010,AMERPCC,.03,"I")
;
;Get the IEN for the 'PV' mnemonic
S DIC=9001001,DIC(0)="",X="PV" D ^DIC
I Y<1 Q "^"
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
S AMERGBL="^AUPNVPOV"
S Y=AMERGBL_"(""AD"","_AMERPCC_",0)" I '$O(@Y) S APCDMODE="A"
;
;Perform POV edit/entry
D ^APCDEA3
Q ""
;
INJURY(AMERPOV,X) ;Match Injury with V POV and update V POV record
;
NEW POVCNT,VPOVIEN,CNT,Y,DTOUT,DUOUT,DIRUT,DIROUT,VAL,POVLST
;
;If no injury quit
I '+$G(^TMP("AMER",$J,2,2)) Q
;
;Get the number of V POV entries
S POVCNT=+$G(AMERPOV) Q:'POVCNT
;
;If only one V POV entry map to that one automatically
I POVCNT=1 D Q
. S VPOVIEN=$P($G(AMERPOV(1)),U,6) Q:VPOVIEN=""
. D UPDPOV(VPOVIEN)
;
;If more than one V POV entry, allow user to select entry or entries to map to
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
. Q:'$D(AMERPOV(+VAL))
. S VPOVIEN=$P($G(AMERPOV(+VAL)),U,6) Q:VPOVIEN=""
. D UPDPOV(VPOVIEN)
;
Q
;
UPDPOV(VPOVIEN) ;Update V POV entry with Injury Information
;
NEW VPOVUPD,ERROR,INJDT,INJCS,INJPL,INJCVPL,%,AUPNVSIT
;
;Quit if no V POV IEN
I $G(VPOVIEN)="" Q
;
;Get the visit IEN
S AUPNVSIT=$$GET1^DIQ(9000010.07,VPOVIEN_",",.03,"I")
;
;Pull Injury Date
S INJDT=$P($G(^TMP("AMER",$J,2,32)),".")
;
;Pull Injury Cause
S INJCS=$G(^TMP("AMER",$J,2,33))
;I INJCS]"" S INJCS=$$GET1^DIQ(9009083,INJCS_",",7,"I")
;
;Place of Accident - Convert
S INJPL=$G(^TMP("AMER",$J,2,34))
I INJPL]"" S INJPL=$$GET1^DIQ(9009083,INJPL_",",.01,"E")
;
;Valid PCC values
;A:HOME-INSIDE;B:HOME-OUTSIDE;C:FARM;D:SCHOOL;E:INDUSTRIAL PREMISES;F:RECREATIONAL AREA;
;G:STREET/HIGHWAY;H:PUBLIC BUILDING;I:RESIDENT INSTITUTION;J:HUNTING/FISHING;K:OTHER;L:UNKNOWN
S INJCVPL="L"
I INJPL["HIGHWAY" S INJCVPL="G"
E I INJPL["HOME" S INJCVPL="A"
E I INJPL["INDUSTRIAL" S INJCVPL="E"
E I INJPL["MINE" S INJCVPL="K"
E I INJPL["OTHER" S INJCVPL="K"
E I INJPL["PUBLIC" S INJCVPL="H"
E I INJPL["FARM" S INJCVPL="C"
E I INJPL["RECREATION" S INJCVPL="F"
E I INJPL["RESIDENT" S INJCVPL="I"
E I INJPL["UNSPECIFIED" S INJCVPL="L"
E I INJPL["SCHOOL" S INJCVPL="D"
E I INJPL["HUNTING" S INJCVPL="J"
E I INJPL["FISHING" S INJCVPL="J"
;
;Save the injury date in the V POV entry
D NOW^%DTC
S VPOVUPD(9000010.07,VPOVIEN_",",.09)=INJCS
S VPOVUPD(9000010.07,VPOVIEN_",",.11)=INJCVPL
S VPOVUPD(9000010.07,VPOVIEN_",",.13)=INJDT
S VPOVUPD(9000010.07,VPOVIEN_",",1218)=%
S VPOVUPD(9000010.07,VPOVIEN_",",1219)=DUZ
D FILE^DIE("","VPOVUPD","ERROR")
;
;Mark that the visit was modified
D MOD^AUPNVSIT
;
Q
AMER31 ; IHS/ANMC/GIS -ISC - ENTER DIAGNOSES ;
+1 ;;3.0;ER VISIT SYSTEM;**6,7,8**;MAR 03, 2009;Build 23
+2 ;
QD11 ; ENTRY POINT FROM AMER3
+1 ;
+2 NEW PVCNT,DLAYGO,AMERDUZ,AMERPOV,AMERIEN,AMERNCHK
+3 NEW APCDCAT,APCDVSIT,APCDPAT,APCDLOC,APCDTYPE,APCDMODE,APCDPARM
+4 NEW APCDMNE,APCDVLDT,APCDVLK,DIC,AMERPCC,VDT,ICD10,DIDEL,AMERPOV
+5 ;
+6 ;Make sure variables are set up properly to allow adds/deletes
+7 SET (DLAYGO,DIDEL)=9000010.07
+8 IF $GET(DUZ("AG"))="I"
SET AMERDUZ=DUZ(0)
SET DUZ(0)="@"
+9 ;
QD11E ;Get the visit IEN
+1 SET AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
IF AMERPCC=""
GOTO QD11X
+2 SET VDT=$PIECE($$GET1^DIQ(9000010,AMERPCC,.01,"I"),".")
+3 ;
+4 ;Determine if ICD-10 has been implemented
+5 SET ICD10=0
IF $$VERSION^XPDUTL("AICD")>3.51
IF $$IMP^ICDEXA(30)'>VDT
SET ICD10=1
+6 ;
+7 ;AMER*3.0*6;Display any POV information already on file
+8 SET AMERPOV=""
FOR PVCNT=1:1
SET AMERPOV=$ORDER(^AUPNVPOV("AD",AMERPCC,AMERPOV))
IF AMERPOV=""
QUIT
Begin DoDot:1
+9 NEW ICDIEN,INFO,PS,PNARR
+10 IF PVCNT=1
Begin DoDot:2
+11 WRITE $$S^AMERUTIL("RVN")
+12 WRITE !!,"Current Purpose of Visit entries on file for this visit:",!
+13 WRITE $$S^AMERUTIL("RVF")
End DoDot:2
+14 ;
+15 ;Display each entry
+16 SET ICDIEN=$$GET1^DIQ(9000010.07,AMERPOV,.01,"I")
+17 SET PS=$$GET1^DIQ(9000010.07,AMERPOV,.12,"I")
+18 SET INFO=$$ICDDX^AUPNVUTL(ICDIEN,VDT)
+19 SET PNARR=$$VAL^XBDIQ1(9000010.07,AMERPOV,.04)
+20 WRITE !,"Code: ",$PIECE(INFO,U,2),?15,"P/S: ",PS,?23,"Description: ",$EXTRACT($PIECE(INFO,U,4),1,55)
+21 IF PNARR=""
WRITE $$S^AMERUTIL("RVN")
+22 WRITE !?3,"Prov Narrative: ",PNARR
+23 IF PNARR=""
WRITE $$S^AMERUTIL("RVF")
End DoDot:1
+24 ;
+25 ;Prompt for Edits
+26 SET X=$GET(X)
+27 IF PVCNT>1
Begin DoDot:1
+28 ;
+29 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+30 SET DIR(0)="Y"
SET DIR("B")="NO"
+31 SET DIR("A")="Edit Existing Purpose of Visit Information"
+32 WRITE !
+33 DO ^DIR
+34 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIRUT)!$GET(DIROUT)
SET X="^"
QUIT
+35 SET X=$SELECT(Y=1:"",Y=0:"",1:X)
+36 IF Y'=1
QUIT
+37 ;
+38 ;Perform Purpose of Visit Edit
+39 WRITE $$S^AMERUTIL("RVN")
+40 WRITE !!,"Select the Purpose of Visit Entry to Edit"
+41 WRITE $$S^AMERUTIL("RVF")
+42 SET X=$$AEPOV(AMERPCC,DFN,"M")
End DoDot:1
IF X]""
QUIT
+43 ;
+44 ;Perform POV adds
+45 IF PVCNT>1
WRITE !!,"*Enter Additional Purpose of Visit Information"
+46 IF '$TEST
WRITE !!,"*Enter Purpose of Visit Information"
+47 WRITE !," Enter ",$$S^AMERUTIL("RVN"),$SELECT(ICD10:"ZZZ.999",1:".9999"),$$S^AMERUTIL("RVF")," to log an uncoded diagnosis"
+48 SET X=$$AEPOV(AMERPCC,DFN,"A")
+49 ;
+50 ;Make sure a POV entry was logged
+51 SET AMERPOV=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
+52 IF ($PIECE(AMERPOV,U)<1)
Begin DoDot:1
+53 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+54 WRITE !!,"This answer is mandatory."
+55 SET DIR(0)="SA^E:Enter POV now;P:Step to previous prompt"
SET DIR("B")="E"
+56 SET DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
+57 WRITE !
+58 DO ^DIR
+59 IF Y'="E"
SET X="^"
SET Y="^"
QUIT
+60 SET X=""
End DoDot:1
IF X=""
GOTO QD11E
IF X]""
GOTO QD11X
+61 ;
+62 ;Make sure a primary POV entry was logged
+63 IF ($PIECE(AMERPOV,U,2)<1)
Begin DoDot:1
+64 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+65 WRITE !!,"A primary Purpose of Visit is required."
+66 SET DIR(0)="SA^E:Enter POV now;P:Step to previous prompt"
SET DIR("B")="E"
+67 SET DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
+68 WRITE !
+69 DO ^DIR
+70 IF Y'="E"
SET X="^"
QUIT
+71 SET X=""
End DoDot:1
IF X=""
GOTO QD11E
IF X]""
GOTO QD11X
+72 ;
+73 ;Make sure only one primary POV entry was logged
+74 IF ($PIECE(AMERPOV,U,2)>1)
Begin DoDot:1
+75 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+76 WRITE !!,"Only one primary POV is permitted."
+77 SET DIR(0)="SA^E:Enter POV now;P:Step to previous prompt"
SET DIR("B")="E"
+78 SET DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
+79 WRITE !
+80 DO ^DIR
+81 IF Y'="E"
SET X="^"
QUIT
+82 SET X=""
End DoDot:1
IF X=""
GOTO QD11E
IF X]""
GOTO QD11X
+83 ;
+84 ;AMER*3.0*8;Validate provider narrative
+85 SET (AMERNCHK,AMERIEN)=""
FOR
SET AMERIEN=$ORDER(AMERPOV(AMERIEN))
IF AMERIEN=""
QUIT
Begin DoDot:1
+86 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+87 IF $PIECE(AMERPOV(AMERIEN),U,3)]""
QUIT
+88 SET AMERNCHK="1"
+89 WRITE $$S^AMERUTIL("RVN")
+90 WRITE !!,"**POV ",$PIECE(AMERPOV(AMERIEN),U)," is missing a required PROVIDER NARRATIVE entry**",!
+91 WRITE $$S^AMERUTIL("RVF")
End DoDot:1
IF +AMERNCHK
QUIT
+92 IF +AMERNCHK
GOTO QD11E
+93 ;
+94 ;Handle Injury Matching
+95 DO INJURY(.AMERPOV,.X)
IF $GET(X)="^"
GOTO QD11E
+96 ;
+97 ;Set DUZ(0) back to original value
+98 IF $GET(DUZ("AG"))="I"
SET DUZ(0)=$GET(AMERDUZ)
+99 ;
+100 ;BEE;Fix for endless loop issue
+101 SET Y=1
+102 ;
QD11X IF $GET(AMERDUZ)]""
SET DUZ(0)=AMERDUZ
+1 QUIT
+2 ;
AEPOV(AMERPCC,DFN,APCDMODE) ;EP - Add/Edit POV information
+1 NEW APCDCAT,APCDVSIT,APCDVLK,APCDPAT
+2 NEW APCDPARM,APCDDATE,APCDVLDT,APCDLOC,APCDTYPE
+3 NEW DIC,X,Y,DTOUT,DUOUT,APCDMNE,AMERGBL
+4 ;
+5 ;Verify that DUZ was passed in and set up
+6 DO DUZ^XUP(DUZ)
+7 ;
+8 SET APCDCAT="H"
SET (APCDVSIT,APCDVLK)=AMERPCC
SET APCDPAT=DFN
+9 SET APCDPARM=$GET(^APCDSITE(DUZ(2),0))
+10 SET (APCDDATE,APCDVLDT)=$$GET1^DIQ(9000010,AMERPCC,.01,"I")
+11 SET APCDLOC=DUZ(2)
SET APCDTYPE=$$GET1^DIQ(9000010,AMERPCC,.03,"I")
+12 ;
+13 ;Get the IEN for the 'PV' mnemonic
+14 SET DIC=9001001
SET DIC(0)=""
SET X="PV"
DO ^DIC
+15 IF Y<1
QUIT "^"
+16 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+17 SET AMERGBL="^AUPNVPOV"
+18 SET Y=AMERGBL_"(""AD"","_AMERPCC_",0)"
IF '$ORDER(@Y)
SET APCDMODE="A"
+19 ;
+20 ;Perform POV edit/entry
+21 DO ^APCDEA3
+22 QUIT ""
+23 ;
INJURY(AMERPOV,X) ;Match Injury with V POV and update V POV record
+1 ;
+2 NEW POVCNT,VPOVIEN,CNT,Y,DTOUT,DUOUT,DIRUT,DIROUT,VAL,POVLST
+3 ;
+4 ;If no injury quit
+5 IF '+$GET(^TMP("AMER",$JOB,2,2))
QUIT
+6 ;
+7 ;Get the number of V POV entries
+8 SET POVCNT=+$GET(AMERPOV)
IF 'POVCNT
QUIT
+9 ;
+10 ;If only one V POV entry map to that one automatically
+11 IF POVCNT=1
Begin DoDot:1
+12 SET VPOVIEN=$PIECE($GET(AMERPOV(1)),U,6)
IF VPOVIEN=""
QUIT
+13 DO UPDPOV(VPOVIEN)
End DoDot:1
QUIT
+14 ;
+15 ;If more than one V POV entry, allow user to select entry or entries to map to
+16 WRITE $$S^AMERUTIL("RVN")
+17 WRITE !!,"Current POV information on file:"
+18 WRITE $$S^AMERUTIL("RVF")
+19 WRITE !!,"# ",?3,"P/S",?7,"Code",?18,"Description",?50,"Provider Narrative"
+20 FOR CNT=1:1:POVCNT
Begin DoDot:1
+21 IF '$DATA(AMERPOV(CNT))
QUIT
+22 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:1
+23 ;
+24 ;Prompt user for which one(s) to match injury to
+25 SET DIR(0)="L^1:"_POVCNT
+26 SET DIR("A")="Select the POV entry or entries to match the injury information to"
+27 WRITE !
+28 DO ^DIR
+29 IF $DATA(DIRUT)
SET X="^"
QUIT
+30 SET POVLST=Y
+31 ;
+32 ;Match selected entry or entries to the injury information
+33 FOR CNT=1:1:$LENGTH(POVLST,",")
SET VAL=$PIECE(POVLST,",",CNT)
IF +VAL
Begin DoDot:1
+34 IF '$DATA(AMERPOV(+VAL))
QUIT
+35 SET VPOVIEN=$PIECE($GET(AMERPOV(+VAL)),U,6)
IF VPOVIEN=""
QUIT
+36 DO UPDPOV(VPOVIEN)
End DoDot:1
+37 ;
+38 QUIT
+39 ;
UPDPOV(VPOVIEN) ;Update V POV entry with Injury Information
+1 ;
+2 NEW VPOVUPD,ERROR,INJDT,INJCS,INJPL,INJCVPL,%,AUPNVSIT
+3 ;
+4 ;Quit if no V POV IEN
+5 IF $GET(VPOVIEN)=""
QUIT
+6 ;
+7 ;Get the visit IEN
+8 SET AUPNVSIT=$$GET1^DIQ(9000010.07,VPOVIEN_",",.03,"I")
+9 ;
+10 ;Pull Injury Date
+11 SET INJDT=$PIECE($GET(^TMP("AMER",$JOB,2,32)),".")
+12 ;
+13 ;Pull Injury Cause
+14 SET INJCS=$GET(^TMP("AMER",$JOB,2,33))
+15 ;I INJCS]"" S INJCS=$$GET1^DIQ(9009083,INJCS_",",7,"I")
+16 ;
+17 ;Place of Accident - Convert
+18 SET INJPL=$GET(^TMP("AMER",$JOB,2,34))
+19 IF INJPL]""
SET INJPL=$$GET1^DIQ(9009083,INJPL_",",.01,"E")
+20 ;
+21 ;Valid PCC values
+22 ;A:HOME-INSIDE;B:HOME-OUTSIDE;C:FARM;D:SCHOOL;E:INDUSTRIAL PREMISES;F:RECREATIONAL AREA;
+23 ;G:STREET/HIGHWAY;H:PUBLIC BUILDING;I:RESIDENT INSTITUTION;J:HUNTING/FISHING;K:OTHER;L:UNKNOWN
+24 SET INJCVPL="L"
+25 IF INJPL["HIGHWAY"
SET INJCVPL="G"
+26 IF '$TEST
IF INJPL["HOME"
SET INJCVPL="A"
+27 IF '$TEST
IF INJPL["INDUSTRIAL"
SET INJCVPL="E"
+28 IF '$TEST
IF INJPL["MINE"
SET INJCVPL="K"
+29 IF '$TEST
IF INJPL["OTHER"
SET INJCVPL="K"
+30 IF '$TEST
IF INJPL["PUBLIC"
SET INJCVPL="H"
+31 IF '$TEST
IF INJPL["FARM"
SET INJCVPL="C"
+32 IF '$TEST
IF INJPL["RECREATION"
SET INJCVPL="F"
+33 IF '$TEST
IF INJPL["RESIDENT"
SET INJCVPL="I"
+34 IF '$TEST
IF INJPL["UNSPECIFIED"
SET INJCVPL="L"
+35 IF '$TEST
IF INJPL["SCHOOL"
SET INJCVPL="D"
+36 IF '$TEST
IF INJPL["HUNTING"
SET INJCVPL="J"
+37 IF '$TEST
IF INJPL["FISHING"
SET INJCVPL="J"
+38 ;
+39 ;Save the injury date in the V POV entry
+40 DO NOW^%DTC
+41 SET VPOVUPD(9000010.07,VPOVIEN_",",.09)=INJCS
+42 SET VPOVUPD(9000010.07,VPOVIEN_",",.11)=INJCVPL
+43 SET VPOVUPD(9000010.07,VPOVIEN_",",.13)=INJDT
+44 SET VPOVUPD(9000010.07,VPOVIEN_",",1218)=%
+45 SET VPOVUPD(9000010.07,VPOVIEN_",",1219)=DUZ
+46 DO FILE^DIE("","VPOVUPD","ERROR")
+47 ;
+48 ;Mark that the visit was modified
+49 DO MOD^AUPNVSIT
+50 ;
+51 QUIT
