GMRCTIUP ;SLC/DCM,JFR - TIU/Consults UTILITIES; 4/4/01 15:01
;;3.0;CONSULT/REQUEST TRACKING;**4,13,15,17,22**;DEC 27, 1997
;
; This routine invokes IA #616,#2693
;
HDR(GMRCTUPR,GMRCGLB,COUNT,FROM) ;Get Source info for header of display
;and place data in ^TMP( global. Do Not Show Any Results
;GMRCTUPR=TIU record being sought
;GMRCGLOB=Global where data goes - i.e., ^TMP("GMRCR",$J,"RES",GMRCPTR,"ADD",GMRCADD,LINECT,0)
;COUNT=Count of where current line is to go in ^TMP( global
;FROM=flag to tell whether to add Addendum TIU # or not 0=NO, Otherwise addendum number
N DR,GMRCTMP
S:'$D(FROM) FROM=""
S DR=".01;.05;.07;.09;1201;1202;1204;1205;1208;1301;1302",GMRCERR=""
D EXTRACT^TIULQ(GMRCPTR,"LOCAL",.GMRCERR,DR)
S @GMRCGLB@(COUNT,0)="",COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)="Source Information",COUNT=COUNT+1,@GMRCGLB@(COUNT,0)=""
S @GMRCGLB@(COUNT,0)=" Document Status: "_LOCAL(GMRCPTR,.05,"E"),COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=" Entry Date: "_$P($G(LOCAL(GMRCPTR,1201,"E")),":",1,2),COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=" Visit: "_$G(LOCAL(GMRCPTR,.07,"E"))_" "_$G(LOCAL(GMRCPTR,1205,"E"))
S COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=" Author: "_LOCAL(GMRCPTR,1202,"E")
S COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=" Expected Signer: "_$E(LOCAL(GMRCPTR,1204,"E")_TAB,1,22)_$E(TAB,1,5)_"Expected Cosigner: "_$S($L($G(LOCAL(GMRCPTR,1208,"E"))):LOCAL(GMRCPTR,1208,"E"),1:"None"),COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=" Entered By: "_$E(LOCAL(GMRCPTR,1302,"E")_TAB,1,30)_"TIU Document #: "_GMRCTUPR,COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)=$S(+FROM:" TIU Addendum Document #: "_FROM,1:"")_$S(+FROM:$E(TAB,1,10),1:" ")_" Urgency: "_$S($L($G(LOCAL(GMRCPTR,.09,"E"))):LOCAL(GMRCPTR,.09,"E"),1:"None"),COUNT=COUNT+1
S @GMRCGLB@(COUNT,0)="",COUNT=COUNT+1
K LOCAL
Q
PRINT(GMRCO,LINECT,GMRCRT,GMRCDET) ;get TIU results and prepare for the SF-513
;GMRCRT=Flag from RT^GMRCA1 indicating that result request is from there
; GMRCRT=0 means 'NO',
; GMRCRT=1 means 'YES" (and ES is appended to TIU main result); also,
; No result is passed back to print on the 513 if GMRCRT=0.
;GMRCTUFN=IEN of the TIU result from file 8925
;GMRCSIG=signature block name of signer : GMRCSDT=date result was signed
;GMRCSIGT=signers block title : GMRCTUFN=TIU IEN of the result record
;GMRCCSIG=cosigners block name : GMRCCSDT=date cosigner signed
;GMRCCTIT=cosigners block title : GMRCSIGM=Signature mode (E:ELECTRONIC/C:CHART)
;I GMRCDET=1 coming from a detailed display not results display
N GMRCTUFN,TAB,GLOBAL
S:'$D(GMRCRT) GMRCRT=0 S:'$D(GMRCDET) GMRCDET=0
D GETRSLTS(GMRCO,.GMRCAR) ;I $D(GMRCQUT) D:$D(GMRCMSG) EXAC^GMRCADC(GMRCMSG) K GMRCMSG,GMRCRT Q
S GLOBAL="^TMP(""GMRCR"",$J,""GMRCTIU"")",TAB="",$P(TAB," ",31)=""
K ^TMP("GMRCR",$J,"RES"),^TMP("GMRCR",$J,"MCAR")
S (GMRCND,GMRCPTR)="" F K @GLOBAL S GMRCND=$O(GMRCAR(GMRCND)) Q:GMRCND="" S GMRCPKG=$P(GMRCND,";",2),GMRCPTR=$P(GMRCND,";",1) D
.I $E(GMRCPKG,1,3)="TIU" D
.. N GMRCTXT,GMRCPAR,GMRCACTN
.. D EXTRACT^TIULQ(GMRCPTR,"GMRCPAR",.GMRCERR,.06,"I")
.. I $D(GMRCAR(+$G(GMRCPAR(GMRCPTR,.06,"I"))_";TIU(8925,")) Q
.. S GMRCACTN=$S($G(GMRCRT):"VIEW",1:"PRINT RECORD")
.. D TGET^TIUSRVR1(.GMRCTXT,+GMRCPTR,GMRCACTN)
.. I $D(@(GMRCTXT)) M @GLOBAL@(GMRCPTR,"TEXT")=@GMRCTXT
.. K @GMRCTXT
.. I $O(@GLOBAL@(GMRCPTR,"TEXT",0)) D
...S ND=0 F S ND=$O(@GLOBAL@(GMRCPTR,"TEXT",ND)) Q:ND="" D
....S ^TMP("GMRCR",$J,"RES",GMRCPTR,"TEXT",LINECT,0)=@GLOBAL@(GMRCPTR,"TEXT",ND)
....S LINECT=LINECT+1
..Q
.I $E(GMRCPKG,1,4)="MCAR" S GMRCSR=GMRCND,MCFILE=$P(GMRCSR,";",2),MCFILE=$P(MCFILE,","),MCPROC=$O(^MCAR(697.2,"C",MCFILE,"")) Q:'MCPROC D
..S GMRCPRNM=$P(^MCAR(697.2,MCPROC,0),"^",8),ORIFN=$P(^GMR(123,GMRCO,0),"^",3),ORACTION=8,MCGLOBAL="^TMP(""GMRCR"",$J,""MCAR"","_GMRCPTR_")"
..D EN^GMRCTIU3(GMRCO,ORIFN,MCGLOBAL,LINECT) K ^TMP("MC",$J)
..Q
.Q
; inter-facility remote results
I 'GMRCDET,$O(^GMR(123,GMRCO,51,0)) D
.N GMRCTMP S GMRCTMP="^TMP(""GMRCR"",$J,""RRES"")" K @GMRCTMP
.S GLOBAL="^TMP(""GMRCR"",$J,""GMRCRRES"")" K @GLOBAL
.D GETREMOT^GMRCART(GMRCO,GMRCTMP,LINECT)
.I $D(@(GMRCTMP)) M @GLOBAL@(.5,"TEXT")=@GMRCTMP K @GMRCTMP
.I $O(@GLOBAL@(.5,"TEXT",0)) D
..S ND=0 F S ND=$O(@GLOBAL@(.5,"TEXT",ND)) Q:ND="" D
...S ^TMP("GMRCR",$J,"RES",.5,"TEXT",LINECT,0)=@GLOBAL@(.5,"TEXT",ND,0)
...S LINECT=LINECT+1
.Q
K DR,GLOBAL,GMRCSR,GMRCAR,GMRCPKG,GMRCPRNM,MCFILE,MCPROC,ORACTION,ORIFN,MCGLOBAL,ND,ND1,GMRCND,GMRCPTR
Q
GETNOTE(GMRCO,FILE) ;Get the last result added to the record - this is found in $P(^(0),"^",20)
;Function returns last note added to record.
;If it does not contain the file pointer, it is assumed that
;it pointed to the TIU file 8925
;GMRCO=file 123 IEN
;FILE='MCAR' to get last medicine result pointer
;FILE='TIU' to get last TIU result pointer
N X,RSLT
S RSLT=999999,X=""
F S RSLT=$O(^GMR(123,+GMRCO,50,RSLT),-1) Q:'RSLT D Q:+X
. I $G(^GMR(123,+GMRCO,50,RSLT,0))[FILE S X=^GMR(123,+GMRCO,50,RSLT,0)
Q X
GETRSLTS(GMRCO,ARRAY) ;Get the results from record and return it in array 'ARRAY')
;Looks for results in $P(^(0),"^",20),$P(^(0),"^",15) and Field 50 multiple
;GMRCO=File 123 IEN
;ARRAY=array to return results pointers in
;ARRAY will be returned as ARRAY("IEN;FILE"), as e.g., "1289;^TIU(8925,"
N X
S X=$$GETNOTE(GMRCO,"TIU") I $L(X) S:$P(X,";",2)="" X=X_";TIU(8925," S ARRAY(X)=""
S X=$$GETNOTE(GMRCO,"MCAR") I $L(X) S ARRAY(X)=""
S X="" F S X=$O(^GMR(123,GMRCO,50,"B",X)) Q:X?1A.E!(X="") S ARRAY(X)=""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCTIUP 5580 printed Apr 09, 2024@20:52:49 Page 2
GMRCTIUP ;SLC/DCM,JFR - TIU/Consults UTILITIES; 4/4/01 15:01
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,15,17,22**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #616,#2693
+4 ;
HDR(GMRCTUPR,GMRCGLB,COUNT,FROM) ;Get Source info for header of display
+1 ;and place data in ^TMP( global. Do Not Show Any Results
+2 ;GMRCTUPR=TIU record being sought
+3 ;GMRCGLOB=Global where data goes - i.e., ^TMP("GMRCR",$J,"RES",GMRCPTR,"ADD",GMRCADD,LINECT,0)
+4 ;COUNT=Count of where current line is to go in ^TMP( global
+5 ;FROM=flag to tell whether to add Addendum TIU # or not 0=NO, Otherwise addendum number
+6 NEW DR,GMRCTMP
+7 if '$DATA(FROM)
SET FROM=""
+8 SET DR=".01;.05;.07;.09;1201;1202;1204;1205;1208;1301;1302"
SET GMRCERR=""
+9 DO EXTRACT^TIULQ(GMRCPTR,"LOCAL",.GMRCERR,DR)
+10 SET @GMRCGLB@(COUNT,0)=""
SET COUNT=COUNT+1
+11 SET @GMRCGLB@(COUNT,0)="Source Information"
SET COUNT=COUNT+1
SET @GMRCGLB@(COUNT,0)=""
+12 SET @GMRCGLB@(COUNT,0)=" Document Status: "_LOCAL(GMRCPTR,.05,"E")
SET COUNT=COUNT+1
+13 SET @GMRCGLB@(COUNT,0)=" Entry Date: "_$PIECE($GET(LOCAL(GMRCPTR,1201,"E")),":",1,2)
SET COUNT=COUNT+1
+14 SET @GMRCGLB@(COUNT,0)=" Visit: "_$GET(LOCAL(GMRCPTR,.07,"E"))_" "_$GET(LOCAL(GMRCPTR,1205,"E"))
+15 SET COUNT=COUNT+1
+16 SET @GMRCGLB@(COUNT,0)=" Author: "_LOCAL(GMRCPTR,1202,"E")
+17 SET COUNT=COUNT+1
+18 SET @GMRCGLB@(COUNT,0)=" Expected Signer: "_$EXTRACT(LOCAL(GMRCPTR,1204,"E")_TAB,1,22)_$EXTRACT(TAB,1,5)_"Expected Cosigner: "_$SELECT($LENGTH($GET(LOCAL(GMRCPTR,1208,"E"))):LOCAL(GMRCPTR,1208,"E"),1:"None")
SET COUNT=COUNT+1
+19 SET @GMRCGLB@(COUNT,0)=" Entered By: "_$EXTRACT(LOCAL(GMRCPTR,1302,"E")_TAB,1,30)_"TIU Document #: "_GMRCTUPR
SET COUNT=COUNT+1
+20 SET @GMRCGLB@(COUNT,0)=$SELECT(+FROM:" TIU Addendum Document #: "_FROM,1:"")_$SELECT(+FROM:$EXTRACT(TAB,1,10),1:" ")_" Urgency: "_$SELECT($LENGTH($GET(LOCAL(GMRCPTR,.09,"E"))):LOCAL(GMRCPTR,.09,"E"),1:"None")
SET COUNT=COUNT+1
+21 SET @GMRCGLB@(COUNT,0)=""
SET COUNT=COUNT+1
+22 KILL LOCAL
+23 QUIT
PRINT(GMRCO,LINECT,GMRCRT,GMRCDET) ;get TIU results and prepare for the SF-513
+1 ;GMRCRT=Flag from RT^GMRCA1 indicating that result request is from there
+2 ; GMRCRT=0 means 'NO',
+3 ; GMRCRT=1 means 'YES" (and ES is appended to TIU main result); also,
+4 ; No result is passed back to print on the 513 if GMRCRT=0.
+5 ;GMRCTUFN=IEN of the TIU result from file 8925
+6 ;GMRCSIG=signature block name of signer : GMRCSDT=date result was signed
+7 ;GMRCSIGT=signers block title : GMRCTUFN=TIU IEN of the result record
+8 ;GMRCCSIG=cosigners block name : GMRCCSDT=date cosigner signed
+9 ;GMRCCTIT=cosigners block title : GMRCSIGM=Signature mode (E:ELECTRONIC/C:CHART)
+10 ;I GMRCDET=1 coming from a detailed display not results display
+11 NEW GMRCTUFN,TAB,GLOBAL
+12 if '$DATA(GMRCRT)
SET GMRCRT=0
if '$DATA(GMRCDET)
SET GMRCDET=0
+13 ;I $D(GMRCQUT) D:$D(GMRCMSG) EXAC^GMRCADC(GMRCMSG) K GMRCMSG,GMRCRT Q
DO GETRSLTS(GMRCO,.GMRCAR)
+14 SET GLOBAL="^TMP(""GMRCR"",$J,""GMRCTIU"")"
SET TAB=""
SET $PIECE(TAB," ",31)=""
+15 KILL ^TMP("GMRCR",$JOB,"RES"),^TMP("GMRCR",$JOB,"MCAR")
+16 SET (GMRCND,GMRCPTR)=""
FOR
KILL @GLOBAL
SET GMRCND=$ORDER(GMRCAR(GMRCND))
if GMRCND=""
QUIT
SET GMRCPKG=$PIECE(GMRCND,";",2)
SET GMRCPTR=$PIECE(GMRCND,";",1)
Begin DoDot:1
+17 IF $EXTRACT(GMRCPKG,1,3)="TIU"
Begin DoDot:2
+18 NEW GMRCTXT,GMRCPAR,GMRCACTN
+19 DO EXTRACT^TIULQ(GMRCPTR,"GMRCPAR",.GMRCERR,.06,"I")
+20 IF $DATA(GMRCAR(+$GET(GMRCPAR(GMRCPTR,.06,"I"))_";TIU(8925,"))
QUIT
+21 SET GMRCACTN=$SELECT($GET(GMRCRT):"VIEW",1:"PRINT RECORD")
+22 DO TGET^TIUSRVR1(.GMRCTXT,+GMRCPTR,GMRCACTN)
+23 IF $DATA(@(GMRCTXT))
MERGE @GLOBAL@(GMRCPTR,"TEXT")=@GMRCTXT
+24 KILL @GMRCTXT
+25 IF $ORDER(@GLOBAL@(GMRCPTR,"TEXT",0))
Begin DoDot:3
+26 SET ND=0
FOR
SET ND=$ORDER(@GLOBAL@(GMRCPTR,"TEXT",ND))
if ND=""
QUIT
Begin DoDot:4
+27 SET ^TMP("GMRCR",$JOB,"RES",GMRCPTR,"TEXT",LINECT,0)=@GLOBAL@(GMRCPTR,"TEXT",ND)
+28 SET LINECT=LINECT+1
End DoDot:4
End DoDot:3
+29 QUIT
End DoDot:2
+30 IF $EXTRACT(GMRCPKG,1,4)="MCAR"
SET GMRCSR=GMRCND
SET MCFILE=$PIECE(GMRCSR,";",2)
SET MCFILE=$PIECE(MCFILE,",")
SET MCPROC=$ORDER(^MCAR(697.2,"C",MCFILE,""))
if 'MCPROC
QUIT
Begin DoDot:2
+31 SET GMRCPRNM=$PIECE(^MCAR(697.2,MCPROC,0),"^",8)
SET ORIFN=$PIECE(^GMR(123,GMRCO,0),"^",3)
SET ORACTION=8
SET MCGLOBAL="^TMP(""GMRCR"",$J,""MCAR"","_GMRCPTR_")"
+32 DO EN^GMRCTIU3(GMRCO,ORIFN,MCGLOBAL,LINECT)
KILL ^TMP("MC",$JOB)
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 ; inter-facility remote results
+36 IF 'GMRCDET
IF $ORDER(^GMR(123,GMRCO,51,0))
Begin DoDot:1
+37 NEW GMRCTMP
SET GMRCTMP="^TMP(""GMRCR"",$J,""RRES"")"
KILL @GMRCTMP
+38 SET GLOBAL="^TMP(""GMRCR"",$J,""GMRCRRES"")"
KILL @GLOBAL
+39 DO GETREMOT^GMRCART(GMRCO,GMRCTMP,LINECT)
+40 IF $DATA(@(GMRCTMP))
MERGE @GLOBAL@(.5,"TEXT")=@GMRCTMP
KILL @GMRCTMP
+41 IF $ORDER(@GLOBAL@(.5,"TEXT",0))
Begin DoDot:2
+42 SET ND=0
FOR
SET ND=$ORDER(@GLOBAL@(.5,"TEXT",ND))
if ND=""
QUIT
Begin DoDot:3
+43 SET ^TMP("GMRCR",$JOB,"RES",.5,"TEXT",LINECT,0)=@GLOBAL@(.5,"TEXT",ND,0)
+44 SET LINECT=LINECT+1
End DoDot:3
End DoDot:2
+45 QUIT
End DoDot:1
+46 KILL DR,GLOBAL,GMRCSR,GMRCAR,GMRCPKG,GMRCPRNM,MCFILE,MCPROC,ORACTION,ORIFN,MCGLOBAL,ND,ND1,GMRCND,GMRCPTR
+47 QUIT
GETNOTE(GMRCO,FILE) ;Get the last result added to the record - this is found in $P(^(0),"^",20)
+1 ;Function returns last note added to record.
+2 ;If it does not contain the file pointer, it is assumed that
+3 ;it pointed to the TIU file 8925
+4 ;GMRCO=file 123 IEN
+5 ;FILE='MCAR' to get last medicine result pointer
+6 ;FILE='TIU' to get last TIU result pointer
+7 NEW X,RSLT
+8 SET RSLT=999999
SET X=""
+9 FOR
SET RSLT=$ORDER(^GMR(123,+GMRCO,50,RSLT),-1)
if 'RSLT
QUIT
Begin DoDot:1
+10 IF $GET(^GMR(123,+GMRCO,50,RSLT,0))[FILE
SET X=^GMR(123,+GMRCO,50,RSLT,0)
End DoDot:1
if +X
QUIT
+11 QUIT X
GETRSLTS(GMRCO,ARRAY) ;Get the results from record and return it in array 'ARRAY')
+1 ;Looks for results in $P(^(0),"^",20),$P(^(0),"^",15) and Field 50 multiple
+2 ;GMRCO=File 123 IEN
+3 ;ARRAY=array to return results pointers in
+4 ;ARRAY will be returned as ARRAY("IEN;FILE"), as e.g., "1289;^TIU(8925,"
+5 NEW X
+6 SET X=$$GETNOTE(GMRCO,"TIU")
IF $LENGTH(X)
if $PIECE(X,";",2)=""
SET X=X_";TIU(8925,"
SET ARRAY(X)=""
+7 SET X=$$GETNOTE(GMRCO,"MCAR")
IF $LENGTH(X)
SET ARRAY(X)=""
+8 SET X=""
FOR
SET X=$ORDER(^GMR(123,GMRCO,50,"B",X))
if X?1A.E!(X="")
QUIT
SET ARRAY(X)=""
