| [613] | 1 | SDDSO ;BSN/GRR - DELETE ANCILLARY TESTS ;5/8/91 16:23
|
|---|
| 2 | ;;5.3;Scheduling;;Aug 13, 1993
|
|---|
| 3 | D:'$D(DT) DT^SDUTL S HDT=DT,APL=""
|
|---|
| 4 | RD W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:X=""!(X="^") END I Y<0 W !,*7,*7,"PATIENT NOT FOUND",*7,*7 G RD
|
|---|
| 5 | S DA=+Y,DFN=DA,NAME=$P(Y,"^",2) W ! I $N(^DPT(DA,"S",HDT))'>0 G NO
|
|---|
| 6 | S NDT=HDT,L=0 F J=1:1 S NDT=$N(^DPT(DA,"S",NDT)) Q:NDT'>0 I $S($P(^(NDT,0),"^",2)']"":1,$P(^(0),"^",2)["I":1,1:0) D CHKSO S SC=+^(0),L=L+1 D FLEN S Z(L)=NDT_"^"_SC_"^"_APL_"^"_COMMENT
|
|---|
| 7 | WH1 G:L'>0 NO F ZZ=1:1:L W !!,ZZ,") " S Y=$P($P(Z(ZZ),"^",1),".",1) D DT^SDM0 S X=$P(Z(ZZ),"^",1) X ^DD("FUNC",2,1) W " ",$J(X,8)," (",$P(Z(ZZ),"^",3)," MINUTES) ",$P(^SC($P(Z(ZZ),"^",2),0),"^",1)," ",$P(Z(ZZ),"^",4)
|
|---|
| 8 | WH R !!,"DELETE TEST(S) FOR WHICH NUMBERED APPOINTMENT: ",APP:DTIME G:APP=""!(APP="^") RD G:APP["?" WH1 I APP'?1N.N W !,"INVALID ENTRY, MUST BE NUMERIC" G WH
|
|---|
| 9 | I APP<1!(APP>ZZ) W !,"ENTER A NUMBER BETWEEN 1 AND ",ZZ G WH
|
|---|
| 10 | S APP=+APP,(SD,S)=$P(Z(APP),"^",1),I=$P(Z(APP),"^",2)
|
|---|
| 11 | I Z(APP)'["(" W !,*7,"NO TEST ASSOCIATED WITH THIS APPOINTMENT" G WH1
|
|---|
| 12 | I $$CO^SDASO(DFN,S,"delete") G WH1
|
|---|
| 13 | K LAB,XRAY,EKG
|
|---|
| 14 | F ZDT="LAB","XRAY","EKG" D TST
|
|---|
| 15 | I '$D(LAB)&('$D(XRAY))&('$D(EKG)) W !,*7,"NOTHING DELETED" G RD
|
|---|
| 16 | S SD0=^DPT(DFN,"S",S,0)
|
|---|
| 17 | S ^(0)=$P(SD0,"^",1,2)_"^"_$S($D(LAB):"",1:$P(SD0,"^",3))_"^"_$S($D(XRAY):"",1:$P(SD0,"^",4))_"^"_$S($D(EKG):"",1:$P(SD0,"^",5))_"^"_$P(SD0,"^",6,99) G RD ;NAKED REFERENCE - ^DPT(DFN,"S",Date,0)
|
|---|
| 18 | ;
|
|---|
| 19 | NO W !,"NO PENDING APPOINTMENTS",*7,*7,*7
|
|---|
| 20 | G RD
|
|---|
| 21 | FLEN I $D(^SC(SC,"S",NDT)) F ZL=0:0 S ZL=$N(^SC(SC,"S",NDT,1,ZL)) Q:ZL<0 I +^(ZL,0)=DA S APL=$P(^SC(SC,"S",NDT,1,ZL,0),"^",2) Q
|
|---|
| 22 | Q
|
|---|
| 23 | CHKSO S COMMENT="" F SDJ=3,4,5 I $P(^(0),"^",SDJ)]"" S:$L(COMMENT) COMMENT=COMMENT_"," S COMMENT=COMMENT_$S(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG") ;NAKED REFERENCE - ^DPT(DFN,"S",Date,0)
|
|---|
| 24 | S:$L(COMMENT) COMMENT="("_COMMENT_" TEST SCHEDULED)" Q
|
|---|
| 25 | TST Q:Z(APP)'[ZDT S %=1,DTOUT=0 W !,"WANT TO DELETE ",ZDT," TEST" D YN^DICN I '% W !,"RESPOND YES OR NO" G TST
|
|---|
| 26 | W:DTOUT " NO" I '(%-1) S @ZDT="" W ?40,"DELETED"
|
|---|
| 27 | Q
|
|---|
| 28 | END K %DT,APL,APP,COMMENT,DA,DFN,DIC,HDT,I,J,L,NAME,NDT,S,SB,SC,SD,SDJ,SI,SL,SS,ST,STARTDAY,STR,X,Y,Z,ZL,ZZ Q
|
|---|
