DGPTF2 ;ALB/JDS - PTF CORRECTIONS ; MAR 16, 2005
;;5.3;Registration;**37,342,643,1015**;Aug 13, 1993;Build 21
EN Q:'$D(^UTILITY("DG",$J)) 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"
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 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"
Q
401 S DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:12*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>1 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"
Q
601 S DGL=".01*45^1*45^^^4:9*45"
Q
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
S Y=@(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 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
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
I DGREL S (DGN,DGST)=1 G EN1
K DGRTY,DGRTY0 G Q^DGPTF
EN1 K DGRTY,DGRTY0 G EN1^DGPTF4
DGPTF2 ;ALB/JDS - PTF CORRECTIONS ; MAR 16, 2005
+1 ;;5.3;Registration;**37,342,643,1015**;Aug 13, 1993;Build 21
EN IF '$DATA(^UTILITY("DG",$JOB))
QUIT
SET Q=0
SET DG2=""
+1 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
Q IF 'Q
DO DO
KILL DG9,I1,DR,DG45,DG2,DGJ,Q,M,L,^UTILITY("DG",$JOB)
QUIT
SET 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)_";"
+1 QUIT
+2 ; -- DGL sets
101 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"
+1 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"
+2 QUIT
701 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"
+1 QUIT
401 SET DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:12*45"
+1 QUIT
501 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"
+1 IF DGPTFMT>1
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"
+2 QUIT
601 SET DGL=".01*45^1*45^^^4:9*45"
+1 QUIT
+1 QUIT
+2 ;
DO IF DG2]""
WRITE !!,"Editing patient information:"
SET DIE="^DPT("
SET DR=DG2
SET DA=+^DGPT(PTF,0)
DO ^DIE
+1 WRITE !!,"Exiting the correction process."
HANG 2
+2 QUIT
DO1 IF DG45]""
WRITE !!,"Editing PTF information:"
SET DIE="^DGPT("
SET DR=DG45
SET DA=PTF
DO DIE
+1 QUIT
D5 IF DG45=""
GOTO D5Q
+1 SET DIE="^DGPT(PTF,"_$SELECT(DG9=601:"""P""",DG9=401:"""S""",1:"""M""")_","
SET DA(1)=PTF
SET DA=I1
SET DR=DG45
+2 SET Y=@(DIE_DA_",0)")
SET Y=$PIECE(Y,U,$SELECT(DG9=601!(DG9=401):1,1:10))
DO D^DGPTUTL
+3 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 WRITE !,"Want to print error log "
SET %=2
DO YN^DICN
IF %'>0
GOTO PRINT
IF %=2
QUIT
+1 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
+2 SET IOP=""
DO ^%ZIS
KILL IOP
IF $LENGTH(DGVO_DGVI)>4
SET X=132
XECUTE ^%ZOSF("RM")
+3 QUIT
CLS 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
+1 WRITE !,"Performing edit checks..."
+2 ;-- init for Austin Edits
+3 KILL ^TMP("AEDIT",$JOB),^TMP("AERROR",$JOB)
SET DGACNT=0
+4 ;
+5 SET Y=1
DO RTY^DGPTUTL
+6 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
+7 ;
+8 ;-- new austin edit checks
+9 DO ^DGPTAE
IF DGERR>0
KILL DGERR
DO DGPTF2
GOTO EN1
+10 ;
+11 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
+12 SET DIC(0)="LN"
SET (DINUM,X)=PTF
SET DIC="^DGP(45.84,"
KILL DD,DO
DO FILE^DICN
KILL DINUM
+13 IF Y>0
SET DA=+Y
SET DR="2///NOW;3////"_DUZ
SET DIE="^DGP(45.84,"
DO ^DIE
KILL DR
+14 KILL DIE,DIC
+15 IF '$DATA(^DGP(45.84,PTF))
WRITE !,"Cannot close without proper fileman access",*7
DO HANG^DGPTUTL
GOTO EN1
+16 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)
+17 SET $PIECE(^DGP(45.84,PTF,0),U,6)=DRG
+18 WRITE !,"****** PTF CLOSED OUT ******"
DO HANG^DGPTUTL
+19 IF DGREL
SET (DGN,DGST)=1
GOTO EN1
+20 KILL DGRTY,DGRTY0
GOTO Q^DGPTF
EN1 KILL DGRTY,DGRTY0
GOTO EN1^DGPTF4
