| [613] | 1 | DGPTSC01 ;ALB/MTC - Additional routines to check for valid jumping ; JUN 14,1991
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;;MAS 5.1;
|
|---|
| 4 | 501 ;-- check if jump to expanded question was valid.
|
|---|
| 5 | S DGTX=X,DGER=1
|
|---|
| 6 | N DGPTIT,DGBPC,DGHOLD,DGPTF,DG701
|
|---|
| 7 | S DGHOLD=^DGPT(DA(1),"M",DA,0),DGPTF=DA(1)
|
|---|
| 8 | F DGI=5:1:9 I $P(DGHOLD,U,DGI)]"" S DGPTIT($P(DGHOLD,U,DGI)_";ICD9(")=""
|
|---|
| 9 | D SCAN^DGPTSCAN
|
|---|
| 10 | I $D(DGBPC(DGFLAG)) K:(DGFLAG=4)&($$ACTIVE(DGPTF,DGTX)) DGTX S:$D(DGTX) DGER=0,X=DGTX G ENQ
|
|---|
| 11 | D ERRMSG S DGER=1
|
|---|
| 12 | G ENQ
|
|---|
| 13 | ;
|
|---|
| 14 | 401 ;-- check if jump to expanded question was valid.
|
|---|
| 15 | S DGTX=X
|
|---|
| 16 | N DGPTIT,DGBPC,DGHOLD,DGPTF,DG701
|
|---|
| 17 | S DGHOLD=^DGPT(DA(1),"S",DA,0)
|
|---|
| 18 | F DGI=8:1:12 I $P(DGHOLD,U,DGI)]"" S DGPTIT($P(DGHOLD,U,DGI)_";ICD0(")=""
|
|---|
| 19 | D SCAN^DGPTSCAN
|
|---|
| 20 | I $D(DGBPC(DGFLAG)) S DGER=0,X=DGTX G ENQ
|
|---|
| 21 | D ERRMSG S DGER=1
|
|---|
| 22 | G ENQ
|
|---|
| 23 | ;
|
|---|
| 24 | 701 ;--
|
|---|
| 25 | N DGREC,DGPTF,DGPTIT,DGBPC,DGHOLD,DG701
|
|---|
| 26 | S DGPTF=DA,DGTX=X
|
|---|
| 27 | G ENQ:'$D(^DGPT(DA,70)) S DGREC=^(70)
|
|---|
| 28 | F DGI=10,16:1:24 I $P(DGREC,U,DGI) S DGPTIT($P(DGREC,U,DGI)_";ICD9(")=""
|
|---|
| 29 | D SCAN^DGPTSCAN
|
|---|
| 30 | D FLAGCHK^DGPTSCAN,GETNUM^DGPTSCAN
|
|---|
| 31 | F DGI=2:1:DGFNUM I $P(DG701,U,DGI)]"",$D(DGBPC(DGI)) K DGBPC(DGI)
|
|---|
| 32 | S DGER=1
|
|---|
| 33 | F DGI=2:1:DGFNUM I ($D(DGBPC(DGI))&(DGFLAG=DGI)) K:(DGFLAG=4)&($$ACTIVE(DGPTF,DGTX)) DGTX S DGER=0 S:$D(DGTX) X=DGTX Q
|
|---|
| 34 | I 'DGER S:'$D(DGTX) DGER=1 G ENQ
|
|---|
| 35 | D ERRMSG G ENQ
|
|---|
| 36 | ERRMSG ;-- generic error message
|
|---|
| 37 | W !,"*** ERROR *** You must select a ICD that requires an expanded response."
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ENQ ;
|
|---|
| 41 | K DGI,DGTX,DGHOLD,DGPTIT,DGBPC,DGPTF,DG701
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | DRUG ;-- if default drug is present in 45.89 then use it
|
|---|
| 45 | ;-- pass in DGPTIT(X) for one ICD9 code.
|
|---|
| 46 | S DGTY=$O(DGPTIT(0))
|
|---|
| 47 | G:'DGTY DRUGQ
|
|---|
| 48 | K DGTX
|
|---|
| 49 | I $D(^DIC(45.89,"ASPL",DGTY)) F DGTI=0:0 S DGTI=$O(^DIC(45.89,"ASPL",DGTY,DGTI)) Q:DGTI']"" I $D(^DIC(45.89,DGTI,0)),$P(^(0),U)=4,$D(^DIC(45.61,+$P(^(0),U,4),0)) S DGTX=$P(^(0),U)
|
|---|
| 50 | ;
|
|---|
| 51 | DRUGQ ;
|
|---|
| 52 | K DGTY,DGTI
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | ACTIVE(PTF,DRUG) ;-- check if drug has been inactivated
|
|---|
| 56 | ;-- returns 1 if not active, else 0
|
|---|
| 57 | N DATE,SUBDATE,ACTIVE
|
|---|
| 58 | S ACTIVE=0
|
|---|
| 59 | S DATE=$S('$D(^DGPT(PTF,70)):DT,^(70):+^(70),1:DT),SUBDATE=$S($D(^DIC(45.61,+DRUG,0)):$P(^(0),U,3),1:"")
|
|---|
| 60 | I SUBDATE>0,SUBDATE<DATE S Y=SUBDATE X ^DD("DD") W !,"*** ERROR *** This Substance has been inactivated as of ",Y S ACTIVE=1
|
|---|
| 61 | Q ACTIVE
|
|---|
