Routine: DGPTMSGD

DGPTMSGD ;ALB/JDS - PTF MULTIMESSAGE DELETE ; 19 DEC 84@ 0800

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 D LO^DGUTL

EN S Z="^PATIENT^NUMBER" R !!,"DELETE BY [P]ATIENT OR [N]UMBER: ",X:DTIME G Q:X=""!('$T)!(X="^") D IN^DGHELP G:%'=-1 @X W !!,"Enter 'P' to delete PTF messages by patient",!,"   or 'N' to delete PTF messages by number" G EN

P S DIC="^DPT(",DIC(0)="QEAM",DIC("S")="I $D(^DGM(""PT"",+Y))",DIC("A")="Select Patient whose messages you wish to check off:  " D ^DIC G Q:+Y'>0 S DGPTF=+Y K DIC S %DT="XT",X="N" D ^%DT S NOW=+Y D READ G EN

LOOP F I=0:0 S I=$O(^DGM("PT",DGPTF,I)) Q:I'>0  W ! R:Z>20 "'^' TO STOP",X:DTIME D BACK:Z>20 Q:X["^"  W I,?10 I $D(^DGM(I,"M",0)) D MES1

READ R !!,"Enter the message #'s you wish to release:  ",X:DTIME G Q:X']""!('$T) G @($S(X["^":"Q",X["-":"THRU",X[",":"PICK",X?.N:"ONE",X="ALL"!(X="all"):"ALL",1:"HELP"))

THRU S DGFR=$P(X,"-",1),DGTO=$P(X,"-",2) D DEL G Q

DEL S DIK="^DGM(" F I=DGFR:1:DGTO I $D(^DGM(I,0)) I 'DGPTF!($P(^(0),U,2)=DGPTF) S DA=I D ^DIK W !,I,?10,"** Deleted **"

ONE S DGFR=X,DGTO=X D DEL G Q

PICK S J=1,A=X

PICK1 S DGFR=$P(A,",",J) Q:DGFR'>0  S DGTO=DGFR D DEL S J=J+1 G PICK1

G Q

HELP W !!,"Enter:",!?10,"ALL to release all messages",!?10,"# to release a specific message",!?10,"#-# to release a range of messages",!?10,"#,#,#... to release a group of messages"

 S Z=10 I X["??" W !,"Choose From:" G LOOP

 W !!,"Do you want to see a list of messages for this patient" S %=1 D YN^DICN G Q:%<0,HELP:'%,LOOP:%'=2 G READ

ALL S J=0,DGALL=""

ALL1 S J=$O(^DGM("PT",DGPTF,J)) G Q:J'>0 S DGFR=J,DGTO=J D DEL G ALL1

BACK S Z=0 F J=1:1:12 W $C(8)

MES1 F J=0:0 S J=$O(^DGM(I,"M",J)) Q:J'>0  S L=^(J,0) W:J>1 ! D MESS

MESS F K=0:1:2 I $L(L)>(65*K) W:K ! W ?13,$E(L,1+(K*65),65*(K+1)) S Z=Z+1

N S DGPTF=0 R !!,"Enter the message #'s you wish to release: ",X:DTIME G Q:('$T) G @($S(X="":"EN",X["^":"Q",X["-":"THRU",X[",":"PICK",X?.N:"ONE",1:"HLPN"))

HLPN W !!,"Enter:",!?10,"# to release a specific message",!?10,"#-# to release a range of messages",!?10,"#,#,#... to release a group of messages",!

 S DIC="^DGM(",DIC(0)="M" S:X'["?" X="?" D ^DIC G N

Q K %Y,L,K,DA,Z,Y,%,DGPTF,J,I,X,A,DIK,DIC,%DT,DGFR,DGTO Q

DGPTMSGD  ;ALB/JDS - PTF MULTIMESSAGE DELETE ; 19 DEC 84@ 0800

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2        DO LO^DGUTL

EN         SET Z="^PATIENT^NUMBER"

           READ !!,"DELETE BY [P]ATIENT OR [N]UMBER: ",X:DTIME

           IF X=""!('$TEST)!(X="^")

               GOTO Q

           DO IN^DGHELP

           IF %'=-1

               GOTO @X

           WRITE !!,"Enter 'P' to delete PTF messages by patient",!,"   or 'N' to delete PTF messages by number"

           GOTO EN

P          SET DIC="^DPT("

           SET DIC(0)="QEAM"

           SET DIC("S")="I $D(^DGM(""PT"",+Y))"

           SET DIC("A")="Select Patient whose messages you wish to check off:  "

           DO ^DIC

           IF +Y'>0

               GOTO Q

           SET DGPTF=+Y

           KILL DIC

           SET %DT="XT"

           SET X="N"

           DO ^%DT

           SET NOW=+Y

           DO READ

           GOTO EN

LOOP       FOR I=0:0

               SET I=$ORDER(^DGM("PT",DGPTF,I))

               IF I'>0

                   QUIT

               WRITE !

               IF Z>20

                   READ "'^' TO STOP",X:DTIME

               IF Z>20

                   DO BACK

               IF X["^"

                   QUIT

               WRITE I,?10

               IF $DATA(^DGM(I,"M",0))

                   DO MES1

READ       READ !!,"Enter the message #'s you wish to release:  ",X:DTIME

           IF X']""!('$TEST)

               GOTO Q

           GOTO @($SELECT(X["^":"Q",X["-":"THRU",X[",":"PICK",X?.N:"ONE",X="ALL"!(X="all"):"ALL",1:"HELP"))

THRU       SET DGFR=$PIECE(X,"-",1)

           SET DGTO=$PIECE(X,"-",2)

           DO DEL

           GOTO Q

DEL        SET DIK="^DGM("

           FOR I=DGFR:1:DGTO

               IF $DATA(^DGM(I,0))

                   IF 'DGPTF!($PIECE(^(0),U,2)=DGPTF)

                       SET DA=I

                       DO ^DIK

                       WRITE !,I,?10,"** Deleted **"

 +1        QUIT

ONE        SET DGFR=X

           SET DGTO=X

           DO DEL

           GOTO Q

PICK       SET J=1

           SET A=X

PICK1      SET DGFR=$PIECE(A,",",J)

           IF DGFR'>0

               QUIT

           SET DGTO=DGFR

           DO DEL

           SET J=J+1

           GOTO PICK1

 +1        GOTO Q

HELP       WRITE !!,"Enter:",!?10,"ALL to release all messages",!?10,"# to release a specific message",!?10,"#-# to release a range of messages",!?10,"#,#,#... to release a group of messages"

 +1        SET Z=10

           IF X["??"

               WRITE !,"Choose From:"

               GOTO LOOP

 +2        WRITE !!,"Do you want to see a list of messages for this patient"

           SET %=1

           DO YN^DICN

           IF %<0

               GOTO Q

           IF '%

               GOTO HELP

           IF %'=2

               GOTO LOOP

           GOTO READ

ALL        SET J=0

           SET DGALL=""

ALL1       SET J=$ORDER(^DGM("PT",DGPTF,J))

           IF J'>0

               GOTO Q

           SET DGFR=J

           SET DGTO=J

           DO DEL

           GOTO ALL1

 +1        QUIT

BACK       SET Z=0

           FOR J=1:1:12

               WRITE $CHAR(8)

 +1        QUIT

MES1       FOR J=0:0

               SET J=$ORDER(^DGM(I,"M",J))

               IF J'>0

                   QUIT

               SET L=^(J,0)

               IF J>1

                   WRITE !

               DO MESS

 +1        QUIT

MESS       FOR K=0:1:2

               IF $LENGTH(L)>(65*K)

                   IF K

                       WRITE !

                   WRITE ?13,$EXTRACT(L,1+(K*65),65*(K+1))

                   SET Z=Z+1

 +1        QUIT

N          SET DGPTF=0

           READ !!,"Enter the message #'s you wish to release: ",X:DTIME

           IF ('$TEST)

               GOTO Q

           GOTO @($SELECT(X="":"EN",X["^":"Q",X["-":"THRU",X[",":"PICK",X?.N:"ONE",1:"HLPN"))

HLPN       WRITE !!,"Enter:",!?10,"# to release a specific message",!?10,"#-# to release a range of messages",!?10,"#,#,#... to release a group of messages",!

 +1        SET DIC="^DGM("

           SET DIC(0)="M"

           IF X'["?"

               SET X="?"

           DO ^DIC

           GOTO N

Q          KILL %Y,L,K,DA,Z,Y,%,DGPTF,J,I,X,A,DIK,DIC,%DT,DGFR,DGTO

           QUIT

DGPTMSGD.m