- DGPT701 ;ALB/MTC - Process 701 Transaction ;10/06/1999
- ;;5.3;Registration;**64,164,251,415,729,1015**;Aug 13, 1993;Build 21
- ; 10/06/1999 ACS - Removed Place of Disposition codes M,Y,Z from the list of
- ; invalid codes.
- ;
- EN ;
- Q
- SET ;
- S DGPTSTR=$G(^TMP("AEDIT",$J,"N701",DGPTAL7))
- D PARSE^DGPT701P
- DTE ;
- S (X,DGPTDDS)=$$FMDT^DGPT101($E(DGPTDDTD,1,6))_"."_$E(DGPTDDTD,7,10)
- S %DT="XT" D ^%DT I Y<0 S DGPTERC=705 D ERR G:DGPTEDFL EXIT
- 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")
- S X1=DGPTNOW,X2=+DGPTDDS D ^%DTC I X<0 S DGPTERC=740 D ERR G:DGPTEDFL EXIT
- S X1=+DGPTDDS,X2=+DGPTDTS D ^%DTC S DGPTELP=X I X<0 S DGPTERC=737 D ERR G:DGPTEDFL EXIT
- CHECK ;
- TSPEC ; CHECK TREATING SPECIALTY CODE
- N DGPTDSP1
- I DGPTDSP'?2AN S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
- S DGPTSP1=$E(DGPTDSP,1),DGPTSP2=$E(DGPTDSP,2),DGPTERC=0
- D CHECK^DGPTAE02 I DGPTERC S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
- ;-- Active treating specialty edit check
- I $E(DGPTDSP,1)=0!($E(DGPTDSP,1)=" ") S DGPTDSP=$E(DGPTDSP,2)
- ; DGPTDSP := ptf code (alpha-numeric) value (file:42.4,field:7)
- ; DGPTDSP1 := dinum value (ien, file:42.4,field:.001)
- S DGPTDSP1=+$O(^DIC(42.4,"C",DGPTDSP,0))
- ;-- If not active treat spec, set flag to print error msg during
- ;-- PTF Close-out Error display at WRER^DGPTAEE
- I '$$ACTIVE^DGACT(42.4,DGPTDSP1,DGPTDDS) S DGPTERC=706,DGPTSER(DGPTDDS_701)=1 D ERR G:DGPTEDFL EXIT
- ;
- DISPTY ;
- I (DGPTDTY<1)!(DGPTDTY>7) S DGPTERC=707 D ERR G:DGPTEDFL EXIT G OPCAR
- S DGPTERC=0 D DISPTY^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- OPCAR ;
- I "13 "'[DGPTDOP S DGPTERC=708 D ERR G:DGPTEDFL EXIT G VA
- I DGPTDOP'=" " S DGPTERC=0 D OP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- VA ;
- I "12 "'[DGPTDVA S DGPTERC=709 D ERR G:DGPTEDFL EXIT
- ;
- VAOP ;-- check for inconsistencies between opcare and va aspices
- I DGPTDVA=2,DGPTDOP=1 D G:DGPTEDFL EXIT
- . S DGPTERC=708 D ERR
- . S DGPTERC=709 D ERR
- CDR ;
- I DGPTDLR'?6" "&(DGPTDLR'?." "6N) S DGPTERC=775 D ERR G:DGPTEDFL EXIT
- POD ;
- ;I "68EIMNOQSVWYZ"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
- I "68EINOQSVW"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
- S DGPTERC=0 D POD^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- RECF ;
- I DGPTDVA'=1!(DGPTDRF=" ") G ASIH
- I DGPTDRF[" " S DGPTDRF=$P(DGPTDRF," ",1)
- I DGPTDRF="" S DGPTERC=711 D ERR G:DGPTEDFL EXIT
- ASIH ;
- I DGPTDAS'=" ",DGPTDAS'?2E1N S DGPTERC=712 D ERR G:DGPTEDFL EXIT
- ;
- LEAVE ;
- S DGPTERC=0 D LEAVE^DGPTAE02 D:DGPTERC ERR G:DGPTEDFL EXIT
- SC ;
- I DGPTDSC'=" "&(DGPTDSC'?3N) S DGPTERC=730 D ERR G:DGPTEDFL EXIT G CP
- S DGPTDSC=+DGPTDSC
- CP ;
- S DGPTERC=0 D CANDP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- DIAG ;
- S DGPTERC=0 D ^DGPT70DX I DGPTERC D ERR G:DGPTEDFL EXIT
- OVER ; Pass FY92 edits for earlier data
- I DGPTDDS'>2911001 G ONED
- LEG ; LEGIONNAIRE'S DISEASE
- S DGPTERC=0 D LEG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- SUI ; Suicide indicator
- S DGPTERC=0 D SUI^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- DRUG ;
- S DGPTERC=0 D DRUG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- AXES ; Psych axises
- I '$P($G(^DIC(42.4,+DGPTDSP1,0)),U,4) S (DGPT70X4,DGPT7X51,DGPT7X52)=" " G ONED
- S DGPTERC=0 D AXIV^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- S DGPTERC=0 D AXV1^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- S DGPTERC=0 D AXV2^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
- ONED ;
- I (DGPTDDXO=" ")&('$D(^TMP("AEDIT",$J,"N702"))&'$D(^TMP("AEDIT",$J,"N703"))) S DGPTERC=718 D ERR G:DGPTEDFL EXIT
- I (DGPTDDXO="X")&($D(^TMP("AEDIT",$J,"N072"))) S DGPTERC=719 D ERR G:DGPTEDFL EXIT
- EXIT ;
- Q
- ERR ;
- D WRTERR^DGPTAE(DGPTERC,"N701",DGPTAL7)
- S ERROR=1
- Q
- DGPT701 ;ALB/MTC - Process 701 Transaction ;10/06/1999
- +1 ;;5.3;Registration;**64,164,251,415,729,1015**;Aug 13, 1993;Build 21
- +2 ; 10/06/1999 ACS - Removed Place of Disposition codes M,Y,Z from the list of
- +3 ; invalid codes.
- +4 ;
- EN ;
- +1 QUIT
- SET ;
- +1 SET DGPTSTR=$GET(^TMP("AEDIT",$JOB,"N701",DGPTAL7))
- +2 DO PARSE^DGPT701P
- DTE ;
- +1 SET (X,DGPTDDS)=$$FMDT^DGPT101($EXTRACT(DGPTDDTD,1,6))_"."_$EXTRACT(DGPTDDTD,7,10)
- +2 SET %DT="XT"
- DO ^%DT
- IF Y<0
- SET DGPTERC=705
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +3 IF Y>0
- DO DD^%DT
- SET DGPTDTD=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)_" "_$SELECT($PIECE(Y,"@",2)]"":$EXTRACT($PIECE(Y,"@",2),1,5),1:"00:00")
- +4 SET X1=DGPTNOW
- SET X2=+DGPTDDS
- DO ^%DTC
- IF X<0
- SET DGPTERC=740
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +5 SET X1=+DGPTDDS
- SET X2=+DGPTDTS
- DO ^%DTC
- SET DGPTELP=X
- IF X<0
- SET DGPTERC=737
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- CHECK ;
- TSPEC ; CHECK TREATING SPECIALTY CODE
- +1 NEW DGPTDSP1
- +2 IF DGPTDSP'?2AN
- SET DGPTERC=706
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO DISPTY
- +3 SET DGPTSP1=$EXTRACT(DGPTDSP,1)
- SET DGPTSP2=$EXTRACT(DGPTDSP,2)
- SET DGPTERC=0
- +4 DO CHECK^DGPTAE02
- IF DGPTERC
- SET DGPTERC=706
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO DISPTY
- +5 ;-- Active treating specialty edit check
- +6 IF $EXTRACT(DGPTDSP,1)=0!($EXTRACT(DGPTDSP,1)=" ")
- SET DGPTDSP=$EXTRACT(DGPTDSP,2)
- +7 ; DGPTDSP := ptf code (alpha-numeric) value (file:42.4,field:7)
- +8 ; DGPTDSP1 := dinum value (ien, file:42.4,field:.001)
- +9 SET DGPTDSP1=+$ORDER(^DIC(42.4,"C",DGPTDSP,0))
- +10 ;-- If not active treat spec, set flag to print error msg during
- +11 ;-- PTF Close-out Error display at WRER^DGPTAEE
- +12 IF '$$ACTIVE^DGACT(42.4,DGPTDSP1,DGPTDDS)
- SET DGPTERC=706
- SET DGPTSER(DGPTDDS_701)=1
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +13 ;
- DISPTY ;
- +1 IF (DGPTDTY<1)!(DGPTDTY>7)
- SET DGPTERC=707
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO OPCAR
- +2 SET DGPTERC=0
- DO DISPTY^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- OPCAR ;
- +1 IF "13 "'[DGPTDOP
- SET DGPTERC=708
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO VA
- +2 IF DGPTDOP'=" "
- SET DGPTERC=0
- DO OP^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- VA ;
- +1 IF "12 "'[DGPTDVA
- SET DGPTERC=709
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +2 ;
- VAOP ;-- check for inconsistencies between opcare and va aspices
- +1 IF DGPTDVA=2
- IF DGPTDOP=1
- Begin DoDot:1
- +2 SET DGPTERC=708
- DO ERR
- +3 SET DGPTERC=709
- DO ERR
- End DoDot:1
- IF DGPTEDFL
- GOTO EXIT
- CDR ;
- +1 IF DGPTDLR'?6" "&(DGPTDLR'?." "6N)
- SET DGPTERC=775
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- POD ;
- +1 ;I "68EIMNOQSVWYZ"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
- +2 IF "68EINOQSVW"[DGPTDPD
- SET DGPTERC=710
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO RECF
- +3 SET DGPTERC=0
- DO POD^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- RECF ;
- +1 IF DGPTDVA'=1!(DGPTDRF=" ")
- GOTO ASIH
- +2 IF DGPTDRF[" "
- SET DGPTDRF=$PIECE(DGPTDRF," ",1)
- +3 IF DGPTDRF=""
- SET DGPTERC=711
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- ASIH ;
- +1 IF DGPTDAS'=" "
- IF DGPTDAS'?2E1N
- SET DGPTERC=712
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +2 ;
- LEAVE ;
- +1 SET DGPTERC=0
- DO LEAVE^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- SC ;
- +1 IF DGPTDSC'=" "&(DGPTDSC'?3N)
- SET DGPTERC=730
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- GOTO CP
- +2 SET DGPTDSC=+DGPTDSC
- CP ;
- +1 SET DGPTERC=0
- DO CANDP^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- DIAG ;
- +1 SET DGPTERC=0
- DO ^DGPT70DX
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- OVER ; Pass FY92 edits for earlier data
- +1 IF DGPTDDS'>2911001
- GOTO ONED
- LEG ; LEGIONNAIRE'S DISEASE
- +1 SET DGPTERC=0
- DO LEG^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- SUI ; Suicide indicator
- +1 SET DGPTERC=0
- DO SUI^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- DRUG ;
- +1 SET DGPTERC=0
- DO DRUG^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- AXES ; Psych axises
- +1 IF '$PIECE($GET(^DIC(42.4,+DGPTDSP1,0)),U,4)
- SET (DGPT70X4,DGPT7X51,DGPT7X52)=" "
- GOTO ONED
- +2 SET DGPTERC=0
- DO AXIV^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +3 SET DGPTERC=0
- DO AXV1^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +4 SET DGPTERC=0
- DO AXV2^DGPTAE02
- IF DGPTERC
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- ONED ;
- +1 IF (DGPTDDXO=" ")&('$DATA(^TMP("AEDIT",$JOB,"N702"))&'$DATA(^TMP("AEDIT",$JOB,"N703")))
- SET DGPTERC=718
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- +2 IF (DGPTDDXO="X")&($DATA(^TMP("AEDIT",$JOB,"N072")))
- SET DGPTERC=719
- DO ERR
- IF DGPTEDFL
- GOTO EXIT
- EXIT ;
- +1 QUIT
- ERR ;
- +1 DO WRTERR^DGPTAE(DGPTERC,"N701",DGPTAL7)
- +2 SET ERROR=1
- +3 QUIT
