- 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