BQIPTLNK ;VNGT/HS/ALA-Get patient record via Link ; 24 Apr 2009 10:42 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
EN(DATA,LINK) ; EP -- BQI GET LINK RECORD
;
;Description
; Returns a record for a patient's visit or problem or whatever type of data record
;Input
; LINK - File Number:Record Internal Entry Number
;
NEW UID,II,FILE,RECIEN,TEXT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQILINK",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTLNK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I $G(LINK)="" D HDR G DONE
S FILE=$P(LINK,":",1),RECIEN=$P(LINK,":",2)
I FILE=9000010 D GET^BQIPTVST(.DATA,RECIEN) Q
D OTH
;I FILE=9000011 D EN^BQIRPL(.DATA,"","",RECIEN)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
OTH ;
D HDR
;
I $$TMPFL^BQIUL1("W",UID,RECIEN) G DONE
;
S IOSL=999,IOM=80,IOST="P-OTHER80"
;
U IO
S DIC=$$ROOT^DILFD(FILE),DA=RECIEN
D EN^DIQ
U IO W $C(9)
;
I $$TMPFL^BQIUL1("C") G DONE
;
I $$TMPFL^BQIUL1("R",UID,RECIEN) G DONE
;
F U IO R HSTEXT:.1 Q:HSTEXT[$C(9) D
. S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
. I HSTEXT="" S HSTEXT=" "
. S II=II+1,@DATA@(II)=HSTEXT_$C(13)_$C(10)
S II=II+1,@DATA@(II)=$C(30)
;
I $$TMPFL^BQIUL1("C") G DONE
;
I $$TMPFL^BQIUL1("D",UID,RECIEN) G DONE
;
DONE ;
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S @DATA@(II)="T01024REPORT_TEXT"_$C(30)
I $G(FILE)'="" D
. S TEXT="Record Data from "_$P(^DIC(FILE,0),U,1)_" file"
. S II=II+1,@DATA@(II)=$$C^XBFUNC(TEXT,80)
Q
BQIPTLNK ;VNGT/HS/ALA-Get patient record via Link ; 24 Apr 2009 10:42 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
EN(DATA,LINK) ; EP -- BQI GET LINK RECORD
+1 ;
+2 ;Description
+3 ; Returns a record for a patient's visit or problem or whatever type of data record
+4 ;Input
+5 ; LINK - File Number:Record Internal Entry Number
+6 ;
+7 NEW UID,II,FILE,RECIEN,TEXT
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQILINK",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTLNK D UNWIND^%ZTER"
+14 ;
+15 IF $GET(LINK)=""
DO HDR
GOTO DONE
+16 SET FILE=$PIECE(LINK,":",1)
SET RECIEN=$PIECE(LINK,":",2)
+17 IF FILE=9000010
DO GET^BQIPTVST(.DATA,RECIEN)
QUIT
+18 DO OTH
+19 ;I FILE=9000011 D EN^BQIRPL(.DATA,"","",RECIEN)
+20 QUIT
+21 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
OTH ;
+1 DO HDR
+2 ;
+3 IF $$TMPFL^BQIUL1("W",UID,RECIEN)
GOTO DONE
+4 ;
+5 SET IOSL=999
SET IOM=80
SET IOST="P-OTHER80"
+6 ;
+7 USE IO
+8 SET DIC=$$ROOT^DILFD(FILE)
SET DA=RECIEN
+9 DO EN^DIQ
+10 USE IO
WRITE $CHAR(9)
+11 ;
+12 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+13 ;
+14 IF $$TMPFL^BQIUL1("R",UID,RECIEN)
GOTO DONE
+15 ;
+16 FOR
USE IO
READ HSTEXT:.1
IF HSTEXT[$CHAR(9)
QUIT
Begin DoDot:1
+17 SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")
+18 IF HSTEXT=""
SET HSTEXT=" "
+19 SET II=II+1
SET @DATA@(II)=HSTEXT_$CHAR(13)_$CHAR(10)
End DoDot:1
+20 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+21 ;
+22 IF $$TMPFL^BQIUL1("C")
GOTO DONE
+23 ;
+24 IF $$TMPFL^BQIUL1("D",UID,RECIEN)
GOTO DONE
+25 ;
DONE ;
+1 ;
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
HDR ;
+1 SET @DATA@(II)="T01024REPORT_TEXT"_$CHAR(30)
+2 IF $GET(FILE)'=""
Begin DoDot:1
+3 SET TEXT="Record Data from "_$PIECE(^DIC(FILE,0),U,1)_" file"
+4 SET II=II+1
SET @DATA@(II)=$$C^XBFUNC(TEXT,80)
End DoDot:1
+5 QUIT
