| [613] | 1 | DGPT601 ;ALB/MTC - Process 601 transmission ; 17 NOV 92
|
|---|
| 2 | ;;5.3;Registration;**64,164,729**;Aug 13, 1993;Build 59
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; Process 601 transmission
|
|---|
| 6 | N ERROR
|
|---|
| 7 | K DGPTPAR
|
|---|
| 8 | S DGPTSTR=^TMP("AEDIT",$J,NODE,SEQ),DGPTEDFL=0,DGPTERP=7
|
|---|
| 9 | S:$E(DGPTSTR,37,40)="2400" DGPTSTR=$E(DGPTSTR,1,36)_"2359"_$E(DGPTSTR,41,125)
|
|---|
| 10 | SET ;
|
|---|
| 11 | S DGPTPSC=$E(DGPTSTR,41,42),DGPTPDY=$E(DGPTSTR,43),DGPTPNT=$E(DGPTSTR,44,46),DGPTPC1=$E(DGPTSTR,47,53),DGPTPC2=$E(DGPTSTR,54,60),DGPTPC3=$E(DGPTSTR,61,67),DGPTPC4=$E(DGPTSTR,68,74),DGPTPC5=$E(DGPTSTR,75,81)
|
|---|
| 12 | S DGPTPDT=$E(DGPTSTR,31,40)
|
|---|
| 13 | DATE ;
|
|---|
| 14 | 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
|
|---|
| 15 | 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")
|
|---|
| 16 | I DGPTPDT'?1.2N1"-"3U1"-"4N1" "2N1":"2N S DGPTERC=601 D ERR G:DGPTEDFL EXIT
|
|---|
| 17 | S X1=DGPTDDS,X2=DGPTPDTS D ^%DTC I (X<0)!(%Y<0) S DGPTERC=640 D ERR G:DGPTEDFL EXIT
|
|---|
| 18 | S X1=DGPTPDTS,X2=DGPTDTS D ^%DTC I (X<0)!(%Y<0) S DGPTERC=637 D ERR G:DGPTEDFL EXIT
|
|---|
| 19 | ;
|
|---|
| 20 | TSPEC ;
|
|---|
| 21 | N DGPTPSC1
|
|---|
| 22 | I DGPTPSC'?2AN S DGPTERC=602 D ERR G:DGPTEDFL EXIT
|
|---|
| 23 | S DGPTSP1=$E(DGPTPSC,1),DGPTSP2=$E(DGPTPSC,2),DGPTERC=0
|
|---|
| 24 | D CHECK^DGPTAE02 I DGPTERC S DGPTERC=602 D ERR G:DGPTEDFL EXIT G DIAL
|
|---|
| 25 | ;-- Active treating specialty edit check
|
|---|
| 26 | I $E(DGPTPSC,1)=0!($E(DGPTPSC,1)=" ") S DGPTPSC=$E(DGPTPSC,2)
|
|---|
| 27 | ; DGPTPSC := ptf code (alpha-numeric) value (file:42.4, field:7)
|
|---|
| 28 | ; DGPTPSC1 := dinum value (ien, file:42.4, field:.001)
|
|---|
| 29 | S DGPTPSC1=+$O(^DIC(42.4,"C",DGPTPSC,0))
|
|---|
| 30 | ;-- If not active treat spec, set 601 flag to print error msg during
|
|---|
| 31 | ;-- PTF close-out error display at WRER^DGPTAEE
|
|---|
| 32 | I '$$ACTIVE^DGACT(42.4,DGPTPSC1,DGPTPDTS) S DGPTERC=602,DGPTSER(DGPTPDTS_601)=1 D ERR G:DGPTEDFL EXIT
|
|---|
| 33 | DIAL ;
|
|---|
| 34 | ;I DGPTPDY'=" " D DIALE I DGPTERC G EXIT
|
|---|
| 35 | I DGPTPNT=" "!(+DGPTPNT'>0) D G:DGPTEDFL EXIT
|
|---|
| 36 | .I DGPTPC1="3995 "!(DGPTPC1="5498 ")!(DGPTPC1="5092 ") S DGPTERC=604 D ERR
|
|---|
| 37 | .I DGPTPC2="3995 "!(DGPTPC2="5498 ")!(DGPTPC2="5092 ") S DGPTERC=604 D ERR
|
|---|
| 38 | .I DGPTPC3="3995 "!(DGPTPC3="5498 ")!(DGPTPC3="5092 ") S DGPTERC=604 D ERR
|
|---|
| 39 | .I DGPTPC4="3995 "!(DGPTPC4="5498 ")!(DGPTPC4="5092 ") S DGPTERC=604 D ERR
|
|---|
| 40 | .I DGPTPC5="3995 "!(DGPTPC5="5498 ")!(DGPTPC5="5092 ") S DGPTERC=604 D ERR
|
|---|
| 41 | OPS ;
|
|---|
| 42 | S DGPTERC=0 D ^DGPT60PR G:DGPTEDFL EXIT
|
|---|
| 43 | ;
|
|---|
| 44 | OPDUP ;--check for duplicate procedure codes
|
|---|
| 45 | I ((DGPTPDY=" ")&(DGPTPNT=" "))&(+$E(DGPTSTR,47,81)=0) S DGPTERC="605Z" D ERR G EXIT
|
|---|
| 46 | F DGPTL4=1:1:5 I +@("DGPTPC"_DGPTL4)'=0 S DGPTPAR(+@("DGPTPC"_DGPTL4),DGPTL4)=""
|
|---|
| 47 | S DGPTPAR1=0 F DGPTL4=1:1:5 S DGPTPAR1=$O(DGPTPAR(DGPTPAR1)) Q:DGPTPAR1="" S DGPTPRA2=$O(DGPTPAR(DGPTPAR1,0)) I DGPTPRA2'="" S DGPTPRA3=$O(DGPTPAR(DGPTPAR1,DGPTPRA2)) I DGPTPRA3'="" S DGPTERC=657 D ERR G:DGPTEDFL EXIT
|
|---|
| 48 | K DGPTPAR
|
|---|
| 49 | GOOD ;
|
|---|
| 50 | W:'$D(ERROR) "."
|
|---|
| 51 | ;
|
|---|
| 52 | EXIT ;
|
|---|
| 53 | K DGPTERC,DGPTL3,DGPTL4,DGPTOP,DGPTOP1,DGPTP1,DGPTP2,DGPTPAR1,DGPTPC1,DGPTPC2,DGPTPC3,DGPTPC4,DGPTPC5,DGPTPDT,DGPTPDTS,DGPTPDY,DGPTPFL,DGPTPNT,DGPTPP,DGPTPRA2,DGPTPRA3,DGPTPSC,DGPTSTR,X,X1,X2,Y
|
|---|
| 54 | K DGPTXX
|
|---|
| 55 | Q
|
|---|
| 56 | ERR ;
|
|---|
| 57 | D WRTERR^DGPTAE(DGPTERC,NODE,SEQ)
|
|---|
| 58 | S ERROR=1
|
|---|
| 59 | Q
|
|---|
| 60 | DIALE ;
|
|---|
| 61 | I "12345678"'[DGPTPDY S DGPTERC=603 D ERR G:DGPTEDFL EXIT
|
|---|
| 62 | I DGPTPNT=" "!(+DGPTPNT'>0) S DGPTERC=604 D ERR G:DGPTEDFL EXIT
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
