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

DGPT601.m

Go to the documentation of this file. 
  1. DGPT601 ;ALB/MTC,HIOFO/FT - Process 601 transmission ;3/23/2015 5:19pm
  1.  ;;5.3;Registration;**64,164,729,850,884,1057**;Aug 13, 1993;Build 17
  1.  ;
  1.  ;no external references
  1.  ;
  1.  ;called from RTE^DGPTAE
  1. EN ; Process 601 transmission
  1.  N ERROR
  1.  K DGPTPAR
  1.  S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ),DGPTEDFL=0,DGPTERP=7
  1.  S:$E(DGPTSTR,37,40)="2400" DGPTSTR=$E(DGPTSTR,1,36)_"2359"_$E(DGPTSTR,41,125)
  1. SET ;parse data string and set variables
  1.  D:DGPTFMT=2 SET9
  1.  D:DGPTFMT=3 SET10
  1. DATE ;date/time of procedure
  1.  ; DGPTDDS - discharge DT
  1.  ; DGPTDTS - admission DT
  1.  ; DGPTPDTS - procedure DT
  1.  ;
  1.  S (X,DGPTPDTS)=$$FMDT^DGPT101($E(DGPTPDT,1,6))_"."_$E(DGPTPDT,7,10),%DT="XT" D ^%DT I Y<0 S DGPTERC=601 D ERR G:DGPTEDFL EXIT G TSPEC
  1.  D DD^%DT S DGPTPDT=$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.  I DGPTPDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=601 D ERR G:DGPTEDFL EXIT
  1.  I $$FMDIFF^XLFDT(DGPTDDS,DGPTPDTS,2)<0 S DGPTERC=640 D ERR G:DGPTEDFL EXIT  ; DG*5.3*1057
  1.  I $$FMDIFF^XLFDT(DGPTPDTS,$$FMADD^XLFDT(DGPTDTS,,-72),2)<0 S DGPTERC=637 D ERR G:DGPTEDFL EXIT  ; DG*5.3*1057
  1.  ;
  1. TSPEC ;treating specialty
  1.  N DGPTPSC1
  1.  I DGPTPSC'?2AN S DGPTERC=602 D ERR G:DGPTEDFL EXIT
  1.  S DGPTSP1=$E(DGPTPSC,1),DGPTSP2=$E(DGPTPSC,2),DGPTERC=0
  1.  D CHECK^DGPTAE02 I DGPTERC S DGPTERC=602 D ERR G:DGPTEDFL EXIT G DIAL
  1.  ;-- Active treating specialty edit check
  1.  I $E(DGPTPSC,1)=0!($E(DGPTPSC,1)=" ") S DGPTPSC=$E(DGPTPSC,2)
  1.  ; DGPTPSC  := ptf code (alpha-numeric) value (file:42.4, field:7)
  1.  ; DGPTPSC1 := dinum value (ien, file:42.4, field:.001)
  1.  S DGPTPSC1=+$O(^DIC(42.4,"C",DGPTPSC,0))
  1.  ;-- If not active treat spec, set 601 flag to print error msg during
  1.  ;-- PTF close-out error display at WRER^DGPTAEE
  1.  I '$$ACTIVE^DGACT(42.4,DGPTPSC1,DGPTPDTS) S DGPTERC=602,DGPTSER(DGPTPDTS_601)=1 D ERR G:DGPTEDFL EXIT
  1. DIAL ;dialysis
  1.  N DGLOOP,DGPTPCODE
  1.  I DGPTPNT="   "!(+DGPTPNT'>0) D  G:DGPTEDFL EXIT
  1.  .F DGLOOP=1:1:$S(DGPTFMT=3:25,1:5) S DGPTPCODE=@("DGPTPC"_DGLOOP) D
  1.  ..I DGPTPCODE="3995   "!(DGPTPCODE="5498   ")!(DGPTPCODE="5092   ") S DGPTERC=604 D ERR
  1.  ..I DGPTPCODE="5A1C00Z"!(DGPTPCODE="5A1C60Z")!(DGPTPCODE="5A1D00Z")!(DGPTPCODE="5A1D60Z")!(DGPTPCODE="3E1M39Z") S DGPTERC=604 D ERR
  1.  ;
  1. OPS ;operation codes
  1.  S DGPTERC=0 D ^DGPT60PR G:DGPTEDFL EXIT
  1.  ;
  1. OPDUP ;--check for duplicate procedure codes
  1.  I DGPTFMT=2 I ((DGPTPDY=" ")&(DGPTPNT="   "))&($E(DGPTSTR,47,81)?1.35" ") S DGPTERC="605Z" D ERR G EXIT
  1.  ;I DGPTFMT=3 I ((DGPTPDY=" ")&(DGPTPNT="   "))&($E(DGPTSTR,47,245)?1.199" ") S DGPTERC="605Z" D ERR G EXIT
  1.  ;commenting out duplicate check with dg*5.3*884 ft 11/5/14
  1.  ;F DGPTL4=1:1:5 I $E(@("DGPTPC"_DGPTL4),1)'=" " S DGPTPAR(@("DGPTPC"_DGPTL4),DGPTL4)=""
  1.  ;S DGPTPAR1=0 F DGPTL4=1:1:5 S DGPTPAR1=$O(DGPTPAR(DGPTPAR1)) Q:DGPTPAR1=""  D  G:DGPTEDFL EXIT
  1.  ;. S DGPTPRA2=$O(DGPTPAR(DGPTPAR1,0))
  1.  ;. I DGPTPRA2'="" S DGPTPRA3=$O(DGPTPAR(DGPTPAR1,DGPTPRA2))
  1.  ;. I DGPTPRA3'="" S DGPTERC=657 D ERR
  1.  K DGPTPAR
  1. GOOD ;
  1.  W:'$D(ERROR) "."
  1.  ;
  1. EXIT ;
  1.  K DGPTERC,DGPTL3,DGPTL4,DGPTOP,DGPTOP1,DGPTP1,DGPTP2,DGPTPAR1
  1.  K DGPTPC1,DGPTPC2,DGPTPC3,DGPTPC4,DGPTPC5,DGPTPC6,DGPTPC7,DGPTPC8,DGPTPC9,DGPTPC10,DGPTPC11,DGPTPC12,DGPTPC13,DGPTPC14,DGPTPC15
  1.  K DGPTPC16,DGPTPC17,DGPTPC18,DGPTPC19,DGPTPC20,DGPTPC21,DGPTPC22,DGPTPC23,DGPTPC24,DGPTPC25
  1.  K DGPTPDT,DGPTPDTS,DGPTPDY,DGPTPFL,DGPTPNT,DGPTPP,DGPTPRA2,DGPTPRA3,DGPTPSC,DGPTSTR,DGPTXX
  1.  K X,X1,X2,Y
  1.  Q
  1. ERR ;
  1.  D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
  1.  S ERROR=1
  1.  Q
  1. DIALE ;dialysis type
  1.  I "12345678"'[DGPTPDY S DGPTERC=603 D ERR G:DGPTEDFL EXIT
  1.  I DGPTPNT="   "!(+DGPTPNT'>0) S DGPTERC=604 D ERR G:DGPTEDFL EXIT
  1.  Q
  1. SET9 ;record layout before icd10 turned on
  1.  S DGPTPDT=$E(DGPTSTR,31,40) ;date/time of procedure
  1.  S DGPTPSC=$E(DGPTSTR,41,42) ;specialty
  1.  S DGPTPDY=$E(DGPTSTR,43)    ;dialysis type
  1.  S DGPTPNT=$E(DGPTSTR,44,46) ;number of dialysis treatments
  1.  S DGPTPC1=$E(DGPTSTR,47,53) ;procedure codes 1-5
  1.  S DGPTPC2=$E(DGPTSTR,54,60)
  1.  S DGPTPC3=$E(DGPTSTR,61,67)
  1.  S DGPTPC4=$E(DGPTSTR,68,74)
  1.  S DGPTPC5=$E(DGPTSTR,75,81)
  1.  Q
  1. SET10 ;record layout after icd10 turned on
  1.  S DGPTPDT=$E(DGPTSTR,31,40) ;date/time of procedure
  1.  S DGPTPSC=$E(DGPTSTR,41,42) ;specialty
  1.  S DGPTPDY=$E(DGPTSTR,43)    ;dialysis type
  1.  S DGPTPNT=$E(DGPTSTR,44,46) ;number of dialysis treatments
  1.  S DGPTPC1=$E(DGPTSTR,47,53) ;procedure codes 1-25. 7 characters long (padded with a space when transmitting)
  1.  S DGPTPC2=$E(DGPTSTR,55,61)
  1.  S DGPTPC3=$E(DGPTSTR,63,69)
  1.  S DGPTPC4=$E(DGPTSTR,71,77)
  1.  S DGPTPC5=$E(DGPTSTR,79,85)
  1.  S DGPTPC6=$E(DGPTSTR,87,93)
  1.  S DGPTPC7=$E(DGPTSTR,95,101)
  1.  S DGPTPC8=$E(DGPTSTR,103,109)
  1.  S DGPTPC9=$E(DGPTSTR,111,117)
  1.  S DGPTPC10=$E(DGPTSTR,119,125)
  1.  S DGPTPC11=$E(DGPTSTR,127,133)
  1.  S DGPTPC12=$E(DGPTSTR,135,141)
  1.  S DGPTPC13=$E(DGPTSTR,143,149)
  1.  S DGPTPC14=$E(DGPTSTR,151,157)
  1.  S DGPTPC15=$E(DGPTSTR,159,165)
  1.  S DGPTPC16=$E(DGPTSTR,167,173)
  1.  S DGPTPC17=$E(DGPTSTR,175,181)
  1.  S DGPTPC18=$E(DGPTSTR,183,189)
  1.  S DGPTPC19=$E(DGPTSTR,191,197)
  1.  S DGPTPC20=$E(DGPTSTR,199,205)
  1.  S DGPTPC21=$E(DGPTSTR,207,213)
  1.  S DGPTPC22=$E(DGPTSTR,215,221)
  1.  S DGPTPC23=$E(DGPTSTR,223,229)
  1.  S DGPTPC24=$E(DGPTSTR,231,237)
  1.  S DGPTPC25=$E(DGPTSTR,239,245)
  1.  Q