source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTF2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1DGPTF2 ;ALB/JDS - PTF CORRECTIONS ; MAR 16, 2005
2 ;;5.3;Registration;**37,342,643**;Aug 13, 1993
3EN Q:'$D(^UTILITY("DG",$J)) S Q=0,DG2=""
4 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
5Q D DO:'Q K DG9,I1,DR,DG45,DG2,DGJ,Q,M,L,^UTILITY("DG",$J) Q
6SET 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)_";"
7 Q
8 ; -- DGL sets
9101 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"
10 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"
11 Q
12701 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"
13 Q
14401 S DGL=".01*45^3*45^4*45^5*45^6*45^7*45^8:12*45"
15 Q
16501 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"
17 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"
18 Q
19601 S DGL=".01*45^1*45^^^4:9*45"
20 Q
21HEADER S DGL=".09*2^2*45*1^3*45*1"
22 Q
23 ;
24DO I DG2]"" W !!,"Editing patient information:" S DIE="^DPT(",DR=DG2,DA=+^DGPT(PTF,0) D ^DIE
25 W !!,"Exiting the correction process." H 2
26 Q
27DO1 I DG45]"" W !!,"Editing PTF information:" S DIE="^DGPT(",DR=DG45,DA=PTF D DIE
28 Q
29D5 G D5Q:DG45=""
30 S DIE="^DGPT(PTF,"_$S(DG9=601:"""P""",DG9=401:"""S""",1:"""M""")_",",DA(1)=PTF,DA=I1,DR=DG45
31 S Y=@(DIE_DA_",0)"),Y=$P(Y,U,$S(DG9=601!(DG9=401):1,1:10)) D D^DGPTUTL
32 W !!,"Editing ",$S(DG9=601:"Procedure",DG9=401:"Surgery",1:"Movement")," of ",Y D DIE
33D5Q Q
34 ;
35DIE D ^DIE
36D Q:'$D(Y)
37D1 K DR W !,"Do you want to stop correcting" S %=1 D YN^DICN
38 I %=1!(%=-1) S Q=1 Q
39 I %=0 W !?10,"Enter 'YES' or '^' to stop making corrections",!?10,"and 'NO' to continue making corrections" G D1
40 Q
41PRINT W !,"Want to print error log " S %=2 D YN^DICN G PRINT:%'>0 Q:%=2
42 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
43 S IOP="" D ^%ZIS K IOP I $L(DGVO_DGVI)>4 S X=132 X ^%ZOSF("RM")
44 Q
45CLS 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
46 W !,"Performing edit checks..."
47 ;-- init for Austin Edits
48 K ^TMP("AEDIT",$J),^TMP("AERROR",$J) S DGACNT=0
49 ;
50 S Y=1 D RTY^DGPTUTL
51 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
52 ;
53 ;-- new austin edit checks
54 D ^DGPTAE I DGERR>0 K DGERR D DGPTF2 G EN1
55 ;
56 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
57 S DIC(0)="LN",(DINUM,X)=PTF,DIC="^DGP(45.84," K DD,DO D FILE^DICN K DINUM
58 I Y>0 S DA=+Y,DR="2///NOW;3////"_DUZ,DIE="^DGP(45.84," D ^DIE K DR
59 K DIE,DIC
60 I '$D(^DGP(45.84,PTF)) W !,"Cannot close without proper fileman access",*7 D HANG^DGPTUTL G EN1
61 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)
62 S $P(^DGP(45.84,PTF,0),U,6)=DRG
63 W !,"****** PTF CLOSED OUT ******" D HANG^DGPTUTL
64 I DGREL S (DGN,DGST)=1 G EN1
65 K DGRTY,DGRTY0 G Q^DGPTF
66EN1 K DGRTY,DGRTY0 G EN1^DGPTF4
Note: See TracBrowser for help on using the repository browser.