MCARPAC ;WISC/TJK-PRINT ROUTINES FOR PACEMAKER ;1/22/98 10:33
;;2.3;Medicine;**15**;09/13/1996
GENERIC ;
D MCPPROC^MCARP
S DIC="^MCAR(699.5,"
I '$D(MCARPPS) S DIC(0)="AEMQZ",DIC("S")="I '$P(^MCAR(699.5,+Y,0),U,3)" D ^DIC G:Y<0 EXIT S (MCARGDA,DA)=+Y
S MCARGNUM=$P(^MCAR(699.5,MCARGDA,0),U,6),MCARZ=$P(^MCAR(697.2,MCARGNUM,0),U,8)_" REPORT",MCARGRTN=$S($G(MCBP)=1:"GENERICB",1:"GENERIC") G DEVQUE
ALEAD S DIC="^MCAR(698.2,",MCARZ="A-LEAD REPORT",MCARGRTN=$S($G(MCBP)=1:"ALEADB",1:"ALEAD"),MCFILE=698.2 G LOOK
VLEAD S DIC="^MCAR(698.1,",MCARZ="V-LEAD REPORT",MCARGRTN=$S($G(MCBP)=1:"VLEADB",1:"VLEAD"),MCFILE=698.1 G LOOK
GEN S DIC="^MCAR(698,",MCARZ="GENERATOR IMPLANT REPORT",MCARGRTN=$S($G(MCBP)=1:"GENIMPB",1:"GENIMP"),MCFILE=698 G LOOK
SURV S DIC="^MCAR(698.3,",MCARZ="PACEMAKER SURVEILLANCE REPORT",MCARGRTN=$S($G(MCBP)=1:"SURVB",1:"SURV"),MCFILE=698.3
LOOK ;
I '$D(MCARPPS) S DIC(0)="AEMQ" D ^DIC G:Y<0 EXIT S (MCARGDA,DA)=+Y
DEVQUE ; Device Control and Queuing Control
I $D(ORHFS) U IO G PRINT ;dcm/slc added for CPRS
K IO("Q") S %ZIS="MQ" D ^%ZIS G EXIT:POP
I $D(IO("Q")) S (ZTSAVE("MC*"),ZTSAVE("DIC"))="",ZTRTN="PRINT^MCARPAC",ZTDESC=MCARZ D ^%ZTLOAD K ZTSK G EXIT
U IO
PRINT ; Print Report
G PRINT^MCARP
EXIT I IOST'?1"P-".E,'$D(MCOUT) R !!,"* END * Press return to continue: ",X:DTIME
K ^UTILITY($J),IO("Q"),MCARGDA,MCARGDT,SSN,MCOUT
K MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE
K DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,DIC
K DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
K DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L
W:IOST?1"P-".E @IOF D ^%ZISC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPAC 1672 printed Oct 16, 2024@18:14:55 Page 2
MCARPAC ;WISC/TJK-PRINT ROUTINES FOR PACEMAKER ;1/22/98 10:33
+1 ;;2.3;Medicine;**15**;09/13/1996
GENERIC ;
+1 DO MCPPROC^MCARP
+2 SET DIC="^MCAR(699.5,"
+3 IF '$DATA(MCARPPS)
SET DIC(0)="AEMQZ"
SET DIC("S")="I '$P(^MCAR(699.5,+Y,0),U,3)"
DO ^DIC
if Y<0
GOTO EXIT
SET (MCARGDA,DA)=+Y
+4 SET MCARGNUM=$PIECE(^MCAR(699.5,MCARGDA,0),U,6)
SET MCARZ=$PIECE(^MCAR(697.2,MCARGNUM,0),U,8)_" REPORT"
SET MCARGRTN=$SELECT($GET(MCBP)=1:"GENERICB",1:"GENERIC")
GOTO DEVQUE
ALEAD SET DIC="^MCAR(698.2,"
SET MCARZ="A-LEAD REPORT"
SET MCARGRTN=$SELECT($GET(MCBP)=1:"ALEADB",1:"ALEAD")
SET MCFILE=698.2
GOTO LOOK
VLEAD SET DIC="^MCAR(698.1,"
SET MCARZ="V-LEAD REPORT"
SET MCARGRTN=$SELECT($GET(MCBP)=1:"VLEADB",1:"VLEAD")
SET MCFILE=698.1
GOTO LOOK
GEN SET DIC="^MCAR(698,"
SET MCARZ="GENERATOR IMPLANT REPORT"
SET MCARGRTN=$SELECT($GET(MCBP)=1:"GENIMPB",1:"GENIMP")
SET MCFILE=698
GOTO LOOK
SURV SET DIC="^MCAR(698.3,"
SET MCARZ="PACEMAKER SURVEILLANCE REPORT"
SET MCARGRTN=$SELECT($GET(MCBP)=1:"SURVB",1:"SURV")
SET MCFILE=698.3
LOOK ;
+1 IF '$DATA(MCARPPS)
SET DIC(0)="AEMQ"
DO ^DIC
if Y<0
GOTO EXIT
SET (MCARGDA,DA)=+Y
DEVQUE ; Device Control and Queuing Control
+1 ;dcm/slc added for CPRS
IF $DATA(ORHFS)
USE IO
GOTO PRINT
+2 KILL IO("Q")
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
SET (ZTSAVE("MC*"),ZTSAVE("DIC"))=""
SET ZTRTN="PRINT^MCARPAC"
SET ZTDESC=MCARZ
DO ^%ZTLOAD
KILL ZTSK
GOTO EXIT
+4 USE IO
PRINT ; Print Report
+1 GOTO PRINT^MCARP
EXIT IF IOST'?1"P-".E
IF '$DATA(MCOUT)
READ !!,"* END * Press return to continue: ",X:DTIME
+1 KILL ^UTILITY($JOB),IO("Q"),MCARGDA,MCARGDT,SSN,MCOUT
+2 Press return to continue: KILL MCARGNM,MCARGRTN,X,DFN,SSN,MCARGNUM,MCARGNAM,MCARZ,DN,D0,FLDS,MCARCODE
+3 KILL DIOEND,DIOBEG,DI,DICS,DJ,BY,A,DICSS,DIC
+4 KILL DIEDT,DIQ,DIWF,DIPZ,DIL,DXS,DALL,DSC,DCL,DPP,DPQ,DIC,DU,DQI,DY,S,DC
+5 KILL DL,DV,DE,DA,DK,Y,R,C,D,I,J,Q,M,P,N,D1,DIW,DIWL,DIWR,DIWT,PG,Z,L
+6 if IOST?1"P-".E
WRITE @IOF
DO ^%ZISC
QUIT
