Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMEREDTA

AMEREDTA.m

Go to the documentation of this file. 
  1. AMEREDTA ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ADMIT information
  1.  ;;3.0;ER VISIT SYSTEM;**2,10**;MAR 3, 2009;Build 23
  1.  ;
  1.  ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
  1.  ;
  1.  ; VARIABLES: The following variables are passed to multiple editing routines
  1.  ; AMERDA  : the IEN of the ER VISIT that is selected for editing
  1.  ;  AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
  1.  ;  AMEREDNO: An integer representing the number of multiple fields that have been edited
  1.  ;            for uniqueness in multiple field number in audit file
  1.  ;            
  1.  ; Edit Auditing VARIABLES newed and used throughout edit routines:
  1.  ;      AMEROLD : original value of edited field
  1.  ;      AMERNEW : new value of edited field
  1.  ;      AMERSTRG : A ";" deliminated string of edit information for a field   
  1.  ;              
  1. EDADMIT(AMERDA,AMERAIEN)   ;EP - CALLED BY AMEREDIT when "ADMIT" is selected for editing
  1.  N AMERCHRT,AMERDOB,AMERSEX,AMERDR,DIR,Y,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
  1.  N AMERQUIT,AMERISNW,AMERONAM,AMERNNAM,AMERANS,AMEROTIM,AMERNTIM,X
  1.  S (AMERCHRT,AMERDOB,AMERSEX,AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTIM)=""
  1.  Q:'$D(^XUSEC("AMERZ9999",DUZ)) $$ERSEDTA(AMERDA,AMERAIEN)
  1.  D EN^DDIOL("**Changing the PATIENT will change chart number, age and other fields**","","!!?3")
  1.  D EN^DDIOL("*** AND will also cause a new PCC VISIT to be created ***","","!?10")
  1.  S DIR(0)="Y",DIR("A")="Change Patient",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT Q 0
  1.  I Y=1 D
  1.  .S (AMERDFN,AMEROLD)=$P($G(^AMERVSIT(AMERDA,0)),U,2)
  1.  .S AMERISNW=$$NEWREG^AMERVSIT(AMERDFN,AMERDA)
  1.  .I AMERISNW  D  ;THIS PATIENT WAS CREATED THE SAME DAY AS THIS VISIT
  1.  ..D EN^DDIOL("The patient record was created on the same day as the ER VISIT being edited","","!")
  1.  ..S DIR(0)="SO^1:UPDATE NEW PATIENT RECORD;2:REPLACE WITH AN EXISITING PATIENT"
  1.  ..S DIR("A")="Which would you like to do"
  1.  ..D ^DIR K DIR
  1.  ..Q:Y=""!(Y="^")
  1.  ..S AMERANS=Y
  1.  ..I AMERANS=1 D   ;PATIENT DFN DOES NOT CHANGE, BUT INFORMATION IN IT DOES
  1.  ...S AMERONAM=$P($G(^DPT(AMERDFN,0)),U,1)
  1.  ...S AMERCHNG=$$UPDATPAT^AMERVSIT(AMERDFN)  ;CALLS PATIENT REG PEPs TO UPDATE FIELDS ORIGINALLY ENTERED
  1.  ...Q:AMERCHNG=0
  1.  ...S AMERCHRT=$P($G(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
  1.  ...S AMERSEX=$P($G(^DPT(AMERDFN,0)),U,2)
  1.  ...S AMERDOB=$P($G(^DPT(AMERDFN,0)),U,3)
  1.  ...S AMERNNAM=$P($G(^DPT(AMERDFN,0)),U,1)
  1.  ...;S AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
  1.  ...S AMERDR=".12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$G(DUZ)  ;IHS/OIT/SCR 071509 patch 2
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMERONAM,AMERNNAM,"PATIENT")
  1.  ...I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ...D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  ...D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ...Q
  1.  ..I AMERANS=2 D
  1.  ...S AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW) ;THIS ROUTINE REMOVES V POV AND V PROVIDER ENTRIES FOR THE VISIT ASSOCIATED TO THE OLD DFN
  1.  ..Q
  1.  .I 'AMERISNW S AMERDFN=$$CHANGPAT^AMERVSIT(AMEROLD,AMERDA,AMERISNW)
  1.  .I AMERDFN=0 Q  ;$$CHANGPAT RETURNS 0 IF USER HAS TIMED OR UPPED OUT
  1.  .I AMEROLD'=AMERDFN D
  1.  ..S AMERCHRT=$P($G(^AUPNPAT(AMERDFN,41,DUZ(2),0)),U,2)
  1.  ..S AMERSEX=$P($G(^DPT(AMERDFN,0)),U,2)
  1.  ..;S AMERDOB=$P($G(^DPT(AMERDFN,0)),U,3)
  1.  ..S AMERDOB=$$DOB^AUPNPAT(AMERDFN)  ;IHS/OIT/SCR 071509 patch 2
  1.  ..;S AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19///"_$G(DUZ)
  1.  ..S AMERDR=".02////"_AMERDFN_";.13////"_AMERCHRT_";.12///"_AMERDOB_";.18///"_AMERSEX_";.19////"_$G(DUZ)  ;IHS/OIT/SCR 071509 patch 2
  1.  ..S AMERNEW=$$EDDISPL^AMEREDAU(AMERDFN,"P")
  1.  ..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"P")
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU(".02",AMEROLD,AMERNEW,"PATIENT")
  1.  ..I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ..D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  ..D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ..D SYNCHPCC^AMERPCC(AMERDA)  ;THIS ROUTINE ADDS THE V PROVIDER AND V POV ENTRIES TO THE NEW VISIT CREATED FOR THIS PATIENT
  1.  ..Q
  1.  .Q
  1.  Q:AMERQUIT 0
  1.  S AMERDR=""
  1.  D EN^DDIOL("**Changing the ADMISSION TIME can cause other time related data to be deleted**","","!!")
  1.  S DIR(0)="Y",DIR("A")="Change Admission Time",DIR("B")="NO"
  1.  D ^DIR
  1.  I $D(DUOUT)!$D(DTOUT)!(Y<0) K DIR,DUOUT,DTOUT,Y Q 0
  1.  I Y=1 D
  1.  .S DIR(0)="D^::ER",DIR("A")="Date and time of admission to ER"
  1.  .S (Y,AMEROTIM)=$P($G(^AMERVSIT(AMERDA,0)),U,1)
  1.  .D DD^%DT
  1.  .S DIR("B")=Y
  1.  .S DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
  1.  .D ^DIR K DIR
  1.  .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q
  1.  .I Y>0 D
  1.  ..S AMERDR=".01///"_Y,AMERNTIM=Y
  1.  ..I AMERNTIM'=AMEROTIM D
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNTIM,"D")  ;tranforms fileman date into user friendly date
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROTIM,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU(".01",AMEROLD,AMERNEW,"ADMISSION TIMESTAMP")
  1.  ...I AMERSTRG="^" Q
  1.  ...D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ...D DIE^AMEREDIT(AMERDA,AMERDR)  ;Updates the AMERVSIT with correct time
  1.  ...D UPDTVTIM^AMERVSIT(AMERDA,AMEROTIM,AMERNTIM)  ;looks up PCC VISIT with old time and updates it with new time
  1.  ...D CHKTIME^AMERTIME(AMERNTIM,AMERAIEN)
  1.  ...Q
  1.  ..I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ..S AMERDR=""
  1.  ..Q
  1.  .Q
  1.  Q:AMERQUIT 0
  1.  ;
  1.  ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Save updated clinic and hospital location
  1.  ;Reworked entire section to save custom clinics and differing hospital locations
  1.  ;
  1.  ;allow user to update "clinic type"
  1.  D EN^DDIOL("","","!")
  1.  ;S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,4)
  1.  ;S:AMEROLD'="" DIC("B")=$P($G(^AMER(3,AMEROLD,0)),U,1)
  1.  ;S DIC("A")="Clinic type (EMERGENCY or URGENT): "
  1.  ;S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE"),DIC(0)="AEQ"
  1.  ;D ^DIC K DIC
  1.  ;I $D(DUOUT)!$D(DTOUT) K DIC,DUOUT,DTOUT Q 0
  1.  ;S AMERNEW=$P(Y,U,1)
  1.  ;I AMEROLD'=AMERNEW D
  1.  ;.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"L")
  1.  ;.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"L")
  1.  ;.S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
  1.  ;.I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ;.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".04///"_AMERNEW
  1.  ;.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ;.D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  ;.S (AMERDR,Y,AMERNEW,AMEROLD)=""
  1.  ;.Q
  1.  N VIEN,NCLN,OCLN
  1.  ;
  1.  ;Get visit
  1.  S VIEN=$$GET1^DIQ(9009080,AMERDA_",",.03,"I") I VIEN="" Q 0
  1.  ;
  1.  ;Update clinic
  1.  S (NCLN,OCLN,AMERQUIT)=""
  1.  I VIEN>0 D
  1.  .NEW DIC,X,Y,AMERCLN,AMERTYP,AMERDR
  1.  .S DIC("B")=""
  1.  .S AMERCLN=$$GETCLN^AMER2A(VIEN) ;Pull Hospital Location
  1.  .I AMERCLN]"" S OCLN=AMERCLN,DIC("B")=$$GET1^DIQ(9009083,AMERCLN,.01,"E")  ;Get AMER clinic text
  1.  .S DIC="^AMER(3,"
  1.  .S DIC("S")="I '$P(^(0),U,5),$P(^(0),U,2)="_$$CAT^AMER0("CLINIC TYPE")
  1.  .S DIC(0)="AEQ"
  1.  .S DIC("A")="*Clinic type: "
  1.  .D ^DIC I '+Y S AMERQUIT=1 Q
  1.  .S NCLN=+Y
  1.  .S AMERDR=".04///"_NCLN
  1.  .D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  ;
  1.  ;Need to update clinic and hospital location if overrides on file
  1.  I OCLN'=NCLN,VIEN>0,'AMERQUIT D
  1.  . NEW ERR,AMEROLD,AMERNEW
  1.  . ;
  1.  . ;GDIT/HS/BEE 05/10/2018;CR#10213/10423 - AMER*3.0*10 - Save updated clinic and hospital location
  1.  . ;Need to update clinic and hospital location if overrides on file
  1.  . S ERR=$$CKHLOC^AMERBSD(VIEN,NCLN)
  1.  . ;
  1.  . S AMEROLD=$$EDDISPL^AMEREDAU(OCLN,"L")
  1.  . S AMERNEW=$$EDDISPL^AMEREDAU(NCLN,"L")
  1.  . S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",AMEROLD,AMERNEW,"CLINIC TYPE")
  1.  . D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ;
  1.  Q:AMERQUIT 0
  1. PQ  ;NOW allow user to update "presenting complaint'
  1.  S Y=$G(^AMERVSIT(AMERDA,1))
  1.  S AMEROLD=Y
  1.  S:AMEROLD'="" DIR("B")=AMEROLD
  1.  S DIR(0)="FOr^1:80",DIR("A")="Presenting complaint",DIR("?")="Enter free text chief complaint (80 characters max.)"
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT,Y Q 0
  1.  ;IHS/OIT/SCR 071509 patch 2 START CHANGES
  1.  ;D CKSC^AMER1 I $D(AMERCKSC) S Y=DIR("B") K AMERCKSC Q
  1.  D CKSC^AMER1
  1.  I $D(AMERCKSC) D  G PQ
  1.  .S Y=$G(DIR("B"))
  1.  .K AMERCKSC
  1.  .Q
  1.  ;IHS/OIT/SCR 071509 patch 2 END CHANGES
  1.  S AMERNEW=Y
  1.  I AMEROLD'=AMERNEW D
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU("1",AMEROLD,AMERNEW,"PRESENTING COMPLAINT")
  1.  .I AMERSTRG="^" S AMERQUIT=1 Q
  1.  .S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_"1////"_AMERNEW
  1.  .D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  .D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  .S (AMERDR,Y,AMERNEW,AMEROLD)=""
  1.  .Q
  1.  Q:AMERQUIT 0
  1.  D EN^DDIOL("","","!")
  1.  K DIC,AMERDR,DIR,AMEREDTS
  1.  D EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
  1.  S DIR("A")="Edit more admission data"
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I Y=1 Q $$ERSEDTA(AMERDA,AMERAIEN)  ;Return with value that subroutine returns
  1.  Q 1
  1.  ;
  1. ERSEDTA(AMERDA,AMERAIEN)  ;SUBROUTINE TO ISOLATE FIELDS THAT DO NOT GO TO PCC THAT DO NOT REQUIRE A LOCK
  1.  ;NOW allow user to update "visit type"
  1.  N AMERTRAN
  1.  S (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT,AMERTRAN)=""
  1.  D EN^DDIOL("","","!")
  1.  S Y=$P($G(^AMERVSIT(AMERDA,0)),U,5)
  1.  S AMEROLD=Y
  1.  S:AMEROLD'="" DIC("B")=AMEROLD
  1.  S DIC="^AMER(3,"
  1.  S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
  1.  S DIC(0)="AEQ"
  1.  S DIC("A")="Visit Type: "
  1.  D ^DIC K DIC
  1.  I $D(DUOUT)!$D(DTOUT) K DIC,DUOUT,DTOUT Q 0
  1.  S AMERNEW=$P(Y,U,1)
  1.  I AMEROLD'=AMERNEW D
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU(".05",$$EDDISPL^AMEREDAU(AMEROLD,"V"),$$EDDISPL^AMEREDAU(AMERNEW,"V"),"VISIT TYPE")
  1.  .I AMERSTRG="^" S AMERQUIT=1 Q
  1.  .S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".05///"_AMERNEW
  1.  .D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  .D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  .;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  .D TIMESTMP^AMERSAV1(AMERDA)
  1.  .S (AMERDR,Y,AMERNEW,AMEROLD)=""
  1.  .Q
  1.  Q:AMERQUIT 0
  1.  ;TRANSFER
  1.  S AMEROLD=""
  1.  S (DIR("B"),AMEROLD)="NO"
  1.  I $P($G(^AMERVSIT(AMERDA,17)),U,1)=1 S (DIR("B"),AMEROLD)="YES"
  1.  S DIR(0)="YO",DIR("A")="*Was this patient transferred from another facility"
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
  1.  S AMERNEW=$$EDDISPL^AMEREDAU(Y,"B") ; "BOOLEAN" translates from 0 to NO
  1.  I AMERNEW'=AMEROLD D
  1.  .S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_"17.1///"_AMERNEW
  1.  .;REMOVE all "MODE OF TRANSPORT" and all ambulance and related info if
  1.  .;MODE OF TRANSPORT is a different type from "TRANSFERED BY" and we just changed
  1.  .S:AMERNEW="YES" AMERDR=$S($D(AMERDR):AMERDR_";",1:""),AMERDR=AMERDR_".25////@;.14////@;.15////@;.21////@"
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU("17.1",AMEROLD,AMERNEW,"TRANSFERED")
  1.  .I AMERSTRG="^" S AMERQUIT=1 Q
  1.  .I AMERNEW="NO" D
  1.  ..;if the original transfered value was "yes" and it is being changed to "no"
  1.  ..;then we have to remove the HER Transfer facility stuff and medical attendant
  1.  ..S AMERDR=$S($D(AMERDR):AMERDR_";",1:""),AMERDR=AMERDR_"17.1////0;17.2////@;17.3////@;17.4////@"
  1.  ..S AMERHERN=0
  1.  ..F  S AMERHERN=$O(^AMERVSIT(AMERDA,18,AMERHERN)) Q:AMERHERN="B"!(AMERHERN="")  I $P($G(^AMERVSIT(AMERDA,18,AMERHERN,0)),U,2)="A" D
  1.  ...S DA=AMERHERN
  1.  ...S DA(1)=AMERDA,DIK="^AMERVSIT(DA(1),18,"
  1.  ...D ^DIK,EN^DIK K DIK  ;Kill the sub-record and Re-index
  1.  ...K DIK,DA(1),DA
  1.  ...Q
  1.  ..Q
  1.  .D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  .D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  .S (AMERDR,Y)=""
  1.  .Q
  1.  I AMERNEW="YES" D TRANSFER^AMEREDTU(AMERDA)
  1.  I AMERNEW="NO" D
  1.  .D EN^DDIOL("**Changing the MODE of TRANSPORT can cause ambulance data to be deleted**","","!!?3")
  1.  .S DIC("A")="Mode of transport to the ER: "
  1.  .S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,25)
  1.  .I AMEROLD="" K DIC("B")
  1.  .I AMEROLD'="" S DIC("B")=$P($G(^AMER(3,AMEROLD,0)),U,1)
  1.  .S (Y,AMEROLD)=$P($G(^AMERVSIT(AMERDA,0)),U,25)
  1.  .S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
  1.  .S DIC(0)="AEQ"
  1.  .D ^DIC K DIC
  1.  .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT,DIC S AMERQUIT=1 Q
  1.  .S AMERNEW=$P(Y,U,1),AMERTRAN=$P(Y,U,2)
  1.  .I AMEROLD'=AMERNEW D
  1.  ..S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".25////"_AMERNEW
  1.  ..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"M") ;TRANSLATE number to MODE OF TRANSPORT description
  1.  ..I AMEROLD["AMBULANCE" S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".14////@;.15////@;.21////@"
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU(".25",AMEROLD,AMERTRAN,"MODE OF TRANSPORT")
  1.  ..I AMERSTRG="^" S AMERQUIT=1 Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)  ;concactonate edit strings
  1.  ..D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  ..D DIE^AMEREDIT(AMERDA,AMERDR)
  1.  ..S (AMERDR,Y)=""
  1.  ..Q
  1.  .I AMERTRAN["AMBULANCE" D AMBULNCE^AMEREDTU
  1.  .Q
  1.  Q:AMERQUIT 0
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
  1.  Q 1