- DGPTMSGD ;ALB/JDS - PTF MULTIMESSAGE DELETE ; 19 DEC 84@ 0800
- ;;5.3;Registration;;Aug 13, 1993
- 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 **"
- Q
- 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
- Q
- BACK S Z=0 F J=1:1:12 W $C(8)
- Q
- MES1 F J=0:0 S J=$O(^DGM(I,"M",J)) Q:J'>0 S L=^(J,0) W:J>1 ! D MESS
- Q
- 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
- Q
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTMSGD 2196 printed Feb 19, 2025@00:18:58 Page 2
- DGPTMSGD ;ALB/JDS - PTF MULTIMESSAGE DELETE ; 19 DEC 84@ 0800
- +1 ;;5.3;Registration;;Aug 13, 1993
- +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