Routine: AMEREDTU

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)=""

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)

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

AMEREDTU.m