MCARPAC.m

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

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)

 +2        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