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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPCS 1327 printed Dec 13, 2024@02:14:22 Page 2
MCARPCS ;WISC/TJK-AUTO TRANSMIT PACEMAKER REPORT-QUEUE ;4/10/96 14:14
+1 ;;2.3;Medicine;;09/13/1996
+2 WRITE @IOF,!!!,"FORM TRANSFER TO NATIONAL CENTER"
+3 KILL DIC
SET DIC="^MCAR(690,"
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^MCAR(698,""C"",+Y))"
DO ^DIC
if Y<0
GOTO EXIT
+4 SET DFN=+Y
KILL MCR
REASON KILL DIC
SET DIC="^MCAR(695.8,"
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^MCAR(695.8,""AC"",""T"",+Y))"
SET DIC("A")="Select Reason for Transmission of this Report: "
DO ^DIC
if X=U
GOTO EXIT
if Y<0
GOTO OK
SET MCR($PIECE(^MCAR(695.8,+Y,0),U))=""
GOTO REASON
OK ;temporarily all transmissions will go to the Eastern Pacemaker Center
+1 SET MCT="E"
+2 ;S MCT="" I $D(^MCAR(690,DFN,"P2")) S MCT=$P(^("P2"),U,2) S:MCT'="W" MCT="E"
+3 ;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)
+4 ;I "WEB"'[X W !,*7,"Answer with 'E' for Eastern Center,'W' for Western Center, or 'B' for Both" G OK
+5 ;S:X'="" MCT=X W !,$S(MCT="E":"EASTERN PACEMAKER CENTER",MCT="W":"WESTERN PACEMAKER CENTER",1:"BOTH EASTERN AND WESTERN PACEMAKER CENTERS")
+6 KILL DIC,DIR
+7 SET DIR("A")="TRANSMIT REPORT"
SET DIR("B")="Y"
SET DIR(0)="Y"
+8 DO ^DIR
+9 IF Y
SET ZTRTN="^MCARPCS1"
SET ZTSAVE("DFN")=""
SET ZTSAVE("MCR(")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("MCT")=""
SET ZTIO=""
SET ZTDESC="PACEMAKER REPORT TRANSMISSION"
DO ^%ZTLOAD
EXIT KILL MCR,X,Y,%,ZTSK,DFN,MCT,DIR
QUIT
+1 QUIT
