VENPCCYV ; IHS/OIT/GIS - COMPONENT FRAMEWORK ; MANAGE VISIT CONTEXT
;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
;
;
PPRV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PROVIDER NAME
; CALLED BY THE BMX SCHEMA
I '$D(^AUPNVPRV("AD",+$G(VIEN))) Q ""
N NAME,PIEN,VPIEN,X,Y,Z,%
S VPIEN=0,PIEN=""
F S VPIEN=$O(^AUPNVPRV("AD",VIEN,VPIEN)) Q:'VPIEN D I PIEN Q
. S X=$G(^AUPNVPRV(VPIEN,0)) I X="" Q
. S TYPE=$P(X,U,4)
. I TYPE="P" S PIEN=+X
. Q
I 'PIEN S VPIEN=$O(^AUPNVPRV("AD",VIEN,0)) I VPIEN S PIEN=+$G(^AUPNVPRV(VPIEN,0))
I 'PIEN Q ""
S PIEN=$$PRV^VENPCCU(PIEN)
S NAME=$P($G(^VA(200,PIEN,0)),U)
Q NAME
;
PPOV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PURPOSE OF VISIT ICD CODE (NARRATIVE)
; CALLED BY BMX SCHEMA
I '$D(^AUPNVPOV("AD",+$G(VIEN))) Q ""
N TXT,IIEN,VPIEN,X,Y,Z,%,ICD,NIEN,DX
S VPIEN=0,IIEN=""
F S VPIEN=$O(^AUPNVPOV("AD",VIEN,VPIEN)) Q:'VPIEN D I IIEN Q
. S X=$G(^AUPNVPOV(VPIEN,0)) I X="" Q
. S TYPE=$P(X,U,12)
. I TYPE="P" S IIEN=+X
. Q
I 'IIEN S VPIEN=$O(^AUPNVPOV("AD",VIEN,0)) I VPIEN S IIEN=+$G(^AUPNVPOV(VPIEN,0))
I IIEN,VPIEN
E Q ""
S ICD=$P($G(^ICD9(IIEN,0)),U) I '$L(ICD) Q ""
S NIEN=$P($G(^AUPNVPOV(VPIEN,0)),U,4) I 'NIEN Q ""
S TXT=$P($G(^AUTNPOV(NIEN,0)),U) I TXT="" Q ""
I $L(TXT)>20 S TXT=$E(TXT,1,17)_"..."
S DX=ICD_" ("_TXT_")"
Q DX
;
NEWV(VIEN,TS,NVIEN) ; EP - RPC: VEN CF CLONE VISIT AND RETURN THE NEW VISIT IEN
; GIVEN A PAST VISIT IEN AND NEW TIMESTAMP: CREATE A NEW VISIT AND NEW V POV & V PROVIDER ENTRIES
I $D(^AUPNVSIT(+$G(VIEN),0)),$G(TS)
E Q
N DA,DIK,DIC,DIE,X,Y,Z,%,PRVIEN,POVIEN,NPRVIEN,NPOVIEN
S POVIEN=$O(^AUPNVPOV("AD",VIEN,0)) I 'POVIEN Q
S PRVIEN=$O(^AUPNVPRV("AD",VIEN,0)) I 'PRVIEN Q
; AT THIS POINT YOU HAVE A VALID SOURCE VISIT AND V FILES
S NVIEN=$O(^AUPNVSIT(999999999999),-1) I 'NVIEN Q
S NVIEN=NVIEN+1
M ^AUPNVSIT(NVIEN)=^AUPNVSIT(VIEN)
S $P(^AUPNVSIT(NVIEN,0),U)=TS ; RESET VISIT TIMESTAMP
S DA=NVIEN,DIK="^AUPNVSIT(" D IX1^DIK ; SET THE INDEXES
S NPOVIEN=$O(^AUPNVPOV(999999999999),-1)+1 ; MAKE NEW V POV ENTRY
M ^AUPNVPOV(NPOVIEN)=^AUPNVPOV(POVIEN)
S $P(^AUPNVPOV(NPOVIEN,0),U,3)=NVIEN
S DA=NPOVIEN,DIK="^AUPNVPOV(" D IX1^DIK
S NPRVIEN=$O(^AUPNVPRV(999999999999),-1)+1 ; MAKE A NEW V PROVIDER ENTRY
M ^AUPNVPRV(NPRVIEN)=^AUPNVPRV(PRVIEN)
S $P(^AUPNVPRV(NPRVIEN,0),U,3)=NVIEN
S DA=NPRVIEN,DIK="^AUPNVPRV(" D IX1^DIK
S $P(^AUPNVSIT(NVIEN,0),U,9)=2 ; RESET DEPENDENT ENTRY COUNT
S $P(^AUPNVSIT(NVIEN,0),U,2)=DT ; RESET DATE VISIT CRATED
D ^XBFMK
Q
;
VALV(DFN,IENS,MAX,OUT,TOT) ; EP - VALID VISIT ITERATION FOR BMX SCHEMA
; ONLY VALID VISITS ARE RETURNED
I '$O(^AUPNVSIT("AA",+$G(DFN),0)) Q ""
N IDT,VIEN,CNT,FIN,END,%
S IDT=0,CNT=0,FIN=0
S END=9999999-$G(START)
I 'MAX S MAX=99
F Q:FIN S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:'IDT S VIEN=999999999999 F Q:FIN S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN),-1) Q:'VIEN D Q
. I IDT>END S FIN=1 Q
. S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q ; VISIT DATA MUST EXIST
. I $P(X,U,11) Q ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
. I $P(X,U,3)="" Q ; VISIT MUST HAVE A TYPE
. I '$P(X,U,6) Q ; MUST HAVE A VALID ENCOUNTER LOCATION
. I $P(X,U,7)="" Q ; VISIT MUST HAVE A CATEGORY
. I $P(X,U,8)="" Q ; VISIT MUST HAVE A VALID CLINIC FIN
. ; I '$D(^AUPNVPOV("AD",VIEN)) Q ; MUST HAVE A POV ; PATCHED BY GIS 4/27/2009
. I '$D(^AUPNVPRV("AD",VIEN)) Q ; MUST HAVE A PROVIDER
. S DA=VIEN,IENS=DA_C
. D DATA^BMXADOV1(IENS,DA)
. S CNT=CNT+1
. I CNT=MAX S FIN=1
. Q
Q ""
;
VENPCCYV ; IHS/OIT/GIS - COMPONENT FRAMEWORK ; MANAGE VISIT CONTEXT
+1 ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
+2 ;
+3 ;
PPRV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PROVIDER NAME
+1 ; CALLED BY THE BMX SCHEMA
+2 IF '$DATA(^AUPNVPRV("AD",+$GET(VIEN)))
QUIT ""
+3 NEW NAME,PIEN,VPIEN,X,Y,Z,%
+4 SET VPIEN=0
SET PIEN=""
+5 FOR
SET VPIEN=$ORDER(^AUPNVPRV("AD",VIEN,VPIEN))
IF 'VPIEN
QUIT
Begin DoDot:1
+6 SET X=$GET(^AUPNVPRV(VPIEN,0))
IF X=""
QUIT
+7 SET TYPE=$PIECE(X,U,4)
+8 IF TYPE="P"
SET PIEN=+X
+9 QUIT
End DoDot:1
IF PIEN
QUIT
+10 IF 'PIEN
SET VPIEN=$ORDER(^AUPNVPRV("AD",VIEN,0))
IF VPIEN
SET PIEN=+$GET(^AUPNVPRV(VPIEN,0))
+11 IF 'PIEN
QUIT ""
+12 SET PIEN=$$PRV^VENPCCU(PIEN)
+13 SET NAME=$PIECE($GET(^VA(200,PIEN,0)),U)
+14 QUIT NAME
+15 ;
PPOV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PURPOSE OF VISIT ICD CODE (NARRATIVE)
+1 ; CALLED BY BMX SCHEMA
+2 IF '$DATA(^AUPNVPOV("AD",+$GET(VIEN)))
QUIT ""
+3 NEW TXT,IIEN,VPIEN,X,Y,Z,%,ICD,NIEN,DX
+4 SET VPIEN=0
SET IIEN=""
+5 FOR
SET VPIEN=$ORDER(^AUPNVPOV("AD",VIEN,VPIEN))
IF 'VPIEN
QUIT
Begin DoDot:1
+6 SET X=$GET(^AUPNVPOV(VPIEN,0))
IF X=""
QUIT
+7 SET TYPE=$PIECE(X,U,12)
+8 IF TYPE="P"
SET IIEN=+X
+9 QUIT
End DoDot:1
IF IIEN
QUIT
+10 IF 'IIEN
SET VPIEN=$ORDER(^AUPNVPOV("AD",VIEN,0))
IF VPIEN
SET IIEN=+$GET(^AUPNVPOV(VPIEN,0))
+11 IF IIEN
IF VPIEN
+12 IF '$TEST
QUIT ""
+13 SET ICD=$PIECE($GET(^ICD9(IIEN,0)),U)
IF '$LENGTH(ICD)
QUIT ""
+14 SET NIEN=$PIECE($GET(^AUPNVPOV(VPIEN,0)),U,4)
IF 'NIEN
QUIT ""
+15 SET TXT=$PIECE($GET(^AUTNPOV(NIEN,0)),U)
IF TXT=""
QUIT ""
+16 IF $LENGTH(TXT)>20
SET TXT=$EXTRACT(TXT,1,17)_"..."
+17 SET DX=ICD_" ("_TXT_")"
+18 QUIT DX
+19 ;
NEWV(VIEN,TS,NVIEN) ; EP - RPC: VEN CF CLONE VISIT AND RETURN THE NEW VISIT IEN
+1 ; GIVEN A PAST VISIT IEN AND NEW TIMESTAMP: CREATE A NEW VISIT AND NEW V POV & V PROVIDER ENTRIES
+2 IF $DATA(^AUPNVSIT(+$GET(VIEN),0))
IF $GET(TS)
+3 IF '$TEST
QUIT
+4 NEW DA,DIK,DIC,DIE,X,Y,Z,%,PRVIEN,POVIEN,NPRVIEN,NPOVIEN
+5 SET POVIEN=$ORDER(^AUPNVPOV("AD",VIEN,0))
IF 'POVIEN
QUIT
+6 SET PRVIEN=$ORDER(^AUPNVPRV("AD",VIEN,0))
IF 'PRVIEN
QUIT
+7 ; AT THIS POINT YOU HAVE A VALID SOURCE VISIT AND V FILES
+8 SET NVIEN=$ORDER(^AUPNVSIT(999999999999),-1)
IF 'NVIEN
QUIT
+9 SET NVIEN=NVIEN+1
+10 MERGE ^AUPNVSIT(NVIEN)=^AUPNVSIT(VIEN)
+11 ; RESET VISIT TIMESTAMP
SET $PIECE(^AUPNVSIT(NVIEN,0),U)=TS
+12 ; SET THE INDEXES
SET DA=NVIEN
SET DIK="^AUPNVSIT("
DO IX1^DIK
+13 ; MAKE NEW V POV ENTRY
SET NPOVIEN=$ORDER(^AUPNVPOV(999999999999),-1)+1
+14 MERGE ^AUPNVPOV(NPOVIEN)=^AUPNVPOV(POVIEN)
+15 SET $PIECE(^AUPNVPOV(NPOVIEN,0),U,3)=NVIEN
+16 SET DA=NPOVIEN
SET DIK="^AUPNVPOV("
DO IX1^DIK
+17 ; MAKE A NEW V PROVIDER ENTRY
SET NPRVIEN=$ORDER(^AUPNVPRV(999999999999),-1)+1
+18 MERGE ^AUPNVPRV(NPRVIEN)=^AUPNVPRV(PRVIEN)
+19 SET $PIECE(^AUPNVPRV(NPRVIEN,0),U,3)=NVIEN
+20 SET DA=NPRVIEN
SET DIK="^AUPNVPRV("
DO IX1^DIK
+21 ; RESET DEPENDENT ENTRY COUNT
SET $PIECE(^AUPNVSIT(NVIEN,0),U,9)=2
+22 ; RESET DATE VISIT CRATED
SET $PIECE(^AUPNVSIT(NVIEN,0),U,2)=DT
+23 DO ^XBFMK
+24 QUIT
+25 ;
VALV(DFN,IENS,MAX,OUT,TOT) ; EP - VALID VISIT ITERATION FOR BMX SCHEMA
+1 ; ONLY VALID VISITS ARE RETURNED
+2 IF '$ORDER(^AUPNVSIT("AA",+$GET(DFN),0))
QUIT ""
+3 NEW IDT,VIEN,CNT,FIN,END,%
+4 SET IDT=0
SET CNT=0
SET FIN=0
+5 SET END=9999999-$GET(START)
+6 IF 'MAX
SET MAX=99
+7 FOR
IF FIN
QUIT
SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))
IF 'IDT
QUIT
SET VIEN=999999999999
FOR
IF FIN
QUIT
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:1
+8 IF IDT>END
SET FIN=1
QUIT
+9 ; VISIT DATA MUST EXIST
SET X=$GET(^AUPNVSIT(VIEN,0))
IF '$LENGTH(X)
QUIT
+10 ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
IF $PIECE(X,U,11)
QUIT
+11 ; VISIT MUST HAVE A TYPE
IF $PIECE(X,U,3)=""
QUIT
+12 ; MUST HAVE A VALID ENCOUNTER LOCATION
IF '$PIECE(X,U,6)
QUIT
+13 ; VISIT MUST HAVE A CATEGORY
IF $PIECE(X,U,7)=""
QUIT
+14 ; VISIT MUST HAVE A VALID CLINIC FIN
IF $PIECE(X,U,8)=""
QUIT
+15 ; I '$D(^AUPNVPOV("AD",VIEN)) Q ; MUST HAVE A POV ; PATCHED BY GIS 4/27/2009
+16 ; MUST HAVE A PROVIDER
IF '$DATA(^AUPNVPRV("AD",VIEN))
QUIT
+17 SET DA=VIEN
SET IENS=DA_C
+18 DO DATA^BMXADOV1(IENS,DA)
+19 SET CNT=CNT+1
+20 IF CNT=MAX
SET FIN=1
+21 QUIT
End DoDot:1
QUIT
+22 QUIT ""
+23 ;
