MCARPCE ;WISC/TJK-ENTER/EDIT ROUTINE FOR PACEMAKER SURVEILLANCE ;5/2/96 08:54
;;2.3;Medicine;**31**;09/13/1996
START S DIC="^MCAR(698.3,",DIC(0)="AEQLM",(MCFILE,DLAYGO,DIDEL)=698.3,DIC("DR")=".01;1//"_$G(MCPATNM)
S DIC("A")="Enter Patient Name, or Date and Time: "
S DIC("B")=$G(MCPATNM)
W @IOF,"SURVEILLANCE PROCEDURES"
I $G(DJSC) W " *** SCREEN EDIT ***"
E I $G(MCBL)=1 W " *** BRIEF EDIT ***"
W !!!
D ^DIC G EXIT:Y<0 S MCARGDA=+Y S MCARNEW="" S:$P(Y,U,3) MCARNEW=1
S (MCARNAM,DFN)=$P(^MCAR(698.3,+Y,0),U,2)
I 'MCARNAM S MCARNEW=1 D KILL G EXIT
I '$D(^MCAR(698,"C",MCARNAM)) D MSG G EXIT
; Get new default patient name
S MCX=$$VALUE^MCENDIQ1(MCFILE,+Y,1)
I MCX'="" S MCPATNM=MCX
; Get most recent procedure
F I=0:0 S I=$O(^MCAR(690,"AC",MCARNAM,I)) Q:I="" Q:$O(^(I,0))="MCAR(698"
I I="" D MSG G EXIT
S MCARGEN=$O(^MCAR(690,"AC",MCARNAM,I,"MCAR(698",0)) I 'MCARGEN D MSG G EXIT
I '$D(^MCAR(698,MCARGEN,0)) D MSG G EXIT
I $D(^MCAR(698,MCARGEN,1)),$P(^(1),U,1) D MSG G EXIT
I $P(^MCAR(698,MCARGEN,0),U,7)="" W !!,*7,"TYPE OF LEAD NOT DEFINED FOR THIS PATIENT IN GENERATOR FILE",!! R "PRESS RETURN TO CONTINUE: ",X:DTIME D KILL G EXIT
S MCARLEAD=$P(^MCAR(698,MCARGEN,0),U,7)
S DIE="^MCAR(698.3,",DR=3,DA=MCARGDA D ^DIE G EXIT:$D(Y),EXIT:$D(DTOUT)
S MCARFLG=$S($P(^MCAR(698.3,DA,0),U,4)["T":1,1:"")
G SCREEN1:$D(DJSC) S DR=$S($G(MCBL)=1:"[MCARPACSURVBRIEF]",1:"[MCARPACSURV]"),DA=MCARGDA,MCFILE=698.3 D ORDERA G EXIT:$D(DUOUT)!$D(DTOUT) D ^DIE,ORDER1,QTASK^MCPARAM
EXIT K %,%X,%Y,%Y2,C,D0,DA,DI,DJSC,DQ,DR,DZ,I,J,MCARFLG,MCARGDA,MCARGEN,MCARLEAD,MCARNAM,MCX,X,Y,DLAYGO,DIDEL,MCFILE,MCARNEW D EXIT^MCARGE Q
ORDERA S MCARGNUM=$O(^MCAR(697.2,"C","MCAR("_MCFILE,0))
ORDER D:'$D(MCOEON) ORDER^MCPARAM Q:'$D(MCOEON)
Q
ORDER1 G IM:'$D(MCOEON) Q:'$D(^MCAR(MCFILE,MCARGDA)) Q:$D(DTOUT)
IM D EN1^MCMAG Q
SCREEN K DJSC
S (DJSC,MCARGNUM)=$O(^MCAR(697.2,"BA","PACEMAKER SURVEILLANCE",0))
G EXIT:DJSC="",START
SCREEN1 S DJDN=MCARGDA,DJSC=$S($G(MCBS)=1:"MCPACSURVBR",1:"MCPACSUR"_$S(MCARFLG:"T",1:"C")_MCARLEAD)
D ORDERA G EXIT:$D(DTOUT)!$D(DUOUT) D EN^MCARD,ORDER1,QTASK^MCPARAM
;get new default patient name
S MCX=$$VALUE^MCENDIQ1(MCFILE,MCARGDA,1)
I MCX'="" S MCPATNM=MCX
G EXIT
MSG W !!,"PATIENT HAS NO CURRENT GENERATOR IMPLANT LISTED IN GENERATOR FILE",!! R "PRESS RETURN TO CONTINUE ",X:DTIME D KILL Q
KILL I MCARNEW S DIK="^MCAR(698.3,",DA=MCARGDA D ^DIK W !,*7,"Entry Deleted"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPCE 2471 printed Apr 09, 2024@21:14:52 Page 2
MCARPCE ;WISC/TJK-ENTER/EDIT ROUTINE FOR PACEMAKER SURVEILLANCE ;5/2/96 08:54
+1 ;;2.3;Medicine;**31**;09/13/1996
START SET DIC="^MCAR(698.3,"
SET DIC(0)="AEQLM"
SET (MCFILE,DLAYGO,DIDEL)=698.3
SET DIC("DR")=".01;1//"_$GET(MCPATNM)
+1 SET DIC("A")="Enter Patient Name, or Date and Time: "
+2 SET DIC("B")=$GET(MCPATNM)
+3 WRITE @IOF,"SURVEILLANCE PROCEDURES"
+4 IF $GET(DJSC)
WRITE " *** SCREEN EDIT ***"
+5 IF '$TEST
IF $GET(MCBL)=1
WRITE " *** BRIEF EDIT ***"
+6 WRITE !!!
+7 DO ^DIC
if Y<0
GOTO EXIT
SET MCARGDA=+Y
SET MCARNEW=""
if $PIECE(Y,U,3)
SET MCARNEW=1
+8 SET (MCARNAM,DFN)=$PIECE(^MCAR(698.3,+Y,0),U,2)
+9 IF 'MCARNAM
SET MCARNEW=1
DO KILL
GOTO EXIT
+10 IF '$DATA(^MCAR(698,"C",MCARNAM))
DO MSG
GOTO EXIT
+11 ; Get new default patient name
+12 SET MCX=$$VALUE^MCENDIQ1(MCFILE,+Y,1)
+13 IF MCX'=""
SET MCPATNM=MCX
+14 ; Get most recent procedure
+15 FOR I=0:0
SET I=$ORDER(^MCAR(690,"AC",MCARNAM,I))
if I=""
QUIT
if $ORDER(^(I,0))="MCAR(698"
QUIT
+16 IF I=""
DO MSG
GOTO EXIT
+17 SET MCARGEN=$ORDER(^MCAR(690,"AC",MCARNAM,I,"MCAR(698",0))
IF 'MCARGEN
DO MSG
GOTO EXIT
+18 IF '$DATA(^MCAR(698,MCARGEN,0))
DO MSG
GOTO EXIT
+19 IF $DATA(^MCAR(698,MCARGEN,1))
IF $PIECE(^(1),U,1)
DO MSG
GOTO EXIT
+20 IF $PIECE(^MCAR(698,MCARGEN,0),U,7)=""
WRITE !!,*7,"TYPE OF LEAD NOT DEFINED FOR THIS PATIENT IN GENERATOR FILE",!!
READ "PRESS RETURN TO CONTINUE: ",X:DTIME
DO KILL
GOTO EXIT
+21 SET MCARLEAD=$PIECE(^MCAR(698,MCARGEN,0),U,7)
+22 SET DIE="^MCAR(698.3,"
SET DR=3
SET DA=MCARGDA
DO ^DIE
if $DATA(Y)
GOTO EXIT
if $DATA(DTOUT)
GOTO EXIT
+23 SET MCARFLG=$SELECT($PIECE(^MCAR(698.3,DA,0),U,4)["T":1,1:"")
+24 if $DATA(DJSC)
GOTO SCREEN1
SET DR=$SELECT($GET(MCBL)=1:"[MCARPACSURVBRIEF]",1:"[MCARPACSURV]")
SET DA=MCARGDA
SET MCFILE=698.3
DO ORDERA
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
DO ^DIE
DO ORDER1
DO QTASK^MCPARAM
EXIT KILL %,%X,%Y,%Y2,C,D0,DA,DI,DJSC,DQ,DR,DZ,I,J,MCARFLG,MCARGDA,MCARGEN,MCARLEAD,MCARNAM,MCX,X,Y,DLAYGO,DIDEL,MCFILE,MCARNEW
DO EXIT^MCARGE
QUIT
ORDERA SET MCARGNUM=$ORDER(^MCAR(697.2,"C","MCAR("_MCFILE,0))
ORDER if '$DATA(MCOEON)
DO ORDER^MCPARAM
if '$DATA(MCOEON)
QUIT
+1 QUIT
ORDER1 if '$DATA(MCOEON)
GOTO IM
if '$DATA(^MCAR(MCFILE,MCARGDA))
QUIT
if $DATA(DTOUT)
QUIT
IM DO EN1^MCMAG
QUIT
SCREEN KILL DJSC
+1 SET (DJSC,MCARGNUM)=$ORDER(^MCAR(697.2,"BA","PACEMAKER SURVEILLANCE",0))
+2 if DJSC=""
GOTO EXIT
GOTO START
SCREEN1 SET DJDN=MCARGDA
SET DJSC=$SELECT($GET(MCBS)=1:"MCPACSURVBR",1:"MCPACSUR"_$SELECT(MCARFLG:"T",1:"C")_MCARLEAD)
+1 DO ORDERA
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
DO EN^MCARD
DO ORDER1
DO QTASK^MCPARAM
+2 ;get new default patient name
+3 SET MCX=$$VALUE^MCENDIQ1(MCFILE,MCARGDA,1)
+4 IF MCX'=""
SET MCPATNM=MCX
+5 GOTO EXIT
MSG WRITE !!,"PATIENT HAS NO CURRENT GENERATOR IMPLANT LISTED IN GENERATOR FILE",!!
READ "PRESS RETURN TO CONTINUE ",X:DTIME
DO KILL
QUIT
KILL IF MCARNEW
SET DIK="^MCAR(698.3,"
SET DA=MCARGDA
DO ^DIK
WRITE !,*7,"Entry Deleted"
+1 QUIT
