19 lines
1.3 KiB
Mathematica
19 lines
1.3 KiB
Mathematica
MCARPCS ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-QUEUE ;4/10/96 14:14
|
|
;;2.3;Medicine;;09/13/1996
|
|
W @IOF,!!!,"FORM TRANSFER TO NATIONAL CENTER"
|
|
K DIC S DIC="^MCAR(690,",DIC(0)="AEQ",DIC("S")="I $D(^MCAR(698,""C"",+Y))" D ^DIC G EXIT:Y<0
|
|
S DFN=+Y K MCR
|
|
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
|
|
OK ;temporarily all transmissions will go to the Eastern Pacemaker Center
|
|
S MCT="E"
|
|
;S MCT="" I $D(^MCAR(690,DFN,"P2")) S MCT=$P(^("P2"),U,2) S:MCT'="W" MCT="E"
|
|
;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)
|
|
;I "WEB"'[X W !,*7,"Answer with 'E' for Eastern Center,'W' for Western Center, or 'B' for Both" G OK
|
|
;S:X'="" MCT=X W !,$S(MCT="E":"EASTERN PACEMAKER CENTER",MCT="W":"WESTERN PACEMAKER CENTER",1:"BOTH EASTERN AND WESTERN PACEMAKER CENTERS")
|
|
K DIC,DIR
|
|
S DIR("A")="TRANSMIT REPORT",DIR("B")="Y",DIR(0)="Y"
|
|
D ^DIR
|
|
I Y S ZTRTN="^MCARPCS1",ZTSAVE("DFN")="",ZTSAVE("MCR(")="",ZTSAVE("DUZ")="",ZTSAVE("MCT")="",ZTIO="",ZTDESC="PACEMAKER REPORT TRANSMISSION" D ^%ZTLOAD
|
|
EXIT K MCR,X,Y,%,ZTSK,DFN,MCT,DIR Q
|
|
Q
|