[613] | 1 | DGPT701 ;ALB/MTC - Process 701 Transaction ;10/06/1999
|
---|
| 2 | ;;5.3;Registration;**64,164,251,415,729**;Aug 13, 1993;Build 59
|
---|
| 3 | ; 10/06/1999 ACS - Removed Place of Disposition codes M,Y,Z from the list of
|
---|
| 4 | ; invalid codes.
|
---|
| 5 | ;
|
---|
| 6 | EN ;
|
---|
| 7 | Q
|
---|
| 8 | SET ;
|
---|
| 9 | S DGPTSTR=$G(^TMP("AEDIT",$J,"N701",DGPTAL7))
|
---|
| 10 | D PARSE^DGPT701P
|
---|
| 11 | DTE ;
|
---|
| 12 | S (X,DGPTDDS)=$$FMDT^DGPT101($E(DGPTDDTD,1,6))_"."_$E(DGPTDDTD,7,10)
|
---|
| 13 | S %DT="XT" D ^%DT I Y<0 S DGPTERC=705 D ERR G:DGPTEDFL EXIT
|
---|
| 14 | 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")
|
---|
| 15 | S X1=DGPTNOW,X2=+DGPTDDS D ^%DTC I X<0 S DGPTERC=740 D ERR G:DGPTEDFL EXIT
|
---|
| 16 | S X1=+DGPTDDS,X2=+DGPTDTS D ^%DTC S DGPTELP=X I X<0 S DGPTERC=737 D ERR G:DGPTEDFL EXIT
|
---|
| 17 | CHECK ;
|
---|
| 18 | TSPEC ; CHECK TREATING SPECIALTY CODE
|
---|
| 19 | N DGPTDSP1
|
---|
| 20 | I DGPTDSP'?2AN S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
|
---|
| 21 | S DGPTSP1=$E(DGPTDSP,1),DGPTSP2=$E(DGPTDSP,2),DGPTERC=0
|
---|
| 22 | D CHECK^DGPTAE02 I DGPTERC S DGPTERC=706 D ERR G:DGPTEDFL EXIT G DISPTY
|
---|
| 23 | ;-- Active treating specialty edit check
|
---|
| 24 | I $E(DGPTDSP,1)=0!($E(DGPTDSP,1)=" ") S DGPTDSP=$E(DGPTDSP,2)
|
---|
| 25 | ; DGPTDSP := ptf code (alpha-numeric) value (file:42.4,field:7)
|
---|
| 26 | ; DGPTDSP1 := dinum value (ien, file:42.4,field:.001)
|
---|
| 27 | S DGPTDSP1=+$O(^DIC(42.4,"C",DGPTDSP,0))
|
---|
| 28 | ;-- If not active treat spec, set flag to print error msg during
|
---|
| 29 | ;-- PTF Close-out Error display at WRER^DGPTAEE
|
---|
| 30 | I '$$ACTIVE^DGACT(42.4,DGPTDSP1,DGPTDDS) S DGPTERC=706,DGPTSER(DGPTDDS_701)=1 D ERR G:DGPTEDFL EXIT
|
---|
| 31 | ;
|
---|
| 32 | DISPTY ;
|
---|
| 33 | I (DGPTDTY<1)!(DGPTDTY>7) S DGPTERC=707 D ERR G:DGPTEDFL EXIT G OPCAR
|
---|
| 34 | S DGPTERC=0 D DISPTY^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 35 | OPCAR ;
|
---|
| 36 | I "13 "'[DGPTDOP S DGPTERC=708 D ERR G:DGPTEDFL EXIT G VA
|
---|
| 37 | I DGPTDOP'=" " S DGPTERC=0 D OP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 38 | VA ;
|
---|
| 39 | I "12 "'[DGPTDVA S DGPTERC=709 D ERR G:DGPTEDFL EXIT
|
---|
| 40 | ;
|
---|
| 41 | VAOP ;-- check for inconsistencies between opcare and va aspices
|
---|
| 42 | I DGPTDVA=2,DGPTDOP=1 D G:DGPTEDFL EXIT
|
---|
| 43 | . S DGPTERC=708 D ERR
|
---|
| 44 | . S DGPTERC=709 D ERR
|
---|
| 45 | CDR ;
|
---|
| 46 | I DGPTDLR'?6" "&(DGPTDLR'?." "6N) S DGPTERC=775 D ERR G:DGPTEDFL EXIT
|
---|
| 47 | POD ;
|
---|
| 48 | ;I "68EIMNOQSVWYZ"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
|
---|
| 49 | I "68EINOQSVW"[DGPTDPD S DGPTERC=710 D ERR G:DGPTEDFL EXIT G RECF
|
---|
| 50 | S DGPTERC=0 D POD^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 51 | RECF ;
|
---|
| 52 | I DGPTDVA'=1!(DGPTDRF=" ") G ASIH
|
---|
| 53 | I DGPTDRF[" " S DGPTDRF=$P(DGPTDRF," ",1)
|
---|
| 54 | I DGPTDRF="" S DGPTERC=711 D ERR G:DGPTEDFL EXIT
|
---|
| 55 | ASIH ;
|
---|
| 56 | I DGPTDAS'=" ",DGPTDAS'?2E1N S DGPTERC=712 D ERR G:DGPTEDFL EXIT
|
---|
| 57 | ;
|
---|
| 58 | LEAVE ;
|
---|
| 59 | S DGPTERC=0 D LEAVE^DGPTAE02 D:DGPTERC ERR G:DGPTEDFL EXIT
|
---|
| 60 | SC ;
|
---|
| 61 | I DGPTDSC'=" "&(DGPTDSC'?3N) S DGPTERC=730 D ERR G:DGPTEDFL EXIT G CP
|
---|
| 62 | S DGPTDSC=+DGPTDSC
|
---|
| 63 | CP ;
|
---|
| 64 | S DGPTERC=0 D CANDP^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 65 | DIAG ;
|
---|
| 66 | S DGPTERC=0 D ^DGPT70DX I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 67 | OVER ; Pass FY92 edits for earlier data
|
---|
| 68 | I DGPTDDS'>2911001 G ONED
|
---|
| 69 | LEG ; LEGIONNAIRE'S DISEASE
|
---|
| 70 | S DGPTERC=0 D LEG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 71 | SUI ; Suicide indicator
|
---|
| 72 | S DGPTERC=0 D SUI^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 73 | DRUG ;
|
---|
| 74 | S DGPTERC=0 D DRUG^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 75 | AXES ; Psych axises
|
---|
| 76 | I '$P($G(^DIC(42.4,+DGPTDSP1,0)),U,4) S (DGPT70X4,DGPT7X51,DGPT7X52)=" " G ONED
|
---|
| 77 | S DGPTERC=0 D AXIV^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 78 | S DGPTERC=0 D AXV1^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 79 | S DGPTERC=0 D AXV2^DGPTAE02 I DGPTERC D ERR G:DGPTEDFL EXIT
|
---|
| 80 | ONED ;
|
---|
| 81 | I (DGPTDDXO=" ")&('$D(^TMP("AEDIT",$J,"N702"))&'$D(^TMP("AEDIT",$J,"N703"))) S DGPTERC=718 D ERR G:DGPTEDFL EXIT
|
---|
| 82 | I (DGPTDDXO="X")&($D(^TMP("AEDIT",$J,"N072"))) S DGPTERC=719 D ERR G:DGPTEDFL EXIT
|
---|
| 83 | EXIT ;
|
---|
| 84 | Q
|
---|
| 85 | ERR ;
|
---|
| 86 | D WRTERR^DGPTAE(DGPTERC,"N701",DGPTAL7)
|
---|
| 87 | S ERROR=1
|
---|
| 88 | Q
|
---|