- 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 Jan 18, 2025@03:15:32 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