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 ---[H[J[2J[HMCPFTP 1323 printed Oct 16, 2024@18:16:39 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
