- 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)=""
- 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)=""
