| [613] | 1 | SDDPA ;MAN/GRR,ALB/TMP - DISPLAY APPOINTMENTS ; 13 SEP 84 4:21 pm
|
|---|
| 2 | ;;5.3;Scheduling;**140,334**;Aug 13, 1993
|
|---|
| 3 | D:'$D(DT) DT^SDUTL K SDACS
|
|---|
| 4 | RD Q:$D(SDACS) S HDT=DT,APL="",SDRG=0,SDEDT=""
|
|---|
| 5 | K ^UTILITY($J) W ! S SDEND=0,DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:X=""!(X="^") END I Y<0 W !,*7,*7,"PATIENT NOT FOUND",*7,*7 G RD
|
|---|
| 6 | S DA=+Y,DFN=DA,NAME=$P(Y,"^",2)
|
|---|
| 7 | RD1 S %=1,DTOUT=0 W !,"Do you want to see only pending appointments" D YN^DICN G:%<0!$T RD I '% W !,"Respond YES or NO" G RD1
|
|---|
| 8 | S (SDONE,POP)=0,SDYN=% D:SDYN=2 RANGE G:POP RD
|
|---|
| 9 | S DGVAR="BEGDATE^ENDATE^SDYN^DFN^HDT^APL^SDRG^SDONE^SDEDT^SDEND",DGPGM="1^SDDPA" D ZIS^DGUTQ G:POP SDDPA D 1 G SDDPA
|
|---|
| 10 | 1 U IO S SDSTR=$S($D(^DPT(DFN,0)):^(0),1:""),SDN=$P(SDSTR,U)
|
|---|
| 11 | S SDSSN=$P(SDSTR,U,9),%DT="R",X="N" D ^%DT
|
|---|
| 12 | W !,"APPOINTMENTS FOR: ",$E(SDN,1,22)
|
|---|
| 13 | W ?42,$E(SDSSN,1,3),"-",$E(SDSSN,4,5),"-",$E(SDSSN,6,9)
|
|---|
| 14 | W ?54,"PRINTED: ",$$FMTE^XLFDT(Y,"5")
|
|---|
| 15 | G:$O(^DPT(DFN,"S",HDT))'>0 NO S NDT=HDT,L=0
|
|---|
| 16 | EN1 F J=1:1 S NDT=$O(^DPT(DFN,"S",NDT)) Q:NDT'>0!(SDRG&(NDT>SDEDT)) I $S($P(^(NDT,0),"^",2)']"":1,$P(^(0),"^",2)["NT":1,$P(^(0),"^",2)["I":1,SDRG:1,1:0) D CHKSO,FLEN S ^UTILITY($J,L)=NDT_"^"_SC_"^"_COV_"^"_APL_"^^"_SDNS_"^"_SDBY
|
|---|
| 17 | G:L'>0 NO F ZZ=1:1:L S AT=$S($P(^UTILITY($J,ZZ),"^",2)'?.N:1,1:0) W !! S Y=$P($P(^(ZZ),"^",1),".",1) D DT^SDM0 S X=$P(^(ZZ),"^",1) X ^DD("FUNC",2,1) W " ",$J(X,8) D MORE Q:SDEND
|
|---|
| 18 | G END
|
|---|
| 19 | ;
|
|---|
| 20 | NO W !,"NO ",$S('SDRG:"PENDING APPOINTMENTS",1:"APPOINTMENTS FOUND DURING RANGE SELECTED")
|
|---|
| 21 | G END
|
|---|
| 22 | RANGE D DATE^SDUTL Q:POP S HDT=BEGDATE,SDEDT=ENDDATE_.9,SDRG=1,SDONE=0
|
|---|
| 23 | I $D(^DPT(DFN,"ARCH","AB","S")) S X=$O(^("S",0)) I $D(^DPT(DFN,"ARCH",X)) F A=0:0 S A=$O(^DPT(DFN,"ARCH",X,1,A)) Q:A'>0 S Z=^(A,0),B=$P(Z,"^",3),C=$P(Z,"^",4),D=$P(Z,"^",5),E=$P(Z,"^",2) I B'<HDT&(B'>SDEDT)!(C'<HDT&(C'>SDEDT)) D ARCH
|
|---|
| 24 | Q
|
|---|
| 25 | ARCH I 'SDONE W @IOF,!!,"This patient has archived appts during this time period:",! W !,?3,"ARCHIVED DATE RANGE # APPOINTMENTS TAPE # DATE ARCHIVED",!
|
|---|
| 26 | W !,?3,$S(B:$$FMTE^XLFDT(B,"5D"),1:""),"-",$S(C:$$FMTE^XLFDT(C,"5D"),1:""),?32,+D,?45,E S Y=+Z D DTS^SDUTL W ?59,Y
|
|---|
| 27 | S SDONE=1 K B,C,D,E,Z Q
|
|---|
| 28 | FLEN S SC=+^DPT(DFN,"S",NDT,0),L=L+1,COV=$S($P(^DPT(DFN,"S",NDT,0),"^",11)=1:" (COLLATERAL) ",1:"") I $D(^SC(SC,"S",NDT)) F ZL=0:0 S ZL=$O(^SC(SC,"S",NDT,1,ZL)) Q:ZL="" I +^(ZL,0)=DFN S APL=$P(^SC(SC,"S",NDT,1,ZL,0),"^",2) Q
|
|---|
| 29 | Q
|
|---|
| 30 | CHKSO S SDNS=$S($P(^DPT(DFN,"S",NDT,0),"^",2)']""!($P(^(0),"^",2)["I"):"",1:$P(^(0),"^",2)),SDBY="" I SDNS["C" S SDU=+$P(^DPT(DFN,"S",NDT,0),"^",12),SDBY=$S($D(^VA(200,SDU,0)):$P(^(0),"^",1),1:SDU) K SDU
|
|---|
| 31 | F SDJ=3,4,5 I $P(^DPT(DFN,"S",NDT,0),"^",SDJ)]"" S L=L+1,^UTILITY($J,L)=$P(^(0),"^",SDJ)_"^"_$S(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")_"^0^0"
|
|---|
| 32 | Q
|
|---|
| 33 | END W ! K %DT,A,C,APL,AT,BEGDATE,ENDDATE,COV,DA,DFN,DGPGM,DGVAR,DIPGM,DIC,HDT,J,L,NAME,NDT,POP,SC,SDED,SDBD,SDBY,SDEDT,SDEND,SDJ,SDN,SDNS,SDONE,SDRG,SDSSN,SDSTR,SDYN,X,Y,ZL,ZX,ZZ,^UTILITY($J) D CLOSE^DGUTQ Q
|
|---|
| 34 | MORE I AT W ?36,$P(^UTILITY($J,ZZ),"^",2) I ($Y+4)>IOSL,$E(IOST,1,2)="C-" D OUT^SDUTL Q:SDEND W @IOF
|
|---|
| 35 | Q:AT
|
|---|
| 36 | W " (",$P(^UTILITY($J,ZZ),"^",4)," MINUTES) ",$S($D(^SC(+$P(^UTILITY($J,ZZ),"^",2),0)):$P(^SC(+$P(^UTILITY($J,ZZ),"^",2),0),"^"),1:"Deleted Clinic"),$P(^UTILITY($J,ZZ),"^",3)," ",$P(^(ZZ),"^",5)
|
|---|
| 37 | I $P(^(ZZ),"^",6)]"" W !,$S($P(^(ZZ),"^",6)["NT":" *** ACTION REQUIRED ***",$P(^(ZZ),"^",6)["N":" *** NO-SHOW ***",$P(^(ZZ),"^",6)["C":" *** CANCELLED BY "_$P(^(ZZ),"^",7)_" ***",1:"") ;NAKED REFERENCE - ^UTILITY($J,ZZ)
|
|---|
| 38 | I ($Y+4)>IOSL,IOST?1"C-".E D OUT^SDUTL W:'SDEND @IOF
|
|---|
| 39 | Q
|
|---|
