- 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
