Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPT701

DGPT701.m

Go to the documentation of this file.
  1. DGPT701 ;ALB/MTC,HIOFO/FT - Process 701 Transaction ;11/5/14 1:27pm
  1. ;;5.3;Registration;**64,164,251,415,729,850,884**;Aug 13, 1993;Build 31
  1. ; 10/06/1999 ACS - Removed Place of Disposition codes M,Y,Z from the list of invalid codes.
  1. ;
  1. ;no external references
  1. ;
  1. EN ;
  1. Q
  1. SET ;
  1. S DGPTSTR=$G(^TMP("AEDIT",$J,"N701",DGPTAL7))
  1. ;S DGPTSTR=$G(^TMP("AEDIT",$J,"N701",SEQ))
  1. D PARSE^DGPT701P
  1. DTE ;
  1. S (X,DGPTDDS)=$$FMDT^DGPT101($E(DGPTDDTD,1,6))_"."_$E(DGPTDDTD,7,10)
  1. S %DT="XT" D ^%DT I Y<0 S DGPTERC=705 D ERR G:DGPTEDFL EXIT
  1. I Y>0 D DD^%DT S DGPTDTD=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)_" "_$S($P(Y,"@",2)]"":$E($P(Y,"@",2),1,5),1:"00:00")
  1. S X1=DGPTNOW,X2=+DGPTDDS D ^%DTC I X<0 S DGPTERC=740 D ERR G:DGPTEDFL EXIT
  1. S X1=+DGPTDDS,X2=+DGPTDTS D ^%DTC S DGPTELP=X I X<0 S DGPTERC=737 D ERR G:DGPTEDFL EXIT
  1. CHECK ;
  1. TSPEC ; CHECK TREATING SPECIALTY CODE
  1. N DGPTDSP1
  1. I DGPTDSP'?2AN S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
  1. S DGPTSP1=$E(DGPTDSP,1),DGPTSP2=$E(DGPTDSP,2),DGPTERC=0
  1. D CHECK^DGPTAE02 I DGPTERC S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
  1. ;-- Active treating specialty edit check
  1. I $E(DGPTDSP,1)=0!($E(DGPTDSP,1)=" ") S DGPTDSP=$E(DGPTDSP,2)
  1. ; DGPTDSP := ptf code (alpha-numeric) value (file:42.4,field:7)
  1. ; DGPTDSP1 := dinum value (ien, file:42.4,field:.001)
  1. S DGPTDSP1=+$O(^DIC(42.4,"C",DGPTDSP,0))
  1. ;-- If not active treat spec, set flag to print error msg during
  1. ;-- PTF Close-out Error display at WRER^DGPTAEE
  1. I '$$ACTIVE^DGACT(42.4,DGPTDSP1,DGPTDDS) S DGPTERC=706,DGPTSER(DGPTDDS_701)=1 D ERR G:DGPTEDFL EXIT
  1. ;
  1. DISPTY ;type of disposition
  1. I (DGPTDTY<1)!(DGPTDTY>7) S DGPTERC=707 D ERR G:DGPTEDFL EXIT G OPCAR
  1. S DGPTERC=0 D DISPTY^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. OPCAR ;outpatient care status
  1. I "13 "'[DGPTDOP S DGPTERC=708 D ERR G:DGPTEDFL EXIT G VA
  1. I DGPTDOP'=" " S DGPTERC=0 D OP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. VA ;under va auspices
  1. I "12 "'[DGPTDVA S DGPTERC=709 D ERR G:DGPTEDFL EXIT
  1. ;
  1. VAOP ;check for inconsistencies between outpatient care and va auspices
  1. I DGPTDVA=2,DGPTDOP=1 D G:DGPTEDFL EXIT
  1. . S DGPTERC=708 D ERR
  1. . S DGPTERC=709 D ERR
  1. CDR ;physical location cdr code
  1. I DGPTDLR'?6" "&(DGPTDLR'?." "6N) S DGPTERC=775 D ERR G:DGPTEDFL EXIT
  1. POD ;place of disposition
  1. I "68EINOQSVW"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
  1. S DGPTERC=0 D POD^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. RECF ;receiving facility number & suffix
  1. I DGPTDVA'=1!(DGPTDRF=" ") G ASIH
  1. I DGPTDRF[" " S DGPTDRF=$P(DGPTDRF," ",1)
  1. I DGPTDRF="" S DGPTERC=711 D ERR G:DGPTEDFL EXIT
  1. ASIH ;extended care days - absent sick in hospital
  1. I DGPTDAS'=" ",DGPTDAS'?2E1N S DGPTERC=712 D ERR G:DGPTEDFL EXIT
  1. ;
  1. LEAVE ;check leave days+pass days with total length of stay
  1. S DGPTERC=0 D LEAVE^DGPTAE02 D:DGPTERC ERR G:DGPTEDFL EXIT
  1. SC ;percentage of service connected
  1. G:DGPTFMT=3 CP ;not set or checked after icd10 turned on. ft 10/30/14
  1. I DGPTDSC'=" "&(DGPTDSC'?3N) S DGPTERC=730 D ERR G:DGPTEDFL EXIT G CP
  1. S DGPTDSC=+DGPTDSC
  1. CP ;compensation & pension status
  1. S DGPTERC=0 D CANDP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. DIAG ;check diagnostic code
  1. S DGPTERC=0 D ^DGPT70DX I DGPTERC D ERR G:DGPTEDFL EXIT
  1. DXLSPOA ;check dxls poa value ;new field & check with 884 ft 11/3/14
  1. I DGPTFMT=3 S DGPTERC=0 D DXLSPOA^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. OVER ; Pass FY92 edits for earlier data
  1. I DGPTDDS'>2911001 G ONED
  1. LEG ; LEGIONNAIRE'S DISEASE
  1. ;S DGPTERC=0 D LEG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT //no longer used because of DG*5.3*683 (7/1/06). ft 11/5/14
  1. ;DGPT70LG is still set with ICD9 & ICD10, so check for space. ft 10/30/14
  1. ;I DGPT70LG'=" " S DGPTERC=7__ D ERR G:DGPTEDFL EXIT
  1. SUI ; Suicide indicator
  1. ;no longer used because of dg*5.3*683 (71/06). ft 11/5/14
  1. ;S DGPTERC=0 D SUI^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. ;I DGPT70SU'=" " S DGPTERC=7__ D ERR G:DGPTEDFL EXIT
  1. DRUG ;drug/substance abuse
  1. ;no longer used as of DG*5.3*683 (7/1/06). ft 11/5/14
  1. ;S DGPTERC=0 D DRUG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. ;I DGPT70DR'?4" " S DGPTERC=7__ D ERR G:DGPTEDFL EXIT
  1. AXES ; Psych axises
  1. ;no longer used when ICD10 is turned on, but still in the record so check for spaces. ft 11/5/14
  1. I DGPTFMT=3 D G ONED
  1. .I DGPT70X4'=" " S DGPTERC=734 D ERR
  1. .I DGPTDXV2'?4" " S DGPTERC=735 D ERR
  1. I '$P($G(^DIC(42.4,+$G(DGPTDSP1),0)),U,4) S (DGPT70X4,DGPT7X51,DGPT7X52)=" " G ONED ;don't think DGPT7X51/52 are ever used, just set & killed. ft 11/5/14
  1. S DGPTERC=0 D AXIV^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. S DGPTERC=0 D AXV1^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. S DGPTERC=0 D AXV2^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. ONED ;check if one diagnostic code only
  1. I (DGPTDDXO=" ")&('$D(^TMP("AEDIT",$J,"N702"))&'$D(^TMP("AEDIT",$J,"N703"))) S DGPTERC=718 D ERR G:DGPTEDFL EXIT
  1. I (DGPTDDXO="X")&($D(^TMP("AEDIT",$J,"N702"))) S DGPTERC=719 D ERR G:DGPTEDFL EXIT
  1. RACE ;race
  1. I DGPTFMT=3 S DGPTERC=0 D RACE^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. TSC ;treated for service condition
  1. I DGPTFMT=3 S DGPTERC=0 D TSC^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. AO ;agent orange condition
  1. I DGPTFMT=3 S DGPTERC=0 D AO^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. IR ;ionizing radiation condition
  1. I DGPTFMT=3 S DGPTERC=0 D IR^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. SWA ;sw asia condition
  1. I DGPTFMT=3 S DGPTERC=0 D SWA^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. MST ;military sexual trauma
  1. I DGPTFMT=3 S DGPTERC=0 D MST^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. HNC ;head & neck care
  1. I DGPTFMT=3 S DGPTERC=0 D HNC^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. ETHNIC ;ethnicity
  1. I DGPTFMT=3 S DGPTERC=0 D ETHNIC^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. RACE16 ;race 1-6
  1. I DGPTFMT=3 D
  1. .F DGLOOP=1:1:6 S DGPTRACE16=@("DGPT70RACE"_DGLOOP)
  1. .Q:DGPTRACE16=" " ;two spaces
  1. .S DGPTERC=0 D RACE16^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. K DGLOOP,DGPTRACE16
  1. CV ;combat vet
  1. I DGPTFMT=3 S DGPTERC=0 D CV^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. SHAD ;shad
  1. I DGPTFMT=3 S DGPTERC=0 D SHAD^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
  1. EXIT ;
  1. Q
  1. ERR ;
  1. D WRTERR^DGPTAE(DGPTERC,"N701",DGPTAL7)
  1. ;D WRTERR^DGPTAE(DGPTERC,"N701",SEQ)
  1. S ERROR=1
  1. Q