- 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
