Routine: AMERVER

AMERVER ; IHS/GDIT/BEE - Save record to V EMERGENCY VISIT RECORD ;

 ;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23

VER(AMERDFN,AMERPCC) ;Create/Update V EMERGENCY VISIT RECORD entry

 I $G(AMERDFN)="" Q

 ;If no VIEN, try to retrieve it

 I $G(AMERPCC)="" D  Q:AMERPCC=""

 . S AMERPCC=$$GET1^DIQ(9009081,AMERDFN_",",1.1,"I")

 NEW ERIEN,ERVIEN,%,VERUPD,ERROR,AUPNVSIT

 D NOW^%DTC

 ;Look for existing entry

 S ERIEN=$O(^AUPNVER("AD",AMERPCC,""))

 ;If no entry create new one

 I ERIEN="" D  Q:ERIEN=""

. ;

 . NEW DIC,DLAYGO,X,Y

. ;

 . S DIC(0)="L",DIC="^AUPNVER("

 . S DLAYGO="9000010.29"

 . S X="IHS-114 ER"

 . K DO,DD D FILE^DICN

 . I +Y<0 Q

 . S ERIEN=+Y

. ;

 . ;Now enter initial fields

 . S VERUPD(9000010.29,ERIEN_",",.02)=AMERDFN  ;PATIENT NAME

 . S VERUPD(9000010.29,ERIEN_",",.03)=AMERPCC   ;VISIT

 . S VERUPD(9000010.29,ERIEN_",",1216)=%  ;DATE ENTERED

 . S VERUPD(9000010.29,ERIEN_",",1217)=DUZ  ;ENTERED BY

 ;Update Modified By/Date

 S VERUPD(9000010.29,ERIEN_",",1218)=%  ;DATE MODIFIED

 S VERUPD(9000010.29,ERIEN_",",1219)=DUZ  ;LAST MODIFIED BY

 ;Pull from ER VISIT file if available

 S ERVIEN=$O(^AMERVSIT("AD",AMERPCC,""))

 I ERVIEN]"" D

 . NEW URG,MOT,MOA,ENTBY,DIS,DISP,DISDT

. ;

 . ;Urgency

 . S URG=$$GET1^DIQ(9009080,ERVIEN_",",.24,"I")  ;INITIAL ACUITY

 . S URG=$S(URG=1:"R",URG=2:"E",URG=3:"U",URG=4:"L",URG=5:"N",1:"@")

 . S VERUPD(9000010.29,ERIEN_",",.04)=URG

