MCPFTE ;WISC/TJK-PULMONARY FUNCTION TEST ENTER/EDIT ;7/9/99 10:08
;;2.3;Medicine;**25,31,35**;09/13/1996
; Reference IA #10061 for VADPT call.
DIC ; Pulmonary Function Test Enter/Edit
D MCEPROC^MCARE,DATE^MCAREH
S DIC="^MCAR(700,",DIC(0)="AEQLMZ",(DLAYGO,DIDEL,MCFILE)=700
I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
D ^DIC K DIC,DLAYGO G EXIT:Y<0
I $D(DTOUT),'$P(Y(0),U,2) S DIK="^MCAR(700,",DA=+Y D ^DIK G EXIT
S DFN=$P(Y(0),U,2),MCARGDA=+Y
I MCESON,$$ESTONUM^MCESSCR(MCFILE,MCARGDA)>2 D ESRC^MCESSCR(MCFILE,MCARGDA) I '$D(MCBACK) G EXIT
D:$D(MCBACK) BACK
D DEM^VADPT S MCSEX=$P(VADM(5),U),MCRACE=$P(VADM(8),U,2)
N MCMRACE,MCHOLD S MCMRACE=0,MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM) D KVAR^VADPT
I MCRACE="" D RACEMSG^MCPFTSS
I MCRACE'="" D
.S:MCRACE["ASIAN" MCMRACE=MCMRACE+1
.S:MCRACE["BLACK" MCMRACE=MCMRACE+1
.K:MCMRACE<2 MCMRACE
S MCRACE=$S(MCRACE["ASIAN":"O",MCRACE["BLACK":"B",1:"") K:MCRACE="" MCRACE
S DIE="^MCAR(700,",DA=MCARGDA
; MFD 2-23-93 S DR=$S($G(MCBL)=1:"[MCPFTBRIEF]",1:"[MCPFTEDIT]")
S DR="["_MCEPROC_"]"
D ORDERA G EXIT:$D(DUOUT)!$D(DTOUT)
S DIE="^MCAR(700,",DA=MCARGDA
S DR="["_MCEPROC_"]"
D ^DIE,ORDER1,QTASK^MCPARAM
D ESRC^MCESSCR(MCFILE,MCARGDA)
I $D(MCMRACE) D
.I $$GET1^DIQ(700,+MCARGDA_",",38,"E")="YES"&($$GET1^DIQ(700,+MCARGDA,38.5,"E")="") D
..N MCFDA
..S MCFDA(700,+MCARGDA_",",38)=""
..D FILE^DIE("","MCFDA")
..W !!?5,"*** Patient has both race values BLACK and ASIAN. ***"
..W !?5,"*** MUST enter a value for the RACE CORRECTIONS FOR RACE TYPE field.***"
..W !?5,"*** USE RACE CORRECTIONS field will be set to NULL. ***"
..Q
.Q
EXIT ; Leave gracefully
K DIC,DIK,DA,DIE,DR,DFN,MCRACE,DIWF,MCSEX,MCARGDA,DIR,DIDEL
K MCESON,MCESKEY,MCROUT,MCARCODE,MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCPATFLD,MCSFULL,MCSBRIEF,MCBACK
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
PVFASS ;Entry point to Associate Predicted Value Formulas
S DIC("A")="Select the SEX for which the Predicted Value will be applied: "
S DIC="^MCAR(700.1,",DIC(0)="AEQM" D ^DIC I Y<0 D EXIT Q
S DIE=DIC,DA=+Y,DR=".01;1:10;11;12:15"
D ^DIE K DIC,DIE,DLAYGO,DA,DR G PVFASS
PVFEDT ;Entry point to Enter/Edit Predicited Value Formulas
S DIC("A")="Select the Predicted Value Formula: "
S DIC(0)="AELQ",DLAYGO=700.2
S DIC=700.2,D="D" D IX^DIC I Y<0 D EXIT Q
S DIE=DIC,DA=+Y,DR=".01:9"
D ^DIE K DIC,DIE,DLAYGO,DA,DR G PVFEDT
DISP N MCX S MCX=^MCAR(700.2,+Y,0)
W ?35,"REFERENCE: ",$P(MCX,U,3)
W !,?5,"SEX: ",$S($P(MCX,U,4)="F":"Female",$P(MCX,U,4)="M":"Male",1:"")
W !,?5,"CI: ",$P(MCX,U,5),?18,"SEE: ",$P(MCX,U,6)
W !,?5,"METHOD: ",$P(MCX,U,7)
W !,?5,"DEMOGRAPHICS: ",$P(MCX,U,8)
W !,?5,"SMOKERS INCLUDED: ",$S($P(MCX,U,9)="N":"NO",$P(MCX,U,9)="Y":"YES",1:""),?30,"ALTITUDE: ",$P(MCX,U,10),! Q
BACK ;Set Y to the new record and allow the user to edit the new record
S Y=MCY,Y(0)=MCY(0),Y(0,0)=MCY(0,0),MCARGDA=+Y K MCY,DIROUT,DUOUT,DTOUT,EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTE 3136 printed Dec 13, 2024@02:15:59 Page 2
MCPFTE ;WISC/TJK-PULMONARY FUNCTION TEST ENTER/EDIT ;7/9/99 10:08
+1 ;;2.3;Medicine;**25,31,35**;09/13/1996
+2 ; Reference IA #10061 for VADPT call.
DIC ; Pulmonary Function Test Enter/Edit
+1 DO MCEPROC^MCARE
DO DATE^MCAREH
+2 SET DIC="^MCAR(700,"
SET DIC(0)="AEQLMZ"
SET (DLAYGO,DIDEL,MCFILE)=700
+3 IF MCESON
SET DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
+4 DO ^DIC
KILL DIC,DLAYGO
if Y<0
GOTO EXIT
+5 IF $DATA(DTOUT)
IF '$PIECE(Y(0),U,2)
SET DIK="^MCAR(700,"
SET DA=+Y
DO ^DIK
GOTO EXIT
+6 SET DFN=$PIECE(Y(0),U,2)
SET MCARGDA=+Y
+7 IF MCESON
IF $$ESTONUM^MCESSCR(MCFILE,MCARGDA)>2
DO ESRC^MCESSCR(MCFILE,MCARGDA)
IF '$DATA(MCBACK)
GOTO EXIT
+8 if $DATA(MCBACK)
DO BACK
+9 DO DEM^VADPT
SET MCSEX=$PIECE(VADM(5),U)
SET MCRACE=$PIECE(VADM(8),U,2)
+10 NEW MCMRACE,MCHOLD
SET MCMRACE=0
SET MCHOLD=MCRACE
SET MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
DO KVAR^VADPT
+11 IF MCRACE=""
DO RACEMSG^MCPFTSS
+12 IF MCRACE'=""
Begin DoDot:1
+13 if MCRACE["ASIAN"
SET MCMRACE=MCMRACE+1
+14 if MCRACE["BLACK"
SET MCMRACE=MCMRACE+1
+15 if MCMRACE<2
KILL MCMRACE
End DoDot:1
+16 SET MCRACE=$SELECT(MCRACE["ASIAN":"O",MCRACE["BLACK":"B",1:"")
if MCRACE=""
KILL MCRACE
+17 SET DIE="^MCAR(700,"
SET DA=MCARGDA
+18 ; MFD 2-23-93 S DR=$S($G(MCBL)=1:"[MCPFTBRIEF]",1:"[MCPFTEDIT]")
+19 SET DR="["_MCEPROC_"]"
+20 DO ORDERA
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+21 SET DIE="^MCAR(700,"
SET DA=MCARGDA
+22 SET DR="["_MCEPROC_"]"
+23 DO ^DIE
DO ORDER1
DO QTASK^MCPARAM
+24 DO ESRC^MCESSCR(MCFILE,MCARGDA)
+25 IF $DATA(MCMRACE)
Begin DoDot:1
+26 IF $$GET1^DIQ(700,+MCARGDA_",",38,"E")="YES"&($$GET1^DIQ(700,+MCARGDA,38.5,"E")="")
Begin DoDot:2
+27 NEW MCFDA
+28 SET MCFDA(700,+MCARGDA_",",38)=""
+29 DO FILE^DIE("","MCFDA")
+30 WRITE !!?5,"*** Patient has both race values BLACK and ASIAN. ***"
+31 WRITE !?5,"*** MUST enter a value for the RACE CORRECTIONS FOR RACE TYPE field.***"
+32 WRITE !?5,"*** USE RACE CORRECTIONS field will be set to NULL. ***"
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
EXIT ; Leave gracefully
+1 KILL DIC,DIK,DA,DIE,DR,DFN,MCRACE,DIWF,MCSEX,MCARGDA,DIR,DIDEL
+2 KILL MCESON,MCESKEY,MCROUT,MCARCODE,MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCPATFLD,MCSFULL,MCSBRIEF,MCBACK
+3 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
+1 QUIT
PVFASS ;Entry point to Associate Predicted Value Formulas
+1 SET DIC("A")="Select the SEX for which the Predicted Value will be applied: "
+2 SET DIC="^MCAR(700.1,"
SET DIC(0)="AEQM"
DO ^DIC
IF Y<0
DO EXIT
QUIT
+3 SET DIE=DIC
SET DA=+Y
SET DR=".01;1:10;11;12:15"
+4 DO ^DIE
KILL DIC,DIE,DLAYGO,DA,DR
GOTO PVFASS
PVFEDT ;Entry point to Enter/Edit Predicited Value Formulas
+1 SET DIC("A")="Select the Predicted Value Formula: "
+2 SET DIC(0)="AELQ"
SET DLAYGO=700.2
+3 SET DIC=700.2
SET D="D"
DO IX^DIC
IF Y<0
DO EXIT
QUIT
+4 SET DIE=DIC
SET DA=+Y
SET DR=".01:9"
+5 DO ^DIE
KILL DIC,DIE,DLAYGO,DA,DR
GOTO PVFEDT
DISP NEW MCX
SET MCX=^MCAR(700.2,+Y,0)
+1 WRITE ?35,"REFERENCE: ",$PIECE(MCX,U,3)
+2 WRITE !,?5,"SEX: ",$SELECT($PIECE(MCX,U,4)="F":"Female",$PIECE(MCX,U,4)="M":"Male",1:"")
+3 WRITE !,?5,"CI: ",$PIECE(MCX,U,5),?18,"SEE: ",$PIECE(MCX,U,6)
+4 WRITE !,?5,"METHOD: ",$PIECE(MCX,U,7)
+5 WRITE !,?5,"DEMOGRAPHICS: ",$PIECE(MCX,U,8)
+6 WRITE !,?5,"SMOKERS INCLUDED: ",$SELECT($PIECE(MCX,U,9)="N":"NO",$PIECE(MCX,U,9)="Y":"YES",1:""),?30,"ALTITUDE: ",$PIECE(MCX,U,10),!
QUIT
BACK ;Set Y to the new record and allow the user to edit the new record
+1 SET Y=MCY
SET Y(0)=MCY(0)
SET Y(0,0)=MCY(0,0)
SET MCARGDA=+Y
KILL MCY,DIROUT,DUOUT,DTOUT,EXIT
+2 QUIT
