AMER1B.m

AMER1B ; IHS/ANMC/GIS -ISC - OVERFLOW FROM AMER1 ;   

 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009

 ;

QA6 ; TRANSFER

 S DIR("B")="NO" I $G(^TMP("AMER",$J,1,6)) S DIR("B")="YES"

 S DIR(0)="YO",DIR("A")="*Was this patient transferred from another facility" D ^DIR K DIR

 D OUT^AMER

 I Y K ^TMP("AMER",$J,1,10) ; ELIMINATE REGULAR TRANSPORT MODES

 I Y!(Y?1."^") Q

 F I=7,8,9 K ^TMP("AMER",$J,1,I) ; KILL OFF ALL DESCENDENTS

 S AMERRUN=9

 Q

 ;

QA7 ; TRANSFERED FROM

 S DIC("A")="*Transferred from: " K DIC("B")

 I $G(^TMP("AMER",$J,1,7)) S %=+^(7),DIC("B")=$P(^AMER(2.1,%,0),U)

 S DIC="^AMER(2.1,",DIC(0)="AEQM"

 D ^DIC K DIC

 D OUT^AMER

 Q

 ;

QA8 ; TRANSFER TRANSPORTATION

 N DIC

 S DIC("A")="*Mode of transport to the ER: " K DIC("B")

 I $G(^TMP("AMER",$J,1,8))>0 S %=+^(8),DIC("B")=$P(^AMER(3,%,0),U)

 E  S DIC("B")="PRIVATE VEHICLE"

 S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS"),DIC(0)="AEQ"

 D ^DIC K DIC

 D OUT^AMER

 I Y=-1!(Y="") Q

 S Z=$P(Y,U,2)

 I Z'["AMBULANCE" F I=10:1:14 K ^TMP("AMER",$J,1,I)

 I Z="PRIVATE VEHICLE" S AMERRIN=9 Q

 Q

 ; 

QA9 ; TRANSFER ATTENDANT

 S DIR("B")="NO" I $G(^TMP("AMER",$J,1,9)) S DIR("B")="YES"

 S DIR(0)="YO",DIR("A")="Medical attendant present during transfer" D ^DIR K DIR

 D OUT^AMER

 S %=$G(^TMP("AMER",$J,1,8)) I $P(%,U,2)="AMBULANCE" S AMERRUN=10,^TMP("AMER",$J,1,10)=^TMP("AMER",$J,1,8) Q

 I X'=U S AMERRUN=98

 Q

AMER1B    ; IHS/ANMC/GIS -ISC - OVERFLOW FROM AMER1 ;   

 +1       ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009

 +2       ;

QA6       ; TRANSFER

 +1        SET DIR("B")="NO"

           IF $GET(^TMP("AMER",$JOB,1,6))

               SET DIR("B")="YES"

 +2        SET DIR(0)="YO"

           SET DIR("A")="*Was this patient transferred from another facility"

           DO ^DIR

           KILL DIR

 +3        DO OUT^AMER

 +4       ; ELIMINATE REGULAR TRANSPORT MODES

           IF Y

               KILL ^TMP("AMER",$JOB,1,10)

 +5        IF Y!(Y?1."^")

               QUIT 

 +6       ; KILL OFF ALL DESCENDENTS

           FOR I=7,8,9

               KILL ^TMP("AMER",$JOB,1,I)

 +7        SET AMERRUN=9

 +8        QUIT 

 +9       ;

QA7       ; TRANSFERED FROM

 +1        SET DIC("A")="*Transferred from: "

           KILL DIC("B")

 +2        IF $GET(^TMP("AMER",$JOB,1,7))

               SET %=+^(7)

               SET DIC("B")=$PIECE(^AMER(2.1,%,0),U)

 +3        SET DIC="^AMER(2.1,"

           SET DIC(0)="AEQM"

 +4        DO ^DIC

           KILL DIC

 +5        DO OUT^AMER

 +6        QUIT 

 +7       ;

QA8       ; TRANSFER TRANSPORTATION

 +1        NEW DIC

 +2        SET DIC("A")="*Mode of transport to the ER: "

           KILL DIC("B")

 +3        IF $GET(^TMP("AMER",$JOB,1,8))>0

               SET %=+^(8)

               SET DIC("B")=$PIECE(^AMER(3,%,0),U)

 +4       IF '$TEST

               SET DIC("B")="PRIVATE VEHICLE"

 +5        SET DIC="^AMER(3,"

           SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS")

           SET DIC(0)="AEQ"

 +6        DO ^DIC

           KILL DIC

 +7        DO OUT^AMER

 +8        IF Y=-1!(Y="")

               QUIT 

 +9        SET Z=$PIECE(Y,U,2)

 +10       IF Z'["AMBULANCE"

               FOR I=10:1:14

                   KILL ^TMP("AMER",$JOB,1,I)

 +11       IF Z="PRIVATE VEHICLE"

               SET AMERRIN=9

               QUIT 

 +12       QUIT 

 +13      ; 

QA9       ; TRANSFER ATTENDANT

 +1        SET DIR("B")="NO"

           IF $GET(^TMP("AMER",$JOB,1,9))

               SET DIR("B")="YES"

 +2        SET DIR(0)="YO"

           SET DIR("A")="Medical attendant present during transfer"

           DO ^DIR

           KILL DIR

 +3        DO OUT^AMER

 +4        SET %=$GET(^TMP("AMER",$JOB,1,8))

           IF $PIECE(%,U,2)="AMBULANCE"

               SET AMERRUN=10

               SET ^TMP("AMER",$JOB,1,10)=^TMP("AMER",$JOB,1,8)

               QUIT 

 +5        IF X'=U

               SET AMERRUN=98

 +6        QUIT