MCPFTI ;WISC/TJK-PFT INTERPRETATION ENTRY ;7/9/99 10:11
;;2.3;Medicine;**25,31,35**;09/13/1996
; Reference IA #10061 for VADPT call.
DIC ; PFT Interpretation Entry.
D MCEPROC^MCARE
S DIC="^MCAR(700,",DIC(0)="AEQMZ"
I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
D ^DIC K DIC G EXIT:Y<0
S DFN=$P(Y(0),U,2),MCARGDA=+Y,MCARGDT=$P(Y,U,2)
I MCESON,$$ESTONUM^MCESSCR(MCFILE,MCARGDA)>2 D ESRC^MCESSCR(MCFILE,MCARGDA) G EXIT Q
GETORDER D ORDERA G EXIT:$D(DUOUT)!$D(DTOUT)
D SETVAR^MCPFTP2
S RDATE=9999999.9999-$P(^MCAR(700,MCARGDA,0),U),MCPFT0=^(0),HT=$P(MCPFT0,U,4),WT=$P(MCPFT0,U,5),X1=$E($P(MCPFT0,U,1),1,7)
S HT=HT*2.54,WT=WT/2.2
S:'HT HT=$P(MCPFT0,U,3) S:'WT WT=$P(MCPFT0,U,6)
S MC17="" D DEM^VADPT S RACE=$P(VADM(8),U,2),MCSEX=$P(VADM(5),U),X2=$P(VADM(3),U) D ^%DTC
N MCHOLD S MCHOLD=RACE,RACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
I RACE="" D RACEMSG^MCPFTSS
; ---------------------
; AGE = the patients age at the date of the procedure
; ---------------------
S AGE=X\365.25 D PRED^MCPFTP1 W:$D(MCRCN) !,MCRCN
;D INP^VADPT S MCARWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MCARRB=VAIN(5)
S MCARZ="PULMONARY FUNCTION TEST" D INIT^MCARP1(MCARZ,MCARGDT,MCFILE)
S DIR(0)="E"
D ^DIR
I 'Y G EXIT
I W @IOF,"***INTERPRETATION ENTRY***"
S HEAD1="VOLUMES",MCX=0,$P(MCDOT," ",81)=""
S MCFF="S DN=1,MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press Return to Continue, '^' to escape: "",MCY:DTIME S:'$T MCY=U S:MCY=U MCOUT=1,DN=0 Q:$D(MCOUT) W:DN @IOF D HEAD^MCARP D:$D(HEAD1) HEAD1^MCPFTP2,HEAD2^MCPFTP2 K MCY"
D HEAD^MCARP,HEAD1^MCPFTP2,HEAD2^MCPFTP2 G EXIT:$D(MCOUT) D VOL^MCPFTP2 G EXIT:$D(MCOUT)
PVPRT ;
S DIR(0)="E" D ^DIR G EXIT:'Y
W @IOF
D PV1^MCPFTP5 G EXIT:$D(MCOUT)
ED D ^MCPFTIC G EXIT:$D(DUOUT)!$D(DTOUT)
S DIE="^MCAR(700,",DA=MCARGDA,DR="33.5;30;21;31;600"
;MFD 2/10/93 DR(2,700.05)=.01
D ^DIE,ORDER1,QTASK^MCPARAM
D ESRC^MCESSCR(MCFILE,MCARGDA)
;
; Allow the user to print a PFT report now
S DIR(0)="Y",DIR("A")="Print report now",DIR("B")="YES" ; setup
D ^DIR ; ask
I Y S TEMP=MCARGDA D ^MCPFTP1A S MCARGDA=TEMP D SUM^MCPFTP ; yes, they want the report
;
EXIT D EXIT1^MCPFTP1 K A,J,F,SUB,FLD,NM,K,I,DIR,LN,DIRUT
K DIE,MCND,DA,DR,DBZZ
K MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
K MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE
K MCPBRIEF,MCPFULL,MCPRTRTN,TEMP
Q
ORDERA S MCARGNUM=$O(^MCAR(697.2,"C","MCAR(700",0)),MCFILE=700
ORDER D:'$D(MCOEON) ORDER^MCPARAM Q:'$D(MCOEON)
Q
ORDER1 G IM:'$D(MCOEON) Q:'$D(^MCAR(MCFILE,MCARGDA)) Q:$D(DTOUT)
IM D EN1^MCMAG Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTI 2601 printed Dec 13, 2024@02:16 Page 2
MCPFTI ;WISC/TJK-PFT INTERPRETATION ENTRY ;7/9/99 10:11
+1 ;;2.3;Medicine;**25,31,35**;09/13/1996
+2 ; Reference IA #10061 for VADPT call.
DIC ; PFT Interpretation Entry.
+1 DO MCEPROC^MCARE
+2 SET DIC="^MCAR(700,"
SET DIC(0)="AEQMZ"
+3 IF MCESON
SET DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
+4 DO ^DIC
KILL DIC
if Y<0
GOTO EXIT
+5 SET DFN=$PIECE(Y(0),U,2)
SET MCARGDA=+Y
SET MCARGDT=$PIECE(Y,U,2)
+6 IF MCESON
IF $$ESTONUM^MCESSCR(MCFILE,MCARGDA)>2
DO ESRC^MCESSCR(MCFILE,MCARGDA)
GOTO EXIT
QUIT
GETORDER DO ORDERA
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+1 DO SETVAR^MCPFTP2
+2 SET RDATE=9999999.9999-$PIECE(^MCAR(700,MCARGDA,0),U)
SET MCPFT0=^(0)
SET HT=$PIECE(MCPFT0,U,4)
SET WT=$PIECE(MCPFT0,U,5)
SET X1=$EXTRACT($PIECE(MCPFT0,U,1),1,7)
+3 SET HT=HT*2.54
SET WT=WT/2.2
+4 if 'HT
SET HT=$PIECE(MCPFT0,U,3)
if 'WT
SET WT=$PIECE(MCPFT0,U,6)
+5 SET MC17=""
DO DEM^VADPT
SET RACE=$PIECE(VADM(8),U,2)
SET MCSEX=$PIECE(VADM(5),U)
SET X2=$PIECE(VADM(3),U)
DO ^%DTC
+6 NEW MCHOLD
SET MCHOLD=RACE
SET RACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
+7 IF RACE=""
DO RACEMSG^MCPFTSS
+8 ; ---------------------
+9 ; AGE = the patients age at the date of the procedure
+10 ; ---------------------
+11 SET AGE=X\365.25
DO PRED^MCPFTP1
if $DATA(MCRCN)
WRITE !,MCRCN
+12 ;D INP^VADPT S MCARWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MCARRB=VAIN(5)
+13 SET MCARZ="PULMONARY FUNCTION TEST"
DO INIT^MCARP1(MCARZ,MCARGDT,MCFILE)
+14 SET DIR(0)="E"
+15 DO ^DIR
+16 IF 'Y
GOTO EXIT
I WRITE @IOF,"***INTERPRETATION ENTRY***"
+1 SET HEAD1="VOLUMES"
SET MCX=0
SET $PIECE(MCDOT," ",81)=""
+2 SET MCFF="S DN=1,MCY="""" I $Y>(IOSL-3) R:$E(IOST,1,2)=""C-"" !!,""Press Return to Continue, '^' to escape: "",MCY:DTIME S:'$T MCY=U S:MCY=U MCOUT=1,DN=0 Q:$D(MCOUT) W:DN @IOF D HEAD^MCARP D:$D(HEAD1) HEAD1^MCPFTP2,HEAD2^MCPFTP2 K MCY"
+3 DO HEAD^MCARP
DO HEAD1^MCPFTP2
DO HEAD2^MCPFTP2
if $DATA(MCOUT)
GOTO EXIT
DO VOL^MCPFTP2
if $DATA(MCOUT)
GOTO EXIT
PVPRT ;
+1 SET DIR(0)="E"
DO ^DIR
if 'Y
GOTO EXIT
+2 WRITE @IOF
+3 DO PV1^MCPFTP5
if $DATA(MCOUT)
GOTO EXIT
ED DO ^MCPFTIC
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+1 SET DIE="^MCAR(700,"
SET DA=MCARGDA
SET DR="33.5;30;21;31;600"
+2 ;MFD 2/10/93 DR(2,700.05)=.01
+3 DO ^DIE
DO ORDER1
DO QTASK^MCPARAM
+4 DO ESRC^MCESSCR(MCFILE,MCARGDA)
+5 ;
+6 ; Allow the user to print a PFT report now
+7 ; setup
SET DIR(0)="Y"
SET DIR("A")="Print report now"
SET DIR("B")="YES"
+8 ; ask
DO ^DIR
+9 ; yes, they want the report
IF Y
SET TEMP=MCARGDA
DO ^MCPFTP1A
SET MCARGDA=TEMP
DO SUM^MCPFTP
+10 ;
EXIT DO EXIT1^MCPFTP1
KILL A,J,F,SUB,FLD,NM,K,I,DIR,LN,DIRUT
+1 KILL DIE,MCND,DA,DR,DBZZ
+2 KILL MCAR,MCARDOB,MCARDTM,MCARHDR,MCARRB,MCARWARD,MCRHR,VADM,VAIN
+3 KILL MCARP,MCFILE,MCESON,MCESKEY,MCROUT,MCTYPE
+4 KILL MCPBRIEF,MCPFULL,MCPRTRTN,TEMP
+5 QUIT
ORDERA SET MCARGNUM=$ORDER(^MCAR(697.2,"C","MCAR(700",0))
SET MCFILE=700
ORDER if '$DATA(MCOEON)
DO ORDER^MCPARAM
if '$DATA(MCOEON)
QUIT
+1 QUIT
ORDER1 if '$DATA(MCOEON)
GOTO IM
if '$DATA(^MCAR(MCFILE,MCARGDA))
QUIT
if $DATA(DTOUT)
QUIT
IM DO EN1^MCMAG
QUIT
