AMERPOV ;GDIT/HS/BEE - SYNCHRONIZE AMER WITH PCC ; 07 Oct 2013 11:33 AM
;;3.0;ER VISIT SYSTEM;**6,10**;MAR 03, 2009;Build 23
;
Q
;
SYNC ;PEP - Sync AMER with PCC
;
;This API is called by the following:
; *MOD^AUPNVSIT has an XBNEW call to this API
;
;Predefined variable:
; AUPNVSIT - Visit IEN
;
NEW AMERVSIT,DFN,RET,ICAUSE,IDT,ILOC,FND,SOI,ACAUSE,PCNT,ADT,AMERPOV,STS,ECLN
;
;Input variable:
;Make sure PCC visit is valid
I $G(AUPNVSIT)="" Q ;Missing visit
I '$D(^AUPNVSIT(AUPNVSIT)) Q ;Invalid visit
S AMERVSIT=$O(^AMERVSIT("AD",AUPNVSIT,""))
I AMERVSIT="" Q
;
;GDIT/HS/BEE 08/01/2018;CR#10213 - AMER*3.0*10 - Save updated hospital location
S ECLN=$$GETCLN^AMER2A(AUPNVSIT) I ECLN]"" D
. NEW AMERUPD,ERROR
. S AMERUPD(9009080,AMERVSIT_",",".04")=ECLN
. D FILE^DIE("","AMERUPD","ERROR")
;
;Get DFN
S DFN=$$GET1^DIQ(9000010,AUPNVSIT,.05,"I") Q:DFN=""
;
;Synchronize the AMERVSIT POVs with V POV
D SYNCHERX^AMERERS(AMERVSIT,AUPNVSIT)
;
;Synchronize the injury information
;
;Get list of V POV entries
S STS=$$POV^AMERUTIL("",AUPNVSIT,.AMERPOV)
;
;Get Scene of Injury code
S SOI=$O(^AMER(2,"B","SCENE OF INJURY","")) Q:SOI=""
;
;Loop through list and find injury - take Primary POV injury as first choice
S (ICAUSE,IDT,ILOC,FND)=""
S PCNT="" F S PCNT=$O(AMERPOV(PCNT)) Q:PCNT="" D Q:FND
. NEW PS,IC,ID,IL,PVIEN
. ;
. ;Get whether primary or secondary, quit if not primary and we have injury info
. S PS=$P(AMERPOV(PCNT),U,2) I ICAUSE]"",PS'="P" Q
. ;
. ;Pull injury information from V POV
. S PVIEN=$P(AMERPOV(PCNT),U,6) Q:PVIEN=""
. ;
. ;Injury Cause
. S IC=$$GET1^DIQ(9000010.07,PVIEN_",",.09,"I") Q:IC=""
. ;
. ;Injury Date
. S ID=$$GET1^DIQ(9000010.07,PVIEN_",",.13,"I")
. ;
. ;Convert from PCC to AMER values
. S IL=$$GET1^DIQ(9000010.07,PVIEN_",",.11,"I")
. I (IL="A")!(IL="B") S CVIL=$$SCENE("HOME",SOI)
. I (IL="C") S CVIL=$$SCENE("RANCH OR FARM",SOI)
. I (IL="E") S CVIL=$$SCENE("INDUSTRIAL PLACE",SOI)
. I (IL="F") S CVIL=$$SCENE("RECREATIONAL/SPORT PLACE",SOI)
. I (IL="G") S CVIL=$$SCENE("HIGHWAY OR ROAD",SOI)
. I (IL="H") S CVIL=$$SCENE("PUBLIC BUILDING",SOI)
. I (IL="I") S CVIL=$$SCENE("RESIDENTIAL INSTITUTION",SOI)
. I (IL="K") S CVIL=$$SCENE("OTHER",SOI)
. S:$G(CVIL)="" CVIL=$$SCENE("UNSPECIFIED",SOI)
. S ICAUSE=IC,IDT=ID,ILOC=CVIL
;
;If there is an injury make sure it needs saved
;
;Get the current injury cause from AMER
S ACAUSE=$$GET1^DIQ(9009080,AMERVSIT_",",3.2,"I")
;
;Get the current injury date/time from AMER
S ADT=$$GET1^DIQ(9009080,AMERVSIT_",",3.4,"I")
;
;IF AMER and PCC causes do not agree clear out AMER as the injuries do not match
I ACAUSE]"",ICAUSE'=ACAUSE D
. NEW AMUPD,ERROR
. S AMUPD(9009080,AMERVSIT_",",3.2)="@"
. S AMUPD(9009080,AMERVSIT_",",3.1)="0"
. S AMUPD(9009080,AMERVSIT_",",3.3)="@"
. S AMUPD(9009080,AMERVSIT_",",3.4)="@"
. S AMUPD(9009080,AMERVSIT_",",3.5)="@"
. S AMUPD(9009080,AMERVSIT_",",3.6)="@"
. S AMUPD(9009080,AMERVSIT_",",3.6)="@"
. S AMUPD(9009080,AMERVSIT_",",13.1)="@"
. S AMUPD(9009080,AMERVSIT_",",13.2)="@"
. S AMUPD(9009080,AMERVSIT_",",13.3)="@"
. S AMUPD(9009080,AMERVSIT_",",13.4)="@"
. S AMUPD(9009080,AMERVSIT_",",13.5)="@"
. S AMUPD(9009080,AMERVSIT_",",13.6)="@"
. D FILE^DIE("","AMUPD","ERROR")
;
;Now save the new values, if a change
D
. NEW AMUPD,ERROR
. S AMUPD(9009080,AMERVSIT_",",3.2)=$S(ICAUSE="":"@",1:ICAUSE)
. S AMUPD(9009080,AMERVSIT_",",3.1)=$S(ICAUSE="":"0",1:1)
. S AMUPD(9009080,AMERVSIT_",",3.3)=$S(ICAUSE="":"@",1:ILOC)
. ;
. ;Only update the injury date if the date is different. This will preserve
. ;the injury time if entered in AMER
. I $P(ADT,".")'=$P(IDT,".") D
.. S AMUPD(9009080,AMERVSIT_",",3.4)=$S(IDT="":"@",1:IDT)
. ;
. I ICAUSE="" S AMUPD(9009080,AMERVSIT_",",3.5)="@"
. I ICAUSE="" S AMUPD(9009080,AMERVSIT_",",3.6)="@"
. D FILE^DIE("","AMUPD","ERROR")
;
;Update the decision to admit date
D
. NEW DECDT,AMUPD,ERROR
. S DECDT=$$GET1^DIQ(9000010,AUPNVSIT_",",1116,"I")
. S AMUPD(9009080,AMERVSIT_",",12.8)=$S(DECDT="":"@",1:DECDT)
. D FILE^DIE("","AMUPD","ERROR")
;
;Now sync up the dashboard if installed
I $T(SYNC^BEDDSYNC)]"" D EN^XBNEW("SYNC^BEDDSYNC","AUPNVSIT")
Q
;
SCENE(SCENE,SOI) ;Return the scene of injury
;
I $G(SCENE)="" Q ""
;
NEW IEN,FND
S (FND,IEN)="" F S IEN=$O(^AMER(3,"B",SCENE,IEN)) Q:IEN="" D Q:FND
. NEW TYPE
. S TYPE=$$GET1^DIQ(9009083,IEN_",",1,"I") Q:TYPE'=SOI
. S FND=IEN
;
Q FND
;
PDX(X,D0) ;EP - Display the ICD Description - Primary Dx
NEW ICDINFO,ICDDESC,VDATE
;
S VDATE=$P($$GET1^DIQ(9009080,D0,.01,"I"),".")
I $$AICD^AMERUTIL() S ICDINFO=$$ICDDX^ICDEX($P(X,U,2),VDATE)
E S ICDINFO=$$ICDDX^ICDCODE($P(X,U,2),VDATE)
;
;Get the description
S ICDDESC=$P(ICDINFO,U,4)
W ICDDESC
Q
;
DSPDX(X,D0,CODE,VDATE) ;Display the ICD Description
;
NEW ICDDESC
;
;Make the call to get the string
S ICDDESC=$$DX($G(X),$G(D0),$G(CODE),$G(VDATE))
;
W ICDDESC
;
Q ICDDESC
;
DX(X,D0,CODE,VDATE) ;Return the ICD Description
;
;Input
; X - Pointer to file 80 - May be in piece 2
; D0 - Pointer to ER VISIT file entry
; CODE - 1 - Include Code in return value (optional) - Default to not include
; VDATE - Date to check on (Optional)
NEW ICDINFO,ICDDESC
;
S:$L(X,"^")>1 X=$P(X,U,2)
;
S D0=$G(D0)
S VDATE=$G(VDATE) I VDATE="",D0]"" S VDATE=$P($$GET1^DIQ(9009080,D0,.01,"I"),".")
S:VDATE="" VDATE=DT
;
I $$AICD^AMERUTIL() S ICDINFO=$$ICDDX^ICDEX(X,VDATE)
E S ICDINFO=$$ICDDX^ICDCODE(X,VDATE)
;
;Get the description
S ICDDESC=$S($G(CODE)=1:$P(ICDINFO,U,2)_" - ",1:"")_$P(ICDINFO,U,4)
I $P(ICDINFO,U,2)="" Q ""
Q ICDDESC
AMERPOV ;GDIT/HS/BEE - SYNCHRONIZE AMER WITH PCC ; 07 Oct 2013 11:33 AM
+1 ;;3.0;ER VISIT SYSTEM;**6,10**;MAR 03, 2009;Build 23
+2 ;
+3 QUIT
+4 ;
SYNC ;PEP - Sync AMER with PCC
+1 ;
+2 ;This API is called by the following:
+3 ; *MOD^AUPNVSIT has an XBNEW call to this API
+4 ;
+5 ;Predefined variable:
+6 ; AUPNVSIT - Visit IEN
+7 ;
+8 NEW AMERVSIT,DFN,RET,ICAUSE,IDT,ILOC,FND,SOI,ACAUSE,PCNT,ADT,AMERPOV,STS,ECLN
+9 ;
+10 ;Input variable:
+11 ;Make sure PCC visit is valid
+12 ;Missing visit
IF $GET(AUPNVSIT)=""
QUIT
+13 ;Invalid visit
IF '$DATA(^AUPNVSIT(AUPNVSIT))
QUIT
+14 SET AMERVSIT=$ORDER(^AMERVSIT("AD",AUPNVSIT,""))
+15 IF AMERVSIT=""
QUIT
+16 ;
+17 ;GDIT/HS/BEE 08/01/2018;CR#10213 - AMER*3.0*10 - Save updated hospital location
+18 SET ECLN=$$GETCLN^AMER2A(AUPNVSIT)
IF ECLN]""
Begin DoDot:1
+19 NEW AMERUPD,ERROR
+20 SET AMERUPD(9009080,AMERVSIT_",",".04")=ECLN
+21 DO FILE^DIE("","AMERUPD","ERROR")
End DoDot:1
+22 ;
+23 ;Get DFN
+24 SET DFN=$$GET1^DIQ(9000010,AUPNVSIT,.05,"I")
IF DFN=""
QUIT
+25 ;
+26 ;Synchronize the AMERVSIT POVs with V POV
+27 DO SYNCHERX^AMERERS(AMERVSIT,AUPNVSIT)
+28 ;
+29 ;Synchronize the injury information
+30 ;
+31 ;Get list of V POV entries
+32 SET STS=$$POV^AMERUTIL("",AUPNVSIT,.AMERPOV)
+33 ;
+34 ;Get Scene of Injury code
+35 SET SOI=$ORDER(^AMER(2,"B","SCENE OF INJURY",""))
IF SOI=""
QUIT
+36 ;
+37 ;Loop through list and find injury - take Primary POV injury as first choice
+38 SET (ICAUSE,IDT,ILOC,FND)=""
+39 SET PCNT=""
FOR
SET PCNT=$ORDER(AMERPOV(PCNT))
IF PCNT=""
QUIT
Begin DoDot:1
+40 NEW PS,IC,ID,IL,PVIEN
+41 ;
+42 ;Get whether primary or secondary, quit if not primary and we have injury info
+43 SET PS=$PIECE(AMERPOV(PCNT),U,2)
IF ICAUSE]""
IF PS'="P"
QUIT
+44 ;
+45 ;Pull injury information from V POV
+46 SET PVIEN=$PIECE(AMERPOV(PCNT),U,6)
IF PVIEN=""
QUIT
+47 ;
+48 ;Injury Cause
+49 SET IC=$$GET1^DIQ(9000010.07,PVIEN_",",.09,"I")
IF IC=""
QUIT
+50 ;
+51 ;Injury Date
+52 SET ID=$$GET1^DIQ(9000010.07,PVIEN_",",.13,"I")
+53 ;
+54 ;Convert from PCC to AMER values
+55 SET IL=$$GET1^DIQ(9000010.07,PVIEN_",",.11,"I")
+56 IF (IL="A")!(IL="B")
SET CVIL=$$SCENE("HOME",SOI)
+57 IF (IL="C")
SET CVIL=$$SCENE("RANCH OR FARM",SOI)
+58 IF (IL="E")
SET CVIL=$$SCENE("INDUSTRIAL PLACE",SOI)
+59 IF (IL="F")
SET CVIL=$$SCENE("RECREATIONAL/SPORT PLACE",SOI)
+60 IF (IL="G")
SET CVIL=$$SCENE("HIGHWAY OR ROAD",SOI)
+61 IF (IL="H")
SET CVIL=$$SCENE("PUBLIC BUILDING",SOI)
+62 IF (IL="I")
SET CVIL=$$SCENE("RESIDENTIAL INSTITUTION",SOI)
+63 IF (IL="K")
SET CVIL=$$SCENE("OTHER",SOI)
+64 IF $GET(CVIL)=""
SET CVIL=$$SCENE("UNSPECIFIED",SOI)
+65 SET ICAUSE=IC
SET IDT=ID
SET ILOC=CVIL
End DoDot:1
IF FND
QUIT
+66 ;
+67 ;If there is an injury make sure it needs saved
+68 ;
+69 ;Get the current injury cause from AMER
+70 SET ACAUSE=$$GET1^DIQ(9009080,AMERVSIT_",",3.2,"I")
+71 ;
+72 ;Get the current injury date/time from AMER
+73 SET ADT=$$GET1^DIQ(9009080,AMERVSIT_",",3.4,"I")
+74 ;
+75 ;IF AMER and PCC causes do not agree clear out AMER as the injuries do not match
+76 IF ACAUSE]""
IF ICAUSE'=ACAUSE
Begin DoDot:1
+77 NEW AMUPD,ERROR
+78 SET AMUPD(9009080,AMERVSIT_",",3.2)="@"
+79 SET AMUPD(9009080,AMERVSIT_",",3.1)="0"
+80 SET AMUPD(9009080,AMERVSIT_",",3.3)="@"
+81 SET AMUPD(9009080,AMERVSIT_",",3.4)="@"
+82 SET AMUPD(9009080,AMERVSIT_",",3.5)="@"
+83 SET AMUPD(9009080,AMERVSIT_",",3.6)="@"
+84 SET AMUPD(9009080,AMERVSIT_",",3.6)="@"
+85 SET AMUPD(9009080,AMERVSIT_",",13.1)="@"
+86 SET AMUPD(9009080,AMERVSIT_",",13.2)="@"
+87 SET AMUPD(9009080,AMERVSIT_",",13.3)="@"
+88 SET AMUPD(9009080,AMERVSIT_",",13.4)="@"
+89 SET AMUPD(9009080,AMERVSIT_",",13.5)="@"
+90 SET AMUPD(9009080,AMERVSIT_",",13.6)="@"
+91 DO FILE^DIE("","AMUPD","ERROR")
End DoDot:1
+92 ;
+93 ;Now save the new values, if a change
+94 Begin DoDot:1
+95 NEW AMUPD,ERROR
+96 SET AMUPD(9009080,AMERVSIT_",",3.2)=$SELECT(ICAUSE="":"@",1:ICAUSE)
+97 SET AMUPD(9009080,AMERVSIT_",",3.1)=$SELECT(ICAUSE="":"0",1:1)
+98 SET AMUPD(9009080,AMERVSIT_",",3.3)=$SELECT(ICAUSE="":"@",1:ILOC)
+99 ;
+100 ;Only update the injury date if the date is different. This will preserve
+101 ;the injury time if entered in AMER
+102 IF $PIECE(ADT,".")'=$PIECE(IDT,".")
Begin DoDot:2
+103 SET AMUPD(9009080,AMERVSIT_",",3.4)=$SELECT(IDT="":"@",1:IDT)
End DoDot:2
+104 ;
+105 IF ICAUSE=""
SET AMUPD(9009080,AMERVSIT_",",3.5)="@"
+106 IF ICAUSE=""
SET AMUPD(9009080,AMERVSIT_",",3.6)="@"
+107 DO FILE^DIE("","AMUPD","ERROR")
End DoDot:1
+108 ;
+109 ;Update the decision to admit date
+110 Begin DoDot:1
+111 NEW DECDT,AMUPD,ERROR
+112 SET DECDT=$$GET1^DIQ(9000010,AUPNVSIT_",",1116,"I")
+113 SET AMUPD(9009080,AMERVSIT_",",12.8)=$SELECT(DECDT="":"@",1:DECDT)
+114 DO FILE^DIE("","AMUPD","ERROR")
End DoDot:1
+115 ;
+116 ;Now sync up the dashboard if installed
+117 IF $TEXT(SYNC^BEDDSYNC)]""
DO EN^XBNEW("SYNC^BEDDSYNC","AUPNVSIT")
+118 QUIT
+119 ;
SCENE(SCENE,SOI) ;Return the scene of injury
+1 ;
+2 IF $GET(SCENE)=""
QUIT ""
+3 ;
+4 NEW IEN,FND
+5 SET (FND,IEN)=""
FOR
SET IEN=$ORDER(^AMER(3,"B",SCENE,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+6 NEW TYPE
+7 SET TYPE=$$GET1^DIQ(9009083,IEN_",",1,"I")
IF TYPE'=SOI
QUIT
+8 SET FND=IEN
End DoDot:1
IF FND
QUIT
+9 ;
+10 QUIT FND
+11 ;
PDX(X,D0) ;EP - Display the ICD Description - Primary Dx
+1 NEW ICDINFO,ICDDESC,VDATE
+2 ;
+3 SET VDATE=$PIECE($$GET1^DIQ(9009080,D0,.01,"I"),".")
+4 IF $$AICD^AMERUTIL()
SET ICDINFO=$$ICDDX^ICDEX($PIECE(X,U,2),VDATE)
+5 IF '$TEST
SET ICDINFO=$$ICDDX^ICDCODE($PIECE(X,U,2),VDATE)
+6 ;
+7 ;Get the description
+8 SET ICDDESC=$PIECE(ICDINFO,U,4)
+9 WRITE ICDDESC
+10 QUIT
+11 ;
DSPDX(X,D0,CODE,VDATE) ;Display the ICD Description
+1 ;
+2 NEW ICDDESC
+3 ;
+4 ;Make the call to get the string
+5 SET ICDDESC=$$DX($GET(X),$GET(D0),$GET(CODE),$GET(VDATE))
+6 ;
+7 WRITE ICDDESC
+8 ;
+9 QUIT ICDDESC
+10 ;
DX(X,D0,CODE,VDATE) ;Return the ICD Description
+1 ;
+2 ;Input
+3 ; X - Pointer to file 80 - May be in piece 2
+4 ; D0 - Pointer to ER VISIT file entry
+5 ; CODE - 1 - Include Code in return value (optional) - Default to not include
+6 ; VDATE - Date to check on (Optional)
+7 NEW ICDINFO,ICDDESC
+8 ;
+9 IF $LENGTH(X,"^")>1
SET X=$PIECE(X,U,2)
+10 ;
+11 SET D0=$GET(D0)
+12 SET VDATE=$GET(VDATE)
IF VDATE=""
IF D0]""
SET VDATE=$PIECE($$GET1^DIQ(9009080,D0,.01,"I"),".")
+13 IF VDATE=""
SET VDATE=DT
+14 ;
+15 IF $$AICD^AMERUTIL()
SET ICDINFO=$$ICDDX^ICDEX(X,VDATE)
+16 IF '$TEST
SET ICDINFO=$$ICDDX^ICDCODE(X,VDATE)
+17 ;
+18 ;Get the description
+19 SET ICDDESC=$SELECT($GET(CODE)=1:$PIECE(ICDINFO,U,2)_" - ",1:"")_$PIECE(ICDINFO,U,4)
+20 IF $PIECE(ICDINFO,U,2)=""
QUIT ""
+21 QUIT ICDDESC
