- 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 Feb 18, 2025@23:42:26 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