| 1 | MCPFTE ;WISC/TJK-PULMONARY FUNCTION TEST ENTER/EDIT ;7/9/99 10:08
|
|---|
| 2 | ;;2.3;Medicine;**25,31,35**;09/13/1996
|
|---|
| 3 | ; Reference IA #10061 for VADPT call.
|
|---|
| 4 | DIC ; Pulmonary Function Test Enter/Edit
|
|---|
| 5 | D MCEPROC^MCARE,DATE^MCAREH
|
|---|
| 6 | S DIC="^MCAR(700,",DIC(0)="AEQLMZ",(DLAYGO,DIDEL,MCFILE)=700
|
|---|
| 7 | I MCESON S DIC("S")=$$PREEDIT^MCESSCR(MCFILE)
|
|---|
| 8 | D ^DIC K DIC,DLAYGO G EXIT:Y<0
|
|---|
| 9 | I $D(DTOUT),'$P(Y(0),U,2) S DIK="^MCAR(700,",DA=+Y D ^DIK G EXIT
|
|---|
| 10 | S DFN=$P(Y(0),U,2),MCARGDA=+Y
|
|---|
| 11 | I MCESON,$$ESTONUM^MCESSCR(MCFILE,MCARGDA)>2 D ESRC^MCESSCR(MCFILE,MCARGDA) I '$D(MCBACK) G EXIT
|
|---|
| 12 | D:$D(MCBACK) BACK
|
|---|
| 13 | D DEM^VADPT S MCSEX=$P(VADM(5),U),MCRACE=$P(VADM(8),U,2)
|
|---|
| 14 | N MCMRACE,MCHOLD S MCMRACE=0,MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM) D KVAR^VADPT
|
|---|
| 15 | I MCRACE="" D RACEMSG^MCPFTSS
|
|---|
| 16 | I MCRACE'="" D
|
|---|
| 17 | .S:MCRACE["ASIAN" MCMRACE=MCMRACE+1
|
|---|
| 18 | .S:MCRACE["BLACK" MCMRACE=MCMRACE+1
|
|---|
| 19 | .K:MCMRACE<2 MCMRACE
|
|---|
| 20 | S MCRACE=$S(MCRACE["ASIAN":"O",MCRACE["BLACK":"B",1:"") K:MCRACE="" MCRACE
|
|---|
| 21 | S DIE="^MCAR(700,",DA=MCARGDA
|
|---|
| 22 | ; MFD 2-23-93 S DR=$S($G(MCBL)=1:"[MCPFTBRIEF]",1:"[MCPFTEDIT]")
|
|---|
| 23 | S DR="["_MCEPROC_"]"
|
|---|
| 24 | D ORDERA G EXIT:$D(DUOUT)!$D(DTOUT)
|
|---|
| 25 | S DIE="^MCAR(700,",DA=MCARGDA
|
|---|
| 26 | S DR="["_MCEPROC_"]"
|
|---|
| 27 | D ^DIE,ORDER1,QTASK^MCPARAM
|
|---|
| 28 | D ESRC^MCESSCR(MCFILE,MCARGDA)
|
|---|
| 29 | I $D(MCMRACE) D
|
|---|
| 30 | .I $$GET1^DIQ(700,+MCARGDA_",",38,"E")="YES"&($$GET1^DIQ(700,+MCARGDA,38.5,"E")="") D
|
|---|
| 31 | ..N MCFDA
|
|---|
| 32 | ..S MCFDA(700,+MCARGDA_",",38)=""
|
|---|
| 33 | ..D FILE^DIE("","MCFDA")
|
|---|
| 34 | ..W !!?5,"*** Patient has both race values BLACK and ASIAN. ***"
|
|---|
| 35 | ..W !?5,"*** MUST enter a value for the RACE CORRECTIONS FOR RACE TYPE field.***"
|
|---|
| 36 | ..W !?5,"*** USE RACE CORRECTIONS field will be set to NULL. ***"
|
|---|
| 37 | ..Q
|
|---|
| 38 | .Q
|
|---|
| 39 | EXIT ; Leave gracefully
|
|---|
| 40 | K DIC,DIK,DA,DIE,DR,DFN,MCRACE,DIWF,MCSEX,MCARGDA,DIR,DIDEL
|
|---|
| 41 | K MCESON,MCESKEY,MCROUT,MCARCODE,MCEBRIEF,MCEFULL,MCPBRIEF,MCPFULL,MCPRTRTN,MCBS,MCPATFLD,MCSFULL,MCSBRIEF,MCBACK
|
|---|
| 42 | Q
|
|---|
| 43 | ORDERA S MCARGNUM=$O(^MCAR(697.2,"C","MCAR(700",0)),MCFILE=700
|
|---|
| 44 | ORDER D:'$D(MCOEON) ORDER^MCPARAM Q:'$D(MCOEON)
|
|---|
| 45 | Q
|
|---|
| 46 | ORDER1 G IM:'$D(MCOEON) Q:'$D(^MCAR(MCFILE,MCARGDA)) Q:$D(DTOUT)
|
|---|
| 47 | IM D EN1^MCMAG
|
|---|
| 48 | Q
|
|---|
| 49 | PVFASS ;Entry point to Associate Predicted Value Formulas
|
|---|
| 50 | S DIC("A")="Select the SEX for which the Predicted Value will be applied: "
|
|---|
| 51 | S DIC="^MCAR(700.1,",DIC(0)="AEQM" D ^DIC I Y<0 D EXIT Q
|
|---|
| 52 | S DIE=DIC,DA=+Y,DR=".01;1:10;11;12:15"
|
|---|
| 53 | D ^DIE K DIC,DIE,DLAYGO,DA,DR G PVFASS
|
|---|
| 54 | PVFEDT ;Entry point to Enter/Edit Predicited Value Formulas
|
|---|
| 55 | S DIC("A")="Select the Predicted Value Formula: "
|
|---|
| 56 | S DIC(0)="AELQ",DLAYGO=700.2
|
|---|
| 57 | S DIC=700.2,D="D" D IX^DIC I Y<0 D EXIT Q
|
|---|
| 58 | S DIE=DIC,DA=+Y,DR=".01:9"
|
|---|
| 59 | D ^DIE K DIC,DIE,DLAYGO,DA,DR G PVFEDT
|
|---|
| 60 | DISP N MCX S MCX=^MCAR(700.2,+Y,0)
|
|---|
| 61 | W ?35,"REFERENCE: ",$P(MCX,U,3)
|
|---|
| 62 | W !,?5,"SEX: ",$S($P(MCX,U,4)="F":"Female",$P(MCX,U,4)="M":"Male",1:"")
|
|---|
| 63 | W !,?5,"CI: ",$P(MCX,U,5),?18,"SEE: ",$P(MCX,U,6)
|
|---|
| 64 | W !,?5,"METHOD: ",$P(MCX,U,7)
|
|---|
| 65 | W !,?5,"DEMOGRAPHICS: ",$P(MCX,U,8)
|
|---|
| 66 | 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
|
|---|
| 67 | BACK ;Set Y to the new record and allow the user to edit the new record
|
|---|
| 68 | S Y=MCY,Y(0)=MCY(0),Y(0,0)=MCY(0,0),MCARGDA=+Y K MCY,DIROUT,DUOUT,DTOUT,EXIT
|
|---|
| 69 | Q
|
|---|
