AMER1 ; IHS/ANMC/GIS - ER ADMISSION QUESTIONS ;
;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23
;
Q
QA1 D QA1^AMER1A ; PATIENT NAME
Q
;
QA2 ; DATE AND TIME OF ADMISSION TO ER
I $D(^TMP("AMER",$J,1,2)) S Y=^(2) X ^DD("DD") S DIR("B")=Y
E S DIR("B")=$S($D(AMERBCH):"",1:"NOW")
S DIR(0)="D^::ER",DIR("A")="*Date and time of admission to ER",DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)" D ^DIR K DIR
D NOW^%DTC
I Y>% D EN^DDIOL("FUTURE DATES NOT ALLOWED","","!!") G QA2
I $D(AMEREFLG),X=U S AMERRUN=999 Q
D OUT^AMER
Q:$D(AMERQUIT)
D APPNTMNT^AMERBSDU(AMERDFN,1,Y)
;
Q
;
QA3 ; PRESENTING COMPLAINT
K DIR("B") I $D(^TMP("AMER",$J,1,3)) S DIR("B")=^(3)
I $D(AMERDOA) S DIR("B")="DOA"
;AMER*3.0*8;Raised maximum field length
;S DIR(0)="F^1:80",DIR("A")="*Presenting complaint",DIR("?")="Enter free text chief complaint (80 characters max.)" D ^DIR K DIR
S DIR(0)="F^2:240",DIR("A")="*Presenting complaint",DIR("?")="Enter free text chief complaint (240 characters max.)" D ^DIR K DIR
D CKSC I $D(AMERCKSC)!($TR(Y," ")="") K AMERCKSC G QA3
D OUT^AMER
Q
;
QA4 ; FULL REG EDIT
N SDSEX
S SDFN=AMERDFN,SDAMTYP="P"
D ^BSDREG
K SDFN,SDAMTYP
S (X,Y)=""
I $D(DUOUT) S X="^"
I $D(DIROUT) S X="^^"
K AMER1,AMER2
I $D(AMERDOA) D
. S AMERRUN=9,AMEROPT=""
. S ^TMP("AMER",$J,1,4)=$$OPT^AMER0("EMERG","CLINIC TYPE")_U_"EMERG"
. S ^TMP("AMER",$J,1,5)=$$OPT^AMER0("UNSCHEDULED REVISIT","VISIT TYPE")_U_"UNSCHEDULED REVISIT"
. S ^TMP("AMER",$J,1,9)=$$OPT^AMER0("EMERGENT","TRIAGE CAT")_U_"EMERGENT"
. Q
Q
;
QA5 ; VISIT TYPE
N AMERVTYP
S DIC("B")=""
S DIC("A")="*Visit type: "
S AMERVTYP=$O(^AMER(3,"B","UNSCHEDULED VISIT",0))
S:AMERVTYP="" AMERVTYP=$O(^AMER(3,"B","UNSCHEDULED",0)) ;IHS/OIT/SCR 10/10/08 - CHANGED TO MATCH NEW OPTION
;S:AMERVTYP="" AMERVTYP=$O(^AMER(3,"B","FIRST VISIT",0))
I $D(^TMP("AMER",$J,1,5)) S %=+^(5),DIC("B")=$P(^AMER(3,%,0),U)
I DIC("B")=""&(AMERVTYP'="") S DIC("B")=$P($G(^AMER(3,AMERVTYP,0)),U,1) ;IF 'FIRST VISIT' exists, set it to default if original entry doesn't exist
S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE"),DIC(0)="AEQ"
D ^DIC K DIC
D OUT^AMER
Q
;
QA10 ; MODE OF TRANSPORT TO HOSPITAL
S DIC("A")="*Mode of transport to the ER: " K DIC("B")
I $D(^TMP("AMER",$J,1,10)) S %=+^(10),DIC("B")=$P(^AMER(3,%,0),U)
E S DIC("B")="PRIVATE VEHICLE/WALK IN"
S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT"),DIC(0)="AEQ"
D ^DIC K DIC
D OUT^AMER I $D(AMERQUIT) Q
I Y'["AMBULANCE",X'?1."^" S AMERRUN=99 K ^TMP("AMER",$J,1,11),^(12),^(13),^(14)
Q
;
QA11 ; AMBULANCE NUMBER
S DIR("A")="Ambulance number" D QAXX
Q
;
QA12 ; AMBULANCE HRCN/BILLING NUMBER
S DIR("A")="Ambulance HRCN/billing number" D QAXX
I $D(AMERDOA) S AMERRUN=13 Q
Q
;
QA14 ; AMBULANCE COMPANY
S DIC("A")="Ambulance company: " K DIC("B")
I $D(^TMP("AMER",$J,1,14)) S %=+^(14),DIC("B")=$P(^AMER(3,%,0),U)
S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY"),DIC(0)="AEQ"
D ^DIC K DIC
D OUT^AMER I $D(AMERQUIT) Q
I '$D(AMERDOA) S AMERRUN=20 Q
S AMERRUN=99
Q
;
QAXX ; TEXT CAPTURE
K DIR("B") I $D(^TMP("AMER",$J,1,AMERRUN)) S DIR("B")=^(AMERRUN)
S DIR(0)="FO^1:20",DIR("?")="Enter free text (30 characters max.)" D ^DIR K DIR
D CKSC I $D(AMERCKSC) K AMERCKSC G QAXX
D OUT^AMER
Q
;
CKSC ; ENTRY POINT FROM SEVERAL ROUTINES
N X
S X=$S(Y[";":"semi-colon",Y[":":"colon",1:"") K AMERCKSC
I X'="" S AMERCKSC="" W !!,*7,"Sorry, you can't use a ",X," in your answer...Try again",!!
Q
;
CHKINGO(CLINIC) ; return 1 if okay to proceed with checkin
NEW GO,DATE,END
S DATE=DT,END=DT+.24,GO=1
F S DATE=$O(^DPT(DFN,"S",DATE)) Q:DATE="" Q:DATE>END D
. I +$G(^DPT(DFN,"S",DATE,0))=CLINIC D S GO=0
.. W !!,"*** Patient already checked in at "_$$FMTE^XLFDT(DATE)_" ***"
I GO Q 1
Q +$$READ("Y","Want to Check Patient In Again")
;
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ; EP; calls reader, returns response
NEW DIR,Y,DIRUT
S DIR(0)=TYPE
I $E(TYPE,1)="P",$P(TYPE,":",2)["L" S DLAYGO=+$P(TYPE,U,2)
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
I $D(DIRA(1)) S Y=0 F S Y=$O(DIRA(Y)) Q:Y="" S DIR("A",Y)=DIRA(Y)
D ^DIR
Q Y
AMER1 ; IHS/ANMC/GIS - ER ADMISSION QUESTIONS ;
+1 ;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23
+2 ;
+3 QUIT
QA1 ; PATIENT NAME
DO QA1^AMER1A
+1 QUIT
+2 ;
QA2 ; DATE AND TIME OF ADMISSION TO ER
+1 IF $DATA(^TMP("AMER",$JOB,1,2))
SET Y=^(2)
XECUTE ^DD("DD")
SET DIR("B")=Y
+2 IF '$TEST
SET DIR("B")=$SELECT($DATA(AMERBCH):"",1:"NOW")
+3 SET DIR(0)="D^::ER"
SET DIR("A")="*Date and time of admission to ER"
SET DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
DO ^DIR
KILL DIR
+4 DO NOW^%DTC
+5 IF Y>%
DO EN^DDIOL("FUTURE DATES NOT ALLOWED","","!!")
GOTO QA2
+6 IF $DATA(AMEREFLG)
IF X=U
SET AMERRUN=999
QUIT
+7 DO OUT^AMER
+8 IF $DATA(AMERQUIT)
QUIT
+9 DO APPNTMNT^AMERBSDU(AMERDFN,1,Y)
+10 ;
+11 QUIT
+12 ;
QA3 ; PRESENTING COMPLAINT
+1 KILL DIR("B")
IF $DATA(^TMP("AMER",$JOB,1,3))
SET DIR("B")=^(3)
+2 IF $DATA(AMERDOA)
SET DIR("B")="DOA"
+3 ;AMER*3.0*8;Raised maximum field length
+4 ;S DIR(0)="F^1:80",DIR("A")="*Presenting complaint",DIR("?")="Enter free text chief complaint (80 characters max.)" D ^DIR K DIR
+5 SET DIR(0)="F^2:240"
SET DIR("A")="*Presenting complaint"
SET DIR("?")="Enter free text chief complaint (240 characters max.)"
DO ^DIR
KILL DIR
+6 DO CKSC
IF $DATA(AMERCKSC)!($TRANSLATE(Y," ")="")
KILL AMERCKSC
GOTO QA3
+7 DO OUT^AMER
+8 QUIT
+9 ;
QA4 ; FULL REG EDIT
+1 NEW SDSEX
+2 SET SDFN=AMERDFN
SET SDAMTYP="P"
+3 DO ^BSDREG
+4 KILL SDFN,SDAMTYP
+5 SET (X,Y)=""
+6 IF $DATA(DUOUT)
SET X="^"
+7 IF $DATA(DIROUT)
SET X="^^"
+8 KILL AMER1,AMER2
+9 IF $DATA(AMERDOA)
Begin DoDot:1
+10 SET AMERRUN=9
SET AMEROPT=""
+11 SET ^TMP("AMER",$JOB,1,4)=$$OPT^AMER0("EMERG","CLINIC TYPE")_U_"EMERG"
+12 SET ^TMP("AMER",$JOB,1,5)=$$OPT^AMER0("UNSCHEDULED REVISIT","VISIT TYPE")_U_"UNSCHEDULED REVISIT"
+13 SET ^TMP("AMER",$JOB,1,9)=$$OPT^AMER0("EMERGENT","TRIAGE CAT")_U_"EMERGENT"
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
QA5 ; VISIT TYPE
+1 NEW AMERVTYP
+2 SET DIC("B")=""
+3 SET DIC("A")="*Visit type: "
+4 SET AMERVTYP=$ORDER(^AMER(3,"B","UNSCHEDULED VISIT",0))
+5 ;IHS/OIT/SCR 10/10/08 - CHANGED TO MATCH NEW OPTION
IF AMERVTYP=""
SET AMERVTYP=$ORDER(^AMER(3,"B","UNSCHEDULED",0))
+6 ;S:AMERVTYP="" AMERVTYP=$O(^AMER(3,"B","FIRST VISIT",0))
+7 IF $DATA(^TMP("AMER",$JOB,1,5))
SET %=+^(5)
SET DIC("B")=$PIECE(^AMER(3,%,0),U)
+8 ;IF 'FIRST VISIT' exists, set it to default if original entry doesn't exist
IF DIC("B")=""&(AMERVTYP'="")
SET DIC("B")=$PIECE($GET(^AMER(3,AMERVTYP,0)),U,1)
+9 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("VISIT TYPE")
SET DIC(0)="AEQ"
+10 DO ^DIC
KILL DIC
+11 DO OUT^AMER
+12 QUIT
+13 ;
QA10 ; MODE OF TRANSPORT TO HOSPITAL
+1 SET DIC("A")="*Mode of transport to the ER: "
KILL DIC("B")
+2 IF $DATA(^TMP("AMER",$JOB,1,10))
SET %=+^(10)
SET DIC("B")=$PIECE(^AMER(3,%,0),U)
+3 IF '$TEST
SET DIC("B")="PRIVATE VEHICLE/WALK IN"
+4 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("MODE OF TRANSPORT")
SET DIC(0)="AEQ"
+5 DO ^DIC
KILL DIC
+6 DO OUT^AMER
IF $DATA(AMERQUIT)
QUIT
+7 IF Y'["AMBULANCE"
IF X'?1."^"
SET AMERRUN=99
KILL ^TMP("AMER",$JOB,1,11),^(12),^(13),^(14)
+8 QUIT
+9 ;
QA11 ; AMBULANCE NUMBER
+1 SET DIR("A")="Ambulance number"
DO QAXX
+2 QUIT
+3 ;
QA12 ; AMBULANCE HRCN/BILLING NUMBER
+1 SET DIR("A")="Ambulance HRCN/billing number"
DO QAXX
+2 IF $DATA(AMERDOA)
SET AMERRUN=13
QUIT
+3 QUIT
+4 ;
QA14 ; AMBULANCE COMPANY
+1 SET DIC("A")="Ambulance company: "
KILL DIC("B")
+2 IF $DATA(^TMP("AMER",$JOB,1,14))
SET %=+^(14)
SET DIC("B")=$PIECE(^AMER(3,%,0),U)
+3 SET DIC="^AMER(3,"
SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY")
SET DIC(0)="AEQ"
+4 DO ^DIC
KILL DIC
+5 DO OUT^AMER
IF $DATA(AMERQUIT)
QUIT
+6 IF '$DATA(AMERDOA)
SET AMERRUN=20
QUIT
+7 SET AMERRUN=99
+8 QUIT
+9 ;
QAXX ; TEXT CAPTURE
+1 KILL DIR("B")
IF $DATA(^TMP("AMER",$JOB,1,AMERRUN))
SET DIR("B")=^(AMERRUN)
+2 SET DIR(0)="FO^1:20"
SET DIR("?")="Enter free text (30 characters max.)"
DO ^DIR
KILL DIR
+3 DO CKSC
IF $DATA(AMERCKSC)
KILL AMERCKSC
GOTO QAXX
+4 DO OUT^AMER
+5 QUIT
+6 ;
CKSC ; ENTRY POINT FROM SEVERAL ROUTINES
+1 NEW X
+2 SET X=$SELECT(Y[";":"semi-colon",Y[":":"colon",1:"")
KILL AMERCKSC
+3 IF X'=""
SET AMERCKSC=""
WRITE !!,*7,"Sorry, you can't use a ",X," in your answer...Try again",!!
+4 QUIT
+5 ;
CHKINGO(CLINIC) ; return 1 if okay to proceed with checkin
+1 NEW GO,DATE,END
+2 SET DATE=DT
SET END=DT+.24
SET GO=1
+3 FOR
SET DATE=$ORDER(^DPT(DFN,"S",DATE))
IF DATE=""
QUIT
IF DATE>END
QUIT
Begin DoDot:1
+4 IF +$GET(^DPT(DFN,"S",DATE,0))=CLINIC
Begin DoDot:2
+5 WRITE !!,"*** Patient already checked in at "_$$FMTE^XLFDT(DATE)_" ***"
End DoDot:2
SET GO=0
End DoDot:1
+6 IF GO
QUIT 1
+7 QUIT +$$READ("Y","Want to Check Patient In Again")
+8 ;
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ; EP; calls reader, returns response
+1 NEW DIR,Y,DIRUT
+2 SET DIR(0)=TYPE
+3 IF $EXTRACT(TYPE,1)="P"
IF $PIECE(TYPE,":",2)["L"
SET DLAYGO=+$PIECE(TYPE,U,2)
+4 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+5 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+6 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+7 IF $DATA(HELP)
SET DIR("?")=HELP
+8 IF $DATA(DIRA(1))
SET Y=0
FOR
SET Y=$ORDER(DIRA(Y))
IF Y=""
QUIT
SET DIR("A",Y)=DIRA(Y)
+9 DO ^DIR
+10 QUIT Y
