source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARATVE.m@ 1375

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1MCARATVE ;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
4EN4 ; 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
13ATSTUD ; 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
23VENSTUD ; 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
34END K MCARZDN G EXIT
35EN51 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
42EN6 ;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
45SETUP4 ;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
56EXIT ;
57 Q
Note: See TracBrowser for help on using the repository browser.