AMEREDTU ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ADMIT information
;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
;
TRANSFER(AMERDA) ;EP from AMEREDTA
N AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,AMERDR,DIC
S (AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,AMERDR)=""
S DIC("A")="*Transferred from: " K DIC("B")
I $G(^AMERVSIT(AMERDA,17))>0 D
.S AMERFACN=$P($G(^AMERVSIT(AMERDA,17)),U,2)
.S:AMERFACN>0 (DIC("B"),AMEROLD)=$P($G(^AMER(2.1,AMERFACN,0)),U,1)
.Q
S DIC="^AMER(2.1,",DIC(0)="AEQM"
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
Q:Y<0 0
S AMERNEW=$P(Y,U,2)
I AMERNEW'=AMEROLD D
.S AMERSTRG=$$EDAUDIT^AMEREDAU("17.2",AMEROLD,AMERNEW,"TRANSFERED FROM")
.S AMERDR=$S($D(AMERDR):AMERDR_";",1:""),AMERDR=AMERDR_"17.2////"_$P(Y,U,1)
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.S (AMERDR,Y,AMEROLD,AMERNEW)=""
.Q
;QA8 - TRANSFER TRANSPORTATION
S DIC("A")="*Mode of TRANSFER transport: " K DIC("B")
I $P($G(^AMERVSIT(AMERDA,0)),U,25)'="" S (DIC("B"),AMEROLD)=$P(^AMERVSIT(AMERDA,0),U,25)
S DIC="^AMER(3,"
S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS")
S DIC(0)="AEQ"
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) Q
Q:Y=-1!(Y="")
S AMERNEW=$$EDDISPL^AMEREDAU($P(Y,U,1),"T")
S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"T")
I AMEROLD'=AMERNEW D
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".25",AMEROLD,AMERNEW,"TRANSFER DETAILS")
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".25////"_+Y
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.S (AMERDR,Y,AMEROLD)=""
.Q
I AMERNEW'["AMBULANCE" S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".14////@;.15////@;.21////@"
E D AMBULNCE
;QA9 - TRANSFER ATTENDANT
S (AMEROLD,DIR("B"))="NO" I $P($G(^AMERVSIT(AMERDA,17)),U,4)=1 S (AMEROLD,DIR("B"))="YES"
S DIR(0)="YO",DIR("A")="*Medical attendant present during transfer"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) Q
Q:Y=-1!(Y="")
S AMERNEW=Y
S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"B") ; "BOOLEAN" translates from 0 to NO
I AMEROLD'=AMERNEW D
.S AMERSTRG=$$EDAUDIT^AMEREDAU("17.4",AMEROLD,AMERNEW,"TRANSFER ATTENDANT")
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_"17.4////"_Y
.D DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
.D DIE^AMEREDIT(AMERDA,AMERDR)
.S (AMERDR,Y,AMEROLD)=""
Q
;
AMBULNCE ; EP from AMEREDTA
;
N AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
S (AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG)=""
S DIR("A")="*Ambulance number"
K DIR("B"),DIR(0)
S DIR(0)="FO^1:80"
S (AMEROLD,DIR("B"))=$P($G(^AMERVSIT(AMERDA,0)),U,14)
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) Q
I Y>0 D
.S AMERNEW=Y
.I AMEROLD'=AMERNEW D
..S AMERSTRG=$$EDAUDIT^AMEREDAU(".14",AMEROLD,AMERNEW,"AMBULANCE NUMBER")
..S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".14////"_Y
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG) ;concatonate edit strings to add to ^AMERAUDT when ^AMERVSIT is actually updated
..Q
.Q
S (AMERNEW,AMEROLD)=""
S DIR("A")="*Ambulance HRCN/billing number"
K DIR("B")
S DIR(0)="FO^1:80"
S (AMEROLD,DIR("B"))=$P($G(^AMERVSIT(AMERDA,0)),U,15)
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) Q
Q:Y<0
S AMERNEW=Y
I AMEROLD'=AMERNEW D
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".15",AMEROLD,AMERNEW,"AMBULANCE INVOICE NUBMER")
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".15////"_Y
.S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.Q
S (AMERNEW,AMEROLD)=""
S DIC("A")="*Ambulance company: " K DIC("B"),DIC("S")
S Y=$P($G(^AMERVSIT(AMERDA,0)),U,21)
I Y'="" S (AMEROLD,DIC("B"))=Y
S DIC="^AMER(3,"
S DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY")
S DIC(0)="AEQO"
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) Q
Q:+Y<0
S AMERNEW=+Y
I AMEROLD'=AMERNEW D
.S AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"A") ; "AMBULANCE" translates from IEN to company name
.S AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"A")
.S AMERSTRG=$$EDAUDIT^AMEREDAU(".21",AMEROLD,AMERNEW,"AMBULANCE COMPANY")
.S AMERDR=$S(AMERDR'="":AMERDR_";",1:""),AMERDR=AMERDR_".21////"_$P(Y,U,1)
.S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
.Q
I AMERDR'="" D DIE^AMEREDIT(AMERDA,AMERDR)
D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
Q
AMEREDTU ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ADMIT information
+1 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
+2 ;
TRANSFER(AMERDA) ;EP from AMEREDTA
+1 NEW AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,AMERDR,DIC
+2 SET (AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,AMERDR)=""
+3 SET DIC("A")="*Transferred from: "
KILL DIC("B")
+4 IF $GET(^AMERVSIT(AMERDA,17))>0
Begin DoDot:1
+5 SET AMERFACN=$PIECE($GET(^AMERVSIT(AMERDA,17)),U,2)
+6 IF AMERFACN>0
SET (DIC("B"),AMEROLD)=$PIECE($GET(^AMER(2.1,AMERFACN,0)),U,1)
+7 QUIT
End DoDot:1
+8 SET DIC="^AMER(2.1,"
SET DIC(0)="AEQM"
+9 DO ^DIC
KILL DIC
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+11 IF Y<0
QUIT 0
+12 SET AMERNEW=$PIECE(Y,U,2)
+13 IF AMERNEW'=AMEROLD
Begin DoDot:1
+14 SET AMERSTRG=$$EDAUDIT^AMEREDAU("17.2",AMEROLD,AMERNEW,"TRANSFERED FROM")
+15 SET AMERDR=$SELECT($DATA(AMERDR):AMERDR_";",1:"")
SET AMERDR=AMERDR_"17.2////"_$PIECE(Y,U,1)
+16 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+17 DO DIE^AMEREDIT(AMERDA,AMERDR)
+18 SET (AMERDR,Y,AMEROLD,AMERNEW)=""
+19 QUIT
End DoDot:1
+20 ;QA8 - TRANSFER TRANSPORTATION
+21 SET DIC("A")="*Mode of TRANSFER transport: "
KILL DIC("B")
+22 IF $PIECE($GET(^AMERVSIT(AMERDA,0)),U,25)'=""
SET (DIC("B"),AMEROLD)=$PIECE(^AMERVSIT(AMERDA,0),U,25)
+23 SET DIC="^AMER(3,"
+24 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS")
+25 SET DIC(0)="AEQ"
+26 DO ^DIC
KILL DIC
+27 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+28 IF Y=-1!(Y="")
QUIT
+29 SET AMERNEW=$$EDDISPL^AMEREDAU($PIECE(Y,U,1),"T")
+30 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"T")
+31 IF AMEROLD'=AMERNEW
Begin DoDot:1
+32 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".25",AMEROLD,AMERNEW,"TRANSFER DETAILS")
+33 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".25////"_+Y
+34 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+35 DO DIE^AMEREDIT(AMERDA,AMERDR)
+36 SET (AMERDR,Y,AMEROLD)=""
+37 QUIT
End DoDot:1
+38 IF AMERNEW'["AMBULANCE"
SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".14////@;.15////@;.21////@"
+39 IF '$TEST
DO AMBULNCE
+40 ;QA9 - TRANSFER ATTENDANT
+41 SET (AMEROLD,DIR("B"))="NO"
IF $PIECE($GET(^AMERVSIT(AMERDA,17)),U,4)=1
SET (AMEROLD,DIR("B"))="YES"
+42 SET DIR(0)="YO"
SET DIR("A")="*Medical attendant present during transfer"
+43 DO ^DIR
KILL DIR
+44 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+45 IF Y=-1!(Y="")
QUIT
+46 SET AMERNEW=Y
+47 ; "BOOLEAN" translates from 0 to NO
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"B")
+48 IF AMEROLD'=AMERNEW
Begin DoDot:1
+49 SET AMERSTRG=$$EDAUDIT^AMEREDAU("17.4",AMEROLD,AMERNEW,"TRANSFER ATTENDANT")
+50 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_"17.4////"_Y
+51 DO DIEREC^AMEREDAU(AMERAIEN,AMERSTRG)
+52 DO DIE^AMEREDIT(AMERDA,AMERDR)
+53 SET (AMERDR,Y,AMEROLD)=""
End DoDot:1
+54 QUIT
+55 ;
AMBULNCE ; EP from AMEREDTA
+1 ;
+2 NEW AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
+3 SET (AMERFACN,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG)=""
+4 SET DIR("A")="*Ambulance number"
+5 KILL DIR("B"),DIR(0)
+6 SET DIR(0)="FO^1:80"
+7 SET (AMEROLD,DIR("B"))=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,14)
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+10 IF Y>0
Begin DoDot:1
+11 SET AMERNEW=Y
+12 IF AMEROLD'=AMERNEW
Begin DoDot:2
+13 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".14",AMEROLD,AMERNEW,"AMBULANCE NUMBER")
+14 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".14////"_Y
+15 ;concatonate edit strings to add to ^AMERAUDT when ^AMERVSIT is actually updated
SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 SET (AMERNEW,AMEROLD)=""
+19 SET DIR("A")="*Ambulance HRCN/billing number"
+20 KILL DIR("B")
+21 SET DIR(0)="FO^1:80"
+22 SET (AMEROLD,DIR("B"))=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,15)
+23 DO ^DIR
KILL DIR
+24 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+25 IF Y<0
QUIT
+26 SET AMERNEW=Y
+27 IF AMEROLD'=AMERNEW
Begin DoDot:1
+28 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".15",AMEROLD,AMERNEW,"AMBULANCE INVOICE NUBMER")
+29 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".15////"_Y
+30 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+31 QUIT
End DoDot:1
+32 SET (AMERNEW,AMEROLD)=""
+33 SET DIC("A")="*Ambulance company: "
KILL DIC("B"),DIC("S")
+34 SET Y=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,21)
+35 IF Y'=""
SET (AMEROLD,DIC("B"))=Y
+36 SET DIC="^AMER(3,"
+37 SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("AMBULANCE COMPANY")
+38 SET DIC(0)="AEQO"
+39 DO ^DIC
KILL DIC
+40 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+41 IF +Y<0
QUIT
+42 SET AMERNEW=+Y
+43 IF AMEROLD'=AMERNEW
Begin DoDot:1
+44 ; "AMBULANCE" translates from IEN to company name
SET AMERNEW=$$EDDISPL^AMEREDAU(AMERNEW,"A")
+45 SET AMEROLD=$$EDDISPL^AMEREDAU(AMEROLD,"A")
+46 SET AMERSTRG=$$EDAUDIT^AMEREDAU(".21",AMEROLD,AMERNEW,"AMBULANCE COMPANY")
+47 SET AMERDR=$SELECT(AMERDR'="":AMERDR_";",1:"")
SET AMERDR=AMERDR_".21////"_$PIECE(Y,U,1)
+48 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+49 QUIT
End DoDot:1
+50 IF AMERDR'=""
DO DIE^AMEREDIT(AMERDA,AMERDR)
+51 IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+52 QUIT
