BPCSC2 ; IHS/OIT/MJL - SPECIAL X-REF ROUTINES - ; [ 12/06/2007 11:53 AM ]
;;1.5;BPC;**1,4**;OCT 04, 2005
;
; BPCGREF - Primary Global Reference
; BPCSBJGR - Subject Global Reference - Used if all of the entries are to be used under this node -- don't need to check a date
; BPCRVCRO - Reverse chronological date subscripted
;
SETUP ;
S BGUCRFS=""
S BPCVWNO=$P(BGUEND,"`",2),BPCLBONL=$P(BGUEND,"`",3),BPCRVCRO=1
S BPCVWOPT=$P(BGUEND,"`",4),BGUMAX=$S('BPCVWOPT:BPCVWNO,1:999999999)
S (BGUBEGIN,BGUEND,BPCXLEVL)="",BPCC=0
Q
;
VISIT ;
I BPCSBJGR="" S BPCC=BPCC+1,BGUSUB(1)=BPCVIEN,BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(BPCVIEN,"N") D FIELDS^BGULIST Q
S BPCSIEN=0 F S BPCSIEN=$O(@BPCSBJGR@(BPCSIEN)) Q:'BPCSIEN S BPCC=BPCC+1,BGUSUB(1)=BPCSIEN,BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(BPCSIEN,"N") D FIELDS^BGULIST
Q
;
VSDTRNG ; Get visits for a patient for a date range
S BPCGREF=$G(BPCGREF,"^AUPNVSIT(""AA"",BPCPIEN)")
S BPCPIEN=$P(BGUBEGIN,"`"),BGUBEGIN=$P(BGUBEGIN,"`",2)
D VSDTDR
Q
VSDTDR ;
I '$D(BGUDRIVR) D Q
.S BGUDRIVR="VSDTDR^BPCSC2",BPCSDATE=BGUBEGIN,BPCEDATE=$P(BGUEND,"`",1)
.S BPCSDATE=$P(BGUEND,"`",1),BPCEDATE=$P(BGUEND,"`",2)
.S BPCVWNO=$P(BGUEND,"`",3),BPCLBONL=$P(BGUEND,"`",4)
.S BPCVWOPT=$P(BGUEND,"`",5),BGUMAX=$S('BPCVWOPT:BPCVWNO,1:999999)
.D SETUP
S BPCVWOPT="2",BPCSBJGR=$G(BPCSBJGR)
D VSDTDR1,KILL
Q
VSDTDR1 ;
S:'(+BPCVWNO) BPCVWNO=10 S:BPCSDATE="" BPCSDATE="1/1/1980"
S:BPCEDATE="" BPCEDATE="T" S:BPCVWOPT="" BPCVWOPT="0"
S:BPCLBONL="" BPCLBONL="1"
D DT^DILF("",BPCSDATE,.BPCSDAT)
I BPCSDAT=-1 S BPCSDATE="1/1/1980" D DT^DILF("",BPCSDATE,.BPCSDAT)
D DT^DILF("",BPCEDATE,.BPCEDAT)
I BPCEDAT=-1 S BPCEDATE="T" D DT^DILF("",BPCEDATE,.BPCEDAT)
S BPCC=0,BPCX=0,BPCLIM=$S(BPCVWOPT="0":BPCVWNO,1:999999)
I BPCRVCRO S BPCSDAT=9999999-BPCSDAT,BPCEDAT=9999999-BPCEDAT
I BPCXLEVL'="" D @BPCXLEVL Q
VSDTDR2 ;
I BPCRVCRO D Q
.S BPCX=$O(@BPCGREF@(BPCEDAT),-1) F S BPCX=$O(@BPCGREF@(BPCX)) Q:'BPCX Q:BPCX\1>BPCSDAT D Q:BPCC=BPCLIM
..S BPCVIEN=0 F S BPCVIEN=$O(@BPCGREF@(BPCX,BPCVIEN)) Q:'BPCVIEN Q:BPCC=BPCLIM D VISIT
S BPCX=$O(@BPCGREF@(BPCSDAT),-1) F S BPCX=$O(@BPCGREF@(BPCX)) Q:'BPCX Q:BPCX\1>BPCEDAT D Q:BPCC=BPCLIM
.S BPCVIEN=0 F S BPCVIEN=$O(@BPCGREF@(BPCX,BPCVIEN)) Q:'BPCVIEN Q:BPCC=BPCLIM D VISIT
Q
;
VED ; Get V PATIENT ED
;
S BPCGREF="^AUPNVPED(""AA"",BPCPIEN)"
D VSDTRNG
Q
;
VHF ; Get V HEALTH FACTORS
S BPCGREF="^AUPNVHF(""AA"",BPCPIEN)",BPCXLEVL="VHF1"
D VSDTRNG
Q
;
VHF1 ; V HEALTH FACTORS XTRA level
S BPCGREF="^AUPNVHF(""AA"",BPCPIEN,BPCXL)"
S BPCXL=0 F S BPCXL=$O(@BPCGREF) Q:'BPCXL D VSDTDR2
Q
;
VEXAM ; Get V EXAMS
S BPCGREF="^AUPNVXAM(""AA"",BPCPIEN)",BPCXLEVL="VEXAM1"
D VSDTRNG
Q
;
VEXAM1 ; V EXAMS XTRA level
S BPCGREF="^AUPNVXAM(""AA"",BPCPIEN,BPCXL)"
S BPCXL=0 F S BPCXL=$O(@BPCGREF) Q:'BPCXL D VSDTDR2
Q
;
ACTVCN ; Get Active Chart number -- only necessary for BPCDIVALL - Set BPCDUZ2=Loc of first active Chart.
;
S BPCDZ2=0,BPCDUZ2=0 F S BPCDZ2=$O(^AUPNPAT(BGUSVSB1(1),41,BPCDZ2)) Q:'BPCDZ2 D Q:'BPCDZ2
.S BPCX=^AUPNPAT(BGUSVSB1(1),41,BPCDZ2,0) I $P(BPCX,U,5)="" D
..I $G(BGUSVSUB(1))="D",BGUBEGIN'=$P(BPCX,U,2) Q
..S BPCDUZ2=BPCDZ2,BPCDZ2=0 Q
S BGUV(BGUFILE,414141)=BPCDUZ2 K BPCDZ2,BPCX
Q
;
ACTVCNG ;
S BPCDZ2=0,BPCDUZ2=0 F S BPCDZ2=$O(^AUPNPAT(BGUSUB(1),41,BPCDZ2)) Q:'BPCDZ2 D Q:'BPCDZ2
.S BPCX=^AUPNPAT(BGUSUB(1),41,BPCDZ2,0) I $P(BPCX,U,5)="" S BPCDUZ2=BPCDZ2,BPCDZ2=0 Q
S BGUV(BGUFILE,414141)=BPCDUZ2 K BPCDZ2,BPCX
Q
;
CSV(BPCCD,BPCDATE) ;
S BPCCSVR=$S(BGUGBL="^ICPT(":"CPT^ICPTCOD",1:"") Q:BPCCSVR=""
S @("BPCCSV="_"(""$$""_BPCCSVR_""(""_BPCCD_"",""_BPCDATE_"")"")")
S @("BPCCSV="_BPCCSV),BPCCSV=$P(BPCCSV,U,3)
S BGUV(BGUFILE,123123)=BPCCSV
Q
;
KILL ;
K BGUDRIVR,BPCC,BPCEDATE,BPCGREF,BPCGROUP,BPCLBONL,BPCLIM,BPCPIEN,BPCSBJGR,BPCSDATE,BPCSIEN,BPCRVCRO,BPCVIEN,BPCVWNO,BPCVWOPT,BPCX,BPCXL,BPCXLEVL
Q
BPCSC2 ; IHS/OIT/MJL - SPECIAL X-REF ROUTINES - ; [ 12/06/2007 11:53 AM ]
+1 ;;1.5;BPC;**1,4**;OCT 04, 2005
+2 ;
+3 ; BPCGREF - Primary Global Reference
+4 ; BPCSBJGR - Subject Global Reference - Used if all of the entries are to be used under this node -- don't need to check a date
+5 ; BPCRVCRO - Reverse chronological date subscripted
+6 ;
SETUP ;
+1 SET BGUCRFS=""
+2 SET BPCVWNO=$PIECE(BGUEND,"`",2)
SET BPCLBONL=$PIECE(BGUEND,"`",3)
SET BPCRVCRO=1
+3 SET BPCVWOPT=$PIECE(BGUEND,"`",4)
SET BGUMAX=$SELECT('BPCVWOPT:BPCVWNO,1:999999999)
+4 SET (BGUBEGIN,BGUEND,BPCXLEVL)=""
SET BPCC=0
+5 QUIT
+6 ;
VISIT ;
+1 IF BPCSBJGR=""
SET BPCC=BPCC+1
SET BGUSUB(1)=BPCVIEN
SET BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(BPCVIEN,"N")
DO FIELDS^BGULIST
QUIT
+2 SET BPCSIEN=0
FOR
SET BPCSIEN=$ORDER(@BPCSBJGR@(BPCSIEN))
IF 'BPCSIEN
QUIT
SET BPCC=BPCC+1
SET BGUSUB(1)=BPCSIEN
SET BGUV(BGUFILE,88888)=$$PRIMPROV^APCLV(BPCSIEN,"N")
DO FIELDS^BGULIST
+3 QUIT
+4 ;
VSDTRNG ; Get visits for a patient for a date range
+1 SET BPCGREF=$GET(BPCGREF,"^AUPNVSIT(""AA"",BPCPIEN)")
+2 SET BPCPIEN=$PIECE(BGUBEGIN,"`")
SET BGUBEGIN=$PIECE(BGUBEGIN,"`",2)
+3 DO VSDTDR
+4 QUIT
VSDTDR ;
+1 IF '$DATA(BGUDRIVR)
Begin DoDot:1
+2 SET BGUDRIVR="VSDTDR^BPCSC2"
SET BPCSDATE=BGUBEGIN
SET BPCEDATE=$PIECE(BGUEND,"`",1)
+3 SET BPCSDATE=$PIECE(BGUEND,"`",1)
SET BPCEDATE=$PIECE(BGUEND,"`",2)
+4 SET BPCVWNO=$PIECE(BGUEND,"`",3)
SET BPCLBONL=$PIECE(BGUEND,"`",4)
+5 SET BPCVWOPT=$PIECE(BGUEND,"`",5)
SET BGUMAX=$SELECT('BPCVWOPT:BPCVWNO,1:999999)
+6 DO SETUP
End DoDot:1
QUIT
+7 SET BPCVWOPT="2"
SET BPCSBJGR=$GET(BPCSBJGR)
+8 DO VSDTDR1
DO KILL
+9 QUIT
VSDTDR1 ;
+1 IF '(+BPCVWNO)
SET BPCVWNO=10
IF BPCSDATE=""
SET BPCSDATE="1/1/1980"
+2 IF BPCEDATE=""
SET BPCEDATE="T"
IF BPCVWOPT=""
SET BPCVWOPT="0"
+3 IF BPCLBONL=""
SET BPCLBONL="1"
+4 DO DT^DILF("",BPCSDATE,.BPCSDAT)
+5 IF BPCSDAT=-1
SET BPCSDATE="1/1/1980"
DO DT^DILF("",BPCSDATE,.BPCSDAT)
+6 DO DT^DILF("",BPCEDATE,.BPCEDAT)
+7 IF BPCEDAT=-1
SET BPCEDATE="T"
DO DT^DILF("",BPCEDATE,.BPCEDAT)
+8 SET BPCC=0
SET BPCX=0
SET BPCLIM=$SELECT(BPCVWOPT="0":BPCVWNO,1:999999)
+9 IF BPCRVCRO
SET BPCSDAT=9999999-BPCSDAT
SET BPCEDAT=9999999-BPCEDAT
+10 IF BPCXLEVL'=""
DO @BPCXLEVL
QUIT
VSDTDR2 ;
+1 IF BPCRVCRO
Begin DoDot:1
+2 SET BPCX=$ORDER(@BPCGREF@(BPCEDAT),-1)
FOR
SET BPCX=$ORDER(@BPCGREF@(BPCX))
IF 'BPCX
QUIT
IF BPCX\1>BPCSDAT
QUIT
Begin DoDot:2
+3 SET BPCVIEN=0
FOR
SET BPCVIEN=$ORDER(@BPCGREF@(BPCX,BPCVIEN))
IF 'BPCVIEN
QUIT
IF BPCC=BPCLIM
QUIT
DO VISIT
End DoDot:2
IF BPCC=BPCLIM
QUIT
End DoDot:1
QUIT
+4 SET BPCX=$ORDER(@BPCGREF@(BPCSDAT),-1)
FOR
SET BPCX=$ORDER(@BPCGREF@(BPCX))
IF 'BPCX
QUIT
IF BPCX\1>BPCEDAT
QUIT
Begin DoDot:1
+5 SET BPCVIEN=0
FOR
SET BPCVIEN=$ORDER(@BPCGREF@(BPCX,BPCVIEN))
IF 'BPCVIEN
QUIT
IF BPCC=BPCLIM
QUIT
DO VISIT
End DoDot:1
IF BPCC=BPCLIM
QUIT
+6 QUIT
+7 ;
VED ; Get V PATIENT ED
+1 ;
+2 SET BPCGREF="^AUPNVPED(""AA"",BPCPIEN)"
+3 DO VSDTRNG
+4 QUIT
+5 ;
VHF ; Get V HEALTH FACTORS
+1 SET BPCGREF="^AUPNVHF(""AA"",BPCPIEN)"
SET BPCXLEVL="VHF1"
+2 DO VSDTRNG
+3 QUIT
+4 ;
VHF1 ; V HEALTH FACTORS XTRA level
+1 SET BPCGREF="^AUPNVHF(""AA"",BPCPIEN,BPCXL)"
+2 SET BPCXL=0
FOR
SET BPCXL=$ORDER(@BPCGREF)
IF 'BPCXL
QUIT
DO VSDTDR2
+3 QUIT
+4 ;
VEXAM ; Get V EXAMS
+1 SET BPCGREF="^AUPNVXAM(""AA"",BPCPIEN)"
SET BPCXLEVL="VEXAM1"
+2 DO VSDTRNG
+3 QUIT
+4 ;
VEXAM1 ; V EXAMS XTRA level
+1 SET BPCGREF="^AUPNVXAM(""AA"",BPCPIEN,BPCXL)"
+2 SET BPCXL=0
FOR
SET BPCXL=$ORDER(@BPCGREF)
IF 'BPCXL
QUIT
DO VSDTDR2
+3 QUIT
+4 ;
ACTVCN ; Get Active Chart number -- only necessary for BPCDIVALL - Set BPCDUZ2=Loc of first active Chart.
+1 ;
+2 SET BPCDZ2=0
SET BPCDUZ2=0
FOR
SET BPCDZ2=$ORDER(^AUPNPAT(BGUSVSB1(1),41,BPCDZ2))
IF 'BPCDZ2
QUIT
Begin DoDot:1
+3 SET BPCX=^AUPNPAT(BGUSVSB1(1),41,BPCDZ2,0)
IF $PIECE(BPCX,U,5)=""
Begin DoDot:2
+4 IF $GET(BGUSVSUB(1))="D"
IF BGUBEGIN'=$PIECE(BPCX,U,2)
QUIT
+5 SET BPCDUZ2=BPCDZ2
SET BPCDZ2=0
QUIT
End DoDot:2
End DoDot:1
IF 'BPCDZ2
QUIT
+6 SET BGUV(BGUFILE,414141)=BPCDUZ2
KILL BPCDZ2,BPCX
+7 QUIT
+8 ;
ACTVCNG ;
+1 SET BPCDZ2=0
SET BPCDUZ2=0
FOR
SET BPCDZ2=$ORDER(^AUPNPAT(BGUSUB(1),41,BPCDZ2))
IF 'BPCDZ2
QUIT
Begin DoDot:1
+2 SET BPCX=^AUPNPAT(BGUSUB(1),41,BPCDZ2,0)
IF $PIECE(BPCX,U,5)=""
SET BPCDUZ2=BPCDZ2
SET BPCDZ2=0
QUIT
End DoDot:1
IF 'BPCDZ2
QUIT
+3 SET BGUV(BGUFILE,414141)=BPCDUZ2
KILL BPCDZ2,BPCX
+4 QUIT
+5 ;
CSV(BPCCD,BPCDATE) ;
+1 SET BPCCSVR=$SELECT(BGUGBL="^ICPT(":"CPT^ICPTCOD",1:"")
IF BPCCSVR=""
QUIT
+2 SET @("BPCCSV="_"(""$$""_BPCCSVR_""(""_BPCCD_"",""_BPCDATE_"")"")")
+3 SET @("BPCCSV="_BPCCSV)
SET BPCCSV=$PIECE(BPCCSV,U,3)
+4 SET BGUV(BGUFILE,123123)=BPCCSV
+5 QUIT
+6 ;
KILL ;
+1 KILL BGUDRIVR,BPCC,BPCEDATE,BPCGREF,BPCGROUP,BPCLBONL,BPCLIM,BPCPIEN,BPCSBJGR,BPCSDATE,BPCSIEN,BPCRVCRO,BPCVIEN,BPCVWNO,BPCVWOPT,BPCX,BPCXL,BPCXLEVL
+2 QUIT
