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

GMRCP.m

Go to the documentation of this file. 
  1. GMRCP ;SLC/DLT,DCM - Message audit and status process ;Nov 09, 2020@08:52:15
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**1,4,17,22,27,53,55,46,91,84**;DEC 27, 1997;Build 27
  1.  ;Processing action on Generic Requests/Consults from OE/RR
  1. MSG(GMRCDFN,GMRCALRM,GMRCIFN,ORN,GMRCADUZ,FLG,GMRCFORC) ;send alert notification information to OERR for notification or update
  1.  ;GMRCDFN=patient's DFN           GMRCORFN=OR file # ^OR(100,GMRCORFN
  1.  ;GMRCALRM=alert message to be displayed with alert
  1.  ;GMRCIFN=internal file number of consult in file 123
  1.  ;GMRCADUZ=set in call to EN^GMRCT=array of providers who will be alerted
  1.  ;FLG=1 if need to get list of service's providers, 0 if service dc'd.
  1.  ;GMRCFORC=optional array passed in; users who will be alerted even if alert is turned OFF
  1.  ;ORN=IFN from file ^ORD(100.9, for consult notification action
  1.  N GMRCSS,GMRCORFN
  1.  S GMRCORFN=$P(^GMR(123,+GMRCIFN,0),"^",3)
  1.  S GMRCSS=$P($G(^GMR(123,+GMRCIFN,0)),"^",5)
  1.  I FLG,GMRCSS D EN^GMRCT(GMRCSS)
  1.  I $P($G(^GMR(123,+GMRCIFN,12)),U,5)="P" D
  1.  . Q:ORN=27  ; don't notify requestor if a new order they placed, duh...
  1.  . I DUZ=+$P(^GMR(123,+GMRCIFN,0),U,14) Q  ; don;t alert on own actions
  1.  . S GMRCADUZ(+$P(^GMR(123,+GMRCIFN,0),U,14))=""
  1.  I FLG,$P(^GMR(123,+GMRCIFN,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
  1.  S:'$D(GMRCADUZ) GMRCADUZ=""
  1.  S:'$D(GMRCFORC) GMRCFORC=""
  1.  I $G(^GMR(123.5,GMRCSS,"INT"))=1 D  ;set ORN to prosthetics alert, if necessary
  1.  . S:$G(ORN)=63 ORN=89
  1.  ;N X S X="" F  S X=$O(GMRCADUZ(X)) Q:(X="")  I +X=DUZ,X'=DUZ K GMRCADUZ(X) ;Don't send alert to user generating alert
  1.  K GMRCADUZ(DUZ) ;Don't send alert to user generating alert
  1.  D EN^ORB3(ORN,GMRCDFN,GMRCORFN,.GMRCADUZ,GMRCALRM,GMRCIFN,.GMRCFORC)
  1.  Q
  1. AUDIT ;Build processing activity audit trail multiple.
  1.  S GMRCDT=$$NOW^XLFDT
  1. AUDIT0 ;alternate entry with date already defined
  1.  L +^GMR(123,+GMRCO,40):5 I '$T S GMRCUT=1,GMRCERR=1,GMRCERMS="Activity Trail Not filed - Consult In Use By Another User." L -^GMR(123,+GMRCO,40)  Q
  1.  S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
  1.  S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
  1.  S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
  1. AUDIT1 ;entry when the DA is not incremented (INCOMPLETE RPT writeovers)
  1.  S GMRCORNP=$G(GMRCORNP) S:'$D(GMRCOM) GMRCOM=0
  1.  S GMRCDEV=$G(GMRCDEV),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA)
  1.  S GMRCAD=$S('$D(GMRCAD):GMRCDT,1:GMRCAD)
  1.  S GMRCRSLT=$G(GMRCRSLT) ;Added result with GMRC*3.0*4
  1.  S DIE="^GMR(123,"_+GMRCO_",40,",DA(1)=+GMRCO
  1.  I '$D(^GMR(123,DA(1),40,DA,0)) D
  1.  . S DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP"
  1.  . I GMRCA'=22 S DR=DR_";4////^S X=DUZ" ;if it's a print, pkg did it
  1.  . S DR=DR_";6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
  1.  E  D
  1.  . ;DR string on .01 allows write over, rather than forced new entry
  1.  . S DR=".01///^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=DUZ;6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
  1.  ;Added result to the DR string
  1.  D ^DIE
  1. COMMENT ;Enter comment
  1.  I +$G(GMRCOM) S GMRCOM(0)=DA D
  1.  . W !,"Enter COMMENT..."
  1.  . N DIC,DWPK,DWLW,DIWESUB
  1.  . S DIC=DIE_DA_",1,",DWPK=1,DWLW=74
  1.  . S DIWESUB="COMMENTS" D EN^DIWE
  1.  . I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="ADDED COMMENT",'$O(^GMR(123,+GMRCO,40,DA,0)) D  Q
  1.  .. S DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
  1.  .. Q
  1.  . I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="COMPLETE/UPDATE",$P($G(^GMR(123,+GMRCO,40,DA,0)),U,9)="" D
  1.  .. N GMRCMT,GMRCMT1
  1.  .. S (GMRCMT,GMRCMT1)=0
  1.  .. F  S GMRCMT=$O(^GMR(123,+GMRCO,40,DA,1,GMRCMT)) Q:GMRCMT=""  D  Q:GMRCMT1=1
  1.  ... I $TR($G(^GMR(123,+GMRCO,40,DA,1,GMRCMT,0))," ","")'="" S GMRCMT1=1
  1.  .. I 'GMRCMT1 D  G:'GMRCQUIT COMMENT Q
  1.  ... S GMRCQUIT=0
  1.  ... W !!,"A comment is required to complete this request!",!
  1.  ... D WP^DIE(123.02,DA_","_+GMRCO_",",5,,"@")
  1.  ... K DIR
  1.  ... S DIR("A")="Type 'Q' to quit or 'C' to continue entering a comment:"
  1.  ... S DIR("B")="C"
  1.  ... S DIR(0)="S^C:CONTINUE;Q:QUIT"
  1.  ... S DIR("?")="Type 'Q' if you would like to abort completion of this Consult/Procedure."
  1.  ... S DIR("?",1)="Type 'C' or press <RETURN> to re-enter your comments."
  1.  ... D ^DIR K DIR I Y'="C" S GMRCQUIT=1,DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
  1.  . I '$G(DA) S DA=D0
  1.  . I $D(^GMR(123,+GMRCO,40,DA,0)),$O(^GMR(123,+GMRCO,40,DA,0)) S $P(GMRCOM,"^",2)=1
  1.  . Q
  1.  L -^GMR(123,+GMRCO,40)
  1.  ; if an IFC, call event handler to generate a msg to remote site
  1.  I $D(^GMR(123,GMRCO,12)),$L($P(^(12),U,5)) D
  1.  . Q:'$D(^GMR(123,GMRCO,40,DA))
  1.  . D TRIGR^GMRCIEVT(GMRCO,DA)
  1.  ;
  1.  K DIE,DA,DR,GMRCDEV,GMRCFF,GMRCPA,X,% Q
  1.  ;
  1. STATUS ;Update the status for the Request/Consultation File
  1.  K GMRCQUT
  1.  Q:'$D(GMRCSTS)!('$D(GMRCA))
  1.  S DIE=123,DA=+GMRCO
  1.  I $D(GMRCDR),$L(GMRCDR) S DR=GMRCDR
  1.  E  S DR="8////^S X=GMRCSTS;9////^S X=GMRCA"
  1.  L +^GMR(123,GMRCO):2 I '$T S GMRCQUT=1,GMRCERR=1,GMRCERMS="Unable to update status and last action - Consult In Use By Another User." Q
  1.  D ^DIE
  1.  L -^GMR(123,+GMRCO)
  1.  K DIE,DA,DR,GMRCDR
  1.  Q