| 1 | MCARATVE ;WISC/TJK,RCH-ENTER/EDIT CARDIAC PROCEDURES ;5/2/96 13:53
|
|---|
| 2 | ;;2.3;Medicine;**35**;09/13/1996
|
|---|
| 3 | ; Reference IA #10061 for VADPT calls
|
|---|
| 4 | EN4 ; ENTRY POINT FOR ATRIAL,VENTRICULAR STUDY ENTRY/EDIT (SCREEN)
|
|---|
| 5 | IF $D(MCARZDN) D ; must have something to associate with
|
|---|
| 6 | . S MCARGNUM=$O(^MCAR(697.2,"C","MCAR(691.8",0)),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|---|
| 7 | . D ATSTUD,VENSTUD ; atrial study
|
|---|
| 8 | .; I 'USEREND D VENSTUD ; ventricular study
|
|---|
| 9 | . K MCARZDN
|
|---|
| 10 | . Q
|
|---|
| 11 | D EXIT ; clean up variables
|
|---|
| 12 | Q
|
|---|
| 13 | ATSTUD ; atrial study
|
|---|
| 14 | N ENDAT
|
|---|
| 15 | S ENDAT=0
|
|---|
| 16 | FOR D Q:ENDAT
|
|---|
| 17 | . 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
|
|---|
| 18 | . I Y<0 S ENDAT=1 ; no more atrial studies
|
|---|
| 19 | . E S DJDN=+Y,$P(^MCAR(691.9,+Y,0),U,2)=MCARZDN,^MCAR(691.9,"C",MCARZDN,+Y)="" D EN^MCARD
|
|---|
| 20 | . Q
|
|---|
| 21 | ;END FOR
|
|---|
| 22 | Q
|
|---|
| 23 | VENSTUD ; ventricular study
|
|---|
| 24 | N ENDVEN
|
|---|
| 25 | S ENDVEN=0
|
|---|
| 26 | FOR D Q:ENDVEN
|
|---|
| 27 | . N DLAYGO S DLAYGO=692
|
|---|
| 28 | . S DIC(0)="AEQLMN",DIC="^MCAR(692,",DJSC="MCAREPVT",DIC("S")="I $P(^(0),U,2)=MCARZDN" D ^DIC
|
|---|
| 29 | . I Y<0 S ENDVEN=1 ; no more ventricular studies
|
|---|
| 30 | . 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
|
|---|
| 31 | . Q
|
|---|
| 32 | ;END FOR
|
|---|
| 33 | Q
|
|---|
| 34 | END K MCARZDN G EXIT
|
|---|
| 35 | EN51 S (DIC,DIE)="^MCAR("_MCFILE_",",DIC(0)="AEQLMZ",(DLAYGO,DIDEL)=MCFILE
|
|---|
| 36 | D ^DIC G EXIT:Y<0 S (MCARGDA,DA,MCARGDA1)=+Y I $G(MCBL)=1 S DR="[MCARHEMBRIEF]"
|
|---|
| 37 | E S DR=$S($G(MCBL)=1:$P($T(@MCLINE),";;",3),1:$P($T(@MCLINE),";;",2))
|
|---|
| 38 | K DIC("DR"),DIC("S") S DFN=$P(Y(0),U,2)
|
|---|
| 39 | I MCFILE=694 S MCARGNUM=$P(Y(0),U,3),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|---|
| 40 | I MCFILE=699.5 S MCARGNUM=$P(Y(0),U,3),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|---|
| 41 | 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
|
|---|
| 42 | EN6 ;ENTRY POINT FOR HEMATOLOGY,PACEMAKER IMPLANTS ENTER/EDIT
|
|---|
| 43 | I MCFILE'=694 S MCARGNUM=$O(^MCAR(697.2,"C","MCAR("_MCFILE,0)),MCARGNAM=$P(^MCAR(697.2,MCARGNUM,0),U)
|
|---|
| 44 | S MCLINE=$S(MCFILE=694:"HEM",MCFILE=698:"GENIMP",MCFILE=698.1:"VLEAD",1:"ALEAD") G EN51
|
|---|
| 45 | SETUP4 ;MFR 25-JAN-93 GET VARS FOR PFT ENTRY/EDIT
|
|---|
| 46 | ;NEXT LINE DEFINES LOOKUP VARIABLES IF CALLED FROM DJINJ
|
|---|
| 47 | I '$D(DFN) S DFN=$P(@(DIC_DA_",0)"),U,2),MCARGDA=DA
|
|---|
| 48 | ;CALLED BY 'DATE' PARAGRAPH AND BY SCREEN HANDLER ROUTINES
|
|---|
| 49 | D DEM^VADPT
|
|---|
| 50 | S MCSEX=$P(VADM(5),U,1),MCRACE=$P(VADM(8),U,2)
|
|---|
| 51 | N MCHOLD S MCHOLD=MCRACE,MCRACE=$$ETHN^MCPFTP1(MCHOLD,.VADM)
|
|---|
| 52 | D KVAR^VADPT
|
|---|
| 53 | I MCRACE["BLACK" S MCRACE="B"
|
|---|
| 54 | E K MCRACE
|
|---|
| 55 | Q
|
|---|
| 56 | EXIT ;
|
|---|
| 57 | Q
|
|---|
