AMER ; IHS/ANMC/GIS - PRIMARY ROUTINE FOR ER ADMISSION ;
;;3.0;ER VISIT SYSTEM;**4,5,6**;MAR 03, 2009;Build 30
;
N AMERLINE,AMERPCC,AMERTIME,AMERNEW
I $D(AMERBFLG) K AMERBFLG S AMERSTRT=10,AMERFIN=14,AMERQSEQ=$G(AMERSSEQ) G RUN
VAR D EXIT1 S AMERSTRT=1,AMERFIN=19
VAR1 S %="",$P(%,"~",80)="",AMERLINE=%
S AMERVER=$$VERSION^XPDUTL("AMER")
S AMERSVER=$$VERSION^XPDUTL("PIMS")
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."
EDIT ; ENTRY POINT FROM AMER4
I '$D(AMERTFLG) S AMERQSEQ=""
RUN F AMERRUN=AMERSTRT:1 Q:AMERRUN>AMERFIN Q:$D(AMERQUIT) D
. I '$D(^AMER(2.3,"B",("QA"_AMERRUN))) Q
. S AMERQNO=AMERRUN
. I '$D(AMERMAND) W $$LINE("QA"_AMERRUN)
. D OPT("QA"_AMERRUN)
. D @("QA"_AMERRUN_"^AMER"_$S(AMERRUN<6:"1",AMERRUN<10:"1B",1:"1"))
. D SET
. ;
. ;AMER*3.0*5;Log activity
. D
.. NEW ERIEN,AFIELD,ADMFLD
.. S AFIELD=""
.. S ERIEN=$O(^AMER(2.3,"B","QA"_AMERRUN,"")) Q:ERIEN=""
.. S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.04,"I")
.. I ADMFLD]"" S AFIELD=$P($G(^DD(9009081,ADMFLD,0)),U)
.. I AFIELD="" D
... S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.05,"I")
... I ADMFLD]"" S AFIELD=$P($G(^DD(9009080,ADMFLD,0)),U)
.. Q:AFIELD=""
.. ;
.. ;Now log the activity
.. I $G(AMERDFN)]"" D LOG^AMERBUSA("P","E","AMER","AMER: Entered Patient ER visit information - "_AFIELD_" ("_AMERDFN_")",AMERDFN)
. Q
;
;AMER*3*5;Added auditing call
I $G(AMERDFN)]"",'$D(^AMERADM(AMERDFN)) D LOG^AMERBUSA("P","A","AMER","AMER: Admitted Patient to the ER",AMERDFN) S AMERNEW=1
;
I $D(AMEREFLG) S AMERNOHS=""
;
;AMER*3*6;Change batch handling, comment out line, add next line
;I $D(AMERBCH) Q ;NO TEMP FILES SO NO "SAVE" FROM TEMP FILES
;
I $D(AMERBCH),$D(AMERQUIT) Q
;
I $D(AMEREFLG) D Q
.S AMERNOHS=""
.S AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
.D:AMERPCC>0 VISITIN^AMERPCC(AMERDFN,AMERPCC) ;update VISIT file if it exists
.Q
I $D(AMERQUIT) G EXIT
I '$D(AMERNOHS) D PRINT I $D(AMERQUIT) G EXIT
D ^AMER0 I $D(AMERQUIT) G EXIT
;
;AMER*3.0*4
;Supply information to BEDD application if loaded
;
;First see if RPMS patch has been loaded
I $$VERSION^XPDUTL("BEDD") D
. ;
. ;Check if XML portion has been loaded
. N X
. S X="BEDDUTW" X ^%ZOSF("TEST") Q:'$T
. ;
. ;Check for needed fields
. I $G(DFN)="" Q
. S:$G(D0)="" D0=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
. S:$G(D1)="" D1=$$GET1^DIQ(9009081,DFN_",",1,"I")
. ;
. ;Call routine to pass info to BEDD
. D NEW^BEDDUTIL($G(D),AMERDFN,$G(D0),$G(D1),DFN)
. ;
. ;AMER*3*5;Added auditing call
. I $G(AMERNEW)=1 D LOG^AMERBUSA("P","A","AMER","AMER: Admitted patient to the ED Dashboard",AMERDFN)
;
;AMER*3*6;Quit if batch
I $D(AMERBCH) Q
;
W *7,!!,"ER admission data collection is now complete. Thank you.",!!
EXIT ; ENTRY POINT FROM AMERD
H 2 I $D(IOF) W @IOF
EXIT1 ; ENTRY POINT FROM AMERD
K AMERPRV,L,AGMVDF,AMERDA,AMERSSEQ
K AMERDR,AGE,DFN,DOB,SEX,SSN,AMERNEW
K AMERQUIT,AMERRUN,AMERLINE,AMERDFN,AMERQNO,AMERQSEQ,AMERSTG,X,Y,Z,F,I,A,%,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX,AMERI,AMERNOHS,DIROUT,DH,AMQQSSEQ
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
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
K ^TMP("AMER",$J,1),^(2),^(3)
Q
;
SET K AMERMAND I $D(AMERQUIT) Q
I AMERRUN=98 Q
I AMERRUN="REG" D REG Q
I AMERRUN="PRINT" D PRINT S AMERRUN=98 Q
I AMERRUN="EDIT" S AMERNOHS="" D RESTORE Q
I X?2."^" W !,*7,"Session terminated..." S AMERQUIT="" Q
I $E(X)=U S X=U
I X=U,$D(AMEREFLG),(AMERRUN>AMERFIN) Q
I X=U,AMERQNO<3 W !,"Session terminated...",*7 S AMERQUIT="" Q
I Y=""!(Y=-1),'$D(AMEROPT),AMERQNO>2,X'=U D MAND Q
K AMEROPT
S AMERQSEQ=AMERQSEQ_AMERQNO_";"
I X=U S X="^B" D BACK Q
I Y=""!(Y=-1) Q
S ^TMP("AMER",$J,1,AMERQNO)=Y
Q
;
OUT ; ENTRY POINT FROM MULTIPLE ROUTINES
I '$D(POP) S POP=0
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DTOUT,DUOUT,POP,DIRUT S AMERQUIT=""
I $G(X)=U K AMERQUIT
I $G(X)?2."^" S AMERQUIT=""
I $D(AMERQUIT) W *7,!,"Session terminated. No data has been entered!"
Q
;
BACK ; ENTRY POINT FROM AMERD
S A=$L(AMERQSEQ,";"),AMERRUN=$P(AMERQSEQ,";",A-2)-1,AMERQSEQ=$P(AMERQSEQ,";",1,A-3)_";"
I AMERRUN=-1 S AMERRUN=999
Q
;
RESTORE ;
S AMERDFN=+Y,AMERRUN=1
W *7,!!,"This patient is currently admitted to the ER....",!,"Want to edit his/her ER admission data"
S %=1 D YN^DICN D OUT I $D(AMERQUIT) Q
I "Yy"'[$E(%Y) S AMERRUN=0 Q
D UTL^AMER0(AMERDFN)
Q
;
PRINT ; PRINT HEALTH SUMMARY
Q
;
W ! S DIC="^APCHSCTL(",DIC(0)="AEQ"
S DIC("B")="ADULT REGULAR"
D ^DIC K DIC D OUT I $D(AMERQUIT) Q
S APCHSTYP=+Y,APCHSPAT=AMERDFN
D HSOUT^APCHS
Q
;
REG ;
I $D(AMERDEMO) W !!,"Patient registration not available in demo mode",!! H 2 W *7 Q
S DOG="" K DFN D ^AGVAR,DOG^AG0
I '$D(DFN) S AMERQUIT="" G REGEXIT
;
;AMER*3.0*5;Now log the activity
D LOG^AMERBUSA("P","A","AMER","AMER: Performed Patient Mini-Registration",DFN)
S ^TMP("AMER",$J,1,1)=DFN,AMERDFN=DFN,AMERRUN=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
Q
;
MAND ; ENTRY POINT FROM AMERD ; MANDATORY ANSWER
W *7,!,"This answer is mandatory. If you need help, type '??'."
S AMERRUN=AMERRUN-1,AMERMAND=""
Q
;
BATCH ; ENTRY POINT FOR BATCH MODE
S AMERBCH=""
B1 D AMER I $D(AMERQUIT) D EXIT1 K AMERBCH Q
S AMERSSEQ=$P(AMERQSEQ,";",1,$L(AMERQSEQ,";")-2)_";"
D VAR^AMERD I $D(AMERQUIT) D EXIT1 K AMERBCH,AMERSSEQ Q
I $D(AMERDOA) K AMERDOA
I '$D(AMERBCH) D EXIT1
G B1
;
DOA ; ENTRY POINT FOR DOA
S AMERDOA=""
D BATCH,EXIT1 K AMERDOA
Q
;
SCAN ; ENTRY POINT FROM SCAN PT NAME OPTION ;SCAN PT NAMES
D MSG^AMER1A
SC1 W !!
;
;Call to patient lookup
D ^AMERLKP
I $D(IOF) W @IOF
D EXIT1^AMER K DIRUT
Q
;
EN1 ; ENTRY POINT FOR MINI REGISTRATION
D REG
K A1BETAG,AGDOG,AGDTS
D EXIT1 I $D(IOF) W @IOF
Q
;
TRG ; ENTRY POINT FOR EDITING TRIAGE NURSE'S FIELDS
N AMERLINE
D EXIT1
S %="",$P(%,"~",80)="",AMERLINE=% K %
;S AMERSTRT=1,AMERFIN=27,AMERQSEQ="" ;IHS/OIT/SCR 01/06/09
S AMERSTRT=1,AMERFIN=25,AMERQSEQ=""
S AMERTRG=1
D EDIT^AMERD
K AMERTRG,AMERLINE
Q
;
LINE(X) ; QUERY SEPERATOR LINE
N Y,AMERLINE
S %="",$P(%,"~",80)="",AMERLINE=% K %
I $G(X)="" S X="Q"
S Y=$O(^AMER(2.3,"B",X,"")),Y=$P($G(^AMER(2.3,+Y,0)),U,11)
I 'Y Q ($C(10)_$C(13)_$C(10)_$C(13)_AMERLINE_$C(10)_$C(13))
Q ""
;
DEMO ; ENTRY POINT FOR DEMO MODE. NO VISIT CREATED
S AMERDEMO=1
D AMER
K AMERDEMO
Q
;
OPT(X) ; ENTRY POINT FROM AMERD ;OPTIONAL
K AMEROPT
N %,Y,Z
S Y=$O(^AMER(2.3,"B",X,"")) I 'Y Q
S %=$P($G(^AMER(2.3,Y,0)),U,12)
I % S AMEROPT=""
Q
;
R1 ;
Q
AMER ; IHS/ANMC/GIS - PRIMARY ROUTINE FOR ER ADMISSION ;
+1 ;;3.0;ER VISIT SYSTEM;**4,5,6**;MAR 03, 2009;Build 30
+2 ;
+3 NEW AMERLINE,AMERPCC,AMERTIME,AMERNEW
+4 IF $DATA(AMERBFLG)
KILL AMERBFLG
SET AMERSTRT=10
SET AMERFIN=14
SET AMERQSEQ=$GET(AMERSSEQ)
GOTO RUN
VAR DO EXIT1
SET AMERSTRT=1
SET AMERFIN=19
VAR1 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
+1 SET AMERVER=$$VERSION^XPDUTL("AMER")
+2 SET AMERSVER=$$VERSION^XPDUTL("PIMS")
+3 SET IOP=0
DO ^%ZIS
WRITE @IOF,"ER SYSTEM Ver ",AMERVER,": ",$SELECT('$DATA(AMERDOA):"ADMISSION TO EMERGENCY ROOM",1:" DOA ADMISSION")," ^ = back up ^^ = quit",!,"Questions preceded by a '*' are MANDATORY. Enter '??' to see choices."
EDIT ; ENTRY POINT FROM AMER4
+1 IF '$DATA(AMERTFLG)
SET AMERQSEQ=""
RUN FOR AMERRUN=AMERSTRT:1
IF AMERRUN>AMERFIN
QUIT
IF $DATA(AMERQUIT)
QUIT
Begin DoDot:1
+1 IF '$DATA(^AMER(2.3,"B",("QA"_AMERRUN)))
QUIT
+2 SET AMERQNO=AMERRUN
+3 IF '$DATA(AMERMAND)
WRITE $$LINE("QA"_AMERRUN)
+4 DO OPT("QA"_AMERRUN)
+5 DO @("QA"_AMERRUN_"^AMER"_$SELECT(AMERRUN<6:"1",AMERRUN<10:"1B",1:"1"))
+6 DO SET
+7 ;
+8 ;AMER*3.0*5;Log activity
+9 Begin DoDot:2
+10 NEW ERIEN,AFIELD,ADMFLD
+11 SET AFIELD=""
+12 SET ERIEN=$ORDER(^AMER(2.3,"B","QA"_AMERRUN,""))
IF ERIEN=""
QUIT
+13 SET ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.04,"I")
+14 IF ADMFLD]""
SET AFIELD=$PIECE($GET(^DD(9009081,ADMFLD,0)),U)
+15 IF AFIELD=""
Begin DoDot:3
+16 SET ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.05,"I")
+17 IF ADMFLD]""
SET AFIELD=$PIECE($GET(^DD(9009080,ADMFLD,0)),U)
End DoDot:3
+18 IF AFIELD=""
QUIT
+19 ;
+20 ;Now log the activity
+21 IF $GET(AMERDFN)]""
DO LOG^AMERBUSA("P","E","AMER","AMER: Entered Patient ER visit information - "_AFIELD_" ("_AMERDFN_")",AMERDFN)
End DoDot:2
+22 QUIT
End DoDot:1
+23 ;
+24 ;AMER*3*5;Added auditing call
+25 IF $GET(AMERDFN)]""
IF '$DATA(^AMERADM(AMERDFN))
DO LOG^AMERBUSA("P","A","AMER","AMER: Admitted Patient to the ER",AMERDFN)
SET AMERNEW=1
+26 ;
+27 IF $DATA(AMEREFLG)
SET AMERNOHS=""
+28 ;
+29 ;AMER*3*6;Change batch handling, comment out line, add next line
+30 ;I $D(AMERBCH) Q ;NO TEMP FILES SO NO "SAVE" FROM TEMP FILES
+31 ;
+32 IF $DATA(AMERBCH)
IF $DATA(AMERQUIT)
QUIT
+33 ;
+34 IF $DATA(AMEREFLG)
Begin DoDot:1
+35 SET AMERNOHS=""
+36 SET AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
+37 ;update VISIT file if it exists
IF AMERPCC>0
DO VISITIN^AMERPCC(AMERDFN,AMERPCC)
+38 QUIT
End DoDot:1
QUIT
+39 IF $DATA(AMERQUIT)
GOTO EXIT
+40 IF '$DATA(AMERNOHS)
DO PRINT
IF $DATA(AMERQUIT)
GOTO EXIT
+41 DO ^AMER0
IF $DATA(AMERQUIT)
GOTO EXIT
+42 ;
+43 ;AMER*3.0*4
+44 ;Supply information to BEDD application if loaded
+45 ;
+46 ;First see if RPMS patch has been loaded
+47 IF $$VERSION^XPDUTL("BEDD")
Begin DoDot:1
+48 ;
+49 ;Check if XML portion has been loaded
+50 NEW X
+51 SET X="BEDDUTW"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+52 ;
+53 ;Check for needed fields
+54 IF $GET(DFN)=""
QUIT
+55 IF $GET(D0)=""
SET D0=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
+56 IF $GET(D1)=""
SET D1=$$GET1^DIQ(9009081,DFN_",",1,"I")
+57 ;
+58 ;Call routine to pass info to BEDD
+59 DO NEW^BEDDUTIL($GET(D),AMERDFN,$GET(D0),$GET(D1),DFN)
+60 ;
+61 ;AMER*3*5;Added auditing call
+62 IF $GET(AMERNEW)=1
DO LOG^AMERBUSA("P","A","AMER","AMER: Admitted patient to the ED Dashboard",AMERDFN)
End DoDot:1
+63 ;
+64 ;AMER*3*6;Quit if batch
+65 IF $DATA(AMERBCH)
QUIT
+66 ;
+67 WRITE *7,!!,"ER admission data collection is now complete. Thank you.",!!
EXIT ; ENTRY POINT FROM AMERD
+1 HANG 2
IF $DATA(IOF)
WRITE @IOF
EXIT1 ; ENTRY POINT FROM AMERD
+1 KILL AMERPRV,L,AGMVDF,AMERDA,AMERSSEQ
+2 KILL AMERDR,AGE,DFN,DOB,SEX,SSN,AMERNEW
+3 KILL AMERQUIT,AMERRUN,AMERLINE,AMERDFN,AMERQNO,AMERQSEQ,AMERSTG,X,Y,Z,F,I,A,%,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX,AMERI,AMERNOHS,DIROUT,DH,AMQQSSEQ
+4 KILL 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
+5 KILL 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
+6 KILL ^TMP("AMER",$JOB,1),^(2),^(3)
+7 QUIT
+8 ;
SET KILL AMERMAND
IF $DATA(AMERQUIT)
QUIT
+1 IF AMERRUN=98
QUIT
+2 IF AMERRUN="REG"
DO REG
QUIT
+3 IF AMERRUN="PRINT"
DO PRINT
SET AMERRUN=98
QUIT
+4 IF AMERRUN="EDIT"
SET AMERNOHS=""
DO RESTORE
QUIT
+5 IF X?2."^"
WRITE !,*7,"Session terminated..."
SET AMERQUIT=""
QUIT
+6 IF $EXTRACT(X)=U
SET X=U
+7 IF X=U
IF $DATA(AMEREFLG)
IF (AMERRUN>AMERFIN)
QUIT
+8 IF X=U
IF AMERQNO<3
WRITE !,"Session terminated...",*7
SET AMERQUIT=""
QUIT
+9 IF Y=""!(Y=-1)
IF '$DATA(AMEROPT)
IF AMERQNO>2
IF X'=U
DO MAND
QUIT
+10 KILL AMEROPT
+11 SET AMERQSEQ=AMERQSEQ_AMERQNO_";"
+12 IF X=U
SET X="^B"
DO BACK
QUIT
+13 IF Y=""!(Y=-1)
QUIT
+14 SET ^TMP("AMER",$JOB,1,AMERQNO)=Y
+15 QUIT
+16 ;
OUT ; ENTRY POINT FROM MULTIPLE ROUTINES
+1 IF '$DATA(POP)
SET POP=0
+2 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DTOUT,DUOUT,POP,DIRUT
SET AMERQUIT=""
+3 IF $GET(X)=U
KILL AMERQUIT
+4 IF $GET(X)?2."^"
SET AMERQUIT=""
+5 IF $DATA(AMERQUIT)
WRITE *7,!,"Session terminated. No data has been entered!"
+6 QUIT
+7 ;
BACK ; ENTRY POINT FROM AMERD
+1 SET A=$LENGTH(AMERQSEQ,";")
SET AMERRUN=$PIECE(AMERQSEQ,";",A-2)-1
SET AMERQSEQ=$PIECE(AMERQSEQ,";",1,A-3)_";"
+2 IF AMERRUN=-1
SET AMERRUN=999
+3 QUIT
+4 ;
RESTORE ;
+1 SET AMERDFN=+Y
SET AMERRUN=1
+2 WRITE *7,!!,"This patient is currently admitted to the ER....",!,"Want to edit his/her ER admission data"
+3 SET %=1
DO YN^DICN
DO OUT
IF $DATA(AMERQUIT)
QUIT
+4 IF "Yy"'[$EXTRACT(%Y)
SET AMERRUN=0
QUIT
+5 DO UTL^AMER0(AMERDFN)
+6 QUIT
+7 ;
PRINT ; PRINT HEALTH SUMMARY
+1 QUIT
+2 ;
+3 WRITE !
SET DIC="^APCHSCTL("
SET DIC(0)="AEQ"
+4 SET DIC("B")="ADULT REGULAR"
+5 DO ^DIC
KILL DIC
DO OUT
IF $DATA(AMERQUIT)
QUIT
+6 SET APCHSTYP=+Y
SET APCHSPAT=AMERDFN
+7 DO HSOUT^APCHS
+8 QUIT
+9 ;
REG ;
+1 IF $DATA(AMERDEMO)
WRITE !!,"Patient registration not available in demo mode",!!
HANG 2
WRITE *7
QUIT
+2 SET DOG=""
KILL DFN
DO ^AGVAR
DO DOG^AG0
+3 IF '$DATA(DFN)
SET AMERQUIT=""
GOTO REGEXIT
+4 ;
+5 ;AMER*3.0*5;Now log the activity
+6 DO LOG^AMERBUSA("P","A","AMER","AMER: Performed Patient Mini-Registration",DFN)
+7 SET ^TMP("AMER",$JOB,1,1)=DFN
SET AMERDFN=DFN
SET AMERRUN=1
REGEXIT KILL 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 QUIT
+2 ;
MAND ; ENTRY POINT FROM AMERD ; MANDATORY ANSWER
+1 WRITE *7,!,"This answer is mandatory. If you need help, type '??'."
+2 SET AMERRUN=AMERRUN-1
SET AMERMAND=""
+3 QUIT
+4 ;
BATCH ; ENTRY POINT FOR BATCH MODE
+1 SET AMERBCH=""
B1 DO AMER
IF $DATA(AMERQUIT)
DO EXIT1
KILL AMERBCH
QUIT
+1 SET AMERSSEQ=$PIECE(AMERQSEQ,";",1,$LENGTH(AMERQSEQ,";")-2)_";"
+2 DO VAR^AMERD
IF $DATA(AMERQUIT)
DO EXIT1
KILL AMERBCH,AMERSSEQ
QUIT
+3 IF $DATA(AMERDOA)
KILL AMERDOA
+4 IF '$DATA(AMERBCH)
DO EXIT1
+5 GOTO B1
+6 ;
DOA ; ENTRY POINT FOR DOA
+1 SET AMERDOA=""
+2 DO BATCH
DO EXIT1
KILL AMERDOA
+3 QUIT
+4 ;
SCAN ; ENTRY POINT FROM SCAN PT NAME OPTION ;SCAN PT NAMES
+1 DO MSG^AMER1A
SC1 WRITE !!
+1 ;
+2 ;Call to patient lookup
+3 DO ^AMERLKP
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EXIT1^AMER
KILL DIRUT
+6 QUIT
+7 ;
EN1 ; ENTRY POINT FOR MINI REGISTRATION
+1 DO REG
+2 KILL A1BETAG,AGDOG,AGDTS
+3 DO EXIT1
IF $DATA(IOF)
WRITE @IOF
+4 QUIT
+5 ;
TRG ; ENTRY POINT FOR EDITING TRIAGE NURSE'S FIELDS
+1 NEW AMERLINE
+2 DO EXIT1
+3 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
KILL %
+4 ;S AMERSTRT=1,AMERFIN=27,AMERQSEQ="" ;IHS/OIT/SCR 01/06/09
+5 SET AMERSTRT=1
SET AMERFIN=25
SET AMERQSEQ=""
+6 SET AMERTRG=1
+7 DO EDIT^AMERD
+8 KILL AMERTRG,AMERLINE
+9 QUIT
+10 ;
LINE(X) ; QUERY SEPERATOR LINE
+1 NEW Y,AMERLINE
+2 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
KILL %
+3 IF $GET(X)=""
SET X="Q"
+4 SET Y=$ORDER(^AMER(2.3,"B",X,""))
SET Y=$PIECE($GET(^AMER(2.3,+Y,0)),U,11)
+5 IF 'Y
QUIT ($CHAR(10)_$CHAR(13)_$CHAR(10)_$CHAR(13)_AMERLINE_$CHAR(10)_$CHAR(13))
+6 QUIT ""
+7 ;
DEMO ; ENTRY POINT FOR DEMO MODE. NO VISIT CREATED
+1 SET AMERDEMO=1
+2 DO AMER
+3 KILL AMERDEMO
+4 QUIT
+5 ;
OPT(X) ; ENTRY POINT FROM AMERD ;OPTIONAL
+1 KILL AMEROPT
+2 NEW %,Y,Z
+3 SET Y=$ORDER(^AMER(2.3,"B",X,""))
IF 'Y
QUIT
+4 SET %=$PIECE($GET(^AMER(2.3,Y,0)),U,12)
+5 IF %
SET AMEROPT=""
+6 QUIT
+7 ;
R1 ;
+1 QUIT
