Routine: AMERPOV

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

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

 . 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

 . 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")

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

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

AMERPOV.m