source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARED.m@ 1800

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

initial load of WorldVistAEHR

File size: 953 bytes
RevLine 
[613]1MCARED ;WISC/MLH-ENTER/EDIT CARDIAC PROCEDURES-PROCESS A NEW PROCEDURE DATE ;8/3/92 15:52
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 S DIC=MCARDIC,DIC(0)="LZ",DIC("DR")=".01;1"
5 S DIC("S")="D:Y>0&'$P(Y,U,3) CAUTION^MCARED(MCFILE,+Y) I $P(Y,U,3)=1"
6 S (DLAYGO,MCFILE,DIDEL)=+$P(DIC,"(",2) D ^DIC K DIC,DLAYGO
7 IF $P(Y,U,3)'=1 S:(X=U)!(X="") USEREND=1 ; record didn't file
8 ELSE D
9 . S (DJDN,MCARGDA)=$P(Y,U,1),DFN=$P(Y(0),U,2) S:MCARDIC[691.8 MCARGDA1=DJDN D ORDER^MCAREO
10 . IF $D(DUOUT)!$D(DTOUT) S USEREND=1
11 . ELSE D
12 .. S DJSC=MCARDJSC
13 .. D EN4^MCARATVE,ORDER1^MCAREO,QTASK^MCPARAM
14 .. K DIDEL
15 .. I $G(MCFILE)=691.8 D EN4^MCARATVE
16 .. Q
17 . ;END IF
18 . ;
19 . Q
20 ;END IF
21 ;
22 QUIT
23 ;
24CAUTION(X,Y) ;WARN USER ON POSSIBLE DUPE ENTRY
25 N MCARPAT
26 S MCARPAT=$P(^MCAR(X,Y,0),U,2),MCARPAT=$P(^DPT(MCARPAT,0),U)
27 W !!,"CAUTION: POSSIBLE DUPLICATE!",*7
28 W !,"A procedure with this date and time is already on file",*7
29 W !," for ",MCARPAT,!
30 Q
Note: See TracBrowser for help on using the repository browser.