MCPFTP.m

MCPFTP ;WISC/TJK-PULMONARY FUNCTION TEST PRINT ;3/6/98  16:29

 ;;2.3;Medicine;**17,18**;09/13/1996

DIC ;

 D MCPPROC^MCARP

 S MCBP=$S($E(XQY0,3,3)="B":1,1:0)

 S DIC="^MCAR(700,",DIC(0)="AEQMZ"

 G:$G(MCARGDA)>0 SUM

 S:MCESON DIC("S")=$$PREVIEW^MCESSCR(MCFILE)

 D ^DIC K DIC G EXIT:Y<0

 S MCARGDA=+Y

 ;

SUM ;    Entry point when procedure # (MCARGDA) is already defined.

 ;    Called by Summary of Patient Procedures, Interpretation Enter/

 ;    Edit.

 S MCARZ="PULMONARY FUNCTION TEST REPORT"

 D:$G(MCESON) STATUS^MCESPRT(MCFILE,MCARGDA)

 S MCPFT0=^MCAR(700,MCARGDA,0),MCFILE=700,DFN=$P(^(0),U,2)

 I $D(ORHFS) U IO G PRINT ;dcm/slc added for CPRS

DEVQUE ; Device Control and Queuing Control

 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP G EXIT

 I $D(IO("Q")) K IO("Q") S (ZTSAVE("MC*"),ZTSAVE("DFN"),ZTSAVE("DIC"))="",ZTRTN=$S($G(MCBP)=1:"^MCBPFTP1",1:"^MCPFTP1"),ZTDESC="PFT REPORT" D ^%ZTLOAD K ZTSK G EXIT

 U IO

PRINT S HOSP=$P($G(^DPT(DFN,.1)),U) S:HOSP'="" HOSP=$O(^SC("B",HOSP,"")) S:HOSP'="" HOSP=$P(^SC(HOSP,0),U,15) S:HOSP'="" HOSP=$P($G(^DG(40.8,HOSP,0)),U) S PG=0

 G:$G(MCBP)=1 ^MCBPFTP1 G ^MCPFTP1

EXIT K DFN,MCARGDA,MCPFT0,Y,POP

 K MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN

 K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCARGDA

 K MCPBRIEF,MCPFULL,MCPRTRTN,MCBS

 D ^%ZISC Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCPFTP   1323     printed  Apr 09, 2024@21:18:02                                                                                                                                                                                                      Page 2

MCPFTP    ;WISC/TJK-PULMONARY FUNCTION TEST PRINT ;3/6/98  16:29

 +1       ;;2.3;Medicine;**17,18**;09/13/1996

DIC       ;

 +1        DO MCPPROC^MCARP

 +2        SET MCBP=$SELECT($EXTRACT(XQY0,3,3)="B":1,1:0)

 +3        SET DIC="^MCAR(700,"

           SET DIC(0)="AEQMZ"

 +4        if $GET(MCARGDA)>0

               GOTO SUM

 +5        if MCESON

               SET DIC("S")=$$PREVIEW^MCESSCR(MCFILE)

 +6        DO ^DIC

           KILL DIC

           if Y<0

               GOTO EXIT

 +7        SET MCARGDA=+Y

 +8       ;

SUM       ;    Entry point when procedure # (MCARGDA) is already defined.

 +1       ;    Called by Summary of Patient Procedures, Interpretation Enter/

 +2       ;    Edit.

 +3        SET MCARZ="PULMONARY FUNCTION TEST REPORT"

 +4        if $GET(MCESON)

               DO STATUS^MCESPRT(MCFILE,MCARGDA)

 +5        SET MCPFT0=^MCAR(700,MCARGDA,0)

           SET MCFILE=700

           SET DFN=$PIECE(^(0),U,2)

 +6       ;dcm/slc added for CPRS

           IF $DATA(ORHFS)

               USE IO

               GOTO PRINT

DEVQUE    ; Device Control and Queuing Control

 +1        KILL IO("Q")

           SET %ZIS="MQ"

           DO ^%ZIS

           IF POP

               GOTO EXIT

 +2        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET (ZTSAVE("MC*"),ZTSAVE("DFN"),ZTSAVE("DIC"))=""

               SET ZTRTN=$SELECT($GET(MCBP)=1:"^MCBPFTP1",1:"^MCPFTP1")

               SET ZTDESC="PFT REPORT"

               DO ^%ZTLOAD

               KILL ZTSK

               GOTO EXIT

 +3        USE IO

PRINT      SET HOSP=$PIECE($GET(^DPT(DFN,.1)),U)

           if HOSP'=""

               SET HOSP=$ORDER(^SC("B",HOSP,""))

           if HOSP'=""

               SET HOSP=$PIECE(^SC(HOSP,0),U,15)

           if HOSP'=""

               SET HOSP=$PIECE($GET(^DG(40.8,HOSP,0)),U)

           SET PG=0

 +1        if $GET(MCBP)=1

               GOTO ^MCBPFTP1

           GOTO ^MCPFTP1

EXIT       KILL DFN,MCARGDA,MCPFT0,Y,POP

 +1        KILL MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN

 +2        KILL MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE,MCARGDA

 +3        KILL MCPBRIEF,MCPFULL,MCPRTRTN,MCBS

 +4        DO ^%ZISC

           QUIT