Changeset 636 for FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFM4.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFM4.m (modified) (2 diffs)

FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFM4.m

@@ -1 @@
-DGPTFM4 ;ALB/MTC/ADL - PTF ENTRY/EDIT-2 ; 12/18/07 11:37am
- ;;5.3;Registration;**114,195,397,510,565,775**;Aug 13, 1993;Build 3
+DGPTFM4 ;ALB/MTC/ADL - PTF ENTRY/EDIT-2 ; 11/19/03 11:37am
+ ;;5.3;Registration;**114,195,397,510,565**;Aug 13, 1993
  ;;ADL;Update for CSV Project;;Mar 26, 2003
  ;
@@ -26 +26 @@
  . W $S(+DGPTTMP>0&($P(DGPTTMP,U,10)):$P(DGPTTMP,U,4)_" ("_$P(DGPTTMP,U,2)_")",1:"**********-"_L),!?17
  D PRN2^DGPTFM8:DG300]""
- I $P(M1,U,20) S DRG=$P(M1,U,20) W:DRG=998!(DRG=999)!((DRG=468!(DRG=469)!(DRG=470))&(+$P($G(M1),U,10)<3071001)) *7 W !!?14,"TRANSFER DRG: ",DRG D
- . N DXD,DGDX
- . S DXD=$$DRGD^ICDGTDRG(DRG,"DGDX",,$P(M1,U,10)),DGDS=0
- . F  S DGDS=$O(DGDX(DGDS)) Q:'+DGDS  Q:DGDX(DGDS)=" "  W !,DGDX(DGDS)
+ I $P(M1,U,20) S DRG=$P(M1,U,20) W:DRG=468!(DRG=469)!(DRG=470) *7 W !!?14,"TRANSFER DRG: ",DRG F DGDRGNM=0:0 S DGDRGNM=$O(^ICD(DRG,1,DGDRGNM)) Q:'DGDRGNM  W !,$P(^(DGDRGNM,0),U,1)
 JUMP K DG300 F I=$Y:1:21 W !
 X S DGNUM=$S($D(M(DGZM0+1)):501_"-"_(DGZM0+1),1:"MAS") G 501^DGPTFJC:DGST