- 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 ;
