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
