GMRADEL ;HIRMFO/WAA-PATIENT DELETE REACTION ;11/14/06 13:18
;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9
;
; Is this data Correct question:
;Single Reaction:
; user |
; reponse | action taken
;-------------------------------------------------------------
; Yes | Data is Sign off
; |
; No | User is asked if they wish to delete the entry
; ^,timeout|---------------------------------------------------
; | response | action taken
; |---------------------------------------------------
; | yes | the entry is deleted
; | ^,timeout|
; | |
; | no | the entry is not deletes and a alert trigered
; |---------------------------------------------------
;
;Multiple Reaction:
; user |
; reponse | action taken
;-------------------------------------------------------------
; select | Selected reaction will be signed
;reactions |
; |
;reactions | all User is asked if they wish to delete the entry
;NOT |---------------------------------------------------
;selected | response | action taken
; OR |---------------------------------------------------
;^,timeout | yes | the entries is deleted
; | ^,timeout|
; | |
; | no | the entries is not deletes and a alert trigered
; |---------------------------------------------------
;
;Note: Only one entry point will be needed.....
DEL ; Main Entry point
N DIR,GMRACNT,GMRAPCT
D DELPRT ; No reaction to be deleted
S DIR(0)="YA",DIR("B")="YES"
S DIR("?")="PLEASE ENTER 'Y' TO DELETE THE CAUSATIVE AGENT"_$S(GMRACNT>1:"S",1:"")_" 'N' NOT TO DELETE THE DATA"
S DIR("??")="^D PRINT^GMRASIGN",DIR("A")="Do you wish to delete "_$S(GMRACNT>1:"these",1:"this")_" Causative Agent"_$S(GMRACNT>1:"s",1:"")_"? " D ^DIR
I $D(DIRUT) S Y=1,GMRAOUT=1
S GMRAPCT=Y
Q:'GMRAPCT ; User did not want to delete the entry(s)
; User want to delete the data
D DELETE
Q
DELETE ; Deleting the data
N X
;W !,"One moment please deleting data..."
S X=0 F S X=$O(^TMP($J,"GMRASF",X)) Q:X<1 D
.N GMRAPA
.S GMRAPA=$O(^TMP($J,"GMRASF",X,0)) ; find 120.8 data
.S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
.I '$G(^TMP($J,"GMRASF",X,GMRAPA)) D EIE Q ;36 Existing records are marked entered in error rather than being deleted
.N GMRAPA1
.S GMRAPA1=0
.; find 120.85 data
.F S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,GMRAPA1)) Q:GMRAPA1<1 D
..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
..I GMRAPA1(0)="" K ^GMR(120.85,"C",GMRAPA,GMRAPA1) Q
..D ; delete 120.85 data
...N DIK,DA
...S DIK="^GMR(120.85,",DA=GMRAPA1 D ^DIK
...D UNLOCK^GMRAUTL(120.85,GMRAPA1) ; Unlocking the data 120.85
...;W "." ;36
...Q
..Q
.D ; delete 120.8 data
..N DIK,DA
..S DIK="^GMR(120.8,",DA=GMRAPA D ^DIK
..D UNLOCK^GMRAUTL(120.8,GMRAPA) ; Unlocking the data 120.8
..;W "." ;36
..Q
.S X=$O(^TMP($J,"GMRASF","B",GMRAPA,0))
.K ^TMP($J,"GMRASF",X,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,X)
.Q
Q
DELPRT ; List all the reaction not signed
N X,GMRAPA
W @IOF
S (GMRACNT,X)=0
F S X=$O(^TMP($J,"GMRASF",X)) Q:X<1 D
.S GMRAPA=$O(^TMP($J,"GMRASF",X,0))
.S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
.W !,$P(GMRAPA(0),U,2)
.S GMRACNT=GMRACNT+1
.Q
Q
;
EIE ;Section added in patch 36, will mark existing records entered in error
N GMRADFN,ALDATA,SUB
S GMRADFN=$P(GMRAPA(0),U)
S ALDATA("GMRAERRDT")=$$NOW^XLFDT,ALDATA("GMRAERRBY")=$G(DUZ,.5)
D EIE^GMRAGUI1(GMRAPA,GMRADFN,"ALDATA")
S SUB=$O(^TMP($J,"GMRASF","B",GMRAPA,0))
K ^TMP($J,"GMRASF",SUB,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,SUB) ;Delete entry as it's been taken care of
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADEL 3806 printed Apr 09, 2024@20:45:13 Page 2
GMRADEL ;HIRMFO/WAA-PATIENT DELETE REACTION ;11/14/06 13:18
+1 ;;4.0;Adverse Reaction Tracking;**36**;Mar 29, 1996;Build 9
+2 ;
+3 ; Is this data Correct question:
+4 ;Single Reaction:
+5 ; user |
+6 ; reponse | action taken
+7 ;-------------------------------------------------------------
+8 ; Yes | Data is Sign off
+9 ; |
+10 ; No | User is asked if they wish to delete the entry
+11 ; ^,timeout|---------------------------------------------------
+12 ; | response | action taken
+13 ; |---------------------------------------------------
+14 ; | yes | the entry is deleted
+15 ; | ^,timeout|
+16 ; | |
+17 ; | no | the entry is not deletes and a alert trigered
+18 ; |---------------------------------------------------
+19 ;
+20 ;Multiple Reaction:
+21 ; user |
+22 ; reponse | action taken
+23 ;-------------------------------------------------------------
+24 ; select | Selected reaction will be signed
+25 ;reactions |
+26 ; |
+27 ;reactions | all User is asked if they wish to delete the entry
+28 ;NOT |---------------------------------------------------
+29 ;selected | response | action taken
+30 ; OR |---------------------------------------------------
+31 ;^,timeout | yes | the entries is deleted
+32 ; | ^,timeout|
+33 ; | |
+34 ; | no | the entries is not deletes and a alert trigered
+35 ; |---------------------------------------------------
+36 ;
+37 ;Note: Only one entry point will be needed.....
DEL ; Main Entry point
+1 NEW DIR,GMRACNT,GMRAPCT
+2 ; No reaction to be deleted
DO DELPRT
+3 SET DIR(0)="YA"
SET DIR("B")="YES"
+4 SET DIR("?")="PLEASE ENTER 'Y' TO DELETE THE CAUSATIVE AGENT"_$SELECT(GMRACNT>1:"S",1:"")_" 'N' NOT TO DELETE THE DATA"
+5 SET DIR("??")="^D PRINT^GMRASIGN"
SET DIR("A")="Do you wish to delete "_$SELECT(GMRACNT>1:"these",1:"this")_" Causative Agent"_$SELECT(GMRACNT>1:"s",1:"")_"? "
DO ^DIR
+6 IF $DATA(DIRUT)
SET Y=1
SET GMRAOUT=1
+7 SET GMRAPCT=Y
+8 ; User did not want to delete the entry(s)
if 'GMRAPCT
QUIT
+9 ; User want to delete the data
+10 DO DELETE
+11 QUIT
DELETE ; Deleting the data
+1 NEW X
+2 ;W !,"One moment please deleting data..."
+3 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"GMRASF",X))
if X<1
QUIT
Begin DoDot:1
+4 NEW GMRAPA
+5 ; find 120.8 data
SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",X,0))
+6 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+7 ;36 Existing records are marked entered in error rather than being deleted
IF '$GET(^TMP($JOB,"GMRASF",X,GMRAPA))
DO EIE
QUIT
+8 NEW GMRAPA1
+9 SET GMRAPA1=0
+10 ; find 120.85 data
+11 FOR
SET GMRAPA1=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAPA1))
if GMRAPA1<1
QUIT
Begin DoDot:2
+12 SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
+13 IF GMRAPA1(0)=""
KILL ^GMR(120.85,"C",GMRAPA,GMRAPA1)
QUIT
+14 ; delete 120.85 data
Begin DoDot:3
+15 NEW DIK,DA
+16 SET DIK="^GMR(120.85,"
SET DA=GMRAPA1
DO ^DIK
+17 ; Unlocking the data 120.85
DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
+18 ;W "." ;36
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 ; delete 120.8 data
Begin DoDot:2
+22 NEW DIK,DA
+23 SET DIK="^GMR(120.8,"
SET DA=GMRAPA
DO ^DIK
+24 ; Unlocking the data 120.8
DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+25 ;W "." ;36
+26 QUIT
End DoDot:2
+27 SET X=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA,0))
+28 KILL ^TMP($JOB,"GMRASF",X,GMRAPA),^TMP($JOB,"GMRASF","B",GMRAPA,X)
+29 QUIT
End DoDot:1
+30 QUIT
DELPRT ; List all the reaction not signed
+1 NEW X,GMRAPA
+2 WRITE @IOF
+3 SET (GMRACNT,X)=0
+4 FOR
SET X=$ORDER(^TMP($JOB,"GMRASF",X))
if X<1
QUIT
Begin DoDot:1
+5 SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",X,0))
+6 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+7 WRITE !,$PIECE(GMRAPA(0),U,2)
+8 SET GMRACNT=GMRACNT+1
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
EIE ;Section added in patch 36, will mark existing records entered in error
+1 NEW GMRADFN,ALDATA,SUB
+2 SET GMRADFN=$PIECE(GMRAPA(0),U)
+3 SET ALDATA("GMRAERRDT")=$$NOW^XLFDT
SET ALDATA("GMRAERRBY")=$GET(DUZ,.5)
+4 DO EIE^GMRAGUI1(GMRAPA,GMRADFN,"ALDATA")
+5 SET SUB=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA,0))
+6 ;Delete entry as it's been taken care of
KILL ^TMP($JOB,"GMRASF",SUB,GMRAPA),^TMP($JOB,"GMRASF","B",GMRAPA,SUB)
+7 QUIT
