- 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 Mar 13, 2025@21:20:58 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
