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

AMER.m

Go to the documentation of this file. 
  1. AMER ; IHS/ANMC/GIS - PRIMARY ROUTINE FOR ER ADMISSION ;
  1.  ;;3.0;ER VISIT SYSTEM;**4,5,6**;MAR 03, 2009;Build 30
  1.  ;
  1.  N AMERLINE,AMERPCC,AMERTIME,AMERNEW
  1.  I $D(AMERBFLG) K AMERBFLG S AMERSTRT=10,AMERFIN=14,AMERQSEQ=$G(AMERSSEQ) G RUN
  1. VAR D EXIT1 S AMERSTRT=1,AMERFIN=19
  1. VAR1 S %="",$P(%,"~",80)="",AMERLINE=%
  1.  S AMERVER=$$VERSION^XPDUTL("AMER")
  1.  S AMERSVER=$$VERSION^XPDUTL("PIMS")
  1.  S IOP=0 D ^%ZIS W @IOF,"ER SYSTEM Ver ",AMERVER,": ",$S('$D(AMERDOA):"ADMISSION TO EMERGENCY ROOM",1:"   DOA ADMISSION"),"      ^ = back up     ^^ = quit",!,"Questions preceded by a '*' are MANDATORY.  Enter '??' to see choices."
  1. EDIT ; ENTRY POINT FROM AMER4
  1.  I '$D(AMERTFLG) S AMERQSEQ=""
  1. RUN F AMERRUN=AMERSTRT:1 Q:AMERRUN>AMERFIN  Q:$D(AMERQUIT)  D
  1.  . I '$D(^AMER(2.3,"B",("QA"_AMERRUN))) Q
  1.  . S AMERQNO=AMERRUN
  1.  . I '$D(AMERMAND) W $$LINE("QA"_AMERRUN)
  1.  . D OPT("QA"_AMERRUN)
  1.  . D @("QA"_AMERRUN_"^AMER"_$S(AMERRUN<6:"1",AMERRUN<10:"1B",1:"1"))
  1.  . D SET
  1.  . ;
  1.  . ;AMER*3.0*5;Log activity
  1.  . D
  1.  .. NEW ERIEN,AFIELD,ADMFLD
  1.  .. S AFIELD=""
  1.  .. S ERIEN=$O(^AMER(2.3,"B","QA"_AMERRUN,"")) Q:ERIEN=""
  1.  .. S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.04,"I")
  1.  .. I ADMFLD]"" S AFIELD=$P($G(^DD(9009081,ADMFLD,0)),U)
  1.  .. I AFIELD="" D
  1.  ... S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.05,"I")
  1.  ... I ADMFLD]"" S AFIELD=$P($G(^DD(9009080,ADMFLD,0)),U)
  1.  .. Q:AFIELD=""
  1.  .. ;
  1.  .. ;Now log the activity
  1.  .. I $G(AMERDFN)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Entered Patient ER visit information - "_AFIELD_" ("_AMERDFN_")",AMERDFN)
  1.  . Q
  1.  ;
  1.  ;AMER*3*5;Added auditing call
  1.  I $G(AMERDFN)]"",'$D(^AMERADM(AMERDFN)) D LOG^AMERBUSA("P","A","AMER","AMER: Admitted Patient to the ER",AMERDFN) S AMERNEW=1
  1.  ;
  1.  I $D(AMEREFLG) S AMERNOHS=""
  1.  ;
  1.  ;AMER*3*6;Change batch handling, comment out line, add next line
  1.  ;I $D(AMERBCH) Q  ;NO TEMP FILES SO NO "SAVE" FROM TEMP FILES
  1.  ;
  1.  I $D(AMERBCH),$D(AMERQUIT) Q
  1.  ;
  1.  I $D(AMEREFLG) D  Q
  1.  .S AMERNOHS=""
  1.  .S AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
  1.  .D:AMERPCC>0 VISITIN^AMERPCC(AMERDFN,AMERPCC) ;update VISIT file if it exists
  1.  .Q
  1.  I $D(AMERQUIT) G EXIT
  1.  I '$D(AMERNOHS) D PRINT I $D(AMERQUIT) G EXIT
  1.  D ^AMER0 I $D(AMERQUIT) G EXIT
  1.  ;
  1.  ;AMER*3.0*4
  1.  ;Supply information to BEDD application if loaded
  1.  ;
  1.  ;First see if RPMS patch has been loaded
  1.  I $$VERSION^XPDUTL("BEDD") D
  1.  . ;
  1.  . ;Check if XML portion has been loaded
  1.  . N X
  1.  . S X="BEDDUTW" X ^%ZOSF("TEST") Q:'$T
  1.  . ;
  1.  . ;Check for needed fields
  1.  . I $G(DFN)="" Q
  1.  . S:$G(D0)="" D0=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
  1.  . S:$G(D1)="" D1=$$GET1^DIQ(9009081,DFN_",",1,"I")
  1.  . ;
  1.  . ;Call routine to pass info to BEDD
  1.  . D NEW^BEDDUTIL($G(D),AMERDFN,$G(D0),$G(D1),DFN)
  1.  . ;
  1.  . ;AMER*3*5;Added auditing call
  1.  . I $G(AMERNEW)=1 D LOG^AMERBUSA("P","A","AMER","AMER: Admitted patient to the ED Dashboard",AMERDFN)
  1.  ;
  1.  ;AMER*3*6;Quit if batch
  1.  I $D(AMERBCH) Q
  1.  ;
  1.  W *7,!!,"ER admission data collection is now complete.  Thank you.",!!
  1. EXIT ; ENTRY POINT FROM AMERD
  1.  H 2 I $D(IOF) W @IOF
  1. EXIT1 ; ENTRY POINT FROM AMERD
  1.  K AMERPRV,L,AGMVDF,AMERDA,AMERSSEQ
  1.  K AMERDR,AGE,DFN,DOB,SEX,SSN,AMERNEW
  1.  K AMERQUIT,AMERRUN,AMERLINE,AMERDFN,AMERQNO,AMERQSEQ,AMERSTG,X,Y,Z,F,I,A,%,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX,AMERI,AMERNOHS,DIROUT,DH,AMQQSSEQ
  1.  K D,D0,DA,DD,DI,DIADD,DIC,DICR,DIG,DIH,DIK,DISYS,DIU,DIV,DIW,DO,DQ,DIE,DR,DX,%T,S,DUOUT,DTOUT,DPP,DINUM,DIPGM
  1.  K AUPNDAYS,DIRUT,AMERSTRT,AMERFIN,AMEREFLG,AMER,AMERNV,AMERRV,AMERDEST,AMERTAB,B,C,E,G,H,J,K,N,POP,Q,T,V,SDSEX,%Y,%DT
  1.  K ^TMP("AMER",$J,1),^(2),^(3)
  1.  Q
  1.  ;
  1. SET K AMERMAND I $D(AMERQUIT) Q
  1.  I AMERRUN=98 Q
  1.  I AMERRUN="REG" D REG Q
  1.  I AMERRUN="PRINT" D PRINT S AMERRUN=98 Q
  1.  I AMERRUN="EDIT" S AMERNOHS="" D RESTORE Q
  1.  I X?2."^" W !,*7,"Session terminated..." S AMERQUIT="" Q
  1.  I $E(X)=U S X=U
  1.  I X=U,$D(AMEREFLG),(AMERRUN>AMERFIN) Q
  1.  I X=U,AMERQNO<3 W !,"Session terminated...",*7 S AMERQUIT="" Q
  1.  I Y=""!(Y=-1),'$D(AMEROPT),AMERQNO>2,X'=U D MAND Q
  1.  K AMEROPT
  1.  S AMERQSEQ=AMERQSEQ_AMERQNO_";"
  1.  I X=U S X="^B" D BACK Q
  1.  I Y=""!(Y=-1) Q
  1.  S ^TMP("AMER",$J,1,AMERQNO)=Y
  1.  Q
  1.  ;
  1. OUT ; ENTRY POINT FROM MULTIPLE ROUTINES
  1.  I '$D(POP) S POP=0
  1.  I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DTOUT,DUOUT,POP,DIRUT S AMERQUIT=""
  1.  I $G(X)=U K AMERQUIT
  1.  I $G(X)?2."^" S AMERQUIT=""
  1.  I $D(AMERQUIT) W *7,!,"Session terminated.  No data has been entered!"
  1.  Q
  1.  ;
  1. BACK ; ENTRY POINT FROM AMERD
  1.  S A=$L(AMERQSEQ,";"),AMERRUN=$P(AMERQSEQ,";",A-2)-1,AMERQSEQ=$P(AMERQSEQ,";",1,A-3)_";"
  1.  I AMERRUN=-1 S AMERRUN=999
  1.  Q
  1.  ;
  1. RESTORE ;
  1.  S AMERDFN=+Y,AMERRUN=1
  1.  W *7,!!,"This patient is currently admitted to the ER....",!,"Want to edit his/her ER admission data"
  1.  S %=1 D YN^DICN D OUT I $D(AMERQUIT) Q
  1.  I "Yy"'[$E(%Y) S AMERRUN=0 Q
  1.  D UTL^AMER0(AMERDFN)
  1.  Q
  1.  ;
  1. PRINT ; PRINT HEALTH SUMMARY
  1.  Q
  1.  ;
  1.  W ! S DIC="^APCHSCTL(",DIC(0)="AEQ"
  1.  S DIC("B")="ADULT REGULAR"
  1.  D ^DIC K DIC D OUT I $D(AMERQUIT) Q
  1.  S APCHSTYP=+Y,APCHSPAT=AMERDFN
  1.  D HSOUT^APCHS
  1.  Q
  1.  ;
  1. REG ;
  1.  I $D(AMERDEMO) W !!,"Patient registration not available in demo mode",!! H 2 W *7 Q
  1.  S DOG="" K DFN D ^AGVAR,DOG^AG0
  1.  I '$D(DFN) S AMERQUIT="" G REGEXIT
  1.  ;
  1.  ;AMER*3.0*5;Now log the activity
  1.  D LOG^AMERBUSA("P","A","AMER","AMER: Performed Patient Mini-Registration",DFN)
  1.  S ^TMP("AMER",$J,1,1)=DFN,AMERDFN=DFN,AMERRUN=1
  1. REGEXIT K XY,XYER,AG,AUPDIC,AUPDICW,DIC,DIE,DO,D0,DIU,DIV,DIG,DA,D1,DFN,DIPGM,BS,F,FF,RM,SL,SUB,D,DI,DIH,DOG,DQ,%W,%Y,%,AGOPT,AUPL,AUPQF,AUPX,DIW,DR,%DT
  1.  Q
  1.  ;
  1. MAND ; ENTRY POINT FROM AMERD ; MANDATORY ANSWER
  1.  W *7,!,"This answer is mandatory. If you need help, type '??'."
  1.  S AMERRUN=AMERRUN-1,AMERMAND=""
  1.  Q
  1.  ;
  1. BATCH ; ENTRY POINT FOR BATCH MODE
  1.  S AMERBCH=""
  1. B1 D AMER I $D(AMERQUIT) D EXIT1 K AMERBCH Q
  1.  S AMERSSEQ=$P(AMERQSEQ,";",1,$L(AMERQSEQ,";")-2)_";"
  1.  D VAR^AMERD I $D(AMERQUIT) D EXIT1 K AMERBCH,AMERSSEQ Q
  1.  I $D(AMERDOA) K AMERDOA
  1.  I '$D(AMERBCH) D EXIT1
  1.  G B1
  1.  ;
  1. DOA ; ENTRY POINT FOR DOA
  1.  S AMERDOA=""
  1.  D BATCH,EXIT1 K AMERDOA
  1.  Q
  1.  ;
  1. SCAN ; ENTRY POINT FROM SCAN PT NAME OPTION ;SCAN PT NAMES
  1.  D MSG^AMER1A
  1. SC1 W !!
  1.  ;
  1.  ;Call to patient lookup
  1.  D ^AMERLKP
  1.  I $D(IOF) W @IOF
  1.  D EXIT1^AMER K DIRUT
  1.  Q
  1.  ;
  1. EN1 ; ENTRY POINT FOR MINI REGISTRATION
  1.  D REG
  1.  K A1BETAG,AGDOG,AGDTS
  1.  D EXIT1 I $D(IOF) W @IOF
  1.  Q
  1.  ;
  1. TRG ; ENTRY POINT FOR EDITING TRIAGE NURSE'S FIELDS
  1.  N AMERLINE
  1.  D EXIT1
  1.  S %="",$P(%,"~",80)="",AMERLINE=% K %
  1.  ;S AMERSTRT=1,AMERFIN=27,AMERQSEQ=""   ;IHS/OIT/SCR 01/06/09
  1.  S AMERSTRT=1,AMERFIN=25,AMERQSEQ=""
  1.  S AMERTRG=1
  1.  D EDIT^AMERD
  1.  K AMERTRG,AMERLINE
  1.  Q
  1.  ;
  1. LINE(X) ; QUERY SEPERATOR LINE
  1.  N Y,AMERLINE
  1.  S %="",$P(%,"~",80)="",AMERLINE=% K %
  1.  I $G(X)="" S X="Q"
  1.  S Y=$O(^AMER(2.3,"B",X,"")),Y=$P($G(^AMER(2.3,+Y,0)),U,11)
  1.  I 'Y Q ($C(10)_$C(13)_$C(10)_$C(13)_AMERLINE_$C(10)_$C(13))
  1.  Q ""
  1.  ;
  1. DEMO ; ENTRY POINT FOR DEMO MODE.  NO VISIT CREATED
  1.  S AMERDEMO=1
  1.  D AMER
  1.  K AMERDEMO
  1.  Q
  1.  ;
  1. OPT(X) ; ENTRY POINT FROM AMERD ;OPTIONAL
  1.  K AMEROPT
  1.  N %,Y,Z
  1.  S Y=$O(^AMER(2.3,"B",X,"")) I 'Y Q
  1.  S %=$P($G(^AMER(2.3,Y,0)),U,12)
  1.  I % S AMEROPT=""
  1.  Q
  1.  ;
  1. R1 ;
  1.  Q