| [613] | 1 | QAOC102 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;6/14/93 07:11
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;SCREEN 102 -- ADMISSION WITHIN 3 DAYS OF UNSCHEDULED AMBULATORY CARE VISIT
|
|---|
| 4 | Q:$$INACTIVE^QAOC0(102)
|
|---|
| 5 | S QAODISPL=3600*$P($G(^QA(740,1,"OS")),"^",6)
|
|---|
| 6 | 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
|
|---|
| 7 | . 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
|
|---|
| 8 | . Q
|
|---|
| 9 | Q
|
|---|
| 10 | MAIN ;
|
|---|
| 11 | Q:$$SCHED^QAOC0(QAOSDFN,QAOSDT)
|
|---|
| 12 | S INTYP=$P(QAOSZERO,"^",18) Q:INTYP=40
|
|---|
| 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 | Q:$$TXSP^QAOC0("AS",TXSP)'>0 ; Change "AS" to "ASP" to include psych
|
|---|
| 17 | S X1=QAOSDT,X2=-4 D C^%DTC
|
|---|
| 18 | S (SV,VIS,REGEND)=X\1_".24",REGEND=9999999-REGEND,FLG=0,QAOVISIT=""
|
|---|
| 19 | S QACLINIC=""
|
|---|
| 20 | G:'$D(^DPT(QAOSDFN,"S",0)) TYPE2
|
|---|
| 21 | F VIS=VIS:0 S VIS=$O(^DPT(QAOSDFN,"S",VIS)) Q:(VIS'>0)!(VIS>QAOSDT)!(VIS\1=(QAOSDT\1))!(VIS\1'?7N) D:$P(^DPT(QAOSDFN,"S",VIS,0),"^",2)="" LOOP1 Q:FLG
|
|---|
| 22 | TYPE2 ;
|
|---|
| 23 | G:FLG FILE
|
|---|
| 24 | ;F SV=SV:0 S SV=$O(^SDV("B",SV)) Q:(SV'>0)!(SV>QAOSDT)!(SV\1=(QAOSDT\1))!(SV\1'?7N) I $D(^SDV(SV,0)),$P(^(0),"^",2)=QAOSDFN S FLG=1,QAOVISIT=SV Q
|
|---|
| 25 | TYPE3 ;
|
|---|
| 26 | G FILE:FLG,FILE:'$D(^DPT(QAOSDFN,"DIS",0))
|
|---|
| 27 | S X1=QAOSDT,X2=-1 D C^%DTC S REG=9999999-(X\1_".24")
|
|---|
| 28 | F REG=REG:0 S REG=$O(^DPT(QAOSDFN,"DIS",REG)) Q:(REG'>0)!(REG'<REGEND)!(REG\1'?7N) D LOOP2 Q:FLG
|
|---|
| 29 | FILE ;
|
|---|
| 30 | D:FLG
|
|---|
| 31 | . D VADPT^QAOC0(QAOSDFN,QAOSD0)
|
|---|
| 32 | . S WARDCLIN=+VAIP(5)_"^"_$S(QACLINIC:QACLINIC,1:"")
|
|---|
| 33 | . S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
|
|---|
| 34 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN
|
|---|
| 35 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
|
|---|
| 36 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=QAOVISIT
|
|---|
| 37 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=VAIP(9)
|
|---|
| 38 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=VAIP(13)
|
|---|
| 39 | . Q
|
|---|
| 40 | Q
|
|---|
| 41 | LOOP1 ;
|
|---|
| 42 | S LOC=^DPT(QAOSDFN,"S",VIS,0) I LOC]"",$P(LOC,"^",7)=4 S FLG=1,QAOVISIT=VIS,QACLINIC=+$P(LOC,"^")
|
|---|
| 43 | Q
|
|---|
| 44 | LOOP2 ;
|
|---|
| 45 | Q:$D(^DPT(QAOSDFN,"DIS",REG,0))[0 S LOC=^(0) Q:$P(LOC,"^",2)>1
|
|---|
| 46 | S OUT=$P(LOC,"^",6) Q:OUT'>0
|
|---|
| 47 | S X=QAOSDT D H^%DTC S QAOSH=%H,QAOST=%T,X=OUT
|
|---|
| 48 | D H^%DTC S QAOSH=QAOSH-%H,QAOST=QAOST-%T
|
|---|
| 49 | S QAOST=QAOST+(86400*QAOSH) ; TIME BETWEEN ADMISSION & LOG OUT
|
|---|
| 50 | Q:QAOST<QAODISPL ; QUIT IF TIME < MIN TIME BETWEEN LOG OUT & ADM
|
|---|
| 51 | S FLG=1,QAOVISIT=9999999-REG
|
|---|
| 52 | Q
|
|---|
