| 1 | MCARPCS ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-QUEUE ;4/10/96 14:14
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | W @IOF,!!!,"FORM TRANSFER TO NATIONAL CENTER"
|
|---|
| 4 | K DIC S DIC="^MCAR(690,",DIC(0)="AEQ",DIC("S")="I $D(^MCAR(698,""C"",+Y))" D ^DIC G EXIT:Y<0
|
|---|
| 5 | S DFN=+Y K MCR
|
|---|
| 6 | REASON K DIC S DIC="^MCAR(695.8,",DIC(0)="AEQ",DIC("S")="I $D(^MCAR(695.8,""AC"",""T"",+Y))",DIC("A")="Select Reason for Transmission of this Report: " D ^DIC G EXIT:X=U,OK:Y<0 S MCR($P(^MCAR(695.8,+Y,0),U))="" G REASON
|
|---|
| 7 | OK ;temporarily all transmissions will go to the Eastern Pacemaker Center
|
|---|
| 8 | S MCT="E"
|
|---|
| 9 | ;S MCT="" I $D(^MCAR(690,DFN,"P2")) S MCT=$P(^("P2"),U,2) S:MCT'="W" MCT="E"
|
|---|
| 10 | ;S:MCT="" MCT="E" W !!,"Transfer Report to : "_$S(MCT="W":"WESTERN PACEMAKER CENTER",1:"EASTERN PACEMAKER CENTER")_"//" R X:DTIME G EXIT:'$T,EXIT:X=U S X=$E(X,1)
|
|---|
| 11 | ;I "WEB"'[X W !,*7,"Answer with 'E' for Eastern Center,'W' for Western Center, or 'B' for Both" G OK
|
|---|
| 12 | ;S:X'="" MCT=X W !,$S(MCT="E":"EASTERN PACEMAKER CENTER",MCT="W":"WESTERN PACEMAKER CENTER",1:"BOTH EASTERN AND WESTERN PACEMAKER CENTERS")
|
|---|
| 13 | K DIC,DIR
|
|---|
| 14 | S DIR("A")="TRANSMIT REPORT",DIR("B")="Y",DIR(0)="Y"
|
|---|
| 15 | D ^DIR
|
|---|
| 16 | I Y S ZTRTN="^MCARPCS1",ZTSAVE("DFN")="",ZTSAVE("MCR(")="",ZTSAVE("DUZ")="",ZTSAVE("MCT")="",ZTIO="",ZTDESC="PACEMAKER REPORT TRANSMISSION" D ^%ZTLOAD
|
|---|
| 17 | EXIT K MCR,X,Y,%,ZTSK,DFN,MCT,DIR Q
|
|---|
| 18 | Q
|
|---|
