Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMER1B

AMER1B.m

Go to the documentation of this file.
  1. AMER1B ; IHS/ANMC/GIS -ISC - OVERFLOW FROM AMER1 ;
  1. ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
  1. ;
  1. QA6 ; TRANSFER
  1. S DIR("B")="NO" I $G(^TMP("AMER",$J,1,6)) S DIR("B")="YES"
  1. S DIR(0)="YO",DIR("A")="*Was this patient transferred from another facility" D ^DIR K DIR
  1. D OUT^AMER
  1. I Y K ^TMP("AMER",$J,1,10) ; ELIMINATE REGULAR TRANSPORT MODES
  1. I Y!(Y?1."^") Q
  1. F I=7,8,9 K ^TMP("AMER",$J,1,I) ; KILL OFF ALL DESCENDENTS
  1. S AMERRUN=9
  1. Q
  1. ;
  1. QA7 ; TRANSFERED FROM
  1. S DIC("A")="*Transferred from: " K DIC("B")
  1. I $G(^TMP("AMER",$J,1,7)) S %=+^(7),DIC("B")=$P(^AMER(2.1,%,0),U)
  1. S DIC="^AMER(2.1,",DIC(0)="AEQM"
  1. D ^DIC K DIC
  1. D OUT^AMER
  1. Q
  1. ;
  1. QA8 ; TRANSFER TRANSPORTATION
  1. N DIC
  1. S DIC("A")="*Mode of transport to the ER: " K DIC("B")
  1. I $G(^TMP("AMER",$J,1,8))>0 S %=+^(8),DIC("B")=$P(^AMER(3,%,0),U)
  1. E S DIC("B")="PRIVATE VEHICLE"
  1. S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("TRANSFER DETAILS"),DIC(0)="AEQ"
  1. D ^DIC K DIC
  1. D OUT^AMER
  1. I Y=-1!(Y="") Q
  1. S Z=$P(Y,U,2)
  1. I Z'["AMBULANCE" F I=10:1:14 K ^TMP("AMER",$J,1,I)
  1. I Z="PRIVATE VEHICLE" S AMERRIN=9 Q
  1. Q
  1. ;
  1. QA9 ; TRANSFER ATTENDANT
  1. S DIR("B")="NO" I $G(^TMP("AMER",$J,1,9)) S DIR("B")="YES"
  1. S DIR(0)="YO",DIR("A")="Medical attendant present during transfer" D ^DIR K DIR
  1. D OUT^AMER
  1. 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
  1. I X'=U S AMERRUN=98
  1. Q