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

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1DGPTFM1 ;ALB/MTC - MASTER DIAG/OP/PRO CODE ENTER/EDIT ;4/4/05 3:08pm
2 ;;5.3;Registration;**114,517,635**;Aug 13, 1993
3 ;
4D G D^DGPTFM0
5 ;
6A S L="" F I=1:1:PM S L2=1 F J=5:1:9 I L2&(J'=10)&($P(M(I),U,J)="") S L=L_I_",",L2=0
7 I L="" W !!,"There are no movement records that can be added to.",*7,*7 H 2 G ^DGPTFM
8 S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G A2
9A1 I 'Z W !!,"Add to movement record <",L,"> : " R RC:DTIME G ^DGPTFM:RC[U!('$T)!(RC="")
10 E S RC=+$E(A,2,99)
11A2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the movement record number to add ICD diagnosis to: ",L S Z="" G A1
12 S DIE="^DGPT(",(DA,DGPTF)=PTF,DR="[DG501]",DGJUMP=""
13 S DGMOV=+M(RC),DGADD=1 D ^DIE K DR,DA,DGADD,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV,DGADD
14 G ^DGPTFM
15 ;
16M I DGPTFE G ADD^DGPTFM4
17 S X=80 X ^%ZOSF("RM") D MVT K T,AM,M I $L(DGVO_DGVI)>4 S X=132 X ^%ZOSF("RM")
18 G ^DGPTFM:'$D(DGPMDA) S DA=$S('$D(^DGPM(DGPMDA,"PTF")):"",1:$P(^("PTF"),"^",3)) G ^DGPTFM:'$D(^DGPT(PTF,"M",+DA,0)) S Y=^(0)
19 S X=$S($D(^DIC(42.4,+$P(Y,U,2),0)):$P(^(0),U,1),1:""),Y=$P(Y,U,10)
20 D D^DGPTUTL K M W !,"Editing ",$S(DA=1:"Discharge ",1:""),"Movement " W:Y]"" "of ",Y W " Losing Specialty ",X
21 S DGMOV=DA,(DA,DGPTF)=PTF,DIE="^DGPT(",DR="[DG501]",DGJUMP="1-2" D ^DIE
22 K DA,DR,DIE,DGJUMP D CHK501^DGPTSCAN K DGPTF,DGMOV
23 ;- update MT indicator after edit movement
24 N DGPMCA,DGPMAN D PM^DGPTUTL
25 I '$G(DGADM) S DGADM=+^DGPT(PTF,0)
26 D MT^DGPTUTL
27 G ^DGPTFM
28 ;
29Z I 'SU W !,"No surgeries to delete",! H 3 G ^DGPTFM
30 S ST=1 I 'Z W !!,"Delete surgery record <1",$S(SU=1:"",1:"-"_SU),">: " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="")
31 E S RC=$E(A,2,99) W !
32 I +RC'=RC!('$D(S(RC))) W !!,"Enter the record # to delete from the PTF file, 1",$S(SU=1:"",1:"-"_SU) S Z=0 G Z
33 K DA S DIK="^DGPT("_PTF_",""S"",",ST=1,(DGPTF,DA(1))=PTF,(DGSUR,DA)=+S(RC,1) D ^DIK K DA W " ",RC,"-DELETED***" D CHK401^DGPTSCAN K DGPTF,DGSUR H 2 G ^DGPTFM
34 ;
35C G CEL:Z
36 I '$D(S2) W !,"View codes first",! H 2 G ^DGPTFM
37 I 'S2 W !,"No codes to delete",! H 2 G ^DGPTFM
38C1 R !!,"Enter the item #'s of the ICD operation codes to delete: ",A1:DTIME
39 S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D C^DGPTFM0 G C1
40 S A=A_A1
41CEL D EXPL^DGPTUTL
42 K X,A1 S DA(1)=PTF,DP=45.01 W !!
43 F J=1:1 S L=+$P(DGA,",",J),DIE="^DGPT("_PTF_",""S""," Q:'L D
44 .S L1=$S($D(S2(L)):S2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1
45 .I L1 S (DA,DGSUR)=+S(+L1,1),(DA(1),DGPTF)=PTF,DR=7+$P(S2(+L),U,2)_"///@" D ^DIE,CEL1
46 H 3 S ST=1 G ^DGPTFM
47 ;
48CEL1 ;
49 K DR W " ",L,"-Deleted, " W:$X>70 ! D CHK401^DGPTSCAN K DGPTF,DGSUR
50 Q
51 ;
52O S L="" F I=1:1:SU S L2=1 F J=8:1:12 I L2,$P(S(I),U,J)="" S L=L_I_",",L2=0
53 I L="" W !!,"There are no surgery records that can be added to.",*7 H 2 S ST=1 G ^DGPTFM
54 S L=$E(L,1,$L(L)-1) I L=+L S RC=+L G O2
55O1 I 'Z S ST=1 W !!,"Add to surgery record <",L,"> : " R RC:DTIME G ^DGPTFM:'$T!(RC[U)!(RC="")
56 E S RC=+$E(A,2,99)
57O2 I +RC'=RC!(","_L_","'[(","_RC_",")) W !!,"Enter the surgery record number to add ICD operation codes to: ",L G O1:'Z S Z="" G O1
58 S DIE="^DGPT(",(DGPTF,DA)=PTF,DR="[DG401]"
59 S ST=1,DGZS0=RC,DGADD=1,DGSUR=S(DGZS0,1) D ^DIE,CHK401^DGPTSCAN K DR,DGPTF,DGSUR,DGADD G ^DGPTFM
60 ;
61S G ADD^DGPTFM5
62V S DGZM0=0 G ^DGPTFM4
63J S DGZS0=0 G ^DGPTFM5
64Q G QEL:Z
65QQ R !!,"Enter the item #'s of the ICD Procedure codes to delete: ",A1:DTIME
66 S:'$T A1=U I A1'?1N.NP G ^DGPTFM:"^"[A1 W:A1'["?" " ???",*7 D Q^DGPTFM0 G QQ
67 S A=A_A1
68QEL S DGA=$E(A,2,999) K X,A1 S DIE="^DGPT(",DA=PTF W !!
69 F J=1:1 S DP=45,L=+$P(DGA,",",J) Q:'L S L1=$S($D(P2(L)):P2(L),1:"Undefined, ") W:'L1 " ",L,"-",L1 I L1 S DR=+P2(+L)/100+45_"///@",DA(1)=PTF D ^DIE K DR W " ",L,"-Deleted, " W:$X>70 !
70 H 2 G ^DGPTFM
71 ;
72P G P^DGPTFM6
73Q1 Q
74T G ^DGPTFM6
75R G R^DGPTFM4
76E I $D(^DGPT(PTF,70)),+^(70)>2871000 D MOB^DGPTFM6 G SET^DGPTFM6
77 I DT>2871000 D MOB^DGPTFM6 G SET^DGPTFM6
78 G ^DGPTFM6
79 ;
80MVT ;
81 N PTF,DGPMAN
82 S DGPMT=6 D CA^DGPMV S DGPMDA=+Y
83 K DGPMT Q
84I G ADD^DGPTFM2
85Y G DEL^DGPTFM2
86N G N^DGPTFM2
87G G DC^DGPTFM2
88F G F^DGPTFM2
Note: See TracBrowser for help on using the repository browser.