Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRASIGN

GMRASIGN.m

Go to the documentation of this file.
  1. 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
  1. SIGNOFF ; The signoff code
  1. N GMRAOUT,GMRACNTT S GMRAOUT=0 ;19
  1. S GMRASIGN=0
  1. D ENCNT^GMRASIG1 ; Count entries
  1. D SOQ ; Display entries and ask if user wants all the entries signed.
  1. I 'Y D ; User said no the sign off question
  1. .I GMRACNTT>1 S GMRASIGN=1 D YNSO^GMRASIG1 I Y'=0 D RANGE(Y) ; User had more than one entry
  1. .D ALERT ; Ask Delete and trigger alerts for those non delete entries
  1. .Q
  1. K GMRASITE ; force the update of the site parameters
  1. D PNOTE^GMRASIG1 ; File progress note
  1. K ^TMP($J,"GMRASF") ; clean up the temp globals
  1. Q
  1. SOQ ;Sign off on all allergies for a patient
  1. W @IOF,!,"Causative Agent Data edited this Session:"
  1. K X D PRINT^GMRASIG1 ; Display entries edit this session
  1. N DIR
  1. S DIR(0)="YA",DIR("B")="NO"
  1. S DIR("?")="PLEASE ENTER 'Y' IF THE DATA IS CORRECT OR 'N' IF IT IS NOT CORRECT"
  1. S DIR("??")="^D PRINT^GMRASIG1"
  1. S DIR("A")=$S(GMRACNTT>1:"Are ALL these",1:"Is this")_" correct? "
  1. D ^DIR
  1. I $D(DIRUT) S Y=0,GMRAOUT=1 ; user ^ or timed out
  1. I Y=0 Q ; user answered no the sign off
  1. D ALLSNG,RANGE(Y) ; sign all the entries
  1. S Y=1
  1. Q
  1. ALLSNG ;Sign off on all
  1. N X
  1. S Y="",X=0
  1. F S X=$O(^TMP($J,"GMRASF",X)) Q:X<1 S Y=Y_X_","
  1. Q
  1. RANGE(GMRARNG) ;Sign off select allergies
  1. ;Input:
  1. ; GMRARNG = The entries that need to be signed
  1. ;
  1. N GMRATYPE ;19
  1. F I=1:1 S GMRACNT=$P(GMRARNG,",",I) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA'>0 D
  1. .N I,GMRARNG
  1. .S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE
  1. .S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
  1. .S GMRATYPE=$P(GMRAPA(0),U,20)
  1. .S GMRASLL(GMRAPA)=0
  1. .I '$P(GMRAPA(0),U,16) D
  1. ..N GMRACNT K DR S DA=GMRAPA,DIE="^GMR(120.8,"
  1. ..I $$VFY(.GMRAPA) D
  1. ...S DR="19////1;20///N" D ^DIE
  1. ...Q
  1. ..E S DR="19////0" D ^DIE,EN1^GMRAVAB
  1. ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
  1. .I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS
  1. .D ; Execute the event point for this reaction
  1. ..Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
  1. ..N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U)
  1. ..D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA SIGN-OFF ON DATA")_";ORD(101," D EN^XQOR:X K VAIN,X ;19
  1. ..Q
  1. .K ^TMP($J,"GMRASF",GMRACNT,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)
  1. .Q
  1. Q
  1. ALERT ; SENDS ALERT FOR ALL DATA THAT IS UNSIGNED
  1. I '$O(^TMP($J,"GMRASF",0)) Q
  1. D REMAIN ;D DEL^GMRADEL ; Ask user if they want to delete given entries
  1. Q:$D(XQADATA) ; user is processing alert
  1. 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
  1. .S GMRAPA(0)=(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
  1. .S XQA(DUZ)=""
  1. .S XQAMSG=GMRANAM_" with reaction of "_$P(GMRAPA(0),U,2)_" has not been Signed off."
  1. .S XQAID="GMASignoff Alert"
  1. .S XQADATA=DFN_U_GMRAPA_U_$G(GMRAUSER,0)
  1. .S XQAROU="ALERT^GMRAPEM0"
  1. .D SETUP^XQALERT
  1. .D UNLOCK^GMRAUTL(120.8,GMRAPA)
  1. .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
  1. .S X=$O(^TMP($J,"GMRASF","B",GMRAPA,0))
  1. .K ^TMP($J,"GMRASF",X,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,X)
  1. .Q
  1. K XQA,XQAMSG,GMRACNTF
  1. Q
  1. IDBAND ; Mark ID Bands and Charts for a given patient
  1. I $D(GMRASLL) D
  1. .D EN4^GMRAMCB(.GMRASLL,DFN) S GMRAPA=0 F S GMRAPA=$O(GMRASLL(GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
  1. .K GMRASLL
  1. .Q
  1. Q
  1. VFY(Y) ;THIS FUNCTION WILL RETURN TRUE IF THIS ALLERGY IS AUTO VERIFIED
  1. N GMRAPASS,X
  1. S GMRAPASS=0
  1. I '$D(GMRASITE) D SITE^GMRAUTL
  1. S X=$G(^GMRD(120.84,+GMRASITE,0))
  1. S GMRATYPE=$P(Y(0),U,20)
  1. 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
  1. Q GMRAPASS
  1. Q
  1. ;
  1. REMAIN ;Review remaining entries that were not signed off. Entire section added with patch 17
  1. N GMRAPA,LCVJ,Y,DIR,DIRUT,DUOUT,SIGNED,GMRAOUT,GMRANEW,DIC,DONE
  1. S SIGNED=""
  1. S LCVJ=0 F S LCVJ=$O(^TMP($J,"GMRASF",LCVJ)) Q:'+LCVJ D
  1. .S GMRAPA=$O(^TMP($J,"GMRASF",LCVJ,0)) Q:'+GMRAPA S GMRAPA(0)=^GMR(120.8,GMRAPA,0)
  1. .S DIR(0)="SB^Edit:Edit;Delete:Delete",DIR("B")="Edit" ;36
  1. .S DIR("?")="Select edit or delete" ;36
  1. .S DIR("?",1)="You must complete entry of this record. Select edit to change" ;36
  1. .S DIR("?",2)="the record or delete to remove the record. Previously existing" ;36
  1. .S DIR("?",3)="records will be marked as entered in error while records added" ;36
  1. .S DIR("?",4)="during this session will be deleted." ;36
  1. .S DIR("A")="For reactant "_$P(GMRAPA(0),U,2) D ^DIR K DIR S:$G(DIRUT) Y="E" ;36
  1. .I $E(Y)="D" Q ;Do nothing if allergy is to be deleted
  1. .S GMRANEW=0
  1. .F D Q:DONE
  1. ..S DONE=0,GMRAOUT=0
  1. ..D EDIT^GMRAPEM4 W !
  1. ..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
  1. ...W !,"Observed reactions require the date of the reaction and",!,"sign/symptoms",$S('$$REQCOM^GMRAPEM0:" and comments.",1:"."),!
  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
  1. ..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
  1. ..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
  1. ..I Y=0 Q
  1. ..I $G(DIRUT) S DONE=1 Q
  1. ..S SIGNED=SIGNED_LCVJ_",",DONE=1
  1. I $L(SIGNED)>1 D RANGE(SIGNED) ;Sign off on accepted allergies
  1. I $O(^TMP($J,"GMRASF",0)) D DELETE^GMRADEL ;Delete unaccepted entries
  1. Q
  1. ;
  1. DELOBS ;Delete observed data from 120.85
  1. N OIEN,DIK,DA
  1. S OIEN=0 F S OIEN=$O(^GMR(120.85,"C",GMRAPA,OIEN)) Q:'+OIEN S DIK="^GMR(120.85,",DA=OIEN D ^DIK
  1. Q