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

GMRCGUIB.m

Go to the documentation of this file. 
  1. GMRCGUIB ;SLC/DCM,JFR,MA - GUI actions for consults ;19-Nov-2014 09:52;DU
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**4,12,18,20,17,22,29,30,35,45,53,55,1005**;DEC 27, 1997;Build 2
  1.  ; This routine invokes IA #2980
  1.  ; IHS/MSC/MGH added an unlock when exiting
  1.  ;
  1. SETDA() ;set DA of where audit actions are to be filed
  1.  S:'$D(^GMR(123,+GMRCO,40,0)) ^GMR(123,GMRCO,40,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.  Q DA
  1. REASON(GMRCFN,GMRCRQ,GMRCDT) ;Load the reason for the request into ^GMR(123,GMRCO,20
  1.  ;GMRCFN=File 123 IFN; GMRCRQ=Array containing Reason For Request
  1.  ;GMRCDT=Date time of entry
  1.  S ^GMR(123,GMRCFN,20,0)="^^^"_GMRCDT_"^"
  1.  S L=0,LN=1 F  S L=$O(GMRCRQ(L)) Q:L=""  S ^GMR(123,GMRCFN,20,LN,0)=GMRCRQ(L),LN=LN+1
  1.  S LN=LN-1,$P(^GMR(123,GMRCFN,20,0),"^",3)=LN
  1.  K LN,L
  1.  Q
  1. SETCOM(COMMENT,WHO) ;Set comment array into tracking actions
  1.  N GMRCNOW,DR,DIE
  1.  S GMRCNOW=$$NOW^XLFDT
  1.  S DIE="^GMR(123,GMRCO,40,",DA(1)=GMRCO,DR=".01////^S X=GMRCNOW;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=$G(GMRCORNP);4////^S X=$S($G(WHO):WHO,1:DUZ);6////^S X=$G(GMRCFR);8////^S X=$G(GMRCFF)"
  1.  D ^DIE
  1.  S ^GMR(123,GMRCO,40,DA,1,0)="^^^^"_GMRCAD_"^"
  1.  S (GMRCND,GMRCND1)=0 F  S GMRCND1=$O(COMMENT(GMRCND1)) Q:GMRCND1=""  S GMRCND=GMRCND+1,^GMR(123,GMRCO,40,DA,1,GMRCND,0)=COMMENT(GMRCND)
  1.  S $P(^GMR(123,GMRCO,40,DA,1,0),"^",3)=GMRCND,$P(^(0),"^",4)=GMRCND,^GMR(123,GMRCO,40,"B",GMRCNOW,DA)=""
  1.  ;
  1.  ; if an IFC, call event handler to generate a msg to remote site
  1.  I $D(^GMR(123,+GMRCO,12)),$D(^(40,DA)) D TRIGR^GMRCIEVT(GMRCO,DA)
  1.  ;
  1.  K GMRCND,GMRCND1
  1.  Q
  1. CMT(GMRCO,GMRCOM,GMRCADUZ,GMRCWHN,GMRCWHO) ;add comment to consult
  1.  ; GMRCO = IEN from file 123
  1.  ; GMRCOM = array of comments in format GMRCOM(1)="xxxx", GMRCOM(2)="xxx"
  1.  ; GMRCADUZ = array of alert recipients as GMRCADUZ(DUZ)="" (optional)
  1.  ; GMRCWHO = IEN from file 200 who's responsible activity (optional)
  1.  ; GMRCWHN = date time of activity in FM format
  1.  ;
  1.  N DA,GMRCA,GMRCAD,GMRCORTX,GMRCDFN,GMRCTM,GMRCRP,GMRCUPD
  1.  S DA=$$SETDA ; get next activity tracking entry
  1.  S GMRCA=20,GMRCAD=GMRCWHN S:$G(GMRCWHO) GMRCORNP=GMRCWHO
  1.  D SETCOM(.GMRCOM,$G(GMRCWHO))
  1.  D  ;update LAST ACTION field even though no status change
  1.  . N GMRCDR,GMRCSTS
  1.  . S GMRCSTS="",GMRCDR="9////20"
  1.  . D STATUS^GMRCP
  1.  S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
  1.  S GMRCORTX="Comment Added to Consult "
  1.  I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
  1.  . S GMRCORTX="Comment Added to remote consult "
  1.  S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
  1.  S GMRCRP=+$P(^GMR(123,GMRCO,0),U,14)
  1.  S GMRCUPD=$$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
  1.  I GMRCRP=DUZ D  ;alert team if ord. prov. takes the action
  1.  . S GMRCTM=1
  1.  I GMRCUPD>1,GMRCRP'=DUZ D  ; alert ord. prov if update users takes action
  1.  . S GMRCADUZ(GMRCRP)=""
  1.  I '$G(GMRCTM),GMRCUPD<2 D  ;alert both if not ord. prov or update user
  1.  . S GMRCTM=1,GMRCADUZ(GMRCRP)=""
  1.  D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,63,.GMRCADUZ,$G(GMRCTM))
  1.  Q
  1. SFILE(GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD) ;Process various file update functions from the GUI for a consult
  1.  ; ADMIN COMPLETE or SIGNIFICANT FINDINGS
  1.  ;Input variables:
  1.  ;GMRCO=File 123 IEN of the consult record
  1.  ;GMRCA=pointer to REQUEST ACTION TYPES (#123.1) 10=complete, 4=Sig find.
  1.  ;GMRCSF=Significant Findings flag: 'Y'= significant finding
  1.  ;                                : 'N'= no significant finding
  1.  ;                                : 'U'=unknown significant finding
  1.  ;GMRCORNP=Provider Responsible for action
  1.  ;GMRCDUZ=Person actually doing the action
  1.  ;GMRCOM=An array of comments by reference ARRAY(1)="xxx",ARRAY(2)="xxx"
  1.  ;GMRCALF=Flag to signal that alerts are to be sent; 'N'=NO, 'Y'=YES
  1.  ;GMRCATO=Who alerts are to be sent to; a comma delimited string of DUZ's
  1.  ;GMRCAD =FM date/time of activity
  1.  ;
  1.  ;Output:
  1.  ; GMRCERR=Error Flag: 0 if no error, 1 if error occurred
  1.  ; GMRCERMS - Error message or null
  1.  ;    returned as GMRCERR^GMRCERMS
  1.  ;
  1.  N GMRCERR,GMRCERMS
  1.  L +^GMR(123,GMRCO):5 I '$T S GMRCERR=1,GMRCERMS="Record Locked. File Update Not Accomplished." Q GMRCERR_"^"_GMRCERMS
  1.  S GMRCERR=0,GMRCERMS="",DR="",GMRCORTX=""
  1.  N GMRCADUZ S GMRCADUZ=""
  1.  S GMRCNOW=$$NOW^XLFDT,GMRCSTS=$P(^GMR(123,+GMRCO,0),"^",12),GMRCDFN=$P(^(0),"^",2)
  1.  I '$G(GMRCDUZ) S GMRCDUZ=DUZ
  1.  I '$G(GMRCAD) S GMRCAD=GMRCNOW
  1.  ;Insure comment array contains text for Complete action.
  1.  ;IHS/MSC/MGH Added an unlock before exiting
  1.  I GMRCA=10 D  I GMRCERR=1 L -^GMR(123,GMRCO) S GMRCERMS="Comment field must contain a text value!" Q GMRCERR_"^"_GMRCERMS
  1.  . S GMRCERR=1
  1.  . I '$D(GMRCOM) Q
  1.  . N GMRCOM1 S GMRCOM1=""
  1.  . F  S GMRCOM1=$O(GMRCOM(GMRCOM1)) Q:(GMRCOM1=""!(GMRCERR=0))  D
  1.  .. I $TR($G(GMRCOM(GMRCOM1))," ","")'="" S GMRCERR=0 Q
  1.  I +$G(GMRCA),GMRCA=10 D
  1.  .S GMRCSF=$G(GMRCSF,"")
  1.  .S GMRCSTS=2
  1.  .S DR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
  1.  .S GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(+GMRCO)_$S(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
  1.  .I $P($G(^GMR(123,+GMRCO,0)),U,14) S GMRCADUZ($P($G(^(0)),U,14))=""
  1.  .Q
  1.  I $G(GMRCALF)=1 D
  1.  .N I
  1.  .F I=1:1  S X=$P(GMRCATO,";",I) Q:X=""  S GMRCADUZ(X)=""
  1.  .Q
  1.  I $L(GMRCA),GMRCA=4 S DR=DR_$S($L(DR):";",1:"")_"9////^S X=GMRCA;15////^S X=GMRCSF" D
  1.  .S GMRCORTX=$S(GMRCSF="Y":"Sig Findings ",GMRCSF="N":"No Sig Findings ",1:"Unknown Sig Findings ")_"for consult "_$$ORTX^GMRCAU(GMRCO)
  1.  .I $P($G(^GMR(123,+GMRCO,0)),U,14) S GMRCADUZ($P($G(^(0)),U,14))=""
  1.  .Q
  1.  I $L(DR) S DIE="^GMR(123,",DA=GMRCO D ^DIE K DIE,DR
  1.  I '$O(GMRCOM(0)) D AUDIT^GMRCP
  1.  I $D(GMRCOM),$O(GMRCOM(0)) D
  1.  .N DA
  1.  .S DA=$$SETDA()
  1.  .D SETCOM(.GMRCOM,GMRCDUZ)
  1.  .Q
  1.  L -^GMR(123,GMRCO)
  1.  ;
  1.  D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,$S(GMRCA=20:63,1:23),.GMRCADUZ,0)
  1.  ;
  1.  I $S(GMRCA=10:1,(GMRCA=4&($P(^GMR(123,GMRCO,0),U,12)=2)):1,1:0) D
  1.  . D EN^GMRCHL7($P(^GMR(123,GMRCO,0),"^",2),GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,GMRCAD)
  1.  K DIE,DR,DA,GMRCDT,GMRCNOW,GMRCAD,GMRCORNP,GMRCDUZ,GMRCRSLT,GMRCSTS,GMRCADUZ,GMRCORTX,GMRCDFN
  1.  Q GMRCERR_"^"_GMRCERMS
  1.  ;
  1. SCH(GMRCO,GMRCORNP,GMRCAD,GMRCADUZ,GMRCMT) ;schedule a consult API
  1.  ; Input variables:
  1.  ;GMRCO - The internal file number of the consult from File 123
  1.  ;GMRCORNP - Name of the person who actually 'Received' the consult
  1.  ;GMRCAD - Actual date time that consult was received into the service.
  1.  ;GMRCADUZ - array of alert recipients as chosen by user (by reference)
  1.  ;   ARRAY(DUZ)=""
  1.  ;GMRCMT - array of comments if entered (by reference)
  1.  ;   ARRAY(1)="FIRST LINE OF COMMENT"
  1.  ;   ARRAY(2)="SECOND LINE OF COMMENT"
  1.  ;
  1.  ;Output:
  1.  ;GMRCERR - Error Condition Code: 0 = NO error, 1=error
  1.  ;GMRCERMS - Error message or null
  1.  ;  returned as GMRCERR^GMRCERMS
  1.  ;
  1.  N DFN,GMRCSTS,GMRCNOW,GMRCERR,GMRCERMS
  1.  S GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
  1.  S:$G(GMRCAD)="" GMRCAD=GMRCNOW
  1.  S:'$G(GMRCDUZ) GMRCDUZ=DUZ
  1.  S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" D  Q GMRCERR_"^"_GMRCERMS
  1.  . S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found."
  1.  . D EXIT^GMRCGUIA
  1.  S GMRCSTS=8,GMRCA=8
  1.  D STATUS^GMRCP I $D(GMRCQUT) D EXIT^GMRCGUIA Q GMRCERR_"^"_GMRCERMS
  1.  I '$O(GMRCMT(0)) D AUDIT^GMRCP
  1.  I $O(GMRCMT(0)) D
  1.  . S DA=$$SETDA
  1.  . D SETCOM(.GMRCMT,GMRCDUZ)
  1.  D EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"","","",GMRCAD)
  1.  D  ;send alerts
  1.  . N TXT
  1.  . S TXT="Scheduled Consult: "_$$ORTX^GMRCAU(GMRCO)
  1.  . I $P(^GMR(123,+GMRCO,0),U,14) S GMRCADUZ($P(^(0),U,14))=""
  1.  . D MSG^GMRCP(DFN,TXT,GMRCO,63,.GMRCADUZ,0)
  1.  D EXIT^GMRCGUIA
  1.  Q GMRCERR_"^"_GMRCERMS
  1. DOCLIST(GMRCAR,GMRCDA,GMRCMED) ;return list of linked results
  1.  ; Input:
  1.  ;  GMRCAR - array to return list, passed by reference
  1.  ;  GMRCDA - ien from file 123
  1.  ;  GMRCMED- 1 = include med results; 0 = only TIU docs
  1.  ;
  1.  ; Output:
  1.  ;  GMRCAR - array in format
  1.  ;       GMRCAR(0)=zero node of record
  1.  ;       GMRCAR(50,1)="ien;global ref," e.g. 5;TIU(8925, or 3;MCAR(691,
  1.  ;       GMRCAR(50,2)="ien;global ref,"
  1.  ;
  1.  I '$D(^GMR(123,GMRCDA,0)) Q
  1.  S GMRCAR(0)=^GMR(123,GMRCDA,0),$P(GMRCAR(0),U,20)=""
  1.  N RES,CNT S RES="",CNT=1
  1.  F  S RES=$O(^GMR(123,GMRCDA,50,"B",RES)) Q:RES=""  D
  1.  . I '$G(GMRCMED) Q:RES'["TIU(8925"
  1.  . S GMRCAR(50,CNT)=RES
  1.  . I RES["MCAR" D
  1.  .. N ARR,STR
  1.  .. D MEDLKUP^MCARUTL3(.ARR,+$P(RES,"MCAR(",2),+RES)
  1.  .. I '+ARR K GMRCAR(50,CNT) Q
  1.  .. S STR=$P(ARR,U,9)_U_$P(ARR,U,6)_$S($P(ARR,U,10):"^^^^^^^^1",1:"")
  1.  .. S GMRCAR(50,CNT)=GMRCAR(50,CNT)_U_STR
  1.  . S CNT=CNT+1
  1.  Q