58 lines
2.4 KiB
Mathematica
58 lines
2.4 KiB
Mathematica
MCARATVE ;WISC/TJK,RCH-ENTER/EDIT CARDIAC PROCEDURES ;5/2/96 13:53
|
|
;;2.3;Medicine;**35**;09/13/1996
|
|
; Reference IA #10061 for VADPT calls
|
|
EN4 ; ENTRY POINT FOR ATRIAL,VENTRICULAR STUDY ENTRY/EDIT (SCREEN)
|
|
IF $D(MCARZDN) D ; must have something to associate with
|
|
. S MCARGNUM=$O(^MCAR(697.2,"C","MCAR(691.8",0)),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|
. D ATSTUD,VENSTUD ; atrial study
|
|
.; I 'USEREND D VENSTUD ; ventricular study
|
|
. K MCARZDN
|
|
. Q
|
|
D EXIT ; clean up variables
|
|
Q
|
|
ATSTUD ; atrial study
|
|
N ENDAT
|
|
S ENDAT=0
|
|
FOR D Q:ENDAT
|
|
. S DIC(0)="AEQLMN",DIC="^MCAR(691.9,",DJSC="MCAREPAT",DIC("S")="I $P(^(0),U,2)=MCARZDN",(DLAYGO,DIDEL)=691.9 D ^DIC K DLAYGO
|
|
. I Y<0 S ENDAT=1 ; no more atrial studies
|
|
. E S DJDN=+Y,$P(^MCAR(691.9,+Y,0),U,2)=MCARZDN,^MCAR(691.9,"C",MCARZDN,+Y)="" D EN^MCARD
|
|
. Q
|
|
;END FOR
|
|
Q
|
|
VENSTUD ; ventricular study
|
|
N ENDVEN
|
|
S ENDVEN=0
|
|
FOR D Q:ENDVEN
|
|
. N DLAYGO S DLAYGO=692
|
|
. S DIC(0)="AEQLMN",DIC="^MCAR(692,",DJSC="MCAREPVT",DIC("S")="I $P(^(0),U,2)=MCARZDN" D ^DIC
|
|
. I Y<0 S ENDVEN=1 ; no more ventricular studies
|
|
. E S DJDN=+Y,$P(^MCAR(692,+Y,0),U,2)=MCARZDN,^MCAR(692,"C",MCARZDN,+Y)="",(DIDEL,DLAYGO)=692 D EN^MCARD K DLAYGO
|
|
. Q
|
|
;END FOR
|
|
Q
|
|
END K MCARZDN G EXIT
|
|
EN51 S (DIC,DIE)="^MCAR("_MCFILE_",",DIC(0)="AEQLMZ",(DLAYGO,DIDEL)=MCFILE
|
|
D ^DIC G EXIT:Y<0 S (MCARGDA,DA,MCARGDA1)=+Y I $G(MCBL)=1 S DR="[MCARHEMBRIEF]"
|
|
E S DR=$S($G(MCBL)=1:$P($T(@MCLINE),";;",3),1:$P($T(@MCLINE),";;",2))
|
|
K DIC("DR"),DIC("S") S DFN=$P(Y(0),U,2)
|
|
I MCFILE=694 S MCARGNUM=$P(Y(0),U,3),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|
I MCFILE=699.5 S MCARGNUM=$P(Y(0),U,3),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|
D IN^MCEO G EXIT:$D(DUOUT)!$D(DTOUT) D ^DIE S:(MCFILE=691.9)!(MCFILE=692) MCFILE=691.8,MCARGDA=MCARGDA1 D OUT^MCEO,PCC^MCARE1 G EXIT
|
|
EN6 ;ENTRY POINT FOR HEMATOLOGY,PACEMAKER IMPLANTS ENTER/EDIT
|
|
I MCFILE'=694 S MCARGNUM=$O(^MCAR(697.2,"C","MCAR("_MCFILE,0)),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|
S MCLINE=$S(MCFILE=694:"HEM",MCFILE=698:"GENIMP",MCFILE=698.1:"VLEAD",1:"ALEAD") G EN51
|
|
SETUP4 ;MFR 25-JAN-93 GET VARS FOR PFT ENTRY/EDIT
|
|
;NEXT LINE DEFINES LOOKUP VARIABLES IF CALLED FROM DJINJ
|
|
I '$D(DFN) S DFN=$P(@(DIC_DA_",0)"),U,2),MCARGDA=DA
|
|
;CALLED BY 'DATE' PARAGRAPH AND BY SCREEN HANDLER ROUTINES
|
|
D DEM^VADPT
|
|
S MCSEX=$P(VADM(5),U,1),MCRACE=$P(VADM(8),U,2)
|
|
N MCHOLD S MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
|
|
D KVAR^VADPT
|
|
I MCRACE["BLACK" S MCRACE="B"
|
|
E K MCRACE
|
|
Q
|
|
EXIT ;
|
|
Q
|