| 1 | QAOC1061 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93 09:05
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;SCREEN 106.1 -- TRANSFER TO A SPECIAL CARE UNIT
|
|---|
| 4 | Q:$$INACTIVE^QAOC0(106.1)
|
|---|
| 5 | S QAOSEND=QAMTODAY+.24,QAOSW=""
|
|---|
| 6 | F S QAOSW=$O(^DPT("CN",QAOSW)) Q:QAOSW="" F QAOSDFN=0:0 S QAOSDFN=$O(^DPT("CN",QAOSW,QAOSDFN)) Q:QAOSDFN'>0 S QAOSADM=^DPT("CN",QAOSW,QAOSDFN) I QAOSADM,$D(^DGPM(QAOSADM,0))#2 D MAIN
|
|---|
| 7 | Q
|
|---|
| 8 | MAIN ;
|
|---|
| 9 | S QAOSQUIT=0,QAOVISIT="" K TDATE
|
|---|
| 10 | F QAOSTDT=9999999.9999999-QAOSEND:0 S QAOSTDT=$O(^DGPM("ATS",QAOSDFN,QAOSADM,QAOSTDT)) Q:QAOSTDT'>0!(QAOSTDT\1'?7N)!QAOSQUIT F QAOSSPEC=0:0 S QAOSSPEC=$O(^DGPM("ATS",QAOSDFN,QAOSADM,QAOSTDT,QAOSSPEC)) Q:QAOSSPEC'>0!QAOSQUIT D
|
|---|
| 11 | . F QAOSD0P=0:0 S QAOSD0P=$O(^DGPM("ATS",QAOSDFN,QAOSADM,QAOSTDT,QAOSSPEC,QAOSD0P)) Q:QAOSD0P'>0!QAOSQUIT D LOOP1
|
|---|
| 12 | . Q
|
|---|
| 13 | Q
|
|---|
| 14 | LOOP1 ;
|
|---|
| 15 | S QAOSZERO(0)=$G(^DGPM(QAOSD0P,0)) Q:QAOSZERO(0)=""
|
|---|
| 16 | S TRANTYPE=$P(QAOSZERO(0),"^",2) Q:TRANTYPE'=2&(TRANTYPE'=6)
|
|---|
| 17 | G:$D(TDATE(1))#2 LOOP2
|
|---|
| 18 | I 9999999.9999999-QAOSTDT'>(QAMTODAY-.0000001) S QAOSQUIT=1 Q
|
|---|
| 19 | Q:$$TXSP^QAOC0("S",$P(QAOSZERO(0),"^",9))=-1
|
|---|
| 20 | S TDATE(1)=QAOSZERO(0)
|
|---|
| 21 | Q
|
|---|
| 22 | LOOP2 ;
|
|---|
| 23 | S Y=$$TXSP^QAOC0("S",$P(QAOSZERO(0),"^",9))
|
|---|
| 24 | I $D(TDATE(2))[0,+Y>0 S QAOSQUIT=1 Q
|
|---|
| 25 | I $D(TDATE(2))#2,+Y>0 D LOOP3 S QAOSQUIT=1 Q
|
|---|
| 26 | S Y=$$TXSP^QAOC0("S",$P(QAOSZERO(0),"^",9))
|
|---|
| 27 | I +Y=-1 S (TDATE(2),X2)=QAOSZERO(0),X2=+X2,X1=+TDATE(1) D ^%DTC S:X>3 QAOSQUIT=1 Q
|
|---|
| 28 | Q
|
|---|
| 29 | LOOP3 ;
|
|---|
| 30 | D VADPT^QAOC0(QAOSDFN,QAOSD0P)
|
|---|
| 31 | S QAOVISIT=9999999.9999999-QAOSTDT
|
|---|
| 32 | S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
|
|---|
| 33 | S WARDCLIN=+VAIP(5)_"^"
|
|---|
| 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
|
|---|
