DGPTF2 ;ALB/JDS,HIOFO/FT,WIOFO/PMK - PTF CORRECTIONS ;3/19/2015 3:43 pm
;;5.3;Registration;**37,342,643,861,850,884**;Aug 13, 1993;Build 31
;
; XUSEC APIs - 10076
; %ZOSF APIs - 10096
; %ZIS APIs - 10086
; %ZISC APIs - 10089
;
EN ;This code allows the user to edit some PTF record fields.
;The transmission building code builds each segment (e.g., 101) and validates the data in that segment string.
;Some errors are flagged and noted in the ^UTILITY("DG",$J) global. This global identifies the fields the user can edit.
;For each segment (e.g., 101), the string of fields that can be edited are in the DGL variable.
;The DGL value is determined by the value of the DGPTFMT variable which is either 1, 2, or 3.
;DGPTFMT is set in the calling routine(s).
;DGPTFMT=3 means the site is using ICD10 codes/record format.
;DGPTFMT=2 means the site is using ICD9 codes/record format.
;DGPTFMT=1 means the site is using something prior to ICD9 codes/record format
;
I DGPTFMT'=1,DGPTFMT'=2,DGPTFMT'=3 Q ; not valid parameter value - pmk 3/19/2015
Q:'$D(^UTILITY("DG",$J)) ;^UTILITY is set in DGPTR1, DGPTRI1, DGPTFTR1, DGPTFVC2
S Q=0,DG2=""
F DG9=101,401,501,701,601,"HEADER" D @DG9 F I1=0:0 S I1=$O(^UTILITY("DG",$J,DG9,I1)) Q:I1'>0!(Q) S DG45="",DGJ=^(I1) F J=2:1 S K=$P(DGJ,U,J) Q:'K D SET Q:Q I '$P(DGJ,U,J+1) D @($S(DG9=401!(DG9=501)!(DG9=601):"D5",1:"DO1")) Q:Q
;
Q D DO:'Q
K DG9,I1,DR,DG45,DG2,DGJ,Q,M,L,^UTILITY("DG",$J)
Q
SET ;
S L=$P(DGL,U,K) I DGPTFE!('$P(L,"*",3)) S M="DG"_$P(L,"*",2) I @M'[($P(L,"*",1)_";") S @M=@M_$P(L,"*",1)_";"
Q
; -- DGL sets
101 ;
I DGPTFMT<2 S DGL=".01*2^20*45^21.1;21.2*45^22*45^.526*2^.05*2^.02*2^.03*2^23*45^.32103;.32102;.3212*2^.115;.117;.1112*2^10*45"
;the following DGL set can be used when DGPTFMT=2 or 3
I DGPTFMT>1 S DGL=".01*2^20*45^21.1;21.2*45^22*45^.526*2^.05*2^.02*2^.03*2^.323*2^.32101;.32103;.3212;.32102;.3213*2^.115;.117;.1112*2^10*45"
Q
701 ;
I DGPTFMT<3 S DGL="70*45*1^71*45*1^72*45*1^73*45^74*45^75*45^76.1;76.2*45^77*45^.06*2^78*45^79*45"
I DGPTFMT=3 S DGL="70*45*1^71*45*1^72*45*1^73*45^74*45^75*45^76.1;76.2*45^77*45^.06*2^78*45^79;82.01*45"
Q
401 ;
I DGPTFMT<3 S DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:12*45"
I DGPTFMT=3 S DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:32*45"
Q
501 ;
I DGPTFMT<2 S DGL="10*45*1^2*45*1^3*45^4*45^57.4*2^5:9*45^72.1*45*1"
I DGPTFMT=2 S DGL="10*45*1^2*45*1^2*45*1^3*45^4*45^57.4*2^5:9*45^^^^72.1*45*1"
I DGPTFMT=3 S DGL="10*45*1^2*45*1^2*45*1^3*45^4*45^57.4*2^5:9;11:15;81.01:81.15*45^^^^72.1*45*1"
;OR
;I DGPTFMT=3 S DGL="10*45*1^2*45*1^???*45*1^3*45*1^4*45*1^57.4*2^5:9;11:15;81.01:81.15*45^^^^72.1*45"
Q
601 ;
I DGPTFMT<3 S DGL=".01*45^1*45^^^4:9*45"
I DGPTFMT=3 S DGL=".01*45^1*45^^^4:28*45"
Q
S DGL=".09*2^2*45*1^3*45*1"
Q
;
DO ;
I DG2]"" W !!,"Editing patient information:" S DIE="^DPT(",DR=DG2,DA=+^DGPT(PTF,0) D ^DIE
W !!,"Exiting the correction process." H 2
Q
DO1 ;
I DG45]"" W !!,"Editing PTF information:" S DIE="^DGPT(",DR=DG45,DA=PTF D DIE
Q
D5 ;
G D5Q:DG45=""
S DIE="^DGPT(PTF,"_$S(DG9=601:"""P""",DG9=401:"""S""",1:"""M""")_",",DA(1)=PTF,DA=I1,DR=DG45
I $G(@(DIE_DA_",0)"))="" G D5Q
S Y=$G(@(DIE_DA_",0)")),Y=$P(Y,U,$S(DG9=601!(DG9=401):1,1:10)) D D^DGPTUTL
W !!,"Editing ",$S(DG9=601:"Procedure",DG9=401:"Surgery",1:"Movement")," of ",Y D DIE
D5Q Q
;
DIE D ^DIE
D Q:'$D(Y)
D1 K DR W !,"Do you want to stop correcting" S %=1 D YN^DICN
I %=1!(%=-1) S Q=1 Q
I %=0 W !?10,"Enter 'YES' or '^' to stop making corrections",!?10,"and 'NO' to continue making corrections" G D1
Q
PRINT ;
W !,"Want to print error log " S %=2 D YN^DICN G PRINT:%'>0 Q:%=2
K IOP D ^%ZIS Q:IO']"" S Y=DT X ^DD("DD") W @IOF W !!,"Error log for PTF record ",PTF," "_$P(^DPT(DFN,0),U,1)_" ",Y,!! S DGERR=-1,J=PTF D LOG^DGPTFTR D ^%ZISC
S IOP="" D ^%ZIS K IOP I $L(DGVO_DGVI)>4 S X=132 X ^%ZOSF("RM")
Q
CLS ;called from DGPTF4
I $D(^DGM("PT",DFN)) W !!,"Not all messages have been cleared up for this patient--cannot close.",*7,*7 S DGPTF=DFN,X="??" K DGALL D HELP^DGPTMSGD K DGPTF G EN1:'$D(DGALL) K DGALL
W !,"Performing edit checks..."
;-- init for Austin Edits
K ^TMP("AEDIT",$J),^TMP("AERROR",$J) S DGACNT=0
;
S Y=1 D RTY^DGPTUTL
S J=PTF,DGERR=-1 D LOG^DGPTFTR K DGLOGIC D LO^DGUTL K T1,T2 I DGERR>0 K DGERR H 4 D DGPTF2 G EN1
;
;-- new Austin edit checks
D ^DGPTAE I DGERR>0 K DGERR D DGPTF2 G EN1
;
K DGERR S DR=$S($P(^DGPT(PTF,0),U,7):"",1:";7////"_DUZ_";8///T"),DA=PTF,DIE="^DGPT(",DP=45 D ^DIE K DR
S DIC(0)="LN",(DINUM,X)=PTF,DIC="^DGP(45.84," K DD,DO D FILE^DICN K DINUM,DO,DIC
I Y>0 S DA=+Y,DR="2///NOW;3////"_DUZ,DIE="^DGP(45.84," D ^DIE K DR
K DIE,DIC
I '$D(^DGP(45.84,PTF)) W !,"Cannot close without proper fileman access",*7 D HANG^DGPTUTL G EN1
F I=0,.11,.52,.321,.32,.36,57,.3 S:$D(^DPT(DFN,I)) ^DGP(45.84,PTF,$S(I=0:10,1:I))=^DPT(DFN,I)
S $P(^DGP(45.84,PTF,0),U,6)=DRG
W !,"****** PTF CLOSED OUT ******" D HANG^DGPTUTL
;DG*5.3*861 Added DGRELKEY variable to hold the value for DGREL that is killed in ^EASECU21
I '$G(DGREL) S DGREL=$S($D(^XUSEC("DG PTFREL",DUZ)):1,1:0)
I $G(DGREL) S (DGN,DGST)=1 G EN1
K DGRTY,DGRTY0 G Q^DGPTF
EN1 K DGRTY,DGRTY0 G EN1^DGPTF4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTF2 5267 printed Sep 23, 2025@20:27:55 Page 2
DGPTF2 ;ALB/JDS,HIOFO/FT,WIOFO/PMK - PTF CORRECTIONS ;3/19/2015 3:43 pm
+1 ;;5.3;Registration;**37,342,643,861,850,884**;Aug 13, 1993;Build 31
+2 ;
+3 ; XUSEC APIs - 10076
+4 ; %ZOSF APIs - 10096
+5 ; %ZIS APIs - 10086
+6 ; %ZISC APIs - 10089
+7 ;
EN ;This code allows the user to edit some PTF record fields.
+1 ;The transmission building code builds each segment (e.g., 101) and validates the data in that segment string.
+2 ;Some errors are flagged and noted in the ^UTILITY("DG",$J) global. This global identifies the fields the user can edit.
+3 ;For each segment (e.g., 101), the string of fields that can be edited are in the DGL variable.
+4 ;The DGL value is determined by the value of the DGPTFMT variable which is either 1, 2, or 3.
+5 ;DGPTFMT is set in the calling routine(s).
+6 ;DGPTFMT=3 means the site is using ICD10 codes/record format.
+7 ;DGPTFMT=2 means the site is using ICD9 codes/record format.
+8 ;DGPTFMT=1 means the site is using something prior to ICD9 codes/record format
+9 ;
+10 ; not valid parameter value - pmk 3/19/2015
IF DGPTFMT'=1
IF DGPTFMT'=2
IF DGPTFMT'=3
QUIT
+11 ;^UTILITY is set in DGPTR1, DGPTRI1, DGPTFTR1, DGPTFVC2
if '$DATA(^UTILITY("DG",$JOB))
QUIT
+12 SET Q=0
SET DG2=""
+13 FOR DG9=101,401,501,701,601,"HEADER"
DO @DG9
FOR I1=0:0
SET I1=$ORDER(^UTILITY("DG",$JOB,DG9,I1))
if I1'>0!(Q)
QUIT
SET DG45=""
SET DGJ=^(I1)
FOR J=2:1
SET K=$PIECE(DGJ,U,J)
if 'K
QUIT
DO SET
if Q
QUIT
IF '$PIECE(DGJ,U,J+1)
DO @($SELECT(DG9=401!(DG9=501)!(DG9=601):"D5",1:"DO1"))
if Q
QUIT
+14 ;
Q if 'Q
DO DO
+1 KILL DG9,I1,DR,DG45,DG2,DGJ,Q,M,L,^UTILITY("DG",$JOB)
+2 QUIT
SET ;
+1 SET L=$PIECE(DGL,U,K)
IF DGPTFE!('$PIECE(L,"*",3))
SET M="DG"_$PIECE(L,"*",2)
IF @M'[($PIECE(L,"*",1)_";")
SET @M=@M_$PIECE(L,"*",1)_";"
+2 QUIT
+3 ; -- DGL sets
101 ;
+1 IF DGPTFMT<2
SET DGL=".01*2^20*45^21.1;21.2*45^22*45^.526*2^.05*2^.02*2^.03*2^23*45^.32103;.32102;.3212*2^.115;.117;.1112*2^10*45"
+2 ;the following DGL set can be used when DGPTFMT=2 or 3
+3 IF DGPTFMT>1
SET DGL=".01*2^20*45^21.1;21.2*45^22*45^.526*2^.05*2^.02*2^.03*2^.323*2^.32101;.32103;.3212;.32102;.3213*2^.115;.117;.1112*2^10*45"
+4 QUIT
701 ;
+1 IF DGPTFMT<3
SET DGL="70*45*1^71*45*1^72*45*1^73*45^74*45^75*45^76.1;76.2*45^77*45^.06*2^78*45^79*45"
+2 IF DGPTFMT=3
SET DGL="70*45*1^71*45*1^72*45*1^73*45^74*45^75*45^76.1;76.2*45^77*45^.06*2^78*45^79;82.01*45"
+3 QUIT
401 ;
+1 IF DGPTFMT<3
SET DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:12*45"
+2 IF DGPTFMT=3
SET DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:32*45"
+3 QUIT
501 ;
+1 IF DGPTFMT<2
SET DGL="10*45*1^2*45*1^3*45^4*45^57.4*2^5:9*45^72.1*45*1"
+2 IF DGPTFMT=2
SET DGL="10*45*1^2*45*1^2*45*1^3*45^4*45^57.4*2^5:9*45^^^^72.1*45*1"
+3 IF DGPTFMT=3
SET DGL="10*45*1^2*45*1^2*45*1^3*45^4*45^57.4*2^5:9;11:15;81.01:81.15*45^^^^72.1*45*1"
+4 ;OR
+5 ;I DGPTFMT=3 S DGL="10*45*1^2*45*1^???*45*1^3*45*1^4*45*1^57.4*2^5:9;11:15;81.01:81.15*45^^^^72.1*45"
+6 QUIT
601 ;
+1 IF DGPTFMT<3
SET DGL=".01*45^1*45^^^4:9*45"
+2 IF DGPTFMT=3
SET DGL=".01*45^1*45^^^4:28*45"
+3 QUIT
+1 SET DGL=".09*2^2*45*1^3*45*1"
+2 QUIT
+3 ;
DO ;
+1 IF DG2]""
WRITE !!,"Editing patient information:"
SET DIE="^DPT("
SET DR=DG2
SET DA=+^DGPT(PTF,0)
DO ^DIE
+2 WRITE !!,"Exiting the correction process."
HANG 2
+3 QUIT
DO1 ;
+1 IF DG45]""
WRITE !!,"Editing PTF information:"
SET DIE="^DGPT("
SET DR=DG45
SET DA=PTF
DO DIE
+2 QUIT
D5 ;
+1 if DG45=""
GOTO D5Q
+2 SET DIE="^DGPT(PTF,"_$SELECT(DG9=601:"""P""",DG9=401:"""S""",1:"""M""")_","
SET DA(1)=PTF
SET DA=I1
SET DR=DG45
+3 IF $GET(@(DIE_DA_",0)"))=""
GOTO D5Q
+4 SET Y=$GET(@(DIE_DA_",0)"))
SET Y=$PIECE(Y,U,$SELECT(DG9=601!(DG9=401):1,1:10))
DO D^DGPTUTL
+5 WRITE !!,"Editing ",$SELECT(DG9=601:"Procedure",DG9=401:"Surgery",1:"Movement")," of ",Y
DO DIE
D5Q QUIT
+1 ;
DIE DO ^DIE
D if '$DATA(Y)
QUIT
D1 KILL DR
WRITE !,"Do you want to stop correcting"
SET %=1
DO YN^DICN
+1 IF %=1!(%=-1)
SET Q=1
QUIT
+2 IF %=0
WRITE !?10,"Enter 'YES' or '^' to stop making corrections",!?10,"and 'NO' to continue making corrections"
GOTO D1
+3 QUIT
PRINT ;
+1 WRITE !,"Want to print error log "
SET %=2
DO YN^DICN
if %'>0
GOTO PRINT
if %=2
QUIT
+2 KILL IOP
DO ^%ZIS
if IO']""
QUIT
SET Y=DT
XECUTE ^DD("DD")
WRITE @IOF
WRITE !!,"Error log for PTF record ",PTF," "_$PIECE(^DPT(DFN,0),U,1)_" ",Y,!!
SET DGERR=-1
SET J=PTF
DO LOG^DGPTFTR
DO ^%ZISC
+3 SET IOP=""
DO ^%ZIS
KILL IOP
IF $LENGTH(DGVO_DGVI)>4
SET X=132
XECUTE ^%ZOSF("RM")
+4 QUIT
CLS ;called from DGPTF4
+1 IF $DATA(^DGM("PT",DFN))
WRITE !!,"Not all messages have been cleared up for this patient--cannot close.",*7,*7
SET DGPTF=DFN
SET X="??"
KILL DGALL
DO HELP^DGPTMSGD
KILL DGPTF
if '$DATA(DGALL)
GOTO EN1
KILL DGALL
+2 WRITE !,"Performing edit checks..."
+3 ;-- init for Austin Edits
+4 KILL ^TMP("AEDIT",$JOB),^TMP("AERROR",$JOB)
SET DGACNT=0
+5 ;
+6 SET Y=1
DO RTY^DGPTUTL
+7 SET J=PTF
SET DGERR=-1
DO LOG^DGPTFTR
KILL DGLOGIC
DO LO^DGUTL
KILL T1,T2
IF DGERR>0
KILL DGERR
HANG 4
DO DGPTF2
GOTO EN1
+8 ;
+9 ;-- new Austin edit checks
+10 DO ^DGPTAE
IF DGERR>0
KILL DGERR
DO DGPTF2
GOTO EN1
+11 ;
+12 KILL DGERR
SET DR=$SELECT($PIECE(^DGPT(PTF,0),U,7):"",1:";7////"_DUZ_";8///T")
SET DA=PTF
SET DIE="^DGPT("
SET DP=45
DO ^DIE
KILL DR
+13 SET DIC(0)="LN"
SET (DINUM,X)=PTF
SET DIC="^DGP(45.84,"
KILL DD,DO
DO FILE^DICN
KILL DINUM,DO,DIC
+14 IF Y>0
SET DA=+Y
SET DR="2///NOW;3////"_DUZ
SET DIE="^DGP(45.84,"
DO ^DIE
KILL DR
+15 KILL DIE,DIC
+16 IF '$DATA(^DGP(45.84,PTF))
WRITE !,"Cannot close without proper fileman access",*7
DO HANG^DGPTUTL
GOTO EN1
+17 FOR I=0,.11,.52,.321,.32,.36,57,.3
if $DATA(^DPT(DFN,I))
SET ^DGP(45.84,PTF,$SELECT(I=0:10,1:I))=^DPT(DFN,I)
+18 SET $PIECE(^DGP(45.84,PTF,0),U,6)=DRG
+19 WRITE !,"****** PTF CLOSED OUT ******"
DO HANG^DGPTUTL
+20 ;DG*5.3*861 Added DGRELKEY variable to hold the value for DGREL that is killed in ^EASECU21
+21 IF '$GET(DGREL)
SET DGREL=$SELECT($DATA(^XUSEC("DG PTFREL",DUZ)):1,1:0)
+22 IF $GET(DGREL)
SET (DGN,DGST)=1
GOTO EN1
+23 KILL DGRTY,DGRTY0
GOTO Q^DGPTF
EN1 KILL DGRTY,DGRTY0
GOTO EN1^DGPTF4
