MCARED.m

MCARED ;WISC/MLH-ENTER/EDIT CARDIAC PROCEDURES-PROCESS A NEW PROCEDURE DATE ;8/3/92  15:52

 ;;2.3;Medicine;;09/13/1996

 ;

 S DIC=MCARDIC,DIC(0)="LZ",DIC("DR")=".01;1"

 S DIC("S")="D:Y>0&'$P(Y,U,3) CAUTION^MCARED(MCFILE,+Y) I $P(Y,U,3)=1"

 S (DLAYGO,MCFILE,DIDEL)=+$P(DIC,"(",2) D ^DIC K DIC,DLAYGO

 IF $P(Y,U,3)'=1 S:(X=U)!(X="") USEREND=1 ;    record didn't file

 ELSE  D

 .  S (DJDN,MCARGDA)=$P(Y,U,1),DFN=$P(Y(0),U,2) S:MCARDIC[691.8 MCARGDA1=DJDN D ORDER^MCAREO

 .  IF $D(DUOUT)!$D(DTOUT) S USEREND=1

 .  ELSE  D

 ..    S DJSC=MCARDJSC

 ..    D EN4^MCARATVE,ORDER1^MCAREO,QTASK^MCPARAM

 ..    K DIDEL

 ..    I $G(MCFILE)=691.8 D EN4^MCARATVE

 ..    Q

 .  ;END IF

 .  ;

 .  Q

 ;END IF

 ;

 QUIT

 ;

CAUTION(X,Y) ;WARN USER ON POSSIBLE DUPE ENTRY

 N MCARPAT

 S MCARPAT=$P(^MCAR(X,Y,0),U,2),MCARPAT=$P(^DPT(MCARPAT,0),U)

 W !!,"CAUTION:  POSSIBLE DUPLICATE!",*7

 W !,"A procedure with this date and time is already on file",*7

 W !,"  for ",MCARPAT,!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCARED   983     printed  Apr 09, 2024@21:14:51                                                                                                                                                                                                       Page 2

MCARED    ;WISC/MLH-ENTER/EDIT CARDIAC PROCEDURES-PROCESS A NEW PROCEDURE DATE ;8/3/92  15:52

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3        SET DIC=MCARDIC

           SET DIC(0)="LZ"

           SET DIC("DR")=".01;1"

 +4        SET DIC("S")="D:Y>0&'$P(Y,U,3) CAUTION^MCARED(MCFILE,+Y) I $P(Y,U,3)=1"

 +5        SET (DLAYGO,MCFILE,DIDEL)=+$PIECE(DIC,"(",2)

           DO ^DIC

           KILL DIC,DLAYGO

 +6       ;    record didn't file

           IF $PIECE(Y,U,3)'=1

               if (X=U)!(X="")

                   SET USEREND=1

 +7       IF '$TEST

               Begin DoDot:1

 +8                SET (DJDN,MCARGDA)=$PIECE(Y,U,1)

                   SET DFN=$PIECE(Y(0),U,2)

                   if MCARDIC[691.8

                       SET MCARGDA1=DJDN

                   DO ORDER^MCAREO

 +9                IF $DATA(DUOUT)!$DATA(DTOUT)

                       SET USEREND=1

 +10              IF '$TEST

                       Begin DoDot:2

 +11                       SET DJSC=MCARDJSC

 +12                       DO EN4^MCARATVE

                           DO ORDER1^MCAREO

                           DO QTASK^MCPARAM

 +13                       KILL DIDEL

 +14                       IF $GET(MCFILE)=691.8

                               DO EN4^MCARATVE

 +15                       QUIT 

                       End DoDot:2

 +16      ;END IF

 +17      ;

 +18               QUIT 

               End DoDot:1

 +19      ;END IF

 +20      ;

 +21       QUIT 

 +22      ;

CAUTION(X,Y) ;WARN USER ON POSSIBLE DUPE ENTRY

 +1        NEW MCARPAT

 +2        SET MCARPAT=$PIECE(^MCAR(X,Y,0),U,2)

           SET MCARPAT=$PIECE(^DPT(MCARPAT,0),U)

 +3        WRITE !!,"CAUTION:  POSSIBLE DUPLICATE!",*7

 +4        WRITE !,"A procedure with this date and time is already on file",*7

 +5        WRITE !,"  for ",MCARPAT,!

 +6        QUIT