| 1 | DGPT501 ;ALB/MTC - Set up process 501 transmission ; 8/27/03 10:05am
|
|---|
| 2 | ;;5.3;Registration;**64,164,529,729**;Aug 13, 1993;Build 59
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 5 | N ERROR
|
|---|
| 6 | S DGPTEDFL=0
|
|---|
| 7 | PARSE ; Set up record string, parse record
|
|---|
| 8 | S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ)
|
|---|
| 9 | D SET^DGPT501P
|
|---|
| 10 | DATE ;
|
|---|
| 11 | S DGPTMDT=$E(DGPTSTR,31,40),(X,DGPTMDTS)=$$FMDT^DGPT101($E(DGPTMDT,1,6))_"."_$E(DGPTMDT,7,10) S %DT="XT" D ^%DT K %DT I Y<0 S DGPTERC=505 D ERR G:DGPTEDFL EXIT G ELAPS
|
|---|
| 12 | D DD^%DT S DGPTMDT=$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")
|
|---|
| 13 | I DGPTMDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=505 D ERR G:DGPTEDFL EXIT G TSPEC
|
|---|
| 14 | I DGPTMDTS<DGPTDTS S DGPTERC=537 D ERR G:DGPTEDFL EXIT
|
|---|
| 15 | I DGPTMDTS>DGPTDDS S DGPTERC=540 D ERR G:DGPTEDFL EXIT
|
|---|
| 16 | ELAPS ;
|
|---|
| 17 | S DGPTERC=0 S X1=DGPTMDTS D 501^DGPTAE03 I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 18 | TSPEC ;
|
|---|
| 19 | N DGPTMSC1
|
|---|
| 20 | I DGPTMSC'?2AN S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LEAV
|
|---|
| 21 | S DGPTSP1=$E(DGPTMSC,1),DGPTSP2=$E(DGPTMSC,2),DGPTERC=0
|
|---|
| 22 | D CHECK^DGPTAE02 I DGPTERC S DGPTERC=506 D ERR G:DGPTEDFL EXIT G LEAV
|
|---|
| 23 | ;-- Active treating specialty edit check
|
|---|
| 24 | I $E(DGPTMSC,1)=0!($E(DGPTMSC,1)=" ") S DGPTMSC=$E(DGPTMSC,2)
|
|---|
| 25 | ; DGPTMSC := ptf code (alpha-numeric) value (file:42.4,field:7)
|
|---|
| 26 | ; DGPTMSC1 := dinum value (ien, file:42.4,field:001)
|
|---|
| 27 | S DGPTMSC1=+$O(^DIC(42.4,"C",DGPTMSC,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,DGPTMSC1,DGPTMDTS) S DGPTERC=506,DGPTSER(DGPTMDTS_501)=1 D ERR G:DGPTEDFL EXIT
|
|---|
| 31 | LEAV ;
|
|---|
| 32 | I DGPTMPD'?1.3N S DGPTERC=508 D ERR G:DGPTEDFL EXIT
|
|---|
| 33 | SPINL ;
|
|---|
| 34 | D SP^DGPTAE03 I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 35 | LOCCDR ;
|
|---|
| 36 | I DGPTMLR'?6N S DGPTERC=575 D ERR G:DGPTEDFL EXIT G LOCTRS
|
|---|
| 37 | ;
|
|---|
| 38 | LOCTRS ;
|
|---|
| 39 | I DGPTMLC'?2AN&(DGPTMLC'=" ") S DGPTERC=576 D ERR G:DGPTEDFL EXIT G DIAG
|
|---|
| 40 | I DGPTMLC=" "&(DGPTMLR="000000") G DIAG
|
|---|
| 41 | S DGPTSP1=$E(DGPTMLC,1),DGPTSP2=$E(DGPTMLC,2),DGPTERC=0
|
|---|
| 42 | D CHECK^DGPTAE02 I DGPTERC S DGPTERC=576 D ERR G:DGPTEDFL EXIT
|
|---|
| 43 | DIAG ;
|
|---|
| 44 | D ^DGPT50DI G:DGPTEDFL EXIT
|
|---|
| 45 | BSTAT ;
|
|---|
| 46 | I "12345 "'[DGPTMBS S DGPTERC=515 D ERR G:DGPTEDFL EXIT
|
|---|
| 47 | FY92 ;
|
|---|
| 48 | I DGPTDDS<2911001 G GOOD
|
|---|
| 49 | LEG ; Legionnaires disease
|
|---|
| 50 | S DGPTERC=0 D LEG^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 51 | SUI ; Suicide indicator
|
|---|
| 52 | S DGPTERC=0 D SUI^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 53 | DRUG ; Drug indicator
|
|---|
| 54 | S DGPTERC=0 D DRUG^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 55 | AXES ;Axis 4 and 5
|
|---|
| 56 | I '$P($G(^DIC(42.4,+DGPTMSC1,0)),U,4) S (DGPTMXIV,DGPTMXV1,DGPTMXV2)=" " G SERVC
|
|---|
| 57 | S DGPTERC=0 D AXIV^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 58 | S DGPTERC=0 D AXV1^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 59 | S DGPTERC=0 D AXV2^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 60 | SERVC ; Service connected indicator
|
|---|
| 61 | S DGPTERC=0 D SRVC^DGPT50MS I DGPTERC D ERR G:DGPTEDFL EXIT
|
|---|
| 62 | GOOD ;
|
|---|
| 63 | W:'$D(ERROR) "."
|
|---|
| 64 | EXIT ;
|
|---|
| 65 | K DGPTMD1,DGPTMD2,DGPTMD3,DGPTMD4,DGPTMD5,DGPTMDT,DGPTMDTS,DGPTMLC,DGPTMLD,DGPTMLR,DGPTMPD,DGPTMSC,DGPTMSI,DGPTMSR,DGPTMXX,DGPTSTR,DGPTS,DGPTSP1,DGPTSP2
|
|---|
| 66 | K DGPTMLG,DGPTMSU,DGPTMDG,DGPTMXIV,DGPTMXV1,DGPTMXV2,DGPT50SR,DGPTMBS
|
|---|
| 67 | Q
|
|---|
| 68 | ERR ;
|
|---|
| 69 | D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
|
|---|
| 70 | S ERROR=1
|
|---|
| 71 | Q
|
|---|
