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

GMRCIAC1.m

Go to the documentation of this file. 
  1. GMRCIAC1 ;SLC/JFR - FILE IFC ACTIVITIES cont'd ;2/11/02 16:11
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
  1.  Q
  1. COMP(GMRCAR) ;process partial result, clin complete and admin complete
  1.  ;
  1.  N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,FDA
  1.  N GMRCRES,GMRCERR,GMRCSTS,GMRCREAS
  1.  M ^TMP("GMRCIN",$J)=@GMRCAR
  1.  S GMRCORC=^TMP("GMRCIN",$J,"ORC")
  1.  S GMRCREAS=$P($P(GMRCORC,"|",16),U)
  1.  S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
  1.  S GMRCSTS=$P(^GMR(123,GMRCDA,0),U,12)
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  ;
  1.  S GMRCFDA(8)=$S($P(GMRCORC,"|",5)="CM":2,GMRCSTS=2:2,1:9) ;comp or pr
  1.  S GMRCLAT=$S($P(GMRCORC,"|",5)="A":9,GMRCREAS="A":13,1:10)
  1.  S GMRCFDA(9)=GMRCLAT ;complete/upd or incomplete rpt
  1.  I $D(^TMP("GMRCIN",$J,"OBX",6,1)) D
  1.  . S GMRCFDA(15)=$P(^TMP("GMRCIN",$J,"OBX",6,1),"|",5)
  1.  ;     v-- check to see if a duplicate transmission
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC,$S(GMRCLAT=13:"",1:$G(^TMP("GMRCIN",$J,"OBX",4,1)))) Q
  1.  M FDA(1,123,GMRCDA_",")=GMRCFDA
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
  1.  ; check GMRCERR and act if error
  1.  K GMRCERR
  1.  K GMRCFDA,FDA
  1.  D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
  1.  ;     ^--- file result and activities
  1.  I $D(^TMP("GMRCIN",$J,"OBX",4,1)) D  ;file result if there
  1.  . I GMRCLAT=13 Q  ; addendum carries the result that it's addending
  1.  . I GMRCLAT=9 Q  ; don't file result on inc. report
  1.  . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q  ;no comp coming from placer
  1.  . D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCIN",$J,"OBX",4,1))
  1.  D  ;send notifications
  1.  . I GMRCLAT=9 Q
  1.  . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q  ;filler only gets historical comp
  1.  . N GMRCORTX S GMRCORTX=""
  1.  . I $O(^GMR(123,GMRCDA,51," "),-1)>1 D
  1.  .. S GMRCORTX="New remote result added to "
  1.  . I GMRCLAT=13 S GMRCORTX="Addendum added to "
  1.  . S GMRCORTX=GMRCORTX_"Remote Complete Consult: "_$$ORTX^GMRCAU(+GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
  1.  D  ;send appl ACK
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA")
  1.  ;
  1.  K ^TMP("GMRCIN",$J)
  1.  Q
  1.  ;
  1. FWD(GMRCAR)     ;file forward action from a remote site
  1.  ;Input:
  1.  ; GMRCAR = array name containing message 
  1.  ;      e.g.  ^TMP("GMRCIF",$J)
  1.  ;
  1.  N GMRCFDA,GMRCDA,GMRCFWSR,GMRCFROM,GMRCORC,GMRCTIFC,GMRCLAC,GMRCROL
  1.  M ^TMP("GMRCIN",$J)=@GMRCAR
  1.  I '$D(^TMP("GMRCIN",$J,"OBR")) Q
  1.  S GMRCORC=^TMP("GMRCIN",$J,"ORC")
  1.  S GMRCTIFC=$S($P($P(GMRCORC,"|",16),U)="F":0,1:1)
  1.  S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
  1.         . K ^TMP("GMRCIN",$J) Q
  1.  S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
  1.  I 'GMRCTIFC D
  1.  . S GMRCFDA(9)=17,GMRCLAC=17
  1.  . I GMRCROL="F" D  Q
  1.  .. S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
  1.  . S GMRCFDA(.131)=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
  1.  . S GMRCFROM=$P($G(^GMR(123,GMRCDA,13)),U)
  1.  I GMRCTIFC D
  1.  . S GMRCFROM=$P($P(^TMP("GMRCIN",$J,"OBR"),"|",4),U,2)
  1.  . S GMRCFDA(9)=25,GMRCLAC=25
  1.  ;
  1.  S GMRCFDA(8)=5
  1.  D  ;get urgency to file
  1.  . N URG
  1.  . S URG=$$URG^GMRCHL7A($P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6))
  1.  . S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
  1.  ;   v-- chk to see if activity is a dup transmission
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCORC) Q
  1.  ;
  1.  M FDA(1,123,GMRCDA_",")=GMRCFDA
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR")
  1.  K GMRCFDA
  1.  ;
  1.  ; file activity tracking
  1.  D FILEACT^GMRCIAC2(GMRCDA,GMRCLAC,GMRCFROM,$NA(^TMP("GMRCIN",$J)))
  1.  ;
  1.  ; send alerts
  1.  I GMRCROL="F" D
  1.  . I GMRCLAC'=25 Q  ; filler alerts only on FWD 2 IFC
  1.  . N GMRCTX
  1.  . S GMRCTX="New remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,27,,1)
  1.  . Q
  1.  I GMRCROL="P" D
  1.  . N GMRCTX
  1.  . S GMRCTX="Updated Remote Consult: "_$$ORTX^GMRCAU(GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,63,,1)
  1.  . Q
  1.  ;
  1.  ; print if FWD to IFC
  1.  I GMRCROL="F" D
  1.  . I GMRCLAC'=25 Q
  1.  . D PRNT^GMRCUTL1("",GMRCDA)
  1.  ;
  1.  D  ;send app. ACK and unlock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA")
  1.  K ^TMP("GMRCIN",$J)
  1.  Q
  1.  ;
  1. SF(GMRCAR) ;add significant findings
  1.  ; Input:
  1.  ; GMRCAR = array name containing message 
  1.  ;      e.g.  ^TMP("GMRCIF",$J)
  1.  ;
  1.  N FDA,GMRCERR,GMRCOSF,GMRCISF
  1.  M ^TMP("GMRCIS",$J)=@GMRCAR
  1.  I '$D(^TMP("GMRCIS",$J,"OBX",6,1)) Q  ;no SF flag sent  ;-(
  1.  S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIS",$J,"ORC"))
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  ;
  1.  S GMRCOSF=$P(^GMR(123,GMRCDA,0),U,19)
  1.  S GMRCISF=$P(^TMP("GMRCIS",$J,"OBX",6,1),"|",5)
  1.  S FDA(1,123,GMRCDA_",",15)=GMRCISF
  1.  S FDA(1,123,GMRCDA_",",9)=4
  1.  ;   v-- quit if a duplicate activity
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,4,^TMP("GMRCIS",$J,"ORC")) Q
  1.  ;
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and SF
  1.  D FILEACT^GMRCIAC2(GMRCDA,4,,$NA(^TMP("GMRCIS",$J))) ;activity track
  1.  D  ;send notifications
  1.  . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q  ;filler only gets hist. SF 
  1.  . N GMRCORTX
  1.  . S GMRCORTX=$S(GMRCISF="N":"No ",GMRCISF="Y":"",1:"Unknown ")
  1.  . S GMRCORTX=GMRCORTX_"Sig Findings for "_$$ORTX^GMRCAU(+GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,23,,1)
  1.  D  ;send appl ACK and unlock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA")
  1.  K ^TMP("GMRCIS",$J)
  1.  Q
  1.  ;
  1. RESUB(GMRCAR) ;resubmit a cancelled, remote consult
  1.  ; Input:
  1.  ;   GMRCAR - array name containing message 
  1.  ;      e.g.  ^TMP("GMRCIF",$J)
  1.  ;
  1.  K ^TMP("GMRCIN",$J)
  1.  M ^TMP("GMRCIN",$J)=@GMRCAR
  1.  N GMRCDA,GMRCFDA,FDA
  1.  S GMRCDA=$$GETDA^GMRCIAC2(^TMP("GMRCIN",$J,"ORC"))
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ; send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  ;
  1.  S GMRCFDA(8)=5,GMRCFDA(9)=11 ;status and last action
  1.  ;
  1.  I $D(^TMP("GMRCIN",$J,"OBR")) D  ; has INPATIENT or OUTPATIENT changed?
  1.  . N GMRCION
  1.  . S GMRCION=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
  1.  . I GMRCION'=$P(^GMR(123,GMRCDA,0),U,18) S GMRCFDA(14)=GMRCION
  1.  . Q
  1.  D  ; check for change in urgency
  1.  . N GMRCURG
  1.  . S GMRCURG=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",7),U,6)
  1.  . I '$L(GMRCURG) Q
  1.  . S GMRCURG=$$URG^GMRCHL7A(GMRCURG)
  1.  . S GMRCURG=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_GMRCURG)
  1.  . I GMRCURG'>1 Q
  1.  . I GMRCURG=$P(^GMR(123,GMRCDA,0),U,9) Q  ;no change
  1.  . S GMRCFDA(5)=GMRCURG
  1.  . Q
  1.  I $D(^TMP("GMRCIN",$J,"OBX",2)) D  ; change in Prov. DX?
  1.  . N PROVDX
  1.  . S PROVDX=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
  1.  . I '$L(PROVDX) Q
  1.  . I PROVDX=$G(^GMR(123,GMRCDA,30)) Q  ; no change
  1.  . S GMRCFDA(30)=PROVDX
  1.  . S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
  1.  . Q
  1.  ;   v-- QUIT if a duplicate transmission
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,11,^TMP("GMRCIN",$J,"ORC")) Q
  1.  ;
  1.  M FDA(1,123,GMRCDA_",")=GMRCFDA
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file edits
  1.  K GMRCFDA,FDA
  1.  ;
  1.  I $D(^TMP("GMRCIN",$J,"OBX",1)) D  ; reason for request change?
  1.  . D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
  1.  . N DIFF S DIFF=0
  1.  . D  I 'DIFF Q
  1.  .. I $O(^TMP("GMRCIN",$J,"OBX",1," "),-1)'=$O(^GMR(123,GMRCDA,20," "),-1) S DIFF=1 Q  ;  diff # of lines in new and existing
  1.  .. N LN S LN=0 F  S LN=$O(^GMR(123,GMRCDA,20,LN)) Q:'LN!(DIFF)  D
  1.  ... I $G(^GMR(123,GMRCDA,20,LN,0))=$G(^TMP("GMRCIN",$J,"OBX",1,LN)) Q
  1.  ... S DIFF=1 ;if the lines aren't the same, set DIFF and Q
  1.  . D WP^DIE(123,GMRCDA_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
  1.  . Q
  1.  D  ;file activity tracking
  1.  . D FILEACT^GMRCIAC2(GMRCDA,11,,$NA(^TMP("GMRCIN",$J)))
  1.  N GMRCNTIF
  1.  D  ;determine if part of a FWD to IFC
  1.  . I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 S GMRCNTIF=1 Q
  1.  . N ACT S ACT=1
  1.  . S GMRCNTIF=0
  1.  . F  S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($G(GMRCNTIF))  D
  1.  .. I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^(40,ACT)) S GMRCNTIF=1
  1.  ;
  1.  D  ;print SF-513 & send notifications
  1.  . I '$G(GMRCNTIF) Q  ;part of a FWD to IFC
  1.  . D PRNT^GMRCUTL1("",GMRCDA)
  1.  . N GMRCORTX
  1.  . S GMRCORTX="New remotely re-submitted consult "
  1.  . S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,27,,1)
  1.  ;
  1.  D  ;send appl ACK and unlock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA")
  1.  ;
  1.  K ^TMP("GMRCIN",$J)
  1.  Q
  1.  ;