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