DGPTFM6 ;ALB/BOK/ADL - 601 SCREEN: PROCEDURE ENTER/EDIT ; 21 JUL 88 @ 0900
;;5.3;Registration;**164,510,729,1015**;Aug 13, 1993;Build 21
;;ADL;Update for CSV Project;;Mar 26, 2003
EN I $D(^DGPTF(PTF,70)),+^(70)<2871000 W !!,"Data cannot be entered into these fields until after 10/1/1987" H 5 G ^DGPTFM
I DT<2871000 W !!,"Data can not be entered into these fields until after 10/1/1987" H 5 G ^DGPTFM
G @($S(X=6:"E",1:X))
T ;ADD PROCEDURE RECORD
S DGZP=0 S:'$D(^DGPT(PTF,"P",0)) ^(0)="^45.05DA^^"
S DIC="^DGPT("_PTF_",""P"",",DIC(0)="AEQLMZ",DA(1)=PTF D ^DIC G ^DGPTFM:Y'>0!('$D(^DGPT(PTF,"P",+Y))) S DGPROCM=+Y,DGPROCD=$P(Y,U,2) D MOB I DGPC F I=1:1:DGPC S:P(I,1)=DGPROCM DGZP=I
G:'DGZP ^DGPTFM S DGPROC(DGZP)=DGPROCM,X="1,2"
EDIT G HELP:X<1!(X>2) S DIE="^DGPT(",(DA,DGPTF)=PTF,DR="[DG601]",DGJUMP=X
S DIE="^DGPT(",DGJUMP=X D ^DIE,CHK601^DGPTSCAN K DR,DIE,DIC,DA,DGADD,DGJUMP D MOB
SET D MOB:'$D(P) S:'$D(DGZP) DGZP=1 S P(DGZP,1)=$S($D(P(DGZP,1)):P(DGZP,1),1:"") I P(DGZP,1)="" K P(DGZP) G NEXP
S (P1,P(DGZP))=$S($D(^DGPT(PTF,"P",P(DGZP,1),0)):^(0),1:"")
WRT G:'$D(^DGPT(PTF,"P",P(DGZP,1),0)) ^DGPTFM S DGPROCI=^(0) W @IOF,HEAD,?68 S Z="<601-"_DGZP_">" W @DGVI,Z,@DGVO,!! S (Y,L)=+P(DGZP),Z=1 D D^DGPTUTL,Z^DGPTFM5 W $J("Date of Proc: ",32),Y,!,$J("Specialty: ",35)
W $S($D(^DIC(42.4,+$P(P(DGZP),U,2),0)):$P(^(0),U),1:""),! I $P(P(DGZP),U,4) W " Number of Dialysis Treatments: ",$P(P(DGZP),U,4),!
W !! S Z=2 D Z^DGPTFM5 W " Procedures: " F I=1:1:5 S L=$P(P(DGZP),U,4+I) I L S DGPTTMP=$$ICDOP^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)) D
. W $S(+DGPTTMP>0&($P(DGPTTMP,U,10)):$P(DGPTTMP,U,5)_" ("_$P(DGPTTMP,U,2)_")",1:"**************"_L),!?19
F I=1:1:(IOSL-$Y-5) W !
S DGNUM=$S($D(P(DGZP+1)):601_"-"_(DGZP+1),1:"MAS") G 601^DGPTFJC:DGST
W "Enter <RET> to continue, 1-2 to edit,",!,"'T' to add a Procedure Segment, '^N' for screen N, or '^' to abort: <",DGNUM,">//"
R X:DTIME S:'$T X="^",DGPTOUT=""
K DGNUM G Q^DGPTF:X="^"
I X?1"^".E S DGPTSCRN=601 G ^DGPTFJ
G T:X="T"!(X="t"),HELP:X["?"
I X[1!(X[2) S DA=+P(DGZP) G EDIT
I X'="" G HELP
NEXP ;S DGZP=DGZP+1 G ^DGPTFM:'$D(P(DGZP)),SET
S DGZP=DGZP+1 I '$D(P(DGZP)) S DGZP=1 G ^DGPTFM
G SET
HELP W !,"Enter '^' to stop display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen as <N>)",!,"<RET> to continue on to next screen or 1-2 to edit:"
W !?10,"1-Procedure information",!,?10,"2-Procedure codes",!,"You may also enter any combination of the above, separated by commas (ex:1,2)",!
R !!,"Enter <RET>: ",X:DTIME G WRT
MOB K P,P1,P2 S (I,P2)=0 F I1=1:1 S I=$O(^DGPT(PTF,"P",I)) Q:I'>0 S P(I1)=^(I,0),P(I1,1)=I I P(I1)']"" K P(I1) S I1=I1-1
S DGPC=I1-1 Q
BS ;CALLED FROM [DG601]
S I=$O(^DGPT(PTF,"M","AM",^DGPT(PTF,"P",DA,0)-.0000001)),I=$O(^(+I,0))
S DGMOVM=$S($D(^DGPT(PTF,"M",$S(I:I,1:1),0)):$P(^(0),U,2),1:"")
Q
R ;DELETE PROCEDURE RECORD
G R^DGPTFM4
E ;EDIT PROCEDURE RECORD
G E^DGPTFM1
P I $D(^DGPT(PTF,70)),+^(70)<2871000 G FY86
I DT<2871000 G FY86
S L="" F I=1:1:DGPC S L2=1 F J=5:1:9 I L2,$P(P(I),U,J)="" S L=L_I_",",L2=0
I L="" W !!,"There are no procedure records that can be added to.",*7 H 2 G ^DGPTFM
S L=$E(L,1,$L(L)-1) I L=+L S DGRC=+L G P2
P1 I 'Z W !!,"Add to procedure record <",L,"> : " R DGRC:DTIME G ^DGPTFM:DGRC[U!(DGRC="")
E S DGRC=+$E(A,2,99)
P2 I +DGRC'=DGRC!(","_L_","'[(","_DGRC_",")) W !!,"Enter the procedure record number to add ICD operation codes to: ",L G P1:'Z S Z="" G P1
S DP=45.05,DIE="^DGPT("_PTF_",""P"",",DA(1)=PTF,DR="" F I=5:1:9 I $P(P(DGRC),U,I)="" S DR=DR_(I-1)_";"
S DR=$E(DR,1,$L(DR)-1),DA=+P(DGRC,1),DA(1)=PTF D ^DIE K DR,DIE G ^DGPTFM
FY86 S DR="" F J=1:1:5 I $P(PROC,U,J)="" S DR=DR_(J/100+45)_";"
I DR="" W !!,"No more procedures can be added.",*7 H 2 G ^DGPTFM
S DR=$E(DR,1,$L(DR)-1),DP=45,DIE="^DGPT(",DA=PTF D ^DIE K DR,DIE G ^DGPTFM
GETVAR ;CALLED FROM GET+1^DGPTFM
S PM=I1-1,I=0 F I1=1:1 S I=$O(^DGPT(PTF,"S",I)) Q:I'>0 S S(I1)=^(I,0),S(I1,1)=I
K P2 S SU=I1-1 S PROC=$S($D(^DGPT(PTF,"401P")):^("401P"),1:""),P2=0 F J1=1:1:5 S:$P(PROC,U,J1) P2=P2+1,P2(P2)=J1
K P S I=0 F I1=1:1 S I=$O(^DGPT(PTF,"P",I)) Q:I'>0 S P(I1)=^(I,0),P(I1,1)=I
Q
DGPTFM6 ;ALB/BOK/ADL - 601 SCREEN: PROCEDURE ENTER/EDIT ; 21 JUL 88 @ 0900
+1 ;;5.3;Registration;**164,510,729,1015**;Aug 13, 1993;Build 21
+2 ;;ADL;Update for CSV Project;;Mar 26, 2003
EN IF $DATA(^DGPTF(PTF,70))
IF +^(70)<2871000
WRITE !!,"Data cannot be entered into these fields until after 10/1/1987"
HANG 5
GOTO ^DGPTFM
+1 IF DT<2871000
WRITE !!,"Data can not be entered into these fields until after 10/1/1987"
HANG 5
GOTO ^DGPTFM
+2 GOTO @($SELECT(X=6:"E",1:X))
T ;ADD PROCEDURE RECORD
+1 SET DGZP=0
IF '$DATA(^DGPT(PTF,"P",0))
SET ^(0)="^45.05DA^^"
+2 SET DIC="^DGPT("_PTF_",""P"","
SET DIC(0)="AEQLMZ"
SET DA(1)=PTF
DO ^DIC
IF Y'>0!('$DATA(^DGPT(PTF,"P",+Y)))
GOTO ^DGPTFM
SET DGPROCM=+Y
SET DGPROCD=$PIECE(Y,U,2)
DO MOB
IF DGPC
FOR I=1:1:DGPC
IF P(I,1)=DGPROCM
SET DGZP=I
+3 IF 'DGZP
GOTO ^DGPTFM
SET DGPROC(DGZP)=DGPROCM
SET X="1,2"
EDIT IF X<1!(X>2)
GOTO HELP
SET DIE="^DGPT("
SET (DA,DGPTF)=PTF
SET DR="[DG601]"
SET DGJUMP=X
+1 SET DIE="^DGPT("
SET DGJUMP=X
DO ^DIE
DO CHK601^DGPTSCAN
KILL DR,DIE,DIC,DA,DGADD,DGJUMP
DO MOB
SET IF '$DATA(P)
DO MOB
IF '$DATA(DGZP)
SET DGZP=1
SET P(DGZP,1)=$SELECT($DATA(P(DGZP,1)):P(DGZP,1),1:"")
IF P(DGZP,1)=""
KILL P(DGZP)
GOTO NEXP
+1 SET (P1,P(DGZP))=$SELECT($DATA(^DGPT(PTF,"P",P(DGZP,1),0)):^(0),1:"")
WRT IF '$DATA(^DGPT(PTF,"P",P(DGZP,1),0))
GOTO ^DGPTFM
SET DGPROCI=^(0)
WRITE @IOF,HEAD,?68
SET Z="<601-"_DGZP_">"
WRITE @DGVI,Z,@DGVO,!!
SET (Y,L)=+P(DGZP)
SET Z=1
DO D^DGPTUTL
DO Z^DGPTFM5
WRITE $JUSTIFY("Date of Proc: ",32),Y,!,$JUSTIFY("Specialty: ",35)
+1 WRITE $SELECT($DATA(^DIC(42.4,+$PIECE(P(DGZP),U,2),0)):$PIECE(^(0),U),1:""),!
IF $PIECE(P(DGZP),U,4)
WRITE " Number of Dialysis Treatments: ",$PIECE(P(DGZP),U,4),!
+2 WRITE !!
SET Z=2
DO Z^DGPTFM5
WRITE " Procedures: "
FOR I=1:1:5
SET L=$PIECE(P(DGZP),U,4+I)
IF L
SET DGPTTMP=$$ICDOP^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF))
Begin DoDot:1
+3 WRITE $SELECT(+DGPTTMP>0&($PIECE(DGPTTMP,U,10)):$PIECE(DGPTTMP,U,5)_" ("_$PIECE(DGPTTMP,U,2)_")",1:"**************"_L),!?19
End DoDot:1
+4 FOR I=1:1:(IOSL-$Y-5)
WRITE !
+5 SET DGNUM=$SELECT($DATA(P(DGZP+1)):601_"-"_(DGZP+1),1:"MAS")
IF DGST
GOTO 601^DGPTFJC
+6 WRITE "Enter <RET> to continue, 1-2 to edit,",!,"'T' to add a Procedure Segment, '^N' for screen N, or '^' to abort: <",DGNUM,">//"
+7 READ X:DTIME
IF '$TEST
SET X="^"
SET DGPTOUT=""
+8 KILL DGNUM
IF X="^"
GOTO Q^DGPTF
+9 IF X?1"^".E
SET DGPTSCRN=601
GOTO ^DGPTFJ
+10 IF X="T"!(X="t")
GOTO T
IF X["?"
GOTO HELP
+11 IF X[1!(X[2)
SET DA=+P(DGZP)
GOTO EDIT
+12 IF X'=""
GOTO HELP
NEXP ;S DGZP=DGZP+1 G ^DGPTFM:'$D(P(DGZP)),SET
+1 SET DGZP=DGZP+1
IF '$DATA(P(DGZP))
SET DGZP=1
GOTO ^DGPTFM
+2 GOTO SET
HELP WRITE !,"Enter '^' to stop display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen as <N>)",!,"<RET> to continue on to next screen or 1-2 to edit:"
+1 WRITE !?10,"1-Procedure information",!,?10,"2-Procedure codes",!,"You may also enter any combination of the above, separated by commas (ex:1,2)",!
+2 READ !!,"Enter <RET>: ",X:DTIME
GOTO WRT
MOB KILL P,P1,P2
SET (I,P2)=0
FOR I1=1:1
SET I=$ORDER(^DGPT(PTF,"P",I))
IF I'>0
QUIT
SET P(I1)=^(I,0)
SET P(I1,1)=I
IF P(I1)']""
KILL P(I1)
SET I1=I1-1
+1 SET DGPC=I1-1
QUIT
BS ;CALLED FROM [DG601]
+1 SET I=$ORDER(^DGPT(PTF,"M","AM",^DGPT(PTF,"P",DA,0)-.0000001))
SET I=$ORDER(^(+I,0))
+2 SET DGMOVM=$SELECT($DATA(^DGPT(PTF,"M",$SELECT(I:I,1:1),0)):$PIECE(^(0),U,2),1:"")
+3 QUIT
R ;DELETE PROCEDURE RECORD
+1 GOTO R^DGPTFM4
E ;EDIT PROCEDURE RECORD
+1 GOTO E^DGPTFM1
P IF $DATA(^DGPT(PTF,70))
IF +^(70)<2871000
GOTO FY86
+1 IF DT<2871000
GOTO FY86
+2 SET L=""
FOR I=1:1:DGPC
SET L2=1
FOR J=5:1:9
IF L2
IF $PIECE(P(I),U,J)=""
SET L=L_I_","
SET L2=0
+3 IF L=""
WRITE !!,"There are no procedure records that can be added to.",*7
HANG 2
GOTO ^DGPTFM
+4 SET L=$EXTRACT(L,1,$LENGTH(L)-1)
IF L=+L
SET DGRC=+L
GOTO P2
P1 IF 'Z
WRITE !!,"Add to procedure record <",L,"> : "
READ DGRC:DTIME
IF DGRC[U!(DGRC="")
GOTO ^DGPTFM
+1 IF '$TEST
SET DGRC=+$EXTRACT(A,2,99)
P2 IF +DGRC'=DGRC!(","_L_","'[(","_DGRC_","))
WRITE !!,"Enter the procedure record number to add ICD operation codes to: ",L
IF 'Z
GOTO P1
SET Z=""
GOTO P1
+1 SET DP=45.05
SET DIE="^DGPT("_PTF_",""P"","
SET DA(1)=PTF
SET DR=""
FOR I=5:1:9
IF $PIECE(P(DGRC),U,I)=""
SET DR=DR_(I-1)_";"
+2 SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
SET DA=+P(DGRC,1)
SET DA(1)=PTF
DO ^DIE
KILL DR,DIE
GOTO ^DGPTFM
FY86 SET DR=""
FOR J=1:1:5
IF $PIECE(PROC,U,J)=""
SET DR=DR_(J/100+45)_";"
+1 IF DR=""
WRITE !!,"No more procedures can be added.",*7
HANG 2
GOTO ^DGPTFM
+2 SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
SET DP=45
SET DIE="^DGPT("
SET DA=PTF
DO ^DIE
KILL DR,DIE
GOTO ^DGPTFM
GETVAR ;CALLED FROM GET+1^DGPTFM
+1 SET PM=I1-1
SET I=0
FOR I1=1:1
SET I=$ORDER(^DGPT(PTF,"S",I))
IF I'>0
QUIT
SET S(I1)=^(I,0)
SET S(I1,1)=I
+2 KILL P2
SET SU=I1-1
SET PROC=$SELECT($DATA(^DGPT(PTF,"401P")):^("401P"),1:"")
SET P2=0
FOR J1=1:1:5
IF $PIECE(PROC,U,J1)
SET P2=P2+1
SET P2(P2)=J1
+3 KILL P
SET I=0
FOR I1=1:1
SET I=$ORDER(^DGPT(PTF,"P",I))
IF I'>0
QUIT
SET P(I1)=^(I,0)
SET P(I1,1)=I
+4 QUIT
