GMRASIGN ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT SIGN OFF ;9/22/06 11:01
;;4.0;Adverse Reaction Tracking;**17,19,36**;Mar 29, 1996;Build 9
SIGNOFF ; The signoff code
N GMRAOUT,GMRACNTT S GMRAOUT=0 ;19
S GMRASIGN=0
D ENCNT^GMRASIG1 ; Count entries
D SOQ ; Display entries and ask if user wants all the entries signed.
I 'Y D ; User said no the sign off question
.I GMRACNTT>1 S GMRASIGN=1 D YNSO^GMRASIG1 I Y'=0 D RANGE(Y) ; User had more than one entry
.D ALERT ; Ask Delete and trigger alerts for those non delete entries
.Q
K GMRASITE ; force the update of the site parameters
D PNOTE^GMRASIG1 ; File progress note
K ^TMP($J,"GMRASF") ; clean up the temp globals
Q
SOQ ;Sign off on all allergies for a patient
W @IOF,!,"Causative Agent Data edited this Session:"
K X D PRINT^GMRASIG1 ; Display entries edit this session
N DIR
S DIR(0)="YA",DIR("B")="NO"
S DIR("?")="PLEASE ENTER 'Y' IF THE DATA IS CORRECT OR 'N' IF IT IS NOT CORRECT"
S DIR("??")="^D PRINT^GMRASIG1"
S DIR("A")=$S(GMRACNTT>1:"Are ALL these",1:"Is this")_" correct? "
D ^DIR
I $D(DIRUT) S Y=0,GMRAOUT=1 ; user ^ or timed out
I Y=0 Q ; user answered no the sign off
D ALLSNG,RANGE(Y) ; sign all the entries
S Y=1
Q
ALLSNG ;Sign off on all
N X
S Y="",X=0
F S X=$O(^TMP($J,"GMRASF",X)) Q:X<1 S Y=Y_X_","
Q
RANGE(GMRARNG) ;Sign off select allergies
;Input:
; GMRARNG = The entries that need to be signed
;
N GMRATYPE ;19
F I=1:1 S GMRACNT=$P(GMRARNG,",",I) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA'>0 D
.N I,GMRARNG
.S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE
.S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
.S GMRATYPE=$P(GMRAPA(0),U,20)
.S GMRASLL(GMRAPA)=0
.I '$P(GMRAPA(0),U,16) D
..N GMRACNT K DR S DA=GMRAPA,DIE="^GMR(120.8,"
..I $$VFY(.GMRAPA) D
...S DR="19////1;20///N" D ^DIE
...Q
..E S DR="19////0" D ^DIE,EN1^GMRAVAB
..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
.I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS
.D ; Execute the event point for this reaction
..Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
..N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U)
..D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA SIGN-OFF ON DATA")_";ORD(101," D EN^XQOR:X K VAIN,X ;19
..Q
.K ^TMP($J,"GMRASF",GMRACNT,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)
.Q
Q
ALERT ; SENDS ALERT FOR ALL DATA THAT IS UNSIGNED
I '$O(^TMP($J,"GMRASF",0)) Q
D REMAIN ;D DEL^GMRADEL ; Ask user if they want to delete given entries
Q:$D(XQADATA) ; user is processing alert
S (GMRACNT,GMRACNTF)=0 F S GMRACNT=$O(^TMP($J,"GMRASF",GMRACNT)) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA<1 D
.S GMRAPA(0)=(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
.S XQA(DUZ)=""
.S XQAMSG=GMRANAM_" with reaction of "_$P(GMRAPA(0),U,2)_" has not been Signed off."
.S XQAID="GMASignoff Alert"
.S XQADATA=DFN_U_GMRAPA_U_$G(GMRAUSER,0)
.S XQAROU="ALERT^GMRAPEM0"
.D SETUP^XQALERT
.D UNLOCK^GMRAUTL(120.8,GMRAPA)
.I 'GMRACNTF W !,?5,"Please Note that these UNSIGNED Causative Agents ",!,?5,"will not show in the patient's records.",$C(7) D HANGT^GMRAPEH0 S GMRACNTF=1
.S X=$O(^TMP($J,"GMRASF","B",GMRAPA,0))
.K ^TMP($J,"GMRASF",X,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,X)
.Q
K XQA,XQAMSG,GMRACNTF
Q
IDBAND ; Mark ID Bands and Charts for a given patient
I $D(GMRASLL) D
.D EN4^GMRAMCB(.GMRASLL,DFN) S GMRAPA=0 F S GMRAPA=$O(GMRASLL(GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
.K GMRASLL
.Q
Q
VFY(Y) ;THIS FUNCTION WILL RETURN TRUE IF THIS ALLERGY IS AUTO VERIFIED
N GMRAPASS,X
S GMRAPASS=0
I '$D(GMRASITE) D SITE^GMRAUTL
S X=$G(^GMRD(120.84,+GMRASITE,0))
S GMRATYPE=$P(Y(0),U,20)
I @(($P(Y(0),U,6)="o"&($P(X,U,3)\2)!($P(Y(0),U,6)="h"&($P(X,U,3)#2)))_$S($P(X,U,6)="&":"&",1:"!")_(GMRATYPE["F"&($P(X,U,2)\2#2)!(GMRATYPE["D"&($P(X,U,2)#2))!(GMRATYPE["O"&($P(X,U,2)\4)))) S GMRAPASS=1
Q GMRAPASS
Q
;
REMAIN ;Review remaining entries that were not signed off. Entire section added with patch 17
N GMRAPA,LCVJ,Y,DIR,DIRUT,DUOUT,SIGNED,GMRAOUT,GMRANEW,DIC,DONE
S SIGNED=""
S LCVJ=0 F S LCVJ=$O(^TMP($J,"GMRASF",LCVJ)) Q:'+LCVJ D
.S GMRAPA=$O(^TMP($J,"GMRASF",LCVJ,0)) Q:'+GMRAPA S GMRAPA(0)=^GMR(120.8,GMRAPA,0)
.S DIR(0)="SB^Edit:Edit;Delete:Delete",DIR("B")="Edit" ;36
.S DIR("?")="Select edit or delete" ;36
.S DIR("?",1)="You must complete entry of this record. Select edit to change" ;36
.S DIR("?",2)="the record or delete to remove the record. Previously existing" ;36
.S DIR("?",3)="records will be marked as entered in error while records added" ;36
.S DIR("?",4)="during this session will be deleted." ;36
.S DIR("A")="For reactant "_$P(GMRAPA(0),U,2) D ^DIR K DIR S:$G(DIRUT) Y="E" ;36
.I $E(Y)="D" Q ;Do nothing if allergy is to be deleted
.S GMRANEW=0
.F D Q:DONE
..S DONE=0,GMRAOUT=0
..D EDIT^GMRAPEM4 W !
..I $P(^GMR(120.8,GMRAPA,0),U,6)="o" I '$D(^GMR(120.85,"C",GMRAPA))!('$O(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM^GMRAPEM0) D Q
...W !,"Observed reactions require the date of the reaction and",!,"sign/symptoms",$S('$$REQCOM^GMRAPEM0:" and comments.",1:"."),!
...S DIR(0)="SA^R:Re-edit;D:Delete",DIR("A")="Do you want to (R)e-edit or (D)elete this entry? ",DIR("B")="R" D ^DIR S:Y'="R" DONE=1 Q
..I $P(^GMR(120.8,GMRAPA,0),U,6)="h",$D(^GMR(120.85,"C",GMRAPA)) D DELOBS ;Delete observed data if changing to historical
..S DIR(0)="Y",DIR("A")="Is this entry now correct",DIR("B")="Y",DIR("?")="Answer yes to accept the allergy. Enter NO to re-edit. Enter ^ to delete this entry." D ^DIR
..I Y=0 Q
..I $G(DIRUT) S DONE=1 Q
..S SIGNED=SIGNED_LCVJ_",",DONE=1
I $L(SIGNED)>1 D RANGE(SIGNED) ;Sign off on accepted allergies
I $O(^TMP($J,"GMRASF",0)) D DELETE^GMRADEL ;Delete unaccepted entries
Q
;
DELOBS ;Delete observed data from 120.85
N OIEN,DIK,DA
S OIEN=0 F S OIEN=$O(^GMR(120.85,"C",GMRAPA,OIEN)) Q:'+OIEN S DIK="^GMR(120.85,",DA=OIEN D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRASIGN 6018 printed Dec 13, 2024@01:40:34 Page 2
GMRASIGN ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT SIGN OFF ;9/22/06 11:01
+1 ;;4.0;Adverse Reaction Tracking;**17,19,36**;Mar 29, 1996;Build 9
SIGNOFF ; The signoff code
+1 ;19
NEW GMRAOUT,GMRACNTT
SET GMRAOUT=0
+2 SET GMRASIGN=0
+3 ; Count entries
DO ENCNT^GMRASIG1
+4 ; Display entries and ask if user wants all the entries signed.
DO SOQ
+5 ; User said no the sign off question
IF 'Y
Begin DoDot:1
+6 ; User had more than one entry
IF GMRACNTT>1
SET GMRASIGN=1
DO YNSO^GMRASIG1
IF Y'=0
DO RANGE(Y)
+7 ; Ask Delete and trigger alerts for those non delete entries
DO ALERT
+8 QUIT
End DoDot:1
+9 ; force the update of the site parameters
KILL GMRASITE
+10 ; File progress note
DO PNOTE^GMRASIG1
+11 ; clean up the temp globals
KILL ^TMP($JOB,"GMRASF")
+12 QUIT
SOQ ;Sign off on all allergies for a patient
+1 WRITE @IOF,!,"Causative Agent Data edited this Session:"
+2 ; Display entries edit this session
KILL X
DO PRINT^GMRASIG1
+3 NEW DIR
+4 SET DIR(0)="YA"
SET DIR("B")="NO"
+5 SET DIR("?")="PLEASE ENTER 'Y' IF THE DATA IS CORRECT OR 'N' IF IT IS NOT CORRECT"
+6 SET DIR("??")="^D PRINT^GMRASIG1"
+7 SET DIR("A")=$SELECT(GMRACNTT>1:"Are ALL these",1:"Is this")_" correct? "
+8 DO ^DIR
+9 ; user ^ or timed out
IF $DATA(DIRUT)
SET Y=0
SET GMRAOUT=1
+10 ; user answered no the sign off
IF Y=0
QUIT
+11 ; sign all the entries
DO ALLSNG
DO RANGE(Y)
+12 SET Y=1
+13 QUIT
ALLSNG ;Sign off on all
+1 NEW X
+2 SET Y=""
SET X=0
+3 FOR
SET X=$ORDER(^TMP($JOB,"GMRASF",X))
if X<1
QUIT
SET Y=Y_X_","
+4 QUIT
RANGE(GMRARNG) ;Sign off select allergies
+1 ;Input:
+2 ; GMRARNG = The entries that need to be signed
+3 ;
+4 ;19
NEW GMRATYPE
+5 FOR I=1:1
SET GMRACNT=$PIECE(GMRARNG,",",I)
if GMRACNT<1
QUIT
SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",GMRACNT,0))
if GMRAPA'>0
QUIT
Begin DoDot:1
+6 NEW I,GMRARNG
+7 SET DA=GMRAPA
SET DIE="^GMR(120.8,"
SET DR="15////1"
DO ^DIE
+8 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
+9 SET GMRATYPE=$PIECE(GMRAPA(0),U,20)
+10 SET GMRASLL(GMRAPA)=0
+11 IF '$PIECE(GMRAPA(0),U,16)
Begin DoDot:2
+12 NEW GMRACNT
KILL DR
SET DA=GMRAPA
SET DIE="^GMR(120.8,"
+13 IF $$VFY(.GMRAPA)
Begin DoDot:3
+14 SET DR="19////1;20///N"
DO ^DIE
+15 QUIT
End DoDot:3
+16 IF '$TEST
SET DR="19////0"
DO ^DIE
DO EN1^GMRAVAB
+17 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
End DoDot:2
+18 IF $PIECE(GMRAPA(0),U,6)="o"
IF GMRATYPE["D"
DO PTBUL^GMRAROBS
+19 ; Execute the event point for this reaction
Begin DoDot:2
+20 if '$DATA(GMRAPA)
QUIT
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+21 NEW OROLD,DFN,GMRACNT
SET DFN=$PIECE(GMRAPA(0),U)
+22 ;19
DO INP^VADPT
SET X=$$FIND1^DIC(101,,"BX","GMRA SIGN-OFF ON DATA")_";ORD(101,"
if X
DO EN^XQOR
KILL VAIN,X
+23 QUIT
End DoDot:2
+24 KILL ^TMP($JOB,"GMRASF",GMRACNT,GMRAPA),^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT)
+25 QUIT
End DoDot:1
+26 QUIT
ALERT ; SENDS ALERT FOR ALL DATA THAT IS UNSIGNED
+1 IF '$ORDER(^TMP($JOB,"GMRASF",0))
QUIT
+2 ;D DEL^GMRADEL ; Ask user if they want to delete given entries
DO REMAIN
+3 ; user is processing alert
if $DATA(XQADATA)
QUIT
+4 SET (GMRACNT,GMRACNTF)=0
FOR
SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF",GMRACNT))
if GMRACNT<1
QUIT
SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",GMRACNT,0))
if GMRAPA<1
QUIT
Begin DoDot:1
+5 SET GMRAPA(0)=(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+6 SET XQA(DUZ)=""
+7 SET XQAMSG=GMRANAM_" with reaction of "_$PIECE(GMRAPA(0),U,2)_" has not been Signed off."
+8 SET XQAID="GMASignoff Alert"
+9 SET XQADATA=DFN_U_GMRAPA_U_$GET(GMRAUSER,0)
+10 SET XQAROU="ALERT^GMRAPEM0"
+11 DO SETUP^XQALERT
+12 DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+13 IF 'GMRACNTF
WRITE !,?5,"Please Note that these UNSIGNED Causative Agents ",!,?5,"will not show in the patient's records.",$CHAR(7)
DO HANGT^GMRAPEH0
SET GMRACNTF=1
+14 SET X=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA,0))
+15 KILL ^TMP($JOB,"GMRASF",X,GMRAPA),^TMP($JOB,"GMRASF","B",GMRAPA,X)
+16 QUIT
End DoDot:1
+17 KILL XQA,XQAMSG,GMRACNTF
+18 QUIT
IDBAND ; Mark ID Bands and Charts for a given patient
+1 IF $DATA(GMRASLL)
Begin DoDot:1
+2 DO EN4^GMRAMCB(.GMRASLL,DFN)
SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(GMRASLL(GMRAPA))
if GMRAPA<1
QUIT
DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+3 KILL GMRASLL
+4 QUIT
End DoDot:1
+5 QUIT
VFY(Y) ;THIS FUNCTION WILL RETURN TRUE IF THIS ALLERGY IS AUTO VERIFIED
+1 NEW GMRAPASS,X
+2 SET GMRAPASS=0
+3 IF '$DATA(GMRASITE)
DO SITE^GMRAUTL
+4 SET X=$GET(^GMRD(120.84,+GMRASITE,0))
+5 SET GMRATYPE=$PIECE(Y(0),U,20)
+6 IF @(($PIECE(Y(0),U,6)="o"&($PIECE(X,U,3)\2)!($PIECE(Y(0),U,6)="h"&($PIECE(X,U,3)#2)))_$SELECT($PIECE(X,U,6)="&":"&",1:"!")_(GMRATYPE["F"&($PIECE(X,U,2)\2#2)!(GMRATYPE["D"&($PIECE(X,U,2)#2))!(GMRATYPE["O"&($PIECE(X,U,2)\4))))
SET GMRAPASS=1
+7 QUIT GMRAPASS
+8 QUIT
+9 ;
REMAIN ;Review remaining entries that were not signed off. Entire section added with patch 17
+1 NEW GMRAPA,LCVJ,Y,DIR,DIRUT,DUOUT,SIGNED,GMRAOUT,GMRANEW,DIC,DONE
+2 SET SIGNED=""
+3 SET LCVJ=0
FOR
SET LCVJ=$ORDER(^TMP($JOB,"GMRASF",LCVJ))
if '+LCVJ
QUIT
Begin DoDot:1
+4 SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF",LCVJ,0))
if '+GMRAPA
QUIT
SET GMRAPA(0)=^GMR(120.8,GMRAPA,0)
+5 ;36
SET DIR(0)="SB^Edit:Edit;Delete:Delete"
SET DIR("B")="Edit"
+6 ;36
SET DIR("?")="Select edit or delete"
+7 ;36
SET DIR("?",1)="You must complete entry of this record. Select edit to change"
+8 ;36
SET DIR("?",2)="the record or delete to remove the record. Previously existing"
+9 ;36
SET DIR("?",3)="records will be marked as entered in error while records added"
+10 ;36
SET DIR("?",4)="during this session will be deleted."
+11 ;36
SET DIR("A")="For reactant "_$PIECE(GMRAPA(0),U,2)
DO ^DIR
KILL DIR
if $GET(DIRUT)
SET Y="E"
+12 ;Do nothing if allergy is to be deleted
IF $EXTRACT(Y)="D"
QUIT
+13 SET GMRANEW=0
+14 FOR
Begin DoDot:2
+15 SET DONE=0
SET GMRAOUT=0
+16 DO EDIT^GMRAPEM4
WRITE !
+17 IF $PIECE(^GMR(120.8,GMRAPA,0),U,6)="o"
IF '$DATA(^GMR(120.85,"C",GMRAPA))!('$ORDER(^GMR(120.85,+$ORDER(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM^GMRAPEM0)
Begin DoDot:3
+18 WRITE !,"Observed reactions require the date of the reaction and",!,"sign/symptoms",$SELECT('$$REQCOM^GMRAPEM0:" and comments.",1:"."),!
+19 SET DIR(0)="SA^R:Re-edit;D:Delete"
SET DIR("A")="Do you want to (R)e-edit or (D)elete this entry? "
SET DIR("B")="R"
DO ^DIR
if Y'="R"
SET DONE=1
QUIT
End DoDot:3
QUIT
+20 ;Delete observed data if changing to historical
IF $PIECE(^GMR(120.8,GMRAPA,0),U,6)="h"
IF $DATA(^GMR(120.85,"C",GMRAPA))
DO DELOBS
+21 SET DIR(0)="Y"
SET DIR("A")="Is this entry now correct"
SET DIR("B")="Y"
SET DIR("?")="Answer yes to accept the allergy. Enter NO to re-edit. Enter ^ to delete this entry."
DO ^DIR
+22 IF Y=0
QUIT
+23 IF $GET(DIRUT)
SET DONE=1
QUIT
+24 SET SIGNED=SIGNED_LCVJ_","
SET DONE=1
End DoDot:2
if DONE
QUIT
End DoDot:1
+25 ;Sign off on accepted allergies
IF $LENGTH(SIGNED)>1
DO RANGE(SIGNED)
+26 ;Delete unaccepted entries
IF $ORDER(^TMP($JOB,"GMRASF",0))
DO DELETE^GMRADEL
+27 QUIT
+28 ;
DELOBS ;Delete observed data from 120.85
+1 NEW OIEN,DIK,DA
+2 SET OIEN=0
FOR
SET OIEN=$ORDER(^GMR(120.85,"C",GMRAPA,OIEN))
if '+OIEN
QUIT
SET DIK="^GMR(120.85,"
SET DA=OIEN
DO ^DIK
+3 QUIT