. ;

 . ;Method of Transport

 . S (ENTBY,MOA)="",MOT=$$GET1^DIQ(9009080,ERVIEN_",",".25","I") I MOT'="" D

 .. ;

 .. ;MEANS OF ARRIVAL

 .. S MOT=$$GET1^DIQ(9009083,MOT_",",".01","E")

 .. I MOT["WALK" S MOA="W"

 .. I MOT["AMBULANCE" S MOA="A"

 .. S:MOA="" MOA="O"

 .. ;

 .. ;ENTERED ER BY

 .. I MOT["AMBULANCE" S ENTBY="A"

 .. I MOT["WHEEL" S ENTBY="W"

 .. I MOT["STRET"  S ENTBY="S"

 .. ;

 .. S VERUPD(9000010.29,ERIEN_",",.05)=$S(MOA]"":MOA,1:"@")  ;MEANS OF ARRIVAL

 .. S VERUPD(9000010.29,ERIEN_",",.07)=$S(ENTBY]"":ENTBY,1:"@")  ;ENTERED ER BY

. ;

 . ;DISPOSITION OF CARE

 . S DIS="",DISP=$$GET1^DIQ(9009080,ERVIEN_",","6.1","I") I DISP'="" D

 .. S DISP=$$GET1^DIQ(9009083,DISP_",",".01","E")

 .. I DISP["HOME" S DIS="D"

 .. I DISP["TRANS" S DIS="T"

 .. I DISP["ADMIT" S DIS="A"

 .. I DISP["LEFT" S DIS="1"

 .. I DISP["REGIS" S DIS="O"

 .. I DISP["EXPIRED" S DIS="E"

 .. I DISP["DEA" S DIS="E"

 .. I DISP]"",DIS="" S DIS="O"

 .. S VERUPD(9000010.29,ERIEN_",",.11)=$S(DIS]"":DIS,1:"@")

. ;

 . ;DEPARTURE DATE&TIME

 . S DISDT=$$GET1^DIQ(9009080,ERVIEN_",","6.2","I")

 . S VERUPD(9000010.29,ERIEN_",",".13")=$S(DISDT]"":DISDT,1:"@")

 ;Pull from ER ADMISSION if no ER VISIT entry

 I ERVIEN="" D

 . NEW URG,MOT,MOA,ENTBY

. ;

 . ;Urgency

 . S URG=$$GET1^DIQ(9009081,AMERDFN_",",20,"I")  ;INITIAL ACUITY

 . S URG=$S(URG=1:"R",URG=2:"E",URG=3:"U",URG=4:"L",URG=5:"N",1:"@")

 . S VERUPD(9000010.29,ERIEN_",",.04)=URG

. ;

 . ;Method of Transport

 . S (ENTBY,MOA)="",MOT=$$GET1^DIQ(9009081,AMERDFN_",","6","I") I MOT'="" D

 .. ;

 .. ;Means of Arrival

 .. S MOT=$$GET1^DIQ(9009083,MOT_",",".01","E")

 .. I MOT["WALK" S MOA="W"

 .. I MOT["AMBULANCE" S MOA="A"

 .. S:MOA="" MOA="O"

 .. ;

 .. ;Entered ER By

 .. I MOT["AMBULANCE" S ENTBY="A"

 .. I MOT["WHEEL" S ENTBY="W"

 .. I MOT["STRET"  S ENTBY="S"

 .. ;

 .. S VERUPD(9000010.29,ERIEN_",",.05)=$S(MOA]"":MOA,1:"@")  ;MEANS OF ARRIVAL

 .. S VERUPD(9000010.29,ERIEN_",",.07)=$S(ENTBY]"":ENTBY,1:"@")  ;ENTERED ER BY

 ;File the entry

 D FILE^DIE("","VERUPD","ERROR")

 ;Mark the visit as being modified

 NEW D S AUPNVSIT=AMERPCC D MOD^AUPNVSIT K D

AMERVER   ; IHS/GDIT/BEE - Save record to V EMERGENCY VISIT RECORD ;

 +1       ;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23

 +2       ;

VER(AMERDFN,AMERPCC) ;Create/Update V EMERGENCY VISIT RECORD entry

 +1       ;

 +2        IF $GET(AMERDFN)=""

               QUIT

 +3       ;

 +4       ;If no VIEN, try to retrieve it

 +5        IF $GET(AMERPCC)=""

               Begin DoDot:1

 +6                SET AMERPCC=$$GET1^DIQ(9009081,AMERDFN_",",1.1,"I")

               End DoDot:1

               IF AMERPCC=""

                   QUIT

 +7       ;

 +8        NEW ERIEN,ERVIEN,%,VERUPD,ERROR,AUPNVSIT

 +9       ;

 +10       DO NOW^%DTC

 +11      ;

 +12      ;Look for existing entry

 +13       SET ERIEN=$ORDER(^AUPNVER("AD",AMERPCC,""))

 +14      ;

 +15      ;If no entry create new one

 +16       IF ERIEN=""

               Begin DoDot:1

 +17      ;

 +18               NEW DIC,DLAYGO,X,Y

 +19      ;

 +20               SET DIC(0)="L"

                   SET DIC="^AUPNVER("

 +21               SET DLAYGO="9000010.29"

 +22               SET X="IHS-114 ER"

 +23               KILL DO,DD

                   DO FILE^DICN

 +24               IF +Y<0

                       QUIT

 +25               SET ERIEN=+Y

 +26      ;

 +27      ;Now enter initial fields

 +28      ;PATIENT NAME

                   SET VERUPD(9000010.29,ERIEN_",",.02)=AMERDFN

 +29      ;VISIT

                   SET VERUPD(9000010.29,ERIEN_",",.03)=AMERPCC

 +30      ;DATE ENTERED

                   SET VERUPD(9000010.29,ERIEN_",",1216)=%

 +31      ;ENTERED BY

                   SET VERUPD(9000010.29,ERIEN_",",1217)=DUZ

               End DoDot:1

               IF ERIEN=""

                   QUIT

 +32      ;

 +33      ;Update Modified By/Date

 +34      ;DATE MODIFIED

           SET VERUPD(9000010.29,ERIEN_",",1218)=%

 +35      ;LAST MODIFIED BY

           SET VERUPD(9000010.29,ERIEN_",",1219)=DUZ

 +36      ;

 +37      ;Pull from ER VISIT file if available

 +38       SET ERVIEN=$ORDER(^AMERVSIT("AD",AMERPCC,""))

 +39       IF ERVIEN]""

               Begin DoDot:1

 +40               NEW URG,MOT,MOA,ENTBY,DIS,DISP,DISDT

 +41      ;

 +42      ;Urgency

 +43      ;INITIAL ACUITY

                   SET URG=$$GET1^DIQ(9009080,ERVIEN_",",.24,"I")

 +44               SET URG=$SELECT(URG=1:"R",URG=2:"E",URG=3:"U",URG=4:"L",URG=5:"N",1:"@")

 +45               SET VERUPD(9000010.29,ERIEN_",",.04)=URG

 +46      ;

 +47      ;Method of Transport

 +48               SET (ENTBY,MOA)=""

                   SET MOT=$$GET1^DIQ(9009080,ERVIEN_",",".25","I")

                   IF MOT'=""

                       Begin DoDot:2

 +49      ;

 +50      ;MEANS OF ARRIVAL

 +51                       SET MOT=$$GET1^DIQ(9009083,MOT_",",".01","E")

 +52                       IF MOT["WALK"

                               SET MOA="W"

 +53                       IF MOT["AMBULANCE"

                               SET MOA="A"

 +54                       IF MOA=""

                               SET MOA="O"

 +55      ;

 +56      ;ENTERED ER BY

 +57                       IF MOT["AMBULANCE"

                               SET ENTBY="A"

 +58                       IF MOT["WHEEL"

                               SET ENTBY="W"

 +59                       IF MOT["STRET"

                               SET ENTBY="S"

 +60      ;

 +61      ;MEANS OF ARRIVAL

                           SET VERUPD(9000010.29,ERIEN_",",.05)=$SELECT(MOA]"":MOA,1:"@")

 +62      ;ENTERED ER BY

                           SET VERUPD(9000010.29,ERIEN_",",.07)=$SELECT(ENTBY]"":ENTBY,1:"@")

                       End DoDot:2

 +63      ;

 +64      ;DISPOSITION OF CARE

 +65               SET DIS=""

                   SET DISP=$$GET1^DIQ(9009080,ERVIEN_",","6.1","I")

                   IF DISP'=""

                       Begin DoDot:2

 +66                       SET DISP=$$GET1^DIQ(9009083,DISP_",",".01","E")

 +67                       IF DISP["HOME"

                               SET DIS="D"

 +68                       IF DISP["TRANS"

                               SET DIS="T"

 +69                       IF DISP["ADMIT"

                               SET DIS="A"

 +70                       IF DISP["LEFT"

                               SET DIS="1"

 +71                       IF DISP["REGIS"

                               SET DIS="O"

 +72                       IF DISP["EXPIRED"

                               SET DIS="E"

 +73                       IF DISP["DEA"

                               SET DIS="E"

 +74                       IF DISP]""

                               IF DIS=""

                                   SET DIS="O"

 +75                       SET VERUPD(9000010.29,ERIEN_",",.11)=$SELECT(DIS]"":DIS,1:"@")

                       End DoDot:2

 +76      ;

 +77      ;DEPARTURE DATE&TIME

 +78               SET DISDT=$$GET1^DIQ(9009080,ERVIEN_",","6.2","I")

 +79               SET VERUPD(9000010.29,ERIEN_",",".13")=$SELECT(DISDT]"":DISDT,1:"@")

               End DoDot:1

 +80      ;

 +81      ;Pull from ER ADMISSION if no ER VISIT entry

 +82       IF ERVIEN=""

               Begin DoDot:1

 +83               NEW URG,MOT,MOA,ENTBY

 +84      ;

 +85      ;Urgency

 +86      ;INITIAL ACUITY

                   SET URG=$$GET1^DIQ(9009081,AMERDFN_",",20,"I")

 +87               SET URG=$SELECT(URG=1:"R",URG=2:"E",URG=3:"U",URG=4:"L",URG=5:"N",1:"@")

 +88               SET VERUPD(9000010.29,ERIEN_",",.04)=URG

 +89      ;

 +90      ;Method of Transport

 +91               SET (ENTBY,MOA)=""

                   SET MOT=$$GET1^DIQ(9009081,AMERDFN_",","6","I")

                   IF MOT'=""

                       Begin DoDot:2

 +92      ;

 +93      ;Means of Arrival

 +94                       SET MOT=$$GET1^DIQ(9009083,MOT_",",".01","E")

 +95                       IF MOT["WALK"

                               SET MOA="W"

 +96                       IF MOT["AMBULANCE"

                               SET MOA="A"

 +97                       IF MOA=""

                               SET MOA="O"

 +98      ;

 +99      ;Entered ER By

 +100                      IF MOT["AMBULANCE"

                               SET ENTBY="A"

 +101                      IF MOT["WHEEL"

                               SET ENTBY="W"

 +102                      IF MOT["STRET"

                               SET ENTBY="S"

 +103     ;

 +104     ;MEANS OF ARRIVAL

                           SET VERUPD(9000010.29,ERIEN_",",.05)=$SELECT(MOA]"":MOA,1:"@")

 +105     ;ENTERED ER BY

                           SET VERUPD(9000010.29,ERIEN_",",.07)=$SELECT(ENTBY]"":ENTBY,1:"@")

                       End DoDot:2

               End DoDot:1

 +106     ;

 +107     ;File the entry

 +108      DO FILE^DIE("","VERUPD","ERROR")

 +109     ;

 +110     ;Mark the visit as being modified

 +111      NEW D

           SET AUPNVSIT=AMERPCC

           DO MOD^AUPNVSIT

           KILL D

 +112     ;

 +113      QUIT

AMERVER.m