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

AMER2.m

Go to the documentation of this file. 
  1. AMER2 ; IHS/ANMC/GIS - ER DISCHARGE DATA COLLECTION ;   
  1.  ;;3.0;ER VISIT SYSTEM;**1,2,6**;MAR 03, 2009;Build 30
  1.  ;
  1. QD1 ; NAME
  1.  I $D(AMERDNA) W !,?5,"*****  PROCESS PATIENT WHO LEFT BEFORE VISIT WAS COMPLETED  *****",!!,*7
  1.  D PICK K ^TMP("AMER TEMP",$J) I $D(AMERQUIT) Q
  1.  D UTL^AMER0(AMERDFN) S (X,Y)=AMERDFN
  1.  I $D(AMERDNA) S AMERRUN=12 Q
  1.  S AMERRUN=19
  1.  Q
  1.  ;
  1. QD2 ; INJURY
  1.  ;
  1.  ;Pull information from Dashboard if populated
  1.  NEW AMERPCC,INJ
  1.  S AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I") I AMERPCC]"",$T(INJURY^BEDDINJ)]"" D
  1.  . NEW INJ,EXEC
  1.  . ;
  1.  . ;Make the dashboard retrieval call
  1.  . S EXEC="D INJURY^BEDDINJ(AMERPCC,.INJ)" X EXEC
  1.  . ;
  1.  . ;If injury not set quit
  1.  . I $G(INJ("ISINJ"))'="YES" Q
  1.  . ;
  1.  . ;Fill in information
  1.  . S ^TMP("AMER",$J,2,2)=1   ;Is Injury
  1.  . S ^TMP("AMER",$J,2,31)=$G(INJ("INLOC"))  ;Injury Town
  1.  . S ^TMP("AMER",$J,2,32)=$G(INJ("INDAT"))  ;Injury Date/Time
  1.  . S ^TMP("AMER",$J,2,33)=$G(INJ("ICIEN"))  ;Injury Cause
  1.  . S ^TMP("AMER",$J,2,34)=$G(INJ("INSET"))  ;Injury Setting
  1.  . S ^TMP("AMER",$J,2,35)=$G(INJ("INJEQ"))  ;Injury Safety
  1.  . S ^TMP("AMER",$J,2,42)=$G(INJ("INSCO"))  ;Driver Insurance Co
  1.  . S ^TMP("AMER",$J,2,43)=$G(INJ("INSPO"))  ;Driver Policy Number
  1.  . S ^TMP("AMER",$J,2,41)=$G(INJ("MVLOC"))  ;MVC Location
  1.  . S ^TMP("AMER",$J,2,5)=$G(INJ("WKREL"))   ;Work related
  1.  ;
  1.  S DIR("B")="NO" I $G(^TMP("AMER",$J,2,2)) S DIR("B")="YES"
  1.  S DIR(0)="YO",DIR("A")="*Was this ER visit caused by an injury" D ^DIR K DIR
  1.  D OUT^AMER
  1.   ;
  1.  ;AMER*3.0*6;Added call to update BEDD
  1.  I Y'["^" S INJ=Y D
  1.  . NEW Y
  1.  . D INJ^AMERBEDD("INJ.Injury",INJ)
  1.  ;
  1.  I Y=U,'$D(AMEREFLG) S AMERFIN=28,AMERRUN=27 Q
  1.  I 'Y,'$G(^TMP("AMER",$J,2,2)),$D(AMEREFLG) S AMERRUN=98 Q
  1.  I Y S AMERRUN=29,AMERFIN=71 Q
  1.  F I=32:1:35,41:1:46,51:1:57,61:1:64,70 K ^TMP("AMER",$J,2,I) ; KILL OFF ALL DESCENDENTS
  1.  S AMERRUN=4
  1.  Q
  1.  ;
  1. QD5 ; WORK RELATED
  1.  S DIR("B")="NO" I $G(^TMP("AMER",$J,2,5)) S DIR("B")="YES"
  1.  S DIR(0)="YO",DIR("A")="*Was this ER visit WORK-RELATED" D ^DIR K DIR
  1.  D OUT^AMER I X=U,'$D(AMEREFLG) ;S AMERFIN=27
  1.  ;
  1.  ;AMER*3.0*6;Added call to update BEDD
  1.  NEW INJ
  1.  I Y'["^" S INJ=Y D
  1.  . NEW Y
  1.  . D INJ^AMERBEDD("INJ.PtInjury.WrkRel",INJ)
  1.  K INJ
  1.  ;
  1.  Q
  1. QD6  ; ER CONSULTANT NOTIFIED
  1.  N DIR
  1.  S DIR("B")="NO" I $G(^TMP("AMER",$J,2,6)) S DIR("B")="YES"
  1.  S DIR(0)="YO",DIR("A")="*Was an ER CONSULTANT notified" D ^DIR K DIR
  1.  D OUT^AMER I X?1."^" Q
  1.  I 'Y K ^TMP("AMER",$J,2,7) S ^TMP("AMER",$J,2,6)=0,AMERRUN=9
  1.  I 'Y,$D(AMEREFLG) S AMERRUN=98
  1.  I 'Y Q
  1.  S ^TMP("AMER",$J,2,6)=1
  1.  Q
  1.  ;
  1. QD7 ; ER CONSULTANT TYPE
  1.  S AMERRUN=9
  1.  N AMERSNO,AMERO,AMERDEL,AMERREM,AMERSTOP,DIC,DIR
  1.  S AMERSNO=1,AMERO=0,AMERREM=0,AMERSTOP=""
  1.  F  S AMERO=$O(^TMP("AMER",$J,2,7,AMERO)) Q:'AMERO  S AMERSNO=AMERSNO+1
  1.  F  Q:AMERSTOP="^"  D
  1.  .S AMERREM=0
  1.  .S DIC="^AMER(2.9,",DIC(0)="AMEQ",Y="",DIC("S")="I $P(^(0),U,2)="""""
  1.  .S AMEROPT="",DIC("A")="*CONSULTANT SERVICE: "
  1.  .S DIC("B")=$P($G(^TMP("AMER",$J,2,7,1)),U,2)
  1.  .D ^DIC
  1.  .I X="",AMERSNO=1 D
  1.  ..S AMERO=0
  1.  ..S AMERO=$O(^TMP("AMER",$J,2,7,AMERO))
  1.  ..I AMERO="" K ^TMP("AMER",$J,2,7) D EN^DDIOL("No ER CONSULTANT notified","","!!")
  1.  ..S AMERSTOP="^"
  1.  ..Q
  1.  .I X?2."^" S DIROUT="",AMERSTOP="^"
  1.  .I "^"[$E(X) S AMERSTOP="^",AMERRUN=9 Q
  1.  .S ^TMP("AMER",$J,2,7,AMERSNO)=Y
  1.  .S ^TMP("AMER",$J,2,7,AMERSNO,.01)=+Y
  1.  .S AMERO=0
  1.  .F  S AMERO=$O(^TMP("AMER",$J,2,7,AMERO)) Q:'AMERO  D
  1.  ..I AMERO'=AMERSNO&($P($G(^TMP("AMER",$J,2,7,AMERO)),U,1)=+Y)  D  ;DUPLICATE ENTRY
  1.  ...K ^TMP("AMER",$J,2,7,AMERSNO)  ;WE JUST ADDED A DUPLICATE TO THE TEMP GLOBAL AND WE WANT IT GONE
  1.  ...S AMERREM=$$REM()
  1.  ...K:AMERREM ^TMP("AMER",$J,2,7,AMERO) ;IF USER ANSWERS YES, DELETE THE ORIGINAL ENTRY
  1.  ...Q
  1.  ..Q
  1.  .Q:AMERREM=1
  1.  .I $E(X)=U S AMERQUIT="",AMERRUN=9 Q
  1.  .D QD8 ;to set time
  1.  .;Get name
  1.  .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERSTOP="^" Q
  1.  .K DIC("B")
  1.  .I $G(^TMP("AMER",$J,2,7,AMERSNO,.03)) S DIC("B")=^TMP("AMER",$J,2,7,AMERSNO,.03)
  1.  .S DIC("A")="*CONSULTANT NAME: "
  1.  .S DIC="^VA(200,",DIC(0)="AEQ"
  1.  .S DIC("?")="Only active providers can be selected"
  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.  .;IHS/OIT/SCR 5/11/09 - REQUIRE CONSULTANT TIME AND NAME OR REMOVE ENTRY
  1.  .;I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERSTOP="^" Q
  1.  .I $D(DUOUT)!$D(DTOUT)!(Y<0) D  Q
  1.  ..K DUOUT,DTOUT S AMERSTOP="^"
  1.  ..K ^TMP("AMER",$J,2,7,AMERSNO)
  1.  ..D EN^DDIOL("No Provider Identified!","","!!")
  1.  ..D EN^DDIOL("Consultant Entry not saved","","!")
  1.  ..Q
  1.  .S:Y>0 ^TMP("AMER",$J,2,7,AMERSNO,.03)=+Y,^TMP("AMER",$J,2,7,AMERSNO)=$G(^TMP("AMER",$J,2,7,AMERSNO))_"^"_Y
  1.  .S DIR("A")="*Was another CONSULTANT notified"
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .D ^DIR
  1.  .I Y=1 D
  1.  ..S AMERSNO=AMERSNO+1,AMEROPT="",AMERSTOP=""
  1.  ..F  S AMERO=$O(^TMP("AMER",$J,2,7,AMERO)) Q:'AMERO  S AMERSNO=AMERSNO+1
  1.  ..Q
  1.  .E  S AMERSTOP="^"
  1.  .Q
  1.  ;if there are no ER CONSUTANTS entered, make sure ER CONSULTANT notified field is NO
  1.  K AMERSNO,AMERO,AMERDEL,AMERREM,AMERSTOP,DIC,DIR
  1.  Q
  1.  ;
  1. QD8 ; ER CONSULTANT TIME
  1.  N Y,DIR
  1.  I $G(^TMP("AMER",$J,2,7,AMERSNO,.02)) S Y=^TMP("AMER",$J,2,7,AMERSNO,.02) X ^DD("DD") S DIR("B")=Y
  1.  ;S DIR(0)="DO^::ER",DIR("A")="*What time did the patient see this CONSULTANT"
  1.  S DIR(0)="D^::ER",DIR("A")="*What time did the patient see this CONSULTANT"   ;IHS/OIT/SCR 050509 Patch 1
  1.  S DIR("?")="Enter an exact date and time in Fileman format (e.g. T@1PM)"
  1.  D ^DIR K DIR
  1.  I Y,$$TCK^AMER2A($G(^TMP("AMER",$J,1,2)),Y,1,"admission") K Y G QD8
  1.  I Y,$$TVAL^AMER2A($G(^TMP("AMER",$J,1,2)),Y,4) K Y G QD8
  1.  E  D
  1.  .S ^TMP("AMER",$J,2,7,AMERSNO,.02)=Y
  1.  .S ^TMP("AMER",$J,2,7,AMERSNO)=$G(^TMP("AMER",$J,2,7,AMERSNO))_"^"_Y
  1.  Q
  1.  ;
  1. REM(AMERO)  ;
  1.  S DIR("A")="This consultant type has already been identified. Do you want to remove it"
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  D ^DIR
  1.  I Y=1 Q 1
  1.  Q 0
  1.  ;
  1. TCK(Z,T,X,A) ; TIME CHECK WHERE Z=TIME,T=COMPARISON TIME,X=1:AFTER,X=0:BEFORE AND A=NARRATIVE
  1.  N %,Y
  1.  I $G(Z)=""!($G(A)="") Q ""
  1.  S Y=Z X ^DD("DD")
  1.  I X,T>Z Q 0
  1.  I 'X,T<Z Q 0
  1.  W !!,*7,"Sorry, this time must be ",$S(X:"AFTER",1:"BEFORE")," the time of ",A,": ",Y,!,"Please try again...",! Q 1
  1.  ;
  1. PREV W !,"You have already selected =>",!
  1.  F %=0:0 S %=$O(^TMP("AMER",$J,2,4,%)) Q:'%  W ?3,$P(^(%),U,2),!
  1.  Q
  1.  ;
  1. PICK ;
  1.  D CHECK^AMER1A I '$D(^AMERADM("B")) S AMERQUIT="" Q
  1.  Q:$D(AMERQUIT)  ;IHS/OIT/SCR 10/14/09 patch 2 beta1
  1. PQ S B="" I I=1 S B=1
  1.  ;PQ S B=""  ;IHS/OIT/SCR patch 2
  1.  S DIR(0)="N",DIR("A")="Select ER patient" S:B DIR("B")=B
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT) S X=U E  S X=Y
  1.  K DIR,Y,DTOUT,DUOUT
  1.  I $E(X)=U S AMERQUIT="" Q
  1.  I X?1."?" S X="??"
  1.  I X="",B'="" S X=1
  1.  I X=+X,$D(^TMP("AMER TEMP",$J,X)) S %=$O(^(X,"")) I % S X="`"_% W "  ",$P($G(^DPT(%,0)),U)
  1.  S DIC="^DPT(",DIC(0)="EQS",DIC("S")="I $D(^AMERADM(Y))"
  1.  S AMERI=I D ^DIC S I=AMERI D OUT^AMER
  1.  K AMERI,DIC,D,B,X,%
  1.  I $D(AMERQUIT) Q
  1.  I Y=-1 G PQ
  1.  S AMERDFN=+Y
  1.  Q