DGPTFM1 ;ALB/MTC - MASTER DIAG/OP/PRO CODE ENTER/EDIT ;4/4/05 3:08pm
;;5.3;Registration;**114,517,635,1015**;Aug 13, 1993;Build 21
;
D G D^DGPTFM0
;
A S L="" F I=1:1:PM S L2=1 F J=5:1:9 I L2&(J'=10)&($P(M(I),U,J)="") S L=L_I_",",L2=0
I L="" W !!,"There are no movement records that can be added to.",*7,*7 H 2 G ^DGPTFM
S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G A2
A1 I 'Z W !!,"Add to movement record <",L,"> : " R RC:DTIME G ^DGPTFM:RC[U!('$T)!(RC="")
E S RC=+$E(A,2,99)
A2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the movement record number to add ICD diagnosis to: ",L S Z="" G A1
S DIE="^DGPT(",(DA,DGPTF)=PTF,DR="[DG501]",DGJUMP=""
S DGMOV=+M(RC),DGADD=1 D ^DIE K DR,DA,DGADD,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV,DGADD
G ^DGPTFM
;
M I DGPTFE G ADD^DGPTFM4
S X=80 X ^%ZOSF("RM") D MVT K T,AM,M I $L(DGVO_DGVI)>4 S X=132 X ^%ZOSF("RM")
G ^DGPTFM:'$D(DGPMDA) S DA=$S('$D(^DGPM(DGPMDA,"PTF")):"",1:$P(^("PTF"),"^",3)) G ^DGPTFM:'$D(^DGPT(PTF,"M",+DA,0)) S Y=^(0)
S X=$S($D(^DIC(42.4,+$P(Y,U,2),0)):$P(^(0),U,1),1:""),Y=$P(Y,U,10)
D D^DGPTUTL K M W !,"Editing ",$S(DA=1:"Discharge ",1:""),"Movement " W:Y]"" "of ",Y W " Losing Specialty ",X
S DGMOV=DA,(DA,DGPTF)=PTF,DIE="^DGPT(",DR="[DG501]",DGJUMP="1-2" D ^DIE
K DA,DR,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV
;- update MT indicator after edit movement
N DGPMCA,DGPMAN D PM^DGPTUTL
I '$G(DGADM) S DGADM=+^DGPT(PTF,0)
D MT^DGPTUTL
G ^DGPTFM
;
Z I 'SU W !,"No surgeries to delete",! H 3 G ^DGPTFM
S ST=1 I 'Z W !!,"Delete surgery record <1",$S(SU=1:"",1:"-"_SU),">: " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="")
E S RC=$E(A,2,99) W !
I +RC'=RC!('$D(S(RC))) W !!,"Enter the record # to delete from the PTF file, 1",$S(SU=1:"",1:"-"_SU) S Z=0 G Z
K DA S DIK="^DGPT("_PTF_",""S"",",ST=1,(DGPTF,DA(1))=PTF,(DGSUR,DA)=+S(RC,1) D ^DIK K DA W " ",RC,"-DELETED***" D CHK401^DGPTSCAN K DGPTF,DGSUR H 2 G ^DGPTFM
;
C G CEL:Z
I '$D(S2) W !,"View codes first",! H 2 G ^DGPTFM
I 'S2 W !,"No codes to delete",! H 2 G ^DGPTFM
C1 R !!,"Enter the item #'s of the ICD operation codes to delete: ",A1:DTIME
S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D C^DGPTFM0 G C1
S A=A_A1
CEL D EXPL^DGPTUTL
K X,A1 S DA(1)=PTF,DP=45.01 W !!
F J=1:1 S L=+$P(DGA,",",J),DIE="^DGPT("_PTF_",""S""," Q:'L D
.S L1=$S($D(S2(L)):S2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1
.I L1 S (DA,DGSUR)=+S(+L1,1),(DA(1),DGPTF)=PTF,DR=7+$P(S2(+L),U,2)_"///@" D ^DIE,CEL1
H 3 S ST=1 G ^DGPTFM
;
CEL1 ;
K DR W " ",L,"-Deleted, " W:$X>70 ! D CHK401^DGPTSCAN K DGPTF,DGSUR
Q
;
O S L="" F I=1:1:SU S L2=1 F J=8:1:12 I L2,$P(S(I),U,J)="" S L=L_I_",",L2=0
I L="" W !!,"There are no surgery records that can be added to.",*7 H 2 S ST=1 G ^DGPTFM
S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G O2
O1 I 'Z S ST=1 W !!,"Add to surgery record <",L,"> : " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="")
E S RC=+$E(A,2,99)
O2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the surgery record number to add ICD operation codes to: ",L G O1:'Z S Z="" G O1
S DIE="^DGPT(",(DGPTF,DA)=PTF,DR="[DG401]"
S ST=1,DGZS0=RC,DGADD=1,DGSUR=S(DGZS0,1) D ^DIE,CHK401^DGPTSCAN K DR,DGPTF,DGSUR,DGADD G ^DGPTFM
;
S G ADD^DGPTFM5
V S DGZM0=0 G ^DGPTFM4
J S DGZS0=0 G ^DGPTFM5
Q G QEL:Z
QQ R !!,"Enter the item #'s of the ICD Procedure codes to delete: ",A1:DTIME
S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D Q^DGPTFM0 G QQ
S A=A_A1
QEL S DGA=$E(A,2,999) K X,A1 S DIE="^DGPT(",DA=PTF W !!
F J=1:1 S DP=45,L=+$P(DGA,",",J) Q:'L S L1=$S($D(P2(L)):P2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1 I L1 S DR=+P2(+L)/100+45_"///@",DA(1)=PTF D ^DIE K DR W " ",L,"-Deleted, " W:$X>70 !
H 2 G ^DGPTFM
;
P G P^DGPTFM6
Q1 Q
T G ^DGPTFM6
R G R^DGPTFM4
E I $D(^DGPT(PTF,70)),+^(70)>2871000 D MOB^DGPTFM6 G SET^DGPTFM6
I DT>2871000 D MOB^DGPTFM6 G SET^DGPTFM6
G ^DGPTFM6
;
MVT ;
N PTF,DGPMAN
S DGPMT=6 D CA^DGPMV S DGPMDA=+Y
K DGPMT Q
I G ADD^DGPTFM2
Y G DEL^DGPTFM2
N G N^DGPTFM2
G G DC^DGPTFM2
F G F^DGPTFM2
DGPTFM1 ;ALB/MTC - MASTER DIAG/OP/PRO CODE ENTER/EDIT ;4/4/05 3:08pm
+1 ;;5.3;Registration;**114,517,635,1015**;Aug 13, 1993;Build 21
+2 ;
D GOTO D^DGPTFM0
+1 ;
A SET L=""
FOR I=1:1:PM
SET L2=1
FOR J=5:1:9
IF L2&(J'=10)&($PIECE(M(I),U,J)="")
SET L=L_I_","
SET L2=0
+1 IF L=""
WRITE !!,"There are no movement records that can be added to.",*7,*7
HANG 2
GOTO ^DGPTFM
+2 SET L=$EXTRACT(L,1,$LENGTH(L)-1)
IF L=+L
SET RC=+L
GOTO A2
A1 IF 'Z
WRITE !!,"Add to movement record <",L,"> : "
READ RC:DTIME
IF RC[U!('$TEST)!(RC="")
GOTO ^DGPTFM
+1 IF '$TEST
SET RC=+$EXTRACT(A,2,99)
A2 IF +RC'=RC!(","_L_","'[(","_RC_","))
WRITE !!,"Enter the movement record number to add ICD diagnosis to: ",L
SET Z=""
GOTO A1
+1 SET DIE="^DGPT("
SET (DA,DGPTF)=PTF
SET DR="[DG501]"
SET DGJUMP=""
+2 SET DGMOV=+M(RC)
SET DGADD=1
DO ^DIE
KILL DR,DA,DGADD,DIE,DGJUMP
DO CHK501^DGPTSCAN
KILL DGPTF,DGMOV,DGADD
+3 GOTO ^DGPTFM
+4 ;
M IF DGPTFE
GOTO ADD^DGPTFM4
+1 SET X=80
XECUTE ^%ZOSF("RM")
DO MVT
KILL T,AM,M
IF $LENGTH(DGVO_DGVI)>4
SET X=132
XECUTE ^%ZOSF("RM")
+2 IF '$DATA(DGPMDA)
GOTO ^DGPTFM
SET DA=$SELECT('$DATA(^DGPM(DGPMDA,"PTF")):"",1:$PIECE(^("PTF"),"^",3))
IF '$DATA(^DGPT(PTF,"M",+DA,0))
GOTO ^DGPTFM
SET Y=^(0)
+3 SET X=$SELECT($DATA(^DIC(42.4,+$PIECE(Y,U,2),0)):$PIECE(^(0),U,1),1:"")
SET Y=$PIECE(Y,U,10)
+4 DO D^DGPTUTL
KILL M
WRITE !,"Editing ",$SELECT(DA=1:"Discharge ",1:""),"Movement "
IF Y]""
WRITE "of ",Y
WRITE " Losing Specialty ",X
+5 SET DGMOV=DA
SET (DA,DGPTF)=PTF
SET DIE="^DGPT("
SET DR="[DG501]"
SET DGJUMP="1-2"
DO ^DIE
+6 KILL DA,DR,DIE,DGJUMP
DO CHK501^DGPTSCAN
KILL DGPTF,DGMOV
+7 ;- update MT indicator after edit movement
+8 NEW DGPMCA,DGPMAN
DO PM^DGPTUTL
+9 IF '$GET(DGADM)
SET DGADM=+^DGPT(PTF,0)
+10 DO MT^DGPTUTL
+11 GOTO ^DGPTFM
+12 ;
Z IF 'SU
WRITE !,"No surgeries to delete",!
HANG 3
GOTO ^DGPTFM
+1 SET ST=1
IF 'Z
WRITE !!,"Delete surgery record <1",$SELECT(SU=1:"",1:"-"_SU),">: "
READ RC:DTIME
IF '$TEST!(RC[U)!(RC="")
GOTO ^DGPTFM
+2 IF '$TEST
SET RC=$EXTRACT(A,2,99)
WRITE !
+3 IF +RC'=RC!('$DATA(S(RC)))
WRITE !!,"Enter the record # to delete from the PTF file, 1",$SELECT(SU=1:"",1:"-"_SU)
SET Z=0
GOTO Z
+4 KILL DA
SET DIK="^DGPT("_PTF_",""S"","
SET ST=1
SET (DGPTF,DA(1))=PTF
SET (DGSUR,DA)=+S(RC,1)
DO ^DIK
KILL DA
WRITE " ",RC,"-DELETED***"
DO CHK401^DGPTSCAN
KILL DGPTF,DGSUR
HANG 2
GOTO ^DGPTFM
+5 ;
C IF Z
GOTO CEL
+1 IF '$DATA(S2)
WRITE !,"View codes first",!
HANG 2
GOTO ^DGPTFM
+2 IF 'S2
WRITE !,"No codes to delete",!
HANG 2
GOTO ^DGPTFM
C1 READ !!,"Enter the item #'s of the ICD operation codes to delete: ",A1:DTIME
+1 IF '$TEST
SET A1=U
IF A1'?1N.NP
IF "^"[A1
GOTO ^DGPTFM
IF A1'["?"
WRITE " ???",*7
DO C^DGPTFM0
GOTO C1
+2 SET A=A_A1
CEL DO EXPL^DGPTUTL
+1 KILL X,A1
SET DA(1)=PTF
SET DP=45.01
WRITE !!
+2 FOR J=1:1
SET L=+$PIECE(DGA,",",J)
SET DIE="^DGPT("_PTF_",""S"","
IF 'L
QUIT
Begin DoDot:1
+3 SET L1=$SELECT($DATA(S2(L)):S2(L),1:"Undefined, ")
IF 'L1
WRITE " ",L,"-",L1
+4 IF L1
SET (DA,DGSUR)=+S(+L1,1)
SET (DA(1),DGPTF)=PTF
SET DR=7+$PIECE(S2(+L),U,2)_"///@"
DO ^DIE
DO CEL1
End DoDot:1
+5 HANG 3
SET ST=1
GOTO ^DGPTFM
+6 ;
CEL1 ;
+1 KILL DR
WRITE " ",L,"-Deleted, "
IF $X>70
WRITE !
DO CHK401^DGPTSCAN
KILL DGPTF,DGSUR
+2 QUIT
+3 ;
O SET L=""
FOR I=1:1:SU
SET L2=1
FOR J=8:1:12
IF L2
IF $PIECE(S(I),U,J)=""
SET L=L_I_","
SET L2=0
+1 IF L=""
WRITE !!,"There are no surgery records that can be added to.",*7
HANG 2
SET ST=1
GOTO ^DGPTFM
+2 SET L=$EXTRACT(L,1,$LENGTH(L)-1)
IF L=+L
SET RC=+L
GOTO O2
O1 IF 'Z
SET ST=1
WRITE !!,"Add to surgery record <",L,"> : "
READ RC:DTIME
IF '$TEST!(RC[U)!(RC="")
GOTO ^DGPTFM
+1 IF '$TEST
SET RC=+$EXTRACT(A,2,99)
O2 IF +RC'=RC!(","_L_","'[(","_RC_","))
WRITE !!,"Enter the surgery record number to add ICD operation codes to: ",L
IF 'Z
GOTO O1
SET Z=""
GOTO O1
+1 SET DIE="^DGPT("
SET (DGPTF,DA)=PTF
SET DR="[DG401]"
+2 SET ST=1
SET DGZS0=RC
SET DGADD=1
SET DGSUR=S(DGZS0,1)
DO ^DIE
DO CHK401^DGPTSCAN
KILL DR,DGPTF,DGSUR,DGADD
GOTO ^DGPTFM
+3 ;
S GOTO ADD^DGPTFM5
V SET DGZM0=0
GOTO ^DGPTFM4
J SET DGZS0=0
GOTO ^DGPTFM5
Q IF Z
GOTO QEL
QQ READ !!,"Enter the item #'s of the ICD Procedure codes to delete: ",A1:DTIME
+1 IF '$TEST
SET A1=U
IF A1'?1N.NP
IF "^"[A1
GOTO ^DGPTFM
IF A1'["?"
WRITE " ???",*7
DO Q^DGPTFM0
GOTO QQ
+2 SET A=A_A1
QEL SET DGA=$EXTRACT(A,2,999)
KILL X,A1
SET DIE="^DGPT("
SET DA=PTF
WRITE !!
+1 FOR J=1:1
SET DP=45
SET L=+$PIECE(DGA,",",J)
IF 'L
QUIT
SET L1=$SELECT($DATA(P2(L)):P2(L),1:"Undefined, ")
IF 'L1
WRITE " ",L,"-",L1
IF L1
SET DR=+P2(+L)/100+45_"///@"
SET DA(1)=PTF
DO ^DIE
KILL DR
WRITE " ",L,"-Deleted, "
IF $X>70
WRITE !
+2 HANG 2
GOTO ^DGPTFM
+3 ;
P GOTO P^DGPTFM6
Q1 QUIT
T GOTO ^DGPTFM6
R GOTO R^DGPTFM4
E IF $DATA(^DGPT(PTF,70))
IF +^(70)>2871000
DO MOB^DGPTFM6
GOTO SET^DGPTFM6
+1 IF DT>2871000
DO MOB^DGPTFM6
GOTO SET^DGPTFM6
+2 GOTO ^DGPTFM6
+3 ;
MVT ;
+1 NEW PTF,DGPMAN
+2 SET DGPMT=6
DO CA^DGPMV
SET DGPMDA=+Y
+3 KILL DGPMT
QUIT
I GOTO ADD^DGPTFM2
Y GOTO DEL^DGPTFM2
N GOTO N^DGPTFM2
G GOTO DC^DGPTFM2
F GOTO F^DGPTFM2
