- BQIPTCON ;GDHS/HSD/ALA-Consults by Patient ; 16 Feb 2016 1:15 PM
- ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
- ;
- ;
- CON(DATA,DFN,TMFRAME) ;EP -- BQI PATIENT CONSULTS
- ;
- ;Description - all the consults that a patient has
- ;
- ;Input
- ; DFN - Patient internal entry number
- ; TMFRAME - Timeframe
- ;
- NEW UID,II,HEADER,ENDT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPTCON",UID))
- K @DATA
- ;
- S TMFRAME=$G(TMFRAME,""),ENDT=""
- I TMFRAME'="" S ENDT=$$DATE^BQIUL1(TMFRAME)
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTRF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- NEW GMRCDAT,GMRCDA,GMRCYR,IFLDS,EFLDS
- I $G(IFLDS)="" D
- . D CNN Q
- . S ORD=17,IEN=$O(^BQI(90506.1,"AD","CN",ORD,"")),HDR=$P(^BQI(90506.1,IEN,0),"^",8)
- . S HEADER=HEADER_"^"_HDR
- ;
- S @DATA@(II)="I00010CON_IEN^"_HEADER_$C(30)
- ;
- S TMP=$NA(^TMP("BQICONSLT",$J)) K @TMP
- S GMRCYR=$S($G(ENDT)'="":9999999-ENDT,1:"")
- I GMRCYR="" D
- . S GMRCDAT=""
- . F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:GMRCDAT="" D LD
- ;
- I GMRCYR'="" D
- . S GMRCDAT=""
- . F S GMRCDAT=$O(^GMR(123,"AD",DFN,GMRCDAT)) Q:GMRCDAT=""!(GMRCDAT\1>GMRCYR) D LD
- ;
- S GIEN=""
- F S GIEN=$O(@TMP@(123,GIEN)) Q:GIEN="" D
- . D DA^DILF(GIEN,.DA)
- . S VALUE=""
- . S FLD="" F S FLD=$O(@TMP@(123,GIEN,FLD)) Q:FLD="" D
- .. S PO=$G(PORD(FLD))
- .. S VAL=$G(@TMP@(123,GIEN,FLD,"I")) I VAL'="",FLD=".01" S VAL=$$FMTE^BQIUL1(VAL)
- .. I VAL="" S VAL=$G(@TMP@(123,GIEN,FLD,"E"))
- .. I FLD=20 D
- ... S VAL=$G(@TMP@(123,GIEN,FLD,1))
- ... ;NEW CNN
- ... ;S CNN=GIEN,VAL=$$PURP^BQICONPL()
- .. I FLD=5 S VAL=$P(VAL," - ",2)
- .. S $P(VALUE,"^",PO)=VAL
- . S VALUE=DA_"^"_VALUE
- . S II=II+1,@DATA@(II)=VALUE_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- LD ;EP - Load data
- S GMRCDA=""
- F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA)) Q:GMRCDA="" D
- . D GETS^DIQ(123,GMRCDA_",",IFLDS,"I",TMP)
- . D GETS^DIQ(123,GMRCDA_",",EFLDS,"E",TMP)
- Q
- ;
- CNN ;EP
- NEW ORD,IEN,FLD,FIE
- S PFLDS=".01;1;8;10;13;14;.03;.04;.05;2;5;6;9;30;20;7"
- F I=1:1:$L(PFLDS,";") S FLD=$P(PFLDS,";",I),PDIS(I)=FLD,PORD(FLD)=I
- ;set up fields by display order
- S ORD="",EFLDS="",IFLDS="",HEADER="",ORDER=""
- F S ORD=$O(^BQI(90506.1,"AD","CN",ORD)) Q:ORD="" D
- . S IEN=""
- . F S IEN=$O(^BQI(90506.1,"AD","CN",ORD,IEN)) Q:IEN="" D
- .. S FLD=$$GET1^DIQ(90506.1,IEN_",",.06,"E"),FIE=$$GET1^DIQ(90506.1,IEN_",",.2,"I")
- .. I FLD="" Q
- .. I $P(^BQI(90506.1,IEN,0),"^",10)=1 K PORD(FLD) Q
- .. S PO=$G(PORD(FLD)) I PO="" Q
- .. S HDR=$P(^BQI(90506.1,IEN,0),"^",8),$P(HEADER,"^",PO)=HDR
- .. I FIE="" S FIE="E"
- .. I FIE="E" S EFLDS=EFLDS_FLD_";"
- .. I FIE="I" S IFLDS=IFLDS_FLD_";"
- S EFLDS=$$TKO^BQIUL1(EFLDS,";"),IFLDS=$$TKO^BQIUL1(IFLDS,";")
- Q
- BQIPTCON ;GDHS/HSD/ALA-Consults by Patient ; 16 Feb 2016 1:15 PM
- +1 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
- +2 ;
- +3 ;
- CON(DATA,DFN,TMFRAME) ;EP -- BQI PATIENT CONSULTS
- +1 ;
- +2 ;Description - all the consults that a patient has
- +3 ;
- +4 ;Input
- +5 ; DFN - Patient internal entry number
- +6 ; TMFRAME - Timeframe
- +7 ;
- +8 NEW UID,II,HEADER,ENDT
- +9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +10 SET DATA=$NAME(^TMP("BQIPTCON",UID))
- +11 KILL @DATA
- +12 ;
- +13 SET TMFRAME=$GET(TMFRAME,"")
- SET ENDT=""
- +14 IF TMFRAME'=""
- SET ENDT=$$DATE^BQIUL1(TMFRAME)
- +15 ;
- +16 SET II=0
- +17 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPTRF D UNWIND^%ZTER"
- +18 ;
- +19 NEW GMRCDAT,GMRCDA,GMRCYR,IFLDS,EFLDS
- +20 IF $GET(IFLDS)=""
- Begin DoDot:1
- +21 DO CNN
- QUIT
- +22 SET ORD=17
- SET IEN=$ORDER(^BQI(90506.1,"AD","CN",ORD,""))
- SET HDR=$PIECE(^BQI(90506.1,IEN,0),"^",8)
- +23 SET HEADER=HEADER_"^"_HDR
- End DoDot:1
- +24 ;
- +25 SET @DATA@(II)="I00010CON_IEN^"_HEADER_$CHAR(30)
- +26 ;
- +27 SET TMP=$NAME(^TMP("BQICONSLT",$JOB))
- KILL @TMP
- +28 SET GMRCYR=$SELECT($GET(ENDT)'="":9999999-ENDT,1:"")
- +29 IF GMRCYR=""
- Begin DoDot:1
- +30 SET GMRCDAT=""
- +31 FOR
- SET GMRCDAT=$ORDER(^GMR(123,"AD",DFN,GMRCDAT))
- IF GMRCDAT=""
- QUIT
- DO LD
- End DoDot:1
- +32 ;
- +33 IF GMRCYR'=""
- Begin DoDot:1
- +34 SET GMRCDAT=""
- +35 FOR
- SET GMRCDAT=$ORDER(^GMR(123,"AD",DFN,GMRCDAT))
- IF GMRCDAT=""!(GMRCDAT\1>GMRCYR)
- QUIT
- DO LD
- End DoDot:1
- +36 ;
- +37 SET GIEN=""
- +38 FOR
- SET GIEN=$ORDER(@TMP@(123,GIEN))
- IF GIEN=""
- QUIT
- Begin DoDot:1
- +39 DO DA^DILF(GIEN,.DA)
- +40 SET VALUE=""
- +41 SET FLD=""
- FOR
- SET FLD=$ORDER(@TMP@(123,GIEN,FLD))
- IF FLD=""
- QUIT
- Begin DoDot:2
- +42 SET PO=$GET(PORD(FLD))
- +43 SET VAL=$GET(@TMP@(123,GIEN,FLD,"I"))
- IF VAL'=""
- IF FLD=".01"
- SET VAL=$$FMTE^BQIUL1(VAL)
- +44 IF VAL=""
- SET VAL=$GET(@TMP@(123,GIEN,FLD,"E"))
- +45 IF FLD=20
- Begin DoDot:3
- +46 SET VAL=$GET(@TMP@(123,GIEN,FLD,1))
- +47 ;NEW CNN
- +48 ;S CNN=GIEN,VAL=$$PURP^BQICONPL()
- End DoDot:3
- +49 IF FLD=5
- SET VAL=$PIECE(VAL," - ",2)
- +50 SET $PIECE(VALUE,"^",PO)=VAL
- End DoDot:2
- +51 SET VALUE=DA_"^"_VALUE
- +52 SET II=II+1
- SET @DATA@(II)=VALUE_$CHAR(30)
- End DoDot:1
- +53 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +54 QUIT
- +55 ;
- LD ;EP - Load data
- +1 SET GMRCDA=""
- +2 FOR
- SET GMRCDA=$ORDER(^GMR(123,"AD",DFN,GMRCDAT,GMRCDA))
- IF GMRCDA=""
- QUIT
- Begin DoDot:1
- +3 DO GETS^DIQ(123,GMRCDA_",",IFLDS,"I",TMP)
- +4 DO GETS^DIQ(123,GMRCDA_",",EFLDS,"E",TMP)
- End DoDot:1
- +5 QUIT
- +6 ;
- CNN ;EP
- +1 NEW ORD,IEN,FLD,FIE
- +2 SET PFLDS=".01;1;8;10;13;14;.03;.04;.05;2;5;6;9;30;20;7"
- +3 FOR I=1:1:$LENGTH(PFLDS,";")
- SET FLD=$PIECE(PFLDS,";",I)
- SET PDIS(I)=FLD
- SET PORD(FLD)=I
- +4 ;set up fields by display order
- +5 SET ORD=""
- SET EFLDS=""
- SET IFLDS=""
- SET HEADER=""
- SET ORDER=""
- +6 FOR
- SET ORD=$ORDER(^BQI(90506.1,"AD","CN",ORD))
- IF ORD=""
- QUIT
- Begin DoDot:1
- +7 SET IEN=""
- +8 FOR
- SET IEN=$ORDER(^BQI(90506.1,"AD","CN",ORD,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:2
- +9 SET FLD=$$GET1^DIQ(90506.1,IEN_",",.06,"E")
- SET FIE=$$GET1^DIQ(90506.1,IEN_",",.2,"I")
- +10 IF FLD=""
- QUIT
- +11 IF $PIECE(^BQI(90506.1,IEN,0),"^",10)=1
- KILL PORD(FLD)
- QUIT
- +12 SET PO=$GET(PORD(FLD))
- IF PO=""
- QUIT
- +13 SET HDR=$PIECE(^BQI(90506.1,IEN,0),"^",8)
- SET $PIECE(HEADER,"^",PO)=HDR
- +14 IF FIE=""
- SET FIE="E"
- +15 IF FIE="E"
- SET EFLDS=EFLDS_FLD_";"
- +16 IF FIE="I"
- SET IFLDS=IFLDS_FLD_";"
- End DoDot:2
- End DoDot:1
- +17 SET EFLDS=$$TKO^BQIUL1(EFLDS,";")
- SET IFLDS=$$TKO^BQIUL1(IFLDS,";")
- +18 QUIT
