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

AMERSAV1.m

Go to the documentation of this file. 
  1. AMERSAV1 ; IHS/ANMC/GIS - PUT ENTRY IN ER VISIT FILE ;   
  1.  ;;3.0;ER VISIT SYSTEM;**6**;MAR 03, 2009;Build 30
  1.  ;
  1. RUN() ; EP from AMERSAVE
  1.  D COMP
  1.  D TRANS ; HER TRANSFER FIELDS
  1.  S AMERDA=$$DIC(AMERDR(.01)) I 'AMERDA Q 0
  1.  F AMERX=1,1.1,2,2.1,12 S %=$G(AMERDR(AMERX)) I %]"" D DIE(AMERDA,%)
  1.  ; Save identified "clinic" into ER VISIT
  1.  F AMERX=2:1:7 S %=$G(AMERDRI(AMERX)) I %]"" D DIE(AMERDA,%) ; INJURY INFO
  1.  ;IHS/OIT/SCR 12/15/08 - update ER VISIT FILE with DATE LAST UPDATED (NOW)
  1.  D TIMESTMP(AMERDA)
  1.  D MULT(AMERDA)
  1.  D KILL
  1.  D EXIT
  1.  Q AMERDA
  1.  ;
  1. EXIT K ZTRTN,ZTIO,ZTDESC,ZTSAVE,AMERDR,ZTDTH,AMERX
  1.  K AMERDRI
  1.  Q
  1. COMP ; COMPUTED FIELDS
  1. C0 ; REVOLVING DOOR
  1.  N X,Y,Z,%,%H,%T,%Y,AMERDFN S AMERDFN=+$P(AMERDR(1),".02////",2)
  1.  S Z=AMERDR(.01)
  1.  S %=0 F X=0:0 S X=$O(^AMERVSIT("AC",AMERDFN,X)) Q:'X  S Y=+^AMERVSIT(X,0) I Y>%,Y'>Z S %=Y
  1.  I '% G C1
  1.  S %=$$DT^AMERSAV1(Z,%,"D")
  1.  I %<366 S AMERDR(2)=AMERDR(2)_";8.2////"_%
  1. C1 ; INJURY TRANSPORT LAG
  1.  S X=$$VAL^AMERSAV1("QD32",3) I 'X G C2
  1.  S %=$$DT(Z,X,"M"),AMERDR(2)=AMERDR(2)_";8.1////"_%
  1. C2 ; DOC WAIT
  1.  S X=$$VAL("QD25",12) I 'X G C3
  1.  S %=$$DT(X,Z,"M"),AMERDR(12)=AMERDR(12)_";12.3////"_%
  1. C3 ; TRIAGE WAIT
  1.  S X=$$VAL("QD24",12) I 'X G C4
  1.  S %=$$DT(X,Z,"M"),AMERDR(12)=AMERDR(12)_";12.4////"_%
  1. C4 ; VISIT DURATION
  1.  S X=$$VAL("QD19",2) I 'X G CEXIT
  1.  S %=$$DT(X,Z,"M"),AMERDR(12)=AMERDR(12)_";12.5////"_%
  1. CEXIT K A,B,C,E,X,%,%H,Z
  1.  Q
  1.  ;
  1. KILL I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;
  1. DIC(X) ; GIVEN A ADMISSION TIMESTAMP, CREATE AN ENTRY IN THE ER VISIT FILE AND RETURN THE IEN
  1.  I '$G(X) Q ""
  1.  N Y,DIC
  1.  S DIC="^AMERVSIT(",DIC(0)="L",DIADD=1
  1.  K DD,DO
  1.  D FILE^DICN
  1.  I Y=-1 Q ""
  1.  Q +Y
  1.  ;
  1. DIE(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE ER VISIT FILE
  1.  N X,Y,%
  1.  N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
  1.  S DIE="^AMERVSIT("
  1. DIE1 L +^AMERVSIT:3 E  Q
  1.  D ^DIE
  1.  L -^AMERVSIT
  1.  Q
  1.  ;
  1. MULT(AMERDA) ; SUBENTRIES
  1.  N DA,DIC,X,Y,AMERX,AMERI,AMERY,AMERY2,DR,DIE,D,D0,DICR,DIG,DIH,DIV,DIU,DIW,DQ
  1.  S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),4,",DIC(0)="L",DIC("P")=$P(^DD(9009080,4,0),U,2) ; PROCEDURES
  1.  F AMERI=1:1 S AMERX=$P($G(AMERDR(4)),U,AMERI) Q:AMERX=""  S X="`"_AMERX D ^DIC
  1.  S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),5,",DIC(0)="L",DIC("P")=$P(^DD(9009080,5,0),U,2) ; DIAGNOSES
  1.  F AMERI=1:1 S AMERX=$P($G(AMERDR(6)),U,AMERI) Q:AMERX=""  D
  1.  .S X="`"_AMERX
  1.  .D ^DIC
  1.  .S %=$G(AMERDR(6,AMERI)) I %]""
  1.  .S DIE=DIC,DA=+Y,DR="1////"_$E(%,1,80)
  1.  .D ^DIE
  1.  S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),9,",DIC(0)="L",DIC("P")=$P(^DD(9009080,9,0),U,2) ; PT ED TOPICS
  1.  F AMERI=1:1 S AMERX=$P($G(AMERDR(5)),U,AMERI) Q:AMERX=""  S X="`"_AMERX D ^DIC
  1.  S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),19,",DIC(0)="LN",DIC("P")=$P(^DD(9009080,19,0),U,2) ; ER CONSULTANTS
  1.  F AMERI=1:1 S AMERX=$P($G(AMERDR(3)),U,AMERI)  Q:AMERX=""  D
  1.  .S X="`"_AMERX
  1.  .D ^DIC Q:Y=-1
  1.  .S AMERY=$G(AMERDR(3,AMERI,.02)),AMERY2=$G(AMERDR(3,AMERI,.03))
  1.  .S DIE=DIC,DA=+Y,DR=".02////"_AMERY_";.03////"_AMERY2
  1.  .D DIE1
  1.  S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),18,",DIC(0)="L",DIC("P")=$P(^DD(9009080,18,0),U,2) ; HER TRANSFER FACILITIES
  1.  F AMERI=1:1 S AMERX=$P($G(AMERDR(18)),U,AMERI) Q:AMERX=""  D
  1.  . S X=+AMERX,AMERY=$P(AMERX,";",2)
  1.  . D ^DIC I Y=-1 Q
  1.  . S DIE=DIC,DA=+Y,DR=".02////"_AMERY
  1.  . D DIE1
  1.  Q
  1.  ;
  1. DT(X,Y,T) ; EP - ENTRY POINT FROM AMERFIX ;TIME DIFFERENCE
  1.  ; X=T2,Y=T1,T="D":DAYS,T="M":MINUTES
  1.  I '$G(X)!('$G(Y)) Q ""
  1.  I $G(T)="" S T="M"
  1.  N %,A,B,C,E,%T,%H,%Y
  1.  D H^%DTC S A=+%H,B=%T,X=Y
  1.  D H^%DTC S C=+%H,E=%T
  1.  I E>B S B=B+86400,A=A-1
  1.  S %=((A-C)*86400)+(B-E)
  1.  I T="M" S %=%\60
  1.  E  S %=%\86400
  1.  Q %
  1.  ;
  1. VAL(Q,N) ; EP - ENTRY POINT THIS ROUTINE
  1.  ; GETS A NUMERIC/DATE VALUE FROM THE DR STRING
  1.  N %,X
  1.  S %=$O(^AMER(2.3,"B",Q,0)) I '% Q ""
  1.  S %=$G(^AMER(2.3,%,0)),%=$P(%,U,5) I '% Q ""
  1.  I $P(Q,"QD",2)>30 S X=+$P($G(AMERDRI(N)),(%_"////"),2) Q X
  1.  S X=+$P(AMERDR(N),(%_"////"),2)
  1.  Q X
  1.  ;
  1. INJ ; EP - ENTRY POINT CALLED BY AMERSAV ;INJURY ENTRIES
  1.  N G,X,Y,Z,%,F,N,V
  1.  S G="AMERDRI(N)",X=30
  1.  F  S X=$O(^TMP("AMER",$J,2,X)) Q:'X  S V=^(X) I V]"" D
  1.  . ;
  1.  . ;AMER*3.0*6;No longer convert to ICD - Already done
  1.  . ;I X="33" S V=$G(^AMER(3,+V,"ICD")) I V="" Q  ; CONVERT CAUSE OF INJURY OPTION TO ICD CODE
  1.  . S Y="QD"_X,Z=$O(^AMER(2.3,"B",Y,0)) I Y="" Q
  1.  . S N=X\10,F=$P($G(^AMER(2.3,Z,0)),U,5) I 'F Q
  1.  . S %=$G(@G) I %]"" S %=%_";"
  1.  . S %=%_F_"////"_V,@G=%
  1.  . Q
  1.  ;
  1.  Q
  1.  ;
  1. TRANS ; HER TRANSFER FIELDS
  1.  N %,STG S STG=""
  1.  S %=+$P($G(AMERDR(1)),"17.2////",2)
  1.  I % S STG=%_";"_"A"
  1.  S %=+$P($G(AMERDR(2)),"6.6////",2)
  1.  I %,STG'="" S STG=STG_U
  1.  I % S STG=STG_%_";"_"D"
  1.  S AMERDR(18)=STG
  1.  Q
  1. TIMESTMP(AMERIEN)  ;UPDATE 'DATE LAST MODIFIED' IN ER VISIT FILE WITH CURRENT TIME
  1.  ;IHS/SCR/OIT 12/15/08 - ADDED FUNCTION TO STAMP A MODIFIED ER VISIT WITH CURRENT TIME
  1.  N X,Y,%
  1.  N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ,DA
  1.  S DA=AMERIEN
  1.  D NOW^%DTC
  1.  S DR="12.6///"_%
  1.  S DIE="^AMERVSIT("
  1.  L +^AMERVSIT(AMERIEN):3 E  Q
  1.  D ^DIE
  1.  L -^AMERVSIT(AMERIEN)
  1.  K DIE,DA,DR
  1.  Q