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

AMEREDTT.m

Go to the documentation of this file. 
  1. AMEREDTT ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of Triage Information
  1.  ;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
  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. ADMTRIAG(AMERDA,AMERAIEN)  ; EP from AMEREDIT
  1.  N AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,DIC,AMERSKIP
  1.  S (AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR)=""
  1.  Q:'$D(^XUSEC("AMERZ9999",DUZ)) $$ERSEDTT(AMERDA,AMERAIEN)  ; PROGRAMATICALLY locking fields that pass to PCC
  1.  S AMERSKIP=0
  1.  ; ED PROVIDER
  1.  N DIC,DIR
  1.  S DIC("A")="*ED Provider: "
  1.  S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,6)
  1.  ;screening so that only valid PCC providers identified
  1.  S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
  1.  I AMEROLD'="" S DIC("B")=$P(^VA(200,AMEROLD,0),U)
  1.  S DIC="^VA(200,",DIC(0)="AEQ"   ;
  1.  D ^DIC
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
  1.  I Y>0 S AMERNEW=+Y
  1.  E  S AMERNEW=""
  1.  I AMEROLD=AMERNEW D
  1.  .I AMERNEW="" S AMERSKIP=1 Q
  1.  .; If discharge provider is same as ED provider, don't let 'em delete it
  1.  .I AMERNEW=$P($G(^AMERVSIT(AMERDA,6)),U,3) D  Q
  1.  ..D EN^DDIOL("ED provider is same as DISCHARGE provider","","!!")
  1.  ..D EN^DDIOL("cannot remove ED provider until DISCHARGE provider is updated","","!")
  1.  ..D EN^DDIOL("","","!!")
  1.  .S DIR("A")="Do you want to REMOVE this provider from the ER VISIT"
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .D ^DIR
  1.  .I Y=1 D
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_".06////@;12.1////@"  ;delete any time as well
  1.  ..S AMERNEW="",AMERSKIP=1
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  .Q
  1.  I AMEROLD'=AMERNEW D
  1.  .S DR=$S(DR'="":DR_";",1:""),DR=DR_".06////"_AMERNEW
  1.  .S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
  1.  .S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU(".06",AMEROLD,AMERNEW,"INITIAL ED PROVIDER")
  1.  .I AMERSTRG="^" S AMERQUIT=1,DR="" Q
  1.  .S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  .Q
  1.  K DIC,DIR
  1.  ; DOC TIME
  1.  N DIR
  1.  S AMEROLD=$P($G(^AMERVSIT(AMERDA,12)),U,1)
  1.  I AMEROLD'="" S Y=AMEROLD  X ^DD("DD") S DIR("B")=Y
  1.  S DIR(0)="DO^::ER",DIR("A")="*What was the ED Provider Medical Screening Exam Time"
  1.  S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  F  Q:Y="^"!(Y="")  D
  1.  .D ^DIR
  1.  .I $D(DUOUT)!$D(DTOUT) Q
  1.  .S AMERNEW=Y
  1.  .I AMERNEW,$$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
  1.  .I AMERNEW="" D
  1.  ..I AMEROLD=AMERNEW  S Y="^" Q
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.1////@"
  1.  ..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")  ;tranforms fileman date into user friendly date
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"INITIAL ED PROVIDER TIME")
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ..S Y="^"
  1.  ..Q
  1.  .Q:AMERNEW=""
  1.  .D:'$$TCK^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,1,"admission")
  1.  ..I AMEROLD=AMERNEW  S Y="^" Q
  1.  ..I AMEROLD'=AMERNEW D
  1.  ...S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.1////"_AMERNEW
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")  ;tranforms fileman date into user friendly date
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.1",AMEROLD,AMERNEW,"INITIAL ED PROVIDER TIME")
  1.  ...I AMERSTRG="^" Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S Y="^"
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT  Q 0
  1.  D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  I DR'="" D DIE^AMEREDIT(AMERDA,DR)
  1.  S (DR,AMEREDTS)=""
  1.  K DIR
  1.  ; TRIAGE NURSE
  1.  N DIC,DIR
  1.  S DR="",AMERSKIP=0
  1.  S DIC("A")="*Triage nurse: " K DIC("B")
  1.  S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,7)
  1.  I AMEROLD'="" S DIC("B")=$P($G(^VA(200,AMEROLD,0)),U)
  1.  S DIC="^VA(200,",DIC(0)="AEQM"
  1.  ;screening so that only valid PCC providers identified
  1.  S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
  1.  D ^DIC K DIC
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) Q 0
  1.  I Y>0 S AMERNEW=+Y
  1.  E  S AMERNEW=""
  1.  I AMEROLD=AMERNEW D
  1.  .I AMERNEW="" S AMERSKIP=1 Q
  1.  .; If discharge nurse is same as admitting nurse, don't let 'em delete it
  1.  .I AMERNEW=$P($G(^AMERVSIT(AMERDA,6)),U,4) D  Q
  1.  ..D EN^DDIOL("TRIAGE nurse is same as DISCHARGE nurse","","!!")
  1.  ..D EN^DDIOL("cannot remove TRIAGE nurse until DISCHARGE nurse is updated","","!")
  1.  ..D EN^DDIOL("","","!!")
  1.  ..Q
  1.  .S DIR("A")="Do you want to REMOVE this Triage nurse from this visit"
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .D ^DIR K DIR
  1.  .I Y=1 D
  1.  ..S AMERNEW="",AMERSKIP=1
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_".07////@;12.2////@"
  1.  ..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  .Q
  1.  I AMEROLD'=AMERNEW D
  1.  .S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"N") ;translates from new person ien to name
  1.  .S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"N")
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU(".07",AMEROLD,AMERNEW,"TRIAGE NURSE")
  1.  .I AMERSTRG="^" Q
  1.  .S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  .S DR=$S(DR'="":DR_";",1:""),DR=DR_".07////"_+Y
  1.  .Q
  1.  K DIR,DIC
  1.  ; TRIAGE TIME
  1.  N DIR
  1.  S AMEROLD=$P($G(^AMERVSIT(AMERDA,12)),U,2)
  1.  I AMEROLD'="" S Y=AMEROLD X ^DD("DD") S DIR("B")=Y
  1.  S DIR(0)="D^::ER",DIR("A")="*What time did the patient see the triage nurse"
  1.  S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  F  Q:Y="^"!(Y="")  D
  1.  .D ^DIR K DIR
  1.  .I $D(DUOUT)!$D(DTOUT) Q
  1.  .S AMERNEW=Y
  1.  .I AMERNEW,$$TVAL^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),AMERNEW,6) Q
  1.  .I AMERNEW="" D
  1.  ..I AMEROLD=AMERNEW  S Y="^" Q
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.2////@"
  1.  ..S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D") ;tranforms fileman date into user friendly date
  1.  ..S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW)
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ..S Y="^"
  1.  ..Q
  1.  .Q:AMERNEW=""
  1.  .D:'$$TCK^AMER2A($P($G(^AMERVSIT(AMERDA,0)),U,1),Y,1,"admission")
  1.  ..I AMEROLD=AMERNEW  S Y="^" Q
  1.  ..I AMEROLD'=AMERNEW D
  1.  ...S DR=$S(DR'="":DR_";",1:""),DR=DR_"12.2////"_AMERNEW
  1.  ...S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"D")  ;tranforms fileman date into user friendly date
  1.  ...S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"D")
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("12.2",AMEROLD,AMERNEW,"TRIAGE TIME")
  1.  ...I AMERSTRG="^" Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S Y="^"
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;Edit the Decision to Admit Date
  1.  D
  1.  . NEW AMERRUN,AMERSTRT,AMERFIN,X,Y,AMERPCC,AUPNVSIT,AMEROLD,AMERNEW,AMERSTRG
  1.  . ;
  1.  . ;Get the visit
  1.  . S AMERPCC=$$GET1^DIQ(9009080,AMERDA_",",.03,"I") Q:AMERPCC=""
  1.  . ;
  1.  . ;Get the old value
  1.  . S AMEROLD=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
  1.  . ;
  1.  . ;Call the edit
  1.  . D QD28^AMER2A(AMERPCC)
  1.  . ;
  1.  . ;Get the new value
  1.  . S AMERNEW=$$GET1^DIQ(9000010,AMERPCC_",",1116,"E")
  1.  . ;
  1.  . ;Perform Audit
  1.  . I AMEROLD'=AMERNEW D
  1.  .. S AMERSTRG=$$EDAUDIT^AMEREDAU("12.8",AMEROLD,AMERNEW,"DECISION TO ADMIT DT")
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  . ;
  1.  . ;Update ^AMERVSIT
  1.  . S AUPNVSIT=AMERPCC
  1.  . D MOD^AUPNVSIT
  1.  ;
  1.  S DR=$G(DR),AMEREDTS=$G(AMEREDTS)
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT  Q 0
  1.  I DR'="" D DIE^AMEREDIT(AMERDA,DR)
  1.  D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  S (DR,AMEREDTS)=""
  1.  K DIR
  1.  K AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,DR,DIR,AMERSKIP
  1.  D EN^DDIOL("ERS PCC Data Entry is complete for this option","","!!")
  1.  S DIR("A")="Edit more TRIAGE data"
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  I Y=1 Q $$ERSEDTT(AMERDA,AMERAIEN)
  1.  Q 1
  1. ERSEDTT(AMERDA,AMERAIEN)  ;SUBROUTINE FOR EDIT OF ERS FIELDS THAT DO NOT PASS TO PCC
  1.  S (AMERDR,AMEROLD,AMERNEW,AMEREDTS,AMERSTRG,AMERQUIT)=""
  1.  ; INITIAL TRIAGE
  1.  N DIR
  1.  S AMEROLD=$P($G(^AMERVSIT(AMERDA,0)),U,24)
  1.  I AMEROLD'="" S DIR("B")=AMEROLD
  1.  S DIR(0)="N^1:5:0",DIR("A")="Enter initial triage assessment from RN"
  1.  S DIR("?")="Enter a number from 1 to 5"
  1.  S DIR("?",1)="This is a site-specified value that indicates severity of visit"
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) Q 0
  1.  S AMERNEW=+Y
  1.  I (AMERNEW'=AMEROLD) D
  1.  .S DR=".24////"_AMERNEW
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU(".24",AMEROLD,AMERNEW,"INITIAL ACUITY")
  1.  .I AMERSTRG="^" Q
  1.  .D DIE^AMEREDIT(AMERDA,DR)
  1.  .D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  .Q
  1.  ;Work related
  1.  N DIR
  1.  S AMEROLD=$G(^AMERVSIT(AMERDA,2.1))
  1.  S DIR("B")=$S(AMEROLD=0:"NO",AMEROLD=1:"YES",1:"NO")
  1.  I DIR("B")="NO" S AMEROLD=0  ;NULL VALUE WILL BE UPDATED WITH 0
  1.  S DIR(0)="YO",DIR("A")="Was this ER visit WORK-RELATED"
  1.  D ^DIR
  1.  I $D(DUOUT)!$D(DTOUT)!(Y<0) K DUOUT,DTOUT,Y Q 0
  1.  S AMERNEW=Y
  1.  Q:Y<0
  1.  I AMEROLD'=AMERNEW D
  1.  .S DR="2.1///"_Y
  1.  .S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"B") ;TRANSLATE FROM 0 TO "NO"
  1.  .S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"B")
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU("2.1",AMEROLD,AMERNEW,"WORK RELATED")
  1.  .D DIE^AMEREDIT(AMERDA,DR)
  1.  .S DR=""
  1.  .D:AMERSTRG'="" DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
  1.  .S AMERSTRG=""
  1.  .Q
  1.  K DIR
  1.  Q 1