[613] | 1 | SDAPP ;ALB/TMP - SCHEDULING CHART REQUEST ; 07 SEP 84 4:17 pm
|
---|
| 2 | ;;5.3;Scheduling;**21,32,41,79**;AUG 13, 1993
|
---|
| 3 | 4 ;;Chart Request
|
---|
| 4 | S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
|
---|
| 5 | S (DIC,DIE)="^SC(",DIC(0)="AQME",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="SELECT CLINIC NAME: " D ^DIC K DIC("A"),DIC("S") Q:+Y<0 S SDIN=$S($D(^SC(+Y,"I")):1,1:""),SDRE="" I SDIN S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2)
|
---|
| 6 | I SDIN,SDIN'>DT,'SDRE S D0=+Y D WRT1 Q
|
---|
| 7 | S DA=+Y,DR=1906,DR(2,44.006)=".01;S Y=2 I $S('$D(^SC(D0,""I"")):0,+^(""I"")'>0:0,+^(""I"")>X:0,+$P(^(""I""),U,2)'>X&(+$P(^(""I""),U,2)'=0):0,1:1) K ^SC(D0,""C"",D1) S Y="""" D WRT1^SDAPP;2" G ^DIE
|
---|
| 8 | Q
|
---|
| 9 | 19 ;;Edit Clinic Enrollment Data
|
---|
| 10 | ; SCRESTA = Array of pt's teams causing restricted consults
|
---|
| 11 | N SCRESTA,SCABORT
|
---|
| 12 | S DIC="^DPT(",DIC(0)="AEMQF" D ^DIC Q:"^"[X G:Y<0 19
|
---|
| 13 | S DFN=+Y
|
---|
| 14 | S SCREST=$$RESTPT^SCAPMCU4(.DFN,DT,"SCRESTA")
|
---|
| 15 | IF SCREST D Q:$G(SCABORT)
|
---|
| 16 | .N SCTM
|
---|
| 17 | . W !,?5,"Patient has restricted consults due to the following team assignment(s):"
|
---|
| 18 | .S SCTM=0
|
---|
| 19 | .F S SCTM=$O(SCRESTA(SCTM)) Q:'SCTM W !,?10,SCRESTA(SCTM)
|
---|
| 20 | .IF $D(^XUSEC("SC CONSULT",DUZ)) D
|
---|
| 21 | ..W !!,?10,"Team Members will be notified of new enrollments"
|
---|
| 22 | .ELSE D
|
---|
| 23 | ..W !!,?10,"You need the SC CONSULT key to do enrollments for this patient"
|
---|
| 24 | ..S SCABORT=1
|
---|
| 25 | D BEFORE^SCMCEV3(DFN)
|
---|
| 26 | S DA=+Y,DIE=DIC,DR="3",DR(2,2.001)="1",DR(3,2.011)=".01;1;5;3;4" D ^DIE
|
---|
| 27 | D AFTER^SCMCEV3(DFN)
|
---|
| 28 | D INVOKE^SCMCEV3(DFN)
|
---|
| 29 | G 19
|
---|
| 30 | 20 ;;Additional Non-Vet Elig Status
|
---|
| 31 | S DIC="^DPT(",DIC(0)="AEMQF" D ^DIC Q:"^"[X G:Y'>0 20
|
---|
| 32 | I $S('$D(^DPT(+Y,"VET")):1,^("VET")'="Y":1,1:0) W !,*7,"Patient must be a veteran!!" G 20
|
---|
| 33 | S DIE=DIC,DA=+Y,DR=".099" D ^DIE K DIE,DIC,DR
|
---|
| 34 | G 20
|
---|
| 35 | WRT1 S SDY=Y,SDI=+^SC(D0,"I"),SDI1=+$P(^("I"),U,2) W *7,!,"Clinic is inactive ",$S(SDI1'=0:"from ",1:"as of ") S Y=SDI D DTS^SDUTL W Y S Y=SDI1 D:Y DTS^SDUTL W $S(SDI1=0:"",1:" to "_Y) S Y=SDY K SDY,SDI,SDI1 Q
|
---|