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 ---[H[J[2J[HMCARED 983 printed Dec 13, 2024@02:12:49 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
