MCARPACE ;WISC/RMP,TJK-COMBINED GENERATOR,LEAD ENTER/EDIT ;5/2/96 13:02
;;2.3;Medicine;**16,31**;09/13/1996
W @IOF,!!!,"COMBINED IMPLANT/LEADS PROCEDURES",!!!
S DIC="^MCAR(698,",DIC(0)="AELQM",(DLAYGO,DIDEL)=698
S DIC("A")="Enter Patient name or Date of Generator Implant: "
S DIC("DR")=".01;1//"_$G(MCPATNM)
D ^DIC G:Y<1 EXIT
S DFN=$P(^MCAR(698,+Y,0),U,2),DFNUM=$P(^MCAR(690,DFN,0),U,1),MCPATNM=$P(^DPT(DFNUM,0),"^",1)
W !,"Generator Information...."
S DIE=DIC,(DA,MCARGDA,MCARGDA1)=+Y,DR="2;4;6;S:$P(^(0),U,6)'=12 Y=7;6.1;7;12;14;19:601",MCFILE=698 S MCARGNUM=$$NUM(MCFILE) D IN^MCEO
G EXIT:$D(DTOUT)!$D(DUOUT) D ^DIE,OUT^MCEO,QTASK^MCPARAM G EXIT:$D(DUOUT),EXIT:$D(DTOUT) K DIC,DIE,DR,DA S MCSEL=$P(^MCAR(698,MCARGDA,0),U,7)
G @($S(MCSEL["A":"ALEAD",MCSEL["V":"VLEAD",1:"EXIT"))
ALEAD W !,"Atrial Lead Data...." S (DLAYGO,MCFILE,DIDEL)=698.2 D LAST
S DIC="^MCAR(698.2,",DIC(0)="AELQM",DIC("DR")="1////^S X=DFN",DIC("S")="I $P(^(0),U,2)=DFN",DIC("B")=$P(^MCAR(698,MCARGDA,0),U)
D ^DIC K DIC("B"),DIC("S") G EXIT:$D(DUOUT)!($D(DTOUT)) G:Y<0 @$S(MCSEL["V":"VLEAD",1:"EXIT")
S DIE=DIC,(MCARGDA,DA)=+Y,DR="2;4:601",MCFILE=698.2 S MCARGNUM=$$NUM(MCFILE) D IN^MCEO G EXIT:$D(DTOUT)!$D(DUOUT) D ^DIE,OUT^MCEO,QTASK^MCPARAM K DIC,DIE,DR,DA
G @($S(MCSEL["V":"VLEAD",1:"EXIT"))
VLEAD W !,"Ventricular Lead Data..." S (DLAYGO,MCFILE,DIDEL)=698.1 D LAST
S DIC="^MCAR(698.1,",DIC(0)="AEQLM",DIC("DR")="1////^S X=DFN",DIC("S")="I $P(^(0),U,2)=DFN",DIC("B")=$P(^MCAR(698,MCARGDA,0),U)
D ^DIC K DIC("B"),DIC("S") G EXIT:$D(DUOUT)!($D(DTOUT)),EXIT:Y<0
S DIE=DIC,(MCARGDA,DA)=+Y,DR="2;4:601",MCFILE=698.1 S MCARGNUM=$$NUM(MCFILE) D IN^MCEO G EXIT:$D(DTOUT)!$D(DUOUT) D ^DIE,OUT^MCEO,QTASK^MCPARAM K DIC,DIE,DR,DA
G EXIT
GEN2 W !,"GENERATOR DATA..."
I $D(MCOEON) K MCORSV
S MCFILE=698,DIE="^MCAR(698,",(DA,MCARGDA)=MCARGDA1,DR="19:601" D ^DIE K DIC,DIE,DR,DA,MCARGDA1 D ORDER1,QTASK^MCPARAM
EXIT K MCSEL,DFN,MCARGDA,DLAYGO,DIDEL,DFNUM Q
NUM(MCFILE) ;
Q $O(^MCAR(697.2,"C","MCAR("_MCFILE,0))
LAST S (Y,I)=0 F S I=$O(^MCAR(MCFILE,"C",DFN,I)) Q:I="" S X=+$G(^MCAR(MCFILE,I,0)) I X,X>Y S Y=X
I 'Y W !!,"No ",$S(MCFILE=698.1:"Ventricular",1:"Atrial")," Lead data entered for this patient",!! K I,Y,X Q
X ^DD("DD") W !!,"Last ",$S(MCFILE=698.1:"Ventricular",1:"Atrial")," Lead implanted on ",Y,!! K X,Y,I Q
;
DEM ; EDIT DEMOGRAPHIC INFORMATION ONLY
W @IOF,!!!,"DEMOGRAPHIC INFORMATION",!!!
;S (DIC,DIE)="^MCAR(690,",DIC(0)="AEMQZ",DIC("B")=$G(MCPATNM)
S (DIC,DIE)="^MCAR(690,",DIC(0)="AELMQZ",DIC("B")=$G(MCPATNM),DLAYGO=690
D ^DIC
K DIC
IF Y'<0 D
. S MCPATNM=Y(0,0) ; new default name
. S DA=+Y,DR="[MCARPACEDIT]"
. D ^DIE
. Q
;END IF
;
QUIT
;
ORDER1 ;
Q:'$D(MCOEON) Q:'$D(^MCAR(MCFILE,MCARGDA)) Q:$D(DTOUT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARPACE 2794 printed Apr 09, 2024@21:16:43 Page 2
MCARPACE ;WISC/RMP,TJK-COMBINED GENERATOR,LEAD ENTER/EDIT ;5/2/96 13:02
+1 ;;2.3;Medicine;**16,31**;09/13/1996
+2 WRITE @IOF,!!!,"COMBINED IMPLANT/LEADS PROCEDURES",!!!
+3 SET DIC="^MCAR(698,"
SET DIC(0)="AELQM"
SET (DLAYGO,DIDEL)=698
+4 SET DIC("A")="Enter Patient name or Date of Generator Implant: "
+5 SET DIC("DR")=".01;1//"_$GET(MCPATNM)
+6 DO ^DIC
if Y<1
GOTO EXIT
+7 SET DFN=$PIECE(^MCAR(698,+Y,0),U,2)
SET DFNUM=$PIECE(^MCAR(690,DFN,0),U,1)
SET MCPATNM=$PIECE(^DPT(DFNUM,0),"^",1)
+8 WRITE !,"Generator Information...."
+9 SET DIE=DIC
SET (DA,MCARGDA,MCARGDA1)=+Y
SET DR="2;4;6;S:$P(^(0),U,6)'=12 Y=7;6.1;7;12;14;19:601"
SET MCFILE=698
SET MCARGNUM=$$NUM(MCFILE)
DO IN^MCEO
+10 if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
DO ^DIE
DO OUT^MCEO
DO QTASK^MCPARAM
if $DATA(DUOUT)
GOTO EXIT
if $DATA(DTOUT)
GOTO EXIT
KILL DIC,DIE,DR,DA
SET MCSEL=$PIECE(^MCAR(698,MCARGDA,0),U,7)
+11 GOTO @($SELECT(MCSEL["A":"ALEAD",MCSEL["V":"VLEAD",1:"EXIT"))
ALEAD WRITE !,"Atrial Lead Data...."
SET (DLAYGO,MCFILE,DIDEL)=698.2
DO LAST
+1 SET DIC="^MCAR(698.2,"
SET DIC(0)="AELQM"
SET DIC("DR")="1////^S X=DFN"
SET DIC("S")="I $P(^(0),U,2)=DFN"
SET DIC("B")=$PIECE(^MCAR(698,MCARGDA,0),U)
+2 DO ^DIC
KILL DIC("B"),DIC("S")
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
if Y<0
GOTO @$SELECT(MCSEL["V":"VLEAD",1:"EXIT")
+3 SET DIE=DIC
SET (MCARGDA,DA)=+Y
SET DR="2;4:601"
SET MCFILE=698.2
SET MCARGNUM=$$NUM(MCFILE)
DO IN^MCEO
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
DO ^DIE
DO OUT^MCEO
DO QTASK^MCPARAM
KILL DIC,DIE,DR,DA
+4 GOTO @($SELECT(MCSEL["V":"VLEAD",1:"EXIT"))
VLEAD WRITE !,"Ventricular Lead Data..."
SET (DLAYGO,MCFILE,DIDEL)=698.1
DO LAST
+1 SET DIC="^MCAR(698.1,"
SET DIC(0)="AEQLM"
SET DIC("DR")="1////^S X=DFN"
SET DIC("S")="I $P(^(0),U,2)=DFN"
SET DIC("B")=$PIECE(^MCAR(698,MCARGDA,0),U)
+2 DO ^DIC
KILL DIC("B"),DIC("S")
if $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
if Y<0
GOTO EXIT
+3 SET DIE=DIC
SET (MCARGDA,DA)=+Y
SET DR="2;4:601"
SET MCFILE=698.1
SET MCARGNUM=$$NUM(MCFILE)
DO IN^MCEO
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
DO ^DIE
DO OUT^MCEO
DO QTASK^MCPARAM
KILL DIC,DIE,DR,DA
+4 GOTO EXIT
GEN2 WRITE !,"GENERATOR DATA..."
+1 IF $DATA(MCOEON)
KILL MCORSV
+2 SET MCFILE=698
SET DIE="^MCAR(698,"
SET (DA,MCARGDA)=MCARGDA1
SET DR="19:601"
DO ^DIE
KILL DIC,DIE,DR,DA,MCARGDA1
DO ORDER1
DO QTASK^MCPARAM
EXIT KILL MCSEL,DFN,MCARGDA,DLAYGO,DIDEL,DFNUM
QUIT
NUM(MCFILE) ;
+1 QUIT $ORDER(^MCAR(697.2,"C","MCAR("_MCFILE,0))
LAST SET (Y,I)=0
FOR
SET I=$ORDER(^MCAR(MCFILE,"C",DFN,I))
if I=""
QUIT
SET X=+$GET(^MCAR(MCFILE,I,0))
IF X
IF X>Y
SET Y=X
+1 IF 'Y
WRITE !!,"No ",$SELECT(MCFILE=698.1:"Ventricular",1:"Atrial")," Lead data entered for this patient",!!
KILL I,Y,X
QUIT
+2 XECUTE ^DD("DD")
WRITE !!,"Last ",$SELECT(MCFILE=698.1:"Ventricular",1:"Atrial")," Lead implanted on ",Y,!!
KILL X,Y,I
QUIT
+3 ;
DEM ; EDIT DEMOGRAPHIC INFORMATION ONLY
+1 WRITE @IOF,!!!,"DEMOGRAPHIC INFORMATION",!!!
+2 ;S (DIC,DIE)="^MCAR(690,",DIC(0)="AEMQZ",DIC("B")=$G(MCPATNM)
+3 SET (DIC,DIE)="^MCAR(690,"
SET DIC(0)="AELMQZ"
SET DIC("B")=$GET(MCPATNM)
SET DLAYGO=690
+4 DO ^DIC
+5 KILL DIC
+6 IF Y'<0
Begin DoDot:1
+7 ; new default name
SET MCPATNM=Y(0,0)
+8 SET DA=+Y
SET DR="[MCARPACEDIT]"
+9 DO ^DIE
+10 QUIT
End DoDot:1
+11 ;END IF
+12 ;
+13 QUIT
+14 ;
ORDER1 ;
+1 if '$DATA(MCOEON)
QUIT
if '$DATA(^MCAR(MCFILE,MCARGDA))
QUIT
if $DATA(DTOUT)
QUIT
+2 QUIT
