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