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