- 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 Jan 18, 2025@02:41:47 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