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

GMRCP5A.m

Go to the documentation of this file. 
  1. GMRCP5A ;SLC/DCM,RJS,MA - Print Consult form 513 (Gather Data - TIU Results) ;4/18/01  10:29
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,21,22,53**;Dec 27, 1997;Build 3
  1.  ; Patch #21 added PRNTAUDT to this routine.
  1.  ;
  1. PRNT(GMRCIFN,TIUFLG,GMRCQUED,GMRCCPY,GMRCGUI,GMRCAUDT) ;
  1.  ;
  1.  ; Input Arguments:
  1.  ;
  1.  ;  GMRCIFN: IEN of the Consult/Request in file 123
  1.  ;   TIUFLG: Called from TIU ?  1=yes 0=no
  1.  ; GMRCQUED: Queued job ?  1=yes 0=no
  1.  ;  GMRCCPY: Chart Copy ? C=Chart Copy  W=Working Copy  null=Not Applicable
  1.  ;  GMRCGUI: Called from the GUI. (Only produce output in a formatted global.)
  1.  ; GMRCAUDT:  Set to 1 in GMRCUTL1 if NW or DC consult.
  1.  ; ZTIO:      Output device when job is tasked
  1.  ;
  1.  N GMRCSIG,GMRCSDT,GMRCCSIG,GMRCSIGT,GMRCADDS
  1.  I '+$G(IOM) S IOM=80
  1.  ;
  1.  I GMRCGUI D  Q
  1.  . D FORMAT(80)
  1.  . D ASSMBL^GMRCP5C(GMRCGUI,80)
  1.  . F GMRCX="GMRCTIU","RES","MCAR" K ^TMP("GMRCR",$J,GMRCX)
  1.  . K ^TMP("GMRC",$J,"OUTPUT")
  1.  . Q
  1.  ;
  1.  I 'TIUFLG,'GMRCQUED W @IOF I '$$CRT^GMRCP5C,$L($G(IO(0))),'(IO=IO(0)) U IO(0) W !,"PRINTING... "
  1.  ;
  1.  D FORMAT(IOM),ASSMBL^GMRCP5C(IOSL,IOM)
  1.  U IO
  1.  D PRINT^GMRCP5C(IOSL,IOM)
  1.  ;
  1.  I 'TIUFLG,'$$CRT^GMRCP5C U IO(0) D ^%ZISC
  1.  ;
  1.  I $G(GMRCQUED),$G(ZTSK) D KILL^%ZTLOAD
  1.  ;
  1.  F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
  1.  F GMRCX="GMRCTIU","RES","MCAR" K ^TMP("GMRCR",$J,GMRCX)
  1.  ; If print device (ZTIO) do PRNTAUDT unless there is no GMRCAUDT
  1.  ; GMRCAUDT=1 means print for NW or DC consult
  1.  I $D(ZTIO),$D(GMRCAUDT) D PRNTAUDT(GMRCIFN,ZTIO,GMRCAUDT)
  1.  Q
  1.  ;
  1. PRNTAUDT(GMRCIFN,ZTIO,GMRCAUDT) ; Update the last activity field in 123 and
  1.  ; Processing Activity multiple
  1.  ; Update the activity log to reflect "Printed To:" and the printer
  1.  ; GMRCAUDT=1 indicates the consult is NW or Discontinued
  1.  ; and it should update the audit trail.
  1.  I $G(GMRCAUDT)'=1 K GMRCAUDT  Q
  1.  N GMRCOM,GMRCORNP,GMRCFF,GMRCPA,GMRCAD,GMRCA,DA,DIE
  1.  S GMRCA=22
  1.  S GMRCO=GMRCIFN,GMRCDEV=ZTIO
  1.  S DIE="^GMR(123,",DA=+GMRCO,DR="9////^S X=GMRCA"
  1.  L +^GMR(123,GMRCO):5
  1.  D ^DIE
  1.  L -^GMR(123,GMRCO)
  1.  ;Update activity other than HL7 original msg received
  1.  D AUDIT^GMRCP
  1.  KILL GMRCO,GMRCA,GMRCDEV
  1.  Q
  1.  ;
  1. FORMAT(PAGEWID) ;
  1.  ;
  1.  N %I,CMT,COUNT,D0,DFN,DIC,DIQ2,DR,GLOBAL,GMRC400,GMRCADD,GMRCADDT,GMRCAGE,GMRCCSDT
  1.  N GMRCCTIT,GMRCDFN,GMRCDOB,GMRCDVL,GMRCELIG,GMRCEQL,GMRCERR,GMRCFAC,GMRCFP
  1.  N GMRCFTR,GMRCIPH,GMRCINO,GMRCIRL,GMRCLAST,GMRCMODE,GMRCND,GMRCNDX,GMRCNT,GMRCPG,GMRCPGR,GMRCPNM,GMRCPRNM
  1.  N GMRCPTR,GMRCQSTR,GMRCQSTT,GMRCR0,GMRCR1,GMRCR2,GMRCRB,GMRCRD,GMRCRPT,GMRCSG,GMRCSGAD,GMRCSIGM
  1.  N GMRCSN,GMRCSR,GMRCSVC,GMRCTO,GMRCUL,GMRCWARD,GMRCWLI,GMRCX,LN,MCFILE,MCPROC
  1.  N ND,ND1,ND2,NDS,ORACTION,SEX,TAB,X,Y
  1.  ;
  1.  S GMRCFTR=13,GMRCFP=0,GMRCPG=0
  1.  S GMRCRD=$G(^GMR(123,GMRCIFN,0)),(DFN,GMRCDFN)=$P(GMRCRD,U,2)
  1.  Q:'(DFN)
  1.  D ELIG^VADPT S GMRCELIG=$P(VAEL(6),U,2) K VAEL
  1.  S GMRCDVL="",$P(GMRCDVL,"-",PAGEWID+1)=""
  1.  S GMRCEQL="",$P(GMRCEQL,"=",PAGEWID+1)=""
  1.  S GMRCUL="",$P(GMRCUL,"_",40)=""
  1.  S DFN=GMRCDFN D DEM^GMRCU
  1.  ;
  1.  S GMRCFAC=+$P(GMRCRD,U,21)
  1.  I 'GMRCFAC S GMRCFAC=+$G(DUZ(2))
  1.  I 'GMRCFAC S GMRCFAC=+$$SITE^VASITE()
  1.  I +GMRCFAC S GMRCFAC=$$GET1^DIQ(4,+GMRCFAC,.01)
  1.  E  S GMRCFAC="" Q
  1.  ;
  1.  ; get inter-facility consult info
  1.  I $P(GMRCRD,U,23) D
  1.  .S GMRCINO=$P(GMRCRD,U,22)
  1.  .S GMRCRD(12)=$G(^GMR(123,GMRCIFN,12))
  1.  .S GMRCRD(13)=$G(^GMR(123,GMRCIFN,13))
  1.  .S GMRCIRL=$S($P(GMRCRD(12),U,5)="P":"Requesting facility",$P(GMRCRD(12),U,5)="F":"Consulting facility",1:"")
  1.  ;Commented out following line to allow TIU doc to print based on ASU
  1.  ;rules.
  1.  ;I $P(GMRCRD,U,12)=2!(TIUFLG) D
  1.  D PRINT^GMRCTIUP(GMRCIFN,0,0) ;Removed dot structure
  1.  ;
  1.  K GMRCSG I $D(^TMP("GMRCR",$J,"RES")) D
  1.  .;
  1.  .S GMRCR0=0 F  Q:$D(GMRCSG)  S GMRCR0=$O(^TMP("GMRCR",$J,"RES",GMRCR0)) Q:'GMRCR0  D
  1.  ..F GMRCV="GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT" S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCV))
  1.  ..Q:'$L($G(GMRCSIG))
  1.  ..F GMRCV="GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT" S GMRCSG(GMRCV)=@GMRCV
  1.  ;
  1.  D INIT^GMRCP5B(.GMRCSG) ; Build Header, Footer, Request, and Primary Diagnosis Segments
  1.  ;
  1.  I $L($G(GMRCCPY)) D
  1.  .D BLD("RES",1,1,0,$$CENTER($S(GMRCCPY="C":"C H A R T   C O P Y",1:"W O R K I N G   C O P Y")))
  1.  I ($P(GMRCRD,U,19)="Y") D
  1.  .D BLD("RES",1,1,0,$$CENTER("******* Significant Findings *******"))
  1.  I ($P(GMRCRD,U,19)="N") D
  1.  .D BLD("RES",1,1,0,$$CENTER("******* No Significant Findings *******"))
  1.  I ($P(GMRCRD,U,19)="U") D
  1.  .D BLD("RES",1,1,0,$$CENTER("******* Unknown Significant Findings *******"))
  1.  ;
  1.  I $P(GMRCRD,U,12)=1  D 
  1.  . D BLD("RES",1,2,0,$$CENTER("**** REQUEST CANCELLED    REQUEST CANCELLED ****"))
  1.  I '$D(^TMP("GMRCR",$J,"RES")),'$D(^("MCAR")) D
  1.  .I $L($G(GMRCRPT)) D BLD("RES",1,2,0,$$CENTER(" No Consultation Results for "_GMRCRPT_" available."))
  1.  .I '$L($G(GMRCRPT)) D BLD("RES",1,2,0,$$CENTER(" No Consultation Results available."))
  1.  ;
  1.  I $D(^TMP("GMRCR",$J,"RES")) D
  1.  .;
  1.  .S (GMRCNT,GMRCR0)=0 F  S GMRCR0=$O(^TMP("GMRCR",$J,"RES",GMRCR0)) Q:'GMRCR0  D
  1.  ..N GMRCCSDT,GMRCCSGM,GMRCCSIG,GMRCCTIT,GMRCRPT,GMRCSDT
  1.  ..N GMRCSIG,GMRCSIGM,GMRCSIGT,GMRCV,GMRCENT,GMRCVIS,GMRCVLOC,GMRCNODT
  1.  ..;
  1.  ..F GMRCV="GMRCCSDT","GMRCCSGM","GMRCCSIG","GMRCCTIT","GMRCRPT","GMRCSDT","GMRCSIG","GMRCSIGM","GMRCSIGT","GMRCVIS","GMRCENT","GMRCVLOC","GMRCNODT" D
  1.  ...S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCV))
  1.  ..;
  1.  ..S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1
  1.  ..I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Consultation Results "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"for "_GMRCRPT_" continued.")
  1.  ..I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Consultation Results "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"continued.")
  1.  ..D SUB("H","RES",GMRCNDX," ")
  1.  ..I $L($G(GMRCSIG)) D
  1.  ...D SUB("F","RES",GMRCNDX," ")
  1.  ...I (GMRCSIGM="electronic") S GMRCX=" Results Signature: "_GMRCSIG_" /es/ "_$$EXDT($G(GMRCSDT))
  1.  ...I '(GMRCSIGM="electronic") S GMRCX=" Results Signature: "_GMRCSIG_" /chart/ " S:$L($G(GMRCSDT)) GMRCX=GMRCX_$$EXDT(GMRCSDT)
  1.  ...D SUB("F","RES",GMRCNDX,GMRCX)
  1.  ...D:$L($G(GMRCSIGT)) SUB("F","RES",GMRCNDX,"                    "_GMRCSIGT)
  1.  ..I $L($G(GMRCCSIG)) D
  1.  ...D SUB("F","RES",GMRCNDX," ")
  1.  ...I (GMRCCSGM="electronic") S GMRCX=" Results CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT($G(GMRCCSDT))
  1.  ...I '(GMRCCSGM="electronic") S GMRCX=" Results CoSignature: "_GMRCCSIG_" /chart/ " S:$L($G(GMRCCSDT)) GMRCX=GMRCX_$$EXDT(GMRCCSDT)
  1.  ...D SUB("F","RES",GMRCNDX,GMRCX)
  1.  ...D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX,"                      "_GMRCCTIT)
  1.  ..;extra signers
  1.  .. I $D(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA")) D
  1.  ... D SUB("F","RES",GMRCNDX," ")
  1.  ... D SUB("F","RES",GMRCNDX," Receipt acknowledged by: ")
  1.  ... N XTRA S XTRA=0 F  S XTRA=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA)) Q:'XTRA  D
  1.  .... D SUB("F","RES",GMRCNDX,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA,0))
  1.  .... D SUB("F","RES",GMRCNDX,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","GMRCXTRA",XTRA,1))
  1.  ..;
  1.  ..D BLD("RES",GMRCNDX,1,0," ")
  1.  ..I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("CONSULTATION NOTE "_$S(GMRCR0=.5:"",1:"#"_GMRCR0_" ")_"FOR "_GMRCRPT))
  1.  ..I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("CONSULTATION NOTE "_$S(GMRCR0=.5:"",1:"#"_GMRCR0)))
  1.  ..D BLD("RES",GMRCNDX,1,0," ")
  1.  ..I $L($G(GMRCENT)) D
  1.  ...S GMRCX="         Entry Date: "_$$EXDT($G(GMRCENT))
  1.  ...D BLD("RES",GMRCNDX,1,0,GMRCX)
  1.  ..I $L($G(GMRCNODT)) D
  1.  ...Q:$$EXDT($G(GMRCNODT))=$$EXDT($G(GMRCENT)) 
  1.  ...S GMRCX="Date/Time of result: "_$$EXDT($G(GMRCNODT))
  1.  ...D BLD("RES",GMRCNDX,1,0,GMRCX)
  1.  ..I $L($G(GMRCVIS)) D
  1.  ...S GMRCX="              Visit: "_$$EXDT($G(GMRCVIS))
  1.  ...I $L($G(GMRCVLOC)) S GMRCX=GMRCX_"   "_GMRCVLOC
  1.  ...D BLD("RES",GMRCNDX,1,0,GMRCX)
  1.  ..I $L($G(GMRCVLOC)) S GMRCX=GMRCVLOC
  1.  ..D BLD("RES",GMRCNDX,1,0," ")
  1.  ..I $D(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",0,0)) D  I 1
  1.  ...D BLD("RES",GMRCNDX,1,0,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",0,0))
  1.  ..E  I '$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT","")) D
  1.  ...D BLD("RES",1,1,0,$$CENTER("CONSULTATION NOTE TEXT NOT AVAILABLE"))
  1.  ..S GMRCR1=0 F  S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCR1)) Q:'GMRCR1  D
  1.  ...D BLD("RES",GMRCNDX,1,0,^TMP("GMRCR",$J,"RES",GMRCR0,"TEXT",GMRCR1,0))
  1.  ..;
  1.  ..;  GET ADDENDUMS TO THIS NOTE
  1.  ..;
  1.  ..I +$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",0)) D ADDEND^GMRCP5D(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID)
  1.  ;
  1.  D FORMAT^GMRCP5D(GMRCIFN,GMRCRD,PAGEWID) ;  GET SERVICE REPORTS AND COMMENTS
  1.  ;
  1.  Q
  1.  ;
  1. EXDT(X) ;EXTERNAL DATE FORMAT
  1.  ;
  1.  N DATE,TIME,HR,MN,PD,Y,%DT
  1.  Q:'$L(X) ""
  1.  I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
  1.  Q $$FMTE^XLFDT(X,"5PMZ")
  1.  ;
  1. CENTER(X) ;
  1.  ;
  1.  N TEXT,COL
  1.  S COL=35-($L(X)\2) Q:(COL<1) X
  1.  S $E(TEXT,COL)=X
  1.  Q TEXT
  1.  ;
  1. BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
  1.  ;
  1.  Q:'$L($G(SUB))
  1.  N LINECNT
  1.  ;
  1.  F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
  1.  ;
  1.  S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
  1.  I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
  1.  ;
  1.  S GMRCLAST=SUB
  1.  Q
  1.  ;
  1. SUB(ZONE,SUB,NDX,TEXT) ;
  1.  ;
  1.  N NEXT
  1.  S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
  1.  S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
  1.  Q
  1.  ;
  1. LASTLN(SUB,NDX) ;
  1.  Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
  1.  ;