| [613] | 1 | QAOC1011 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93 09:04
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;SCREEN 101.1 -- READMISSION WITHIN 10 DAYS
|
|---|
| 4 | Q:$$INACTIVE^QAOC0(101.1)
|
|---|
| 5 | F QAOSDT=(QAMTODAY-.0000001):0 S QAOSDT=$O(^DGPM("AMV1",QAOSDT)) Q:QAOSDT'>0!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N) F QAOSDFN=0:0 S QAOSDFN=$O(^DGPM("AMV1",QAOSDT,QAOSDFN)) Q:QAOSDFN'>0 D
|
|---|
| 6 | . F QAOSD0=0:0 S QAOSD0=$O(^DGPM("AMV1",QAOSDT,QAOSDFN,QAOSD0)) Q:QAOSD0'>0 S QAOSZERO=$G(^DGPM(QAOSD0,0)) I QAOSZERO]"" D MAIN
|
|---|
| 7 | . Q
|
|---|
| 8 | Q
|
|---|
| 9 | MAIN ;
|
|---|
| 10 | Q:$$SCHED^QAOC0(QAOSDFN,QAOSDT)
|
|---|
| 11 | S INTYP(0)=$P(QAOSZERO,"^",18)
|
|---|
| 12 | S INTYP=$S(INTYP(0)'>0:"",$D(^DG(405.2,INTYP(0),0))#2:^(0),1:"")
|
|---|
| 13 | S SPECDT=+$O(^DGPM("APTT6",QAOSDFN,+QAOSZERO-.0000001))
|
|---|
| 14 | S SPECD0=$O(^DGPM("APTT6",QAOSDFN,SPECDT,0))
|
|---|
| 15 | S TXSP=$S(SPECD0'>0:"",$D(^DGPM(SPECD0,0))#2:$P(^(0),"^",9),1:"")
|
|---|
| 16 | S Y=$$TXSP^QAOC0("ASP",TXSP)
|
|---|
| 17 | Q:$S(+Y=-1:1,$P(INTYP,"^",2)'=1:1,INTYP(0)'>0:1,1:0)
|
|---|
| 18 | S QAOSDTP=9999999.9999999-QAOSDT
|
|---|
| 19 | AGAIN ;
|
|---|
| 20 | S QAOSDTP=$O(^DGPM("ATID3",QAOSDFN,QAOSDTP))
|
|---|
| 21 | Q:QAOSDTP'>0!(QAOSDTP\1'?7N)
|
|---|
| 22 | S QAOSD1P=$O(^DGPM("ATID3",QAOSDFN,QAOSDTP,0))
|
|---|
| 23 | S QAOSZERO(0)=$S(QAOSD1P'>0:"",$D(^DGPM(QAOSD1P,0))#2:^(0),1:"")
|
|---|
| 24 | G:QAOSZERO(0)="" AGAIN
|
|---|
| 25 | S OUTIMP=+QAOSZERO(0),OUTYPP=$P(QAOSZERO(0),"^",18)
|
|---|
| 26 | S X1=$P(QAOSZERO,"^")\1,X2=OUTIMP\1 D ^%DTC Q:X>10
|
|---|
| 27 | I OUTYPP>0,$D(^DG(405.2,OUTYPP,0))#2,$P(^(0),"^",8)=4 G AGAIN
|
|---|
| 28 | D VADPT^QAOC0(QAOSDFN,QAOSD1P)
|
|---|
| 29 | S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
|
|---|
| 30 | S WARDCLIN=+VAIP(5)_"^"
|
|---|
| 31 | S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN
|
|---|
| 32 | S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
|
|---|
| 33 | S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=OUTIMP
|
|---|
| 34 | D VADPT^QAOC0(QAOSDFN,QAOSD0)
|
|---|
| 35 | S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=VAIP(9)
|
|---|
| 36 | S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=VAIP(13)
|
|---|
| 37 | Q
|
|---|
